1 665c255d 2023-08-04 jrmu ;; Exercise 2.79.  Define a generic equality predicate equ? that tests the equality of two numbers, and install it in the generic arithmetic package. This operation should work for ordinary numbers, rational numbers, and complex numbers. 
  2 665c255d 2023-08-04 jrmu 
  3 665c255d 2023-08-04 jrmu ;; Exercise 2.80.  Define a generic predicate =zero? that tests if its argument is zero, and install it in the generic arithmetic package. This operation should work for ordinary numbers, rational numbers, and complex numbers. 
  4 665c255d 2023-08-04 jrmu 
  5 665c255d 2023-08-04 jrmu (define (attach-tag type-tag contents)
  6 665c255d 2023-08-04 jrmu   (if (eq? type-tag 'scheme-number)
  7 665c255d 2023-08-04 jrmu       contents
  8 665c255d 2023-08-04 jrmu       (cons type-tag contents)))
  9 665c255d 2023-08-04 jrmu (define (type-tag datum)
 10 665c255d 2023-08-04 jrmu   (cond ((number? datum) 'scheme-number)
 11 665c255d 2023-08-04 jrmu 	((pair? datum) (car datum))
 12 665c255d 2023-08-04 jrmu 	((error "error -- invalid datum" datum))))
 13 665c255d 2023-08-04 jrmu (define (contents datum)
 14 665c255d 2023-08-04 jrmu   (cond ((number? datum) datum)
 15 665c255d 2023-08-04 jrmu 	((pair? datum) (cdr datum))
 16 665c255d 2023-08-04 jrmu 	((error "error -- invalid datum" datum))))
 17 665c255d 2023-08-04 jrmu 
 18 665c255d 2023-08-04 jrmu (define (make-table)
 19 665c255d 2023-08-04 jrmu   (define (assoc key records)
 20 665c255d 2023-08-04 jrmu     (cond ((null? records) false)
 21 665c255d 2023-08-04 jrmu 	  ((equal? key (caar records)) (car records))
 22 665c255d 2023-08-04 jrmu 	  (else (assoc key (cdr records)))))
 23 665c255d 2023-08-04 jrmu   (let ((local-table (list '*table*)))
 24 665c255d 2023-08-04 jrmu     (define (lookup key-1 key-2)
 25 665c255d 2023-08-04 jrmu       (let ((subtable (assoc key-1 (cdr local-table))))
 26 665c255d 2023-08-04 jrmu 	(if subtable
 27 665c255d 2023-08-04 jrmu 	    (let ((record (assoc key-2 (cdr subtable))))
 28 665c255d 2023-08-04 jrmu 	      (if record
 29 665c255d 2023-08-04 jrmu 		  (cdr record)
 30 665c255d 2023-08-04 jrmu 		  false))
 31 665c255d 2023-08-04 jrmu 	    false)))
 32 665c255d 2023-08-04 jrmu     (define (insert! key-1 key-2 value)
 33 665c255d 2023-08-04 jrmu       (let ((subtable (assoc key-1 (cdr local-table))))
 34 665c255d 2023-08-04 jrmu 	(if subtable
 35 665c255d 2023-08-04 jrmu 	    (let ((record (assoc key-2 (cdr subtable))))
 36 665c255d 2023-08-04 jrmu 	      (if record
 37 665c255d 2023-08-04 jrmu 		  (set-cdr! record value)
 38 665c255d 2023-08-04 jrmu 		  (set-cdr! subtable
 39 665c255d 2023-08-04 jrmu 			    (cons (cons key-2 value)
 40 665c255d 2023-08-04 jrmu 				  (cdr subtable)))))
 41 665c255d 2023-08-04 jrmu 	    (set-cdr! local-table
 42 665c255d 2023-08-04 jrmu 		      (cons (list key-1
 43 665c255d 2023-08-04 jrmu 				  (cons key-2 value))
 44 665c255d 2023-08-04 jrmu 			    (cdr local-table)))))
 45 665c255d 2023-08-04 jrmu       'ok)
 46 665c255d 2023-08-04 jrmu     (define (dispatch m)
 47 665c255d 2023-08-04 jrmu       (cond ((eq? m 'lookup-proc) lookup)
 48 665c255d 2023-08-04 jrmu 	    ((eq? m 'insert-proc!) insert!)
 49 665c255d 2023-08-04 jrmu 	    (else (error "Unknown operation -- TABLE" m))))
 50 665c255d 2023-08-04 jrmu     dispatch))
 51 665c255d 2023-08-04 jrmu 
 52 665c255d 2023-08-04 jrmu (define operation-table (make-table))
 53 665c255d 2023-08-04 jrmu (define get (operation-table 'lookup-proc))
 54 665c255d 2023-08-04 jrmu (define put (operation-table 'insert-proc!))
 55 665c255d 2023-08-04 jrmu 
 56 665c255d 2023-08-04 jrmu (define (apply-generic op . args)
 57 665c255d 2023-08-04 jrmu   (let* ((type-tags (map type-tag args))
 58 665c255d 2023-08-04 jrmu 	 (proc (get op type-tags)))
 59 665c255d 2023-08-04 jrmu     (if proc
 60 665c255d 2023-08-04 jrmu 	(apply proc (map contents args))
 61 665c255d 2023-08-04 jrmu 	(error "error -- procedure not found" (list op args)))))
 62 665c255d 2023-08-04 jrmu 
 63 665c255d 2023-08-04 jrmu (define (add x y) (apply-generic 'add x y))
 64 665c255d 2023-08-04 jrmu (define (sub x y) (apply-generic 'sub x y))
 65 665c255d 2023-08-04 jrmu (define (mul x y) (apply-generic 'mul x y))
 66 665c255d 2023-08-04 jrmu (define (div x y) (apply-generic 'div x y))
 67 665c255d 2023-08-04 jrmu (define (equ? x y) (apply-generic 'equ? x y))
 68 665c255d 2023-08-04 jrmu (define (=zero? x) (apply-generic '=zero? x))
 69 665c255d 2023-08-04 jrmu 
 70 665c255d 2023-08-04 jrmu (define (install-scheme-number-package)
 71 665c255d 2023-08-04 jrmu   (define (tag x) (attach-tag 'scheme-number x))
 72 665c255d 2023-08-04 jrmu   (put 'add '(scheme-number scheme-number)
 73 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (+ x y))))
 74 665c255d 2023-08-04 jrmu   (put 'sub '(scheme-number scheme-number) 
 75 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (- x y))))
 76 665c255d 2023-08-04 jrmu   (put 'mul '(scheme-number scheme-number)
 77 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (* x y))))
 78 665c255d 2023-08-04 jrmu   (put 'div '(scheme-number scheme-number)
 79 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (/ x y))))
 80 665c255d 2023-08-04 jrmu   (put 'equ? '(scheme-number scheme-number) =)
 81 665c255d 2023-08-04 jrmu   (put '=zero? '(scheme-number) zero?)
 82 665c255d 2023-08-04 jrmu   (put 'make 'scheme-number
 83 665c255d 2023-08-04 jrmu        (lambda (n) (tag n)))
 84 665c255d 2023-08-04 jrmu   'done)
 85 665c255d 2023-08-04 jrmu 
 86 665c255d 2023-08-04 jrmu (define (install-rational-package)
 87 665c255d 2023-08-04 jrmu   (define (gcd a b)
 88 665c255d 2023-08-04 jrmu     (if (= b 0)
 89 665c255d 2023-08-04 jrmu 	a
 90 665c255d 2023-08-04 jrmu 	(gcd b (remainder a b))))
 91 665c255d 2023-08-04 jrmu   (define (numer x) (car x))
 92 665c255d 2023-08-04 jrmu   (define (denom x) (cdr x))
 93 665c255d 2023-08-04 jrmu   (define (make-rat n d)
 94 665c255d 2023-08-04 jrmu     (let ((g (gcd n d)))
 95 665c255d 2023-08-04 jrmu       (cons (/ n g) (/ d g))))
 96 665c255d 2023-08-04 jrmu   (define (add-rat x y)
 97 665c255d 2023-08-04 jrmu     (make-rat (+ (* (numer x) (denom y))
 98 665c255d 2023-08-04 jrmu 		 (* (numer y) (denom x)))
 99 665c255d 2023-08-04 jrmu 	      (* (denom x) (denom y))))
100 665c255d 2023-08-04 jrmu   (define (sub-rat x y)
101 665c255d 2023-08-04 jrmu     (make-rat (- (* (numer x) (denom y))
102 665c255d 2023-08-04 jrmu 		 (* (numer y) (denom x)))
103 665c255d 2023-08-04 jrmu 	      (* (denom x) (denom y))))
104 665c255d 2023-08-04 jrmu   (define (mul-rat x y)
105 665c255d 2023-08-04 jrmu     (make-rat (* (numer x) (numer y))
106 665c255d 2023-08-04 jrmu 	      (* (denom x) (denom y))))
107 665c255d 2023-08-04 jrmu   (define (div-rat x y)
108 665c255d 2023-08-04 jrmu     (make-rat (* (numer x) (denom y))
109 665c255d 2023-08-04 jrmu 	      (* (denom x) (numer y))))
110 665c255d 2023-08-04 jrmu   (define (equ-rat? x y)
111 665c255d 2023-08-04 jrmu     (and (= (numer x) (numer y))
112 665c255d 2023-08-04 jrmu 	 (= (denom x) (denom y))))
113 665c255d 2023-08-04 jrmu   (define (=zero-rat? x) (= (numer x) 0))
114 665c255d 2023-08-04 jrmu   (define (tag x) (attach-tag 'rational x))
115 665c255d 2023-08-04 jrmu   (put 'add '(rational rational) 
116 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (add-rat x y))))
117 665c255d 2023-08-04 jrmu   (put 'sub '(rational rational) 
118 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (sub-rat x y))))
119 665c255d 2023-08-04 jrmu   (put 'mul '(rational rational) 
120 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (mul-rat x y))))
121 665c255d 2023-08-04 jrmu   (put 'div '(rational rational) 
122 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (div-rat x y))))
123 665c255d 2023-08-04 jrmu   (put 'equ? '(rational rational) equ-rat?)
124 665c255d 2023-08-04 jrmu   (put '=zero? '(rational) =zero-rat?)
125 665c255d 2023-08-04 jrmu   (put 'make 'rational
126 665c255d 2023-08-04 jrmu        (lambda (n d) (tag (make-rat n d))))
127 665c255d 2023-08-04 jrmu   'done)
128 665c255d 2023-08-04 jrmu 
129 665c255d 2023-08-04 jrmu (define (install-complex-package)
130 665c255d 2023-08-04 jrmu   (define (make-from-real-imag x y)
131 665c255d 2023-08-04 jrmu     ((get 'make-from-real-imag 'rectangular) x y))
132 665c255d 2023-08-04 jrmu   (define (make-from-mag-ang r a)
133 665c255d 2023-08-04 jrmu     ((get 'make-from-mag-ang 'polar) r a))
134 665c255d 2023-08-04 jrmu 
135 665c255d 2023-08-04 jrmu   (define (real-part z) (apply-generic 'real-part z))
136 665c255d 2023-08-04 jrmu   (define (imag-part z) (apply-generic 'imag-part z))
137 665c255d 2023-08-04 jrmu   (define (magnitude z) (apply-generic 'magnitude z))
138 665c255d 2023-08-04 jrmu   (define (angle z) (apply-generic 'angle z))
139 665c255d 2023-08-04 jrmu 
140 665c255d 2023-08-04 jrmu   ;; rectangular and polar representations...
141 665c255d 2023-08-04 jrmu 
142 665c255d 2023-08-04 jrmu   (define (install-complex-rectangular)
143 665c255d 2023-08-04 jrmu     (define (make-from-real-imag-rectangular x y)
144 665c255d 2023-08-04 jrmu       (cons x y))
145 665c255d 2023-08-04 jrmu     (define (make-from-mag-ang-rectangular r a)
146 665c255d 2023-08-04 jrmu       (cons (* r (cos a)) (* r (sin a))))
147 665c255d 2023-08-04 jrmu     (define (real-part z) (car z))
148 665c255d 2023-08-04 jrmu     (define (imag-part z) (cdr z))
149 665c255d 2023-08-04 jrmu     (define (magnitude z)
150 665c255d 2023-08-04 jrmu       (sqrt (+ (square (real-part z)) 
151 665c255d 2023-08-04 jrmu 	       (square (imag-part z)))))
152 665c255d 2023-08-04 jrmu     (define (angle z) (atan (imag-part z) (real-part z)))
153 665c255d 2023-08-04 jrmu     (define (tag x) (attach-tag 'rectangular x))
154 665c255d 2023-08-04 jrmu     (put 'real-part '(rectangular) real-part)
155 665c255d 2023-08-04 jrmu     (put 'imag-part '(rectangular) imag-part)
156 665c255d 2023-08-04 jrmu     (put 'magnitude '(rectangular) magnitude)
157 665c255d 2023-08-04 jrmu     (put 'angle '(rectangular) angle)
158 665c255d 2023-08-04 jrmu     (put 'make-from-real-imag 'rectangular
159 665c255d 2023-08-04 jrmu 	 (lambda (x y) (tag (make-from-real-imag-rectangular x y))))
160 665c255d 2023-08-04 jrmu     (put 'make-from-mag-ang 'rectangular
161 665c255d 2023-08-04 jrmu 	 (lambda (r a) (tag (make-from-mag-ang-rectangular r a))))
162 665c255d 2023-08-04 jrmu     'done)
163 665c255d 2023-08-04 jrmu   (define (install-complex-polar)
164 665c255d 2023-08-04 jrmu     (define (make-from-real-imag-polar x y)
165 665c255d 2023-08-04 jrmu       (cons (sqrt (+ (square x) (square y)))
166 665c255d 2023-08-04 jrmu 	    (atan y x)))
167 665c255d 2023-08-04 jrmu     (define (make-from-mag-ang-polar r a)
168 665c255d 2023-08-04 jrmu       (cons r a))
169 665c255d 2023-08-04 jrmu     (define (real-part z) (* (magnitude z) (cos (angle z))))
170 665c255d 2023-08-04 jrmu     (define (imag-part z) (* (magnitude z) (sin (angle z))))
171 665c255d 2023-08-04 jrmu     (define (magnitude z) (car z))
172 665c255d 2023-08-04 jrmu     (define (angle z) (cdr z))
173 665c255d 2023-08-04 jrmu     (define (tag x) (attach-tag 'polar x))
174 665c255d 2023-08-04 jrmu     (put 'real-part '(polar) real-part)
175 665c255d 2023-08-04 jrmu     (put 'imag-part '(polar) imag-part)
176 665c255d 2023-08-04 jrmu     (put 'magnitude '(polar) magnitude)
177 665c255d 2023-08-04 jrmu     (put 'angle '(polar) angle)
178 665c255d 2023-08-04 jrmu     (put 'make-from-real-imag 'polar
179 665c255d 2023-08-04 jrmu 	 (lambda (x y) (tag (make-from-real-imag-polar x y))))
180 665c255d 2023-08-04 jrmu     (put 'make-from-mag-ang 'polar
181 665c255d 2023-08-04 jrmu 	 (lambda (r a) (tag (make-from-mag-ang-polar r a))))
182 665c255d 2023-08-04 jrmu     'done)  
183 665c255d 2023-08-04 jrmu   (install-complex-rectangular)
184 665c255d 2023-08-04 jrmu   (install-complex-polar)
185 665c255d 2023-08-04 jrmu   ;; end rectangular and polar representations
186 665c255d 2023-08-04 jrmu 
187 665c255d 2023-08-04 jrmu   (define (add-complex z1 z2)
188 665c255d 2023-08-04 jrmu     (make-from-real-imag (+ (real-part z1) (real-part z2))
189 665c255d 2023-08-04 jrmu 			 (+ (imag-part z1) (imag-part z2))))
190 665c255d 2023-08-04 jrmu   (define (sub-complex z1 z2)
191 665c255d 2023-08-04 jrmu     (make-from-real-imag (- (real-part z1) (real-part z2))
192 665c255d 2023-08-04 jrmu 			 (- (imag-part z1) (imag-part z2))))
193 665c255d 2023-08-04 jrmu   (define (mul-complex z1 z2)
194 665c255d 2023-08-04 jrmu     (make-from-mag-ang (* (magnitude z1) (magnitude z2))
195 665c255d 2023-08-04 jrmu 		       (+ (angle z1) (angle z2))))
196 665c255d 2023-08-04 jrmu   (define (div-complex z1 z2)
197 665c255d 2023-08-04 jrmu     (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
198 665c255d 2023-08-04 jrmu 		       (- (angle z1) (angle z2))))
199 665c255d 2023-08-04 jrmu   (define (equ-complex? z1 z2)
200 665c255d 2023-08-04 jrmu     (or (and (= (real-part z1) (real-part z2))
201 665c255d 2023-08-04 jrmu 	     (= (imag-part z1) (imag-part z2))) ;; in case of rounding error
202 665c255d 2023-08-04 jrmu 	(and (= (magnitude z1) (magnitude z2))
203 665c255d 2023-08-04 jrmu 	     (= (angle z1) (angle z2)))))
204 665c255d 2023-08-04 jrmu   (define (=zero-complex? z) 
205 665c255d 2023-08-04 jrmu     (and (= (real-part z) 0)
206 665c255d 2023-08-04 jrmu 	 (= (imag-part z) 0)))
207 665c255d 2023-08-04 jrmu 
208 665c255d 2023-08-04 jrmu   (define (tag x) (attach-tag 'complex x))
209 665c255d 2023-08-04 jrmu   (put 'add '(complex complex) 
210 665c255d 2023-08-04 jrmu        (lambda (z1 z2) (tag (add-complex z1 z2))))
211 665c255d 2023-08-04 jrmu   (put 'sub '(complex complex) 
212 665c255d 2023-08-04 jrmu        (lambda (z1 z2) (tag (sub-complex z1 z2))))
213 665c255d 2023-08-04 jrmu   (put 'mul '(complex complex) 
214 665c255d 2023-08-04 jrmu        (lambda (z1 z2) (tag (mul-complex z1 z2))))
215 665c255d 2023-08-04 jrmu   (put 'div '(complex complex) 
216 665c255d 2023-08-04 jrmu        (lambda (z1 z2) (tag (div-complex z1 z2))))
217 665c255d 2023-08-04 jrmu   (put 'equ? '(complex complex) equ-complex?)
218 665c255d 2023-08-04 jrmu   (put '=zero? '(complex) =zero-complex?)
219 665c255d 2023-08-04 jrmu   (put 'make-from-real-imag 'complex 
220 665c255d 2023-08-04 jrmu        (lambda (x y) (tag (make-from-real-imag x y))))
221 665c255d 2023-08-04 jrmu   (put 'make-from-mag-ang 'complex 
222 665c255d 2023-08-04 jrmu        (lambda (r a) (tag (make-from-mag-ang r a))))
223 665c255d 2023-08-04 jrmu   'done)
224 665c255d 2023-08-04 jrmu 
225 665c255d 2023-08-04 jrmu (define (make-scheme-number n)
226 665c255d 2023-08-04 jrmu   ((get 'make 'scheme-number) n))
227 665c255d 2023-08-04 jrmu (define (make-rational n d)
228 665c255d 2023-08-04 jrmu   ((get 'make 'rational) n d))
229 665c255d 2023-08-04 jrmu (define (make-complex-from-real-imag x y) 
230 665c255d 2023-08-04 jrmu   ((get 'make-from-real-imag 'complex) x y))
231 665c255d 2023-08-04 jrmu (define (make-complex-from-mag-ang r a) 
232 665c255d 2023-08-04 jrmu   ((get 'make-from-mag-ang 'complex) r a))
233 665c255d 2023-08-04 jrmu 
234 665c255d 2023-08-04 jrmu 
235 665c255d 2023-08-04 jrmu ;; install number packages
236 665c255d 2023-08-04 jrmu 
237 665c255d 2023-08-04 jrmu (install-scheme-number-package)
238 665c255d 2023-08-04 jrmu (install-rational-package)
239 665c255d 2023-08-04 jrmu (install-complex-package)
240 665c255d 2023-08-04 jrmu 
241 665c255d 2023-08-04 jrmu 
242 665c255d 2023-08-04 jrmu (define (test-case actual expected)
243 665c255d 2023-08-04 jrmu   (newline)
244 665c255d 2023-08-04 jrmu   (display "Actual:   ")
245 665c255d 2023-08-04 jrmu   (display actual)
246 665c255d 2023-08-04 jrmu   (newline)
247 665c255d 2023-08-04 jrmu   (display "Expected: ")
248 665c255d 2023-08-04 jrmu   (display expected)
249 665c255d 2023-08-04 jrmu   (newline))
250 665c255d 2023-08-04 jrmu 
251 665c255d 2023-08-04 jrmu (test-case (equ? (div (make-scheme-number 81)
252 665c255d 2023-08-04 jrmu 		      (mul (make-scheme-number 2)
253 665c255d 2023-08-04 jrmu 			   (make-scheme-number 4.5)))
254 665c255d 2023-08-04 jrmu 		 (add (make-scheme-number 4)
255 665c255d 2023-08-04 jrmu 		      (make-scheme-number 5)))
256 665c255d 2023-08-04 jrmu 	   #t)
257 665c255d 2023-08-04 jrmu (test-case (equ? (div (make-rational 4 2)
258 665c255d 2023-08-04 jrmu 		      (make-rational 1 3))
259 665c255d 2023-08-04 jrmu 		 (sub (make-rational 9 1)
260 665c255d 2023-08-04 jrmu 		      (mul (make-rational 4 1)
261 665c255d 2023-08-04 jrmu 			   (make-rational 3 4))))
262 665c255d 2023-08-04 jrmu 	   #t)
263 665c255d 2023-08-04 jrmu (test-case (equ? (add (make-complex-from-real-imag 3 4)
264 665c255d 2023-08-04 jrmu 		      (make-complex-from-real-imag -5 -3))
265 665c255d 2023-08-04 jrmu 		 '(complex rectangular -2 . 1))
266 665c255d 2023-08-04 jrmu 	   #t)
267 665c255d 2023-08-04 jrmu (test-case (equ? (div (make-scheme-number 80)
268 665c255d 2023-08-04 jrmu 		      (mul (make-scheme-number 2)
269 665c255d 2023-08-04 jrmu 			   (make-scheme-number 4.5)))
270 665c255d 2023-08-04 jrmu 		 (add (make-scheme-number 4)
271 665c255d 2023-08-04 jrmu 		      (make-scheme-number 5)))
272 665c255d 2023-08-04 jrmu 	   #f)
273 665c255d 2023-08-04 jrmu (test-case (equ? (div (make-rational 4 3)
274 665c255d 2023-08-04 jrmu 		      (make-rational 1 3))
275 665c255d 2023-08-04 jrmu 		 (sub (make-rational 9 1)
276 665c255d 2023-08-04 jrmu 		      (mul (make-rational 4 1)
277 665c255d 2023-08-04 jrmu 			   (make-rational 3 4))))
278 665c255d 2023-08-04 jrmu 	   #f)
279 665c255d 2023-08-04 jrmu (test-case (equ? (add (make-complex-from-real-imag 3 4.5)
280 665c255d 2023-08-04 jrmu 		      (make-complex-from-real-imag -5 -3))
281 665c255d 2023-08-04 jrmu 		 '(complex rectangular -2 . 1))
282 665c255d 2023-08-04 jrmu 	   #f)
283 665c255d 2023-08-04 jrmu (test-case (=zero? (sub (div (make-scheme-number 81)
284 665c255d 2023-08-04 jrmu 			     (mul (make-scheme-number 2)
285 665c255d 2023-08-04 jrmu 				  (make-scheme-number 4.5)))
286 665c255d 2023-08-04 jrmu 			(add (make-scheme-number 4)
287 665c255d 2023-08-04 jrmu 			     (make-scheme-number 5))))
288 665c255d 2023-08-04 jrmu 	   #t)
289 665c255d 2023-08-04 jrmu (test-case (=zero? (sub (div (make-rational 4 2)
290 665c255d 2023-08-04 jrmu 			     (make-rational 1 3))
291 665c255d 2023-08-04 jrmu 			(sub (make-rational 9 1)
292 665c255d 2023-08-04 jrmu 			     (mul (make-rational 4 1)
293 665c255d 2023-08-04 jrmu 				  (make-rational 3 4)))))
294 665c255d 2023-08-04 jrmu 	   #t)
295 665c255d 2023-08-04 jrmu (test-case (=zero? (sub (add (make-complex-from-real-imag 3 4)
296 665c255d 2023-08-04 jrmu 			     (make-complex-from-real-imag -5 -3))
297 665c255d 2023-08-04 jrmu 			'(complex rectangular -2 . 1)))
298 665c255d 2023-08-04 jrmu 	   #t)
299 665c255d 2023-08-04 jrmu (test-case (=zero? (sub (div (make-scheme-number 81)
300 665c255d 2023-08-04 jrmu 			     (mul (make-scheme-number 2)
301 665c255d 2023-08-04 jrmu 				  (make-scheme-number 4.5)))
302 665c255d 2023-08-04 jrmu 			(add (make-scheme-number 3.5)
303 665c255d 2023-08-04 jrmu 			     (make-scheme-number 5))))
304 665c255d 2023-08-04 jrmu 	   #f)
305 665c255d 2023-08-04 jrmu (test-case (=zero? (sub (div (make-rational 4 3)
306 665c255d 2023-08-04 jrmu 			     (make-rational 1 3))
307 665c255d 2023-08-04 jrmu 			(sub (make-rational 9 1)
308 665c255d 2023-08-04 jrmu 			     (mul (make-rational 4 1)
309 665c255d 2023-08-04 jrmu 				  (make-rational 3 4)))))
310 665c255d 2023-08-04 jrmu 	   #f)
311 665c255d 2023-08-04 jrmu (test-case (=zero? (sub (add (make-complex-from-real-imag 3 5)
312 665c255d 2023-08-04 jrmu 			     (make-complex-from-real-imag -5 -3))
313 665c255d 2023-08-04 jrmu 			'(complex rectangular -2 . 1)))
314 665c255d 2023-08-04 jrmu 	   #f)