/[gcl]/gcl/ansi-tests/numbers-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/numbers-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Wed Apr 9 02:27:57 2003 UTC revision 1.2 by pfdietz, Sun Aug 3 21:05:22 2003 UTC
# Line 11  Line 11 
11          (loop for y in *numbers*          (loop for y in *numbers*
12                unless (if (= x y) (= y x) (not (= y x)))                unless (if (= x y) (= y x) (not (= y x)))
13                collect (list x y))))                collect (list x y))))
14    
15    (defun /=.4-fn ()
16      (loop for x in *numbers*
17            append
18            (loop for y in *numbers*
19                  unless (if (/= x y) (/= y x) (not (/= y x)))
20                  collect (list x y))))
21    
22    (defun /=.4a-fn ()
23      (loop for x in *numbers*
24            append
25            (loop for y in *numbers*
26                  when (if (= x y)
27                           (/= x y)
28                         (not (/= x y)))
29                  collect (list x y))))
30    
31    (defun <.8-fn ()
32      (loop for x in *numbers*
33            when (realp x)
34            nconc
35            (loop for y in *numbers*
36                  when (and (realp y) (and (< x y) (> x y)))
37                  collect (list x y))))
38    
39    (defun <.9-fn ()
40      (loop for x in *numbers*
41            when (realp x)
42            nconc
43            (loop for y in *numbers*
44                  when (and (realp y) (if (< x y)
45                                          (not (> y x))
46                                        (> y x)))
47                  collect (list x y))))
48    
49    (defun <.10-fn ()
50      (loop for x in *numbers*
51            when (realp x)
52            nconc
53            (loop for y in *numbers*
54                  when (and (realp y) (if (< x y)
55                                          (>= x y)
56                                        (not (>= x y))))
57                  collect (list x y))))
58    
59    (defun <=.8-fn ()
60      (loop for x in *numbers*
61            when (realp x)
62            nconc
63            (loop for y in *numbers*
64                  when (and (realp y) (if (<= x y) (not (>= y x))
65                                        (>= y x)))
66                  collect (list x y))))
67    
68    (defun <=.9-fn ()
69      (loop for x in *numbers*
70            when (realp x)
71            nconc
72            (loop for y in *numbers*
73                  when (and (realp y)
74                            (if (<= x y) (not (or (= x y) (< x y)))
75                              (or (= x y) (< x y))))
76                  collect (list x y))))
77    
78    (defun >.8-fn ()
79      (loop for x in *numbers*
80            when (realp x)
81            nconc
82            (loop for y in *numbers*
83                  when (and (realp y) (if (> x y)
84                                          (<= x y)
85                                        (not (<= x y))))
86                  collect (list x y))))
87    
88    (defun >=.8-fn ()
89      (loop for x in *numbers*
90            when (realp x)
91            nconc
92            (loop for y in *numbers*
93                  when (and (realp y)
94                            (if (>= x y) (not (or (= x y) (> x y)))
95                              (or (= x y) (> x y))))
96                  collect (list x y))))
97    
98    ;;; Comparison of rationsls
99    
100    (defun compare-random-rationals (n m rep)
101      (loop for a = (- (random n) m)
102            for b = (- (random n) m)
103            for c = (- (random n) m)
104            for d = (- (random n) m)
105            repeat rep
106            when
107            (and (/= b 0)
108                 (/= d 0)
109                 (let ((q1 (/ a b))
110                       (q2 (/ c d))
111                       (ad (* a d))
112                       (bc (* b c)))
113                   (when (< (* b d) 0)
114                     (setq ad (- ad))
115                     (setq bc (- bc)))
116                   (or (if (< q1 q2) (not (< ad bc)) (< ad bc))
117                       (if (<= q1 q2) (not (<= ad bc)) (<= ad bc))
118                       (if (> q1 q2) (not (> ad bc)) (> ad bc))
119                       (if (>= q1 q2) (not (>= ad bc)) (>= ad bc))
120                       (if (= q1 q2) (not (= ad bc)) (= ad bc))
121                       (if (/= q1 q2) (not (/= ad bc)) (/= ad bc)))))
122            collect (list a b c d)))
123    
124                      
125            

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26