1 files changed, 201 insertions, 6 deletions
diff --git a/coding-exercises/2/83/install-complex.rkt b/coding-exercises/2/83/install-complex.rkt
index 17b479f..e3dfe52 100644
--- a/coding-exercises/2/83/install-complex.rkt
+++ b/coding-exercises/2/83/install-complex.rkt
@@ -1,9 +1,204 @@
 #lang racket
 (provide install-complex)
-(require "../78/install-complex-package.rkt"
-         "../../../shared/data-directed-programming.rkt")
+(require "../../../shared/data-directed-programming.rkt")
 
-(define (install-complex apply-and-drop get put)
-    (install-complex-package apply-and-drop get put)
-    (put 'project '(complex) (lambda (z)
-                               ((get 'make 'real) (apply-and-drop 'real-part z)))))
+(define (install-rectangular-package apply-fn put)
+  ;; import methods
+  (define (add a b)
+    (apply-fn 'add a b))
+  (define (sub a b)
+    (apply-fn 'sub a b))
+  (define (mul a b)
+    (apply-fn 'mul a b))
+  (define (div a b)
+    (apply-fn 'div a b))
+  (define (cos a)
+    (apply-fn 'cos a))
+  (define (sin a)
+    (apply-fn 'sin a))
+  (define (sqr a)
+    (apply-fn 'sqr a))
+  (define (sqrt a)
+    (apply-fn 'sqrt a))
+  (define (atan a b)
+    (apply-fn 'atan a b))
+
+  ;; selectors
+  (define (real-part z) (car z))
+  (define (imag-part z) (cdr z))
+
+  ;; generic selectors
+  (define (magnitude z) (sqrt (add (sqr (real-part z))
+                                   (sqr (imag-part z)))))
+  (define (angle z) (atan (imag-part z) (real-part z)))
+
+  ;; constructors
+  (define (make-from-real-imag x y) (cons x y))
+  (define (make-from-mag-ang r a)
+    (cons (mul r (cos a))
+          (mul r (sin a))))
+
+  ;; interface part
+  (define (typtag x)
+    (attach-tag 'rectangular x))
+
+  (put 'real-part '(rectangular) real-part)
+  (put 'imag-part '(rectangular) imag-part)
+  (put 'magnitude '(rectangular) magnitude)
+  (put 'angle '(rectangular) angle)
+  (put 'make-from-real-imag 'rectangular
+       (lambda (x y) (typtag (make-from-real-imag x y))))
+  (put 'make-from-mag-ang 'rectangular
+       (lambda (r a) (typtag (make-from-mag-ang r a))))
+  'done)
+
+(define (install-polar-package apply-fn put)
+  ;; import methods
+  (define (mul a b)
+    (apply-fn 'mul a b))
+  (define (cos a)
+    (apply-fn 'cos a))
+  (define (sin a)
+    (apply-fn 'sin a))
+  (define (sqr a)
+    (apply-fn 'sqr a))
+  (define (sqrt a)
+    (apply-fn 'sqrt a))
+  (define (atan a b)
+    (apply-fn 'atan a b))
+
+  ;; selectors
+  (define (magnitude z)
+      (car z))
+  (define (angle z)
+    (cdr z))
+  (define (make-from-mag-ang r a)
+    (cons r a))
+
+    ;; generic selectors
+  (define (real-part z)
+      (mul (magnitude z)
+           (cos (angle z))))
+  (define (imag-part z)
+    (mul (magnitude z)
+       (sin (angle z))))
+
+  ;; constructor
+  (define (make-from-real-imag x y)
+    (cons (sqrt (+ (sqr x) (sqr y)))
+          (atan y x)))
+
+  ;; register in data-driven package)
+  (define (typtag x)
+    (attach-tag 'polar x))
+  (put 'real-part '(polar) real-part)
+  (put 'imag-part '(polar) imag-part)
+  (put 'magnitude '(polar) magnitude)
+  (put 'angle '(polar) angle)
+  (put 'make-from-real-imag 'polar (lambda (x y) (typtag (make-from-real-imag x y))))
+  (put 'make-from-mag-ang 'polar (lambda (r a) (typtag (make-from-mag-ang r a))))
+  'done)
+
+(define (install-complex apply-fn get put)
+  ;; import methods
+  (define (add a b)
+    (apply-fn 'add a b))
+  (define (sub a b)
+    (apply-fn 'sub a b))
+  (define (mul a b)
+    (apply-fn 'mul a b))
+  (define (div a b)
+    (apply-fn 'div a b))
+  (define (cos a)
+    (apply-fn 'cos a))
+  (define (sin a)
+    (apply-fn 'sin a))
+  (define (sqr a)
+    (apply-fn 'sqr a))
+  (define (sqrt a)
+    (apply-fn 'sqrt a))
+  (define (atan a b)
+    (apply-fn 'atan a b))
+  (define (=zero? a)
+    (apply-fn '=zero? a))
+  (define (equ? a b)
+    (apply-fn 'equ? a b))
+  (install-rectangular-package apply-fn put)
+  (install-polar-package apply-fn put)
+
+  ;; constructors
+  (define (make-from-real-imag x y)
+    ((get 'make-from-real-imag 'rectangular) x y))
+  (define (make-from-mag-ang r a)
+    ((get 'make-from-mag-ang 'polar) r a))
+
+  ;; selectors
+  (define (real-part z)
+    (apply-fn 'real-part z))
+  (define (imag-part z)
+    (apply-fn 'imag-part z))
+  (define (magnitude z)
+    (apply-fn 'magnitude z))
+  (define (angle z)
+    (apply-fn 'angle z))
+
+  ;; internal
+  (define (add-complex z1 z2)
+    (make-from-real-imag (add (real-part z1) (real-part z2))
+                         (add (imag-part z1) (imag-part z2))))
+  (define (sub-complex z1 z2)
+    (make-from-real-imag (sub (real-part z1) (real-part z2))
+                         (sub (imag-part z1) (imag-part z2))))
+  (define (mul-complex z1 z2)
+    (make-from-mag-ang (mul (magnitude z1) (magnitude z2))
+                       (add (angle z1) (angle z2))))
+  (define (div-complex z1 z2)
+    (newline)
+    (display "DIV-COMPLEX")
+    (newline)
+    (display (list z1 z2))
+    (newline)
+    (display (list (magnitude z1) (magnitude z2)))
+    (make-from-mag-ang (div (magnitude z1) (magnitude z2))
+                       (sub (angle z1) (angle z2))))
+
+  ;; predicates (...) -> bool
+  (define (complex-equ? z1 z2)
+    (and (equ? (real-part z1) (real-part z2))
+         (equ? (imag-part z1) (imag-part z2))))
+  (define (complex-=zero? z)
+    (and (=zero? (real-part z))
+         (=zero? (imag-part z))))
+
+  ;; interface
+  (define (typetag z) (attach-tag 'complex z))
+  (put 'real-part '(complex) real-part)
+  (put 'imag-part '(complex) imag-part)
+  (put 'magnitude '(complex) magnitude)
+  (put 'angle '(complex) angle)
+
+  (put 'add '(complex complex)
+       (lambda (z1 z2) (typetag (add-complex z1 z2))))
+  (put 'neg '(complex)
+       (lambda (z) (typetag (make-from-real-imag (- (real-part z))
+                                                 (- (imag-part z))))))
+  (put 'sub '(complex complex)
+       (lambda (z1 z2) (typetag (sub-complex z1 z2))))
+  (put 'mul '(complex complex)
+       (lambda (z1 z2) (typetag (mul-complex z1 z2))))
+  (put 'div '(complex complex)
+       (lambda (z1 z2) (typetag (div-complex z1 z2))))
+
+  (put 'equ? '(complex complex)
+       (lambda (z1 z2) (complex-equ? z1 z2)))
+  (put '=zero? '(complex)
+       (lambda (z1) (complex-=zero? z1)))
+
+  (put 'make-from-real-imag 'complex
+       (lambda (x y) (typetag (make-from-real-imag x y))))
+  (put 'make-from-mag-ang 'complex
+       (lambda (r a) (typetag (make-from-mag-ang r a))))
+
+  (put 'project '(complex) (lambda (z)
+                             ((get 'make 'real) (apply-fn 'real-part z))))
+  'done)