bugs

3 files changed, 125 insertions, 17 deletions

diff --git a/coding-exercises/2/78/install-complex-package.rkt b/coding-exercises/2/78/install-complex-package.rkt
index a99b7d5..e332351 100644
--- a/coding-exercises/2/78/install-complex-package.rkt
+++ b/coding-exercises/2/78/install-complex-package.rkt
@@ -42,7 +42,7 @@
     (and (= (real-part z1) (real-part z2))
          (= (imag-part z1) (imag-part z2))))
   (define (=zero? z)
-    (and (= (real-part z)) (= (imag-part z))))
+    (and (= (real-part z) 0) (= (imag-part z) 0)))
 
   ;; interface
   (define (typetag z) (attach-tag 'complex z))
diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt
index 109862e..0cd8bbf 100644
--- a/coding-exercises/2/83/install.rkt
+++ b/coding-exercises/2/83/install.rkt
@@ -11,7 +11,21 @@
          make-complex-rect
          test-complex-rect
          make-complex-polar
-         test-complex-polar)
+         test-complex-polar
+         =zero?
+         equ?
+         add
+         sub
+         mul
+         div
+         sinme
+         cosme
+         atanme
+         sqrme
+         sqrtme
+         raiseme
+         dropme)
+
 (require "./install-integer.rkt"
          "./install-rational.rkt"
          "./install-real.rkt"
@@ -34,7 +48,7 @@
 (define (install-arithmetic-package)
   (list get put apply-fn))
 
-;; test running
+;; constructors
 ;; integer
 (define (make-integer n)
   ((get 'make 'integer) n))
@@ -60,3 +74,35 @@
 (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))
+
+;; polynomial
+(define (make-polynomial var terms)
+  ((get 'make 'polynomial) var terms))
+
+;; generic methods
+(define (equ? a1 a2)
+  (apply-fn 'equ? a2))
+(define (=zero? datum)
+  (apply-fn '=zero? datum))
+(define (add a1 a2)
+  (apply-fn 'add a1 a2))
+(define (sub a1 a2)
+  (apply-fn 'sub a1 a2))
+(define (mul a1 a2)
+  (apply-fn 'mul a1 a2))
+(define (div a1 a2)
+  (apply-fn 'div a1 a2))
+(define (raiseme datum)
+  (apply-fn 'raise datum))
+(define (dropme datum)
+  (apply-fn 'project datum))
+(define (sqrme datum)
+  (apply-fn 'sqr datum))
+(define (sqrtme datum)
+  (apply-fn 'sqrt datum))
+(define (cosme datum)
+  (apply-fn 'cos datum))
+(define (sinme datum)
+  (apply-fn 'sin datum))
+(define (atanme a1 a2)
+  (apply-fn 'atan a2))
diff --git a/coding-exercises/2/87.rkt b/coding-exercises/2/87.rkt
index 6c2a3f6..d73093e 100644
--- a/coding-exercises/2/87.rkt
+++ b/coding-exercises/2/87.rkt
@@ -1,4 +1,5 @@
 #lang racket
+(require "../../shared/data-directed-programming.rkt")
 (require "./83/install.rkt")
 ;; arithmetic package
 (define get-put-apply (install-arithmetic-package))
@@ -10,35 +11,96 @@
   ;; internal procedures
   (define (tagme p)
     (attach-tag 'polynomial p))
-  ;;repr
+  (define (variable? x) (symbol? x))
+  (define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
+
+  ;; terms
+  (define (make-term order coeff) (list order coeff))
+  (define (order term) (car term))
+  (define (coeff term) (cadr term))
+
+  ;; termlists
+  (define (adjoin-term term term-list)
+    (if (=zero? (coeff term))
+      term-list
+      (cons term term-list)))
+  (define (the-empty-termlist) '())
+  (define (first-term term-list) (car term-list))
+  (define (rest-terms term-list) (cdr term-list))
+  (define (empty-termlist? term-list) (null? term-list))
+
+  ;; polys
   (define (make-poly variable term-list)
     (cons variable term-list))
   (define (variable p) (car p))
   (define (term-list p) (cdr p))
-  ;; preds
-  (define (variable? x) (symbol? x))
-  (define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
-  ;; term list
-  (define (adjoin-term term-list term)
-    '())
-  (define (coeff term)
-    '())
+
   ;; ops
+  (define (add-terms L1 L2)
+    (cond ((empty-termlist? L1) L2)
+          ((empty-termlist? L2) L1)
+          (else
+            (let ((t1 (first-term L1))
+                  (t2 (first-term L2)))
+              (cond ((> (order t1)
+                        (order t2))
+                     (adjoin-term
+                       t1 (add-terms (rest-terms L1) L2)))
+                    ((> (order t2)
+                        (order t1))
+                     (adjoin-term
+                       t2 (add-terms L1 (rest-terms L2))))
+                    (else
+                      (adjoin-term
+                        (make-term
+                          (order t1)
+                          (apply-fn 'add (coeff t1) (coeff t2)))
+                        (add-terms (rest-terms L1)
+                                   (rest-terms L2)))))))))
   (define (add-poly p1 p2)
     (if (same-variable? (variable p1) (variable p2))
       (make-poly (variable p1)
                  (add-terms (term-list p1)
                             (term-list p2)))
       (error "Polys not in same var -- ADD-POLY" (list p1 p2))))
+
+  (define (mul-term-by-all-terms t1 L)
+    (if (empty-termlist? L)
+      (the-empty-termlist)
+      (let ((t2 (first-term L)))
+        (adjoin-term (make-term
+                       (+ (order t1) (order t2))
+                       (mul (coeff t1) (coeff t2)))
+                     (mul-term-by-all-terms t1 (rest-terms L))))))
+  (define (mul-terms L1 L2)
+    (if (empty-termlist? L1)
+      (the-empty-termlist)
+      (add-terms (mul-term-by-all-terms (first-term L1) L2)
+                 (mul-terms (rest-terms L1) L2))))
   (define (mul-poly p1 p2)
     (if (same-variable? (variable p1)
                         (variable p2))
       (make-poly (variable p1)
                  (mul-terms (term-list p1)
                             (term-list p2)))
-      (error "Polys not in same var -- MUL-POLY" (list p1 p2)))))
-  ;; interface)
-
-
-
+      (error "Polys not in same var -- MUL-POLY" (list p1 p2))))
+  ;;interface
+  (put 'add '(polynomial polynomial) (lambda (p1 p2) (tagme (add-poly p1 p2))))
+  (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tagme (mul-poly p1 p2))))
+  (put 'make 'polynomial
+       (lambda (var terms) (tagme (make-poly var terms))))
+  'done)
 
+(install-polynomial-package put)
+(define (make-polynomial var terms)
+  ((get 'make 'polynomial) var terms))
+(define test-poly1 (make-polynomial 'x (list
+                                         (list 1 test-integer))))
+(define test-poly2 (make-polynomial 'x (list
+                                         (list 100 test-complex)
+                                         (list 3 test-real)
+                                         (list 1 test-rat)
+                                         (list 0 test-integer))))
+((lambda ()
+   (newline)
+   (display (add test-poly2 test-poly2))))