5 files changed, 390 insertions, 25 deletions
diff --git a/coding-exercises/2/78/complex-polar.rkt b/coding-exercises/2/78/complex-polar.rkt
index 725f387..41a81a1 100644
--- a/coding-exercises/2/78/complex-polar.rkt
+++ b/coding-exercises/2/78/complex-polar.rkt
@@ -2,20 +2,42 @@
 (provide install-polar-package)
 (require "../../../shared/data-directed-programming.rkt")
 
-(define (install-polar-package apply-generic put)
+(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))
+      (car z)
+    (define (angle z)
+      (cdr z))
+    (define (make-from-mag-ang r a)
+      (cons r a)))
+
+    ;; generic selectors
   (define (real-part z)
-    (apply-generic 'mul (magnitude z) (apply-generic 'cos (angle z))))
+      (mul (magnitude z)
+         (cos (angle z))))
   (define (imag-part z)
-    (apply-generic 'mul (magnitude z) (apply-generic 'sin (angle 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))
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)
diff --git a/coding-exercises/2/83/install-real.rkt b/coding-exercises/2/83/install-real.rkt
index 6b96137..356ac92 100644
--- a/coding-exercises/2/83/install-real.rkt
+++ b/coding-exercises/2/83/install-real.rkt
@@ -3,11 +3,15 @@
 (require "../../../shared/data-directed-programming.rkt")
 
 (define (install-real put get)
+  (define threshold 0.00001)
   ;; local methods
   (define (tagme datum)
     (attach-tag 'real datum))
   (define (make i)
-    (exact->inexact i))
+    (let ((n (exact->inexact i)))
+      (if (< n threshold)
+        0.0
+        n)))
   (define (raiseme r)
     ((get 'make-from-real-imag 'complex) r 0))
   ;; constructor
@@ -29,5 +33,5 @@
   (put 'atan '(real real) (lambda (x y) (atan x y)))
   ;; predicates
   (put 'equ? '(real real) (lambda (x y) (= x y)))
-  (put '=zero? '(real) (lambda (x) (= 0 x)))
+  (put '=zero? '(real) (lambda (x) (< x threshold)))
   'done)
diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt
index d972784..3f923f0 100644
--- a/coding-exercises/2/83/install.rkt
+++ b/coding-exercises/2/83/install.rkt
@@ -73,7 +73,8 @@
   ((get 'make-from-mag-ang 'complex) x y))
 (define test-complex (make-complex 1 2))
 (define test-complex-rect (make-complex-rect 1 2))
-(define test-complex-polar (make-complex-rect 1 2))
+(define test-complex-polar (make-complex-polar (apply-fn 'magnitude test-complex)
+                                               (apply-fn 'angle test-complex)))
 
 ;; polynomial
 (define (make-polynomial var terms)
diff --git a/coding-exercises/2/87.rkt b/coding-exercises/2/87.rkt
index 4a47e94..d697781 100644
--- a/coding-exercises/2/87.rkt
+++ b/coding-exercises/2/87.rkt
@@ -78,6 +78,70 @@
   (put 'empty-termlist? '(sparse-termlist) empty-termlist?)
   (put 'the-empty-termlist 'sparse-termlist (lambda () (tagme (the-empty-termlist)))))
 
+(define (install-dense-termlist-package put)
+  ;; methods imported from term package
+  (define (order term)
+    ((get 'order '(term)) term))
+  (define (coeff term)
+    ((get 'coeff '(term)) term))
+  (define (make-term order coeff)
+    ((get 'make-from-order-coeff 'term) order coeff))
+
+  ;; selectors
+  ;; export first term as typed term
+  (define (first-term term-list)
+    (let ((term (car term-list)))
+      (make-term (- (length term-list) 1)
+                 term)))
+  (define (rest-terms term-list) (cdr term-list))
+
+  ;; ops
+  ;; map neg over internal storage type (coeff ...)
+  (define (neg termlist)
+    (map (lambda (term)
+           (apply-fn 'neg term))
+         termlist))
+
+  ;; convert term contents to our format
+  (define (term-contents->dense-format term)
+    (coeff term))
+  (define (adjoin-term term term-list)
+    (cond ((=zero? (coeff term)) term-list)
+          ((= (order term)
+              (length term-list))
+           (cons (term-contents->dense-format term) term-list))
+          (else (adjoin-term term (cons 0 term-list)))))
+
+  ;; preds
+  (define (the-empty-termlist) '())
+  (define (empty-termlist? term-list) (null? term-list))
+
+  ;; constructors
+  ;; store as ((order coeff)), list of untyped (order coeff) pairs
+  (define (make-from-terms terms)
+    (if (and (pair? terms)
+             (not (equal? 'term (type-tag (car terms)))))
+      (error "Make-from-terms encountered non-term --" terms)
+      (cond ((null? terms) (the-empty-termlist))
+            (else (adjoin-term (contents (car terms))
+                               (make-from-terms (cdr terms)))))))
+
+
+  ;; interface methods
+  (define (tagme datum)
+    (attach-tag 'dense-termlist datum))
+  ;; constructors
+  (put 'make-from-terms 'dense-termlist (lambda (t) (tagme (make-from-terms t))))
+  ;; ops
+  (put 'neg '(dense-termlist) (lambda (termlist) (tagme (neg termlist))))
+  (put 'adjoin-term '(term dense-termlist) (lambda (term termlist) (tagme (adjoin-term term termlist))))
+  (put 'rest-terms '(dense-termlist) (lambda (termlist) (tagme (rest-terms termlist))))
+  ;; term selector
+  (put 'first-term '(dense-termlist) first-term)
+  ;; pred
+  (put 'empty-termlist? '(dense-termlist) empty-termlist?)
+  (put 'the-empty-termlist 'dense-termlist (lambda () (tagme (the-empty-termlist)))))
+
 (define (install-polynomial-package put get)
   ;; internal procedures
   (define (tagme p)
@@ -96,6 +160,7 @@
 
   ;; termlists
   (install-sparse-termlist-package put)
+  (install-dense-termlist-package put)
   (define (make-term-list terms)
     ((get 'make-from-terms 'sparse-termlist) terms))
   (define (empty-termlist? termlist)
@@ -112,7 +177,8 @@
   ;; polys
   (define (ensure-termlist termlist)
     (if (or
-          (equal? 'sparse-termlist (type-tag termlist)))
+          (equal? 'sparse-termlist (type-tag termlist))
+          (equal? 'dense-termlist (type-tag termlist)))
       termlist
       (error "Unsupported type-tag for termlist --" termlist)))
   (define (make-poly variable term-list)
@@ -149,12 +215,23 @@
                             (term-list p2)))
       (error "Polys not in same var -- ADD-POLY" (list p1 p2))))
 
-  (define (neg-poly poly)
-    (make-poly
-      (variable poly)
-      (apply-fn 'neg (term-list poly))))
+  (define (neg-poly p)
+    (make-poly (variable p)
+               (apply-fn 'neg (term-list p))))
+
+  (define (sub-terms L1 L2)
+    (add-terms L1
+               (apply-fn 'neg L2)))
+
   (define (sub-poly p1 p2)
-    (add-poly p1 (neg-poly p2)))
+    (if (same-variable? (variable p1)
+                        (variable p2))
+      (make-poly
+        (variable p1)
+        (sub-terms (term-list p1)
+                   (term-list p2)))
+      (error "Polys not in same var -- MUL-POLY" (list p1 p2))))
+
 
   (define (mul-term-by-all-terms t1 L)
     (if (empty-termlist? L)
@@ -176,6 +253,42 @@
                  (mul-terms (term-list p1)
                             (term-list p2)))
       (error "Polys not in same var -- MUL-POLY" (list p1 p2))))
+
+  (define (div-terms L1 L2)
+    (if (empty-termlist? L1)
+      (list (the-empty-termlist L1) (the-empty-termlist L1))
+      (let ((t1 (first-term L1))
+            (t2 (first-term L2)))
+        (if (> (order t2) (order t1))
+          (list (the-empty-termlist L1) L1)
+          (let ((new-c (div (coeff t1) (coeff t2)))
+                (new-o (- (order t1) (order t2))))
+            (display (list new-c new-o t1 t2 (sub-terms L1
+                                                (mul-terms
+                                                  (make-term-list (list (make-term new-o new-c)))
+                                                  L2))))
+            (newline)
+            (let ((rest-of-result (div-terms
+                                    (sub-terms L1
+                                               (mul-terms
+                                                 (make-term-list (list (make-term new-o new-c)))
+                                                 L2))
+                                    L2)))
+              (list
+                (adjoin-term
+                  (make-term new-o new-c)
+                  (car rest-of-result))
+                (cadr rest-of-result))))))))
+
+  (define (div-poly p1 p2)
+    (if (same-variable? (variable p1)
+                        (variable p2))
+      (cons
+        (variable p1)
+        (div-terms (term-list p1)
+                   (term-list p2)))
+      (error "Polys not in same var -- DIV-POLY" (list p1 p2))))
+
   (define (polynomial-=zero? poly)
     (define (rec term-list)
       (cond ((empty-termlist? term-list) true)
@@ -189,6 +302,7 @@
   (put 'sub '(polynomial polynomial) (lambda (p1 p2)
                                        (tagme (sub-poly p1 p2))))
   (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tagme (mul-poly p1 p2))))
+  (put 'div '(polynomial polynomial) (lambda (p1 p2) (tagme (div-poly p1 p2))))
   (put 'make 'polynomial
        (lambda (var terms) (tagme (make-poly var terms))))
   'done)
@@ -198,13 +312,14 @@
   ((get 'make-from-order-coeff 'term) order coeff))
 (define (sparse-termlist . terms)
   ((get 'make-from-terms 'sparse-termlist) terms))
+(define (dense-termlist . terms)
+  ((get 'make-from-terms 'dense-termlist) terms))
 (define (make-polynomial var terms)
   ((get 'make 'polynomial) var terms))
 (define test-poly1 (make-polynomial 'x (sparse-termlist
                                          (term 1 test-integer))))
 (define test-poly2 (make-polynomial 'x (sparse-termlist
                                          (term 100 test-complex)
-                                         (term 3 test-real)
                                          (term 1 test-rat)
                                          (term 0 test-integer))))
 (define test-poly3 (make-polynomial 'x (sparse-termlist
@@ -232,7 +347,35 @@
    (newline)
    (display (sub test-poly1 test-poly2))))
 
-;; 89
+;; 89/90
 ;; First we made the polynomial package generic for sparse polys
 ;; Then we added dense polys as allowed types just lists where the length of the sublist until the term is the order of the term
 ;; When we do this, we can even put some heuristics to decide to save polys in the optimal format by scanning and reconstructing the term list during poly construction.
+;; For now the type of the second argument is used if both become empty at the same time, otherwise the one with more terms is used
+(define test-dense-poly (make-polynomial 'x (dense-termlist
+                                              (term 10 3)
+                                              (term 0 1))))
+((lambda ()
+   (newline)
+   (display test-dense-poly)
+   (newline)
+   (display (add test-dense-poly test-poly3))
+   (newline)
+   (display (mul test-dense-poly test-poly3))
+   (newline)
+   (display (sub test-dense-poly test-poly3))))
+
+;; 91
+;; Fill in the gaps excercise, should be easy right? :^)
+((lambda ()
+   (newline)
+   (display (div test-poly3 test-poly3))
+   (newline)
+   (display (div (make-polynomial 'x (dense-termlist (term 3 100)))
+                 (make-polynomial 'x (dense-termlist (term 3 10)))))
+   (newline)
+   (newline)
+   (display (list test-poly2 test-poly1))
+   (newline)
+   (newline)
+   (display (div test-poly2 test-poly1))))