bugs

1 files changed, 76 insertions, 14 deletions

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))))