fixup

5 files changed, 98 insertions, 12 deletions

diff --git a/coding-exercises/2/83/install-integer.rkt b/coding-exercises/2/83/install-integer.rkt
index ca1ebb5..ca33ba0 100644
--- a/coding-exercises/2/83/install-integer.rkt
+++ b/coding-exercises/2/83/install-integer.rkt
@@ -13,13 +13,26 @@
       ((get 'make 'rational) i 1)
       (error "cannot raise non integer in integer package")))
   ;; constructor
-  (put 'make 'integer (lambda (x) (tagme (make x))))
+  (put 'make 'integer (lambda (x)
+                        (newline)
+                        (display (list "MAKE INTEGER --" x (make x)))
+                        (tagme (make x))))
+
+  (define (gcd-integer a b)
+    (newline)
+    (display (list "GCD-INTEGER -- " a b))
+    (if (= b 0)
+      a
+      (gcd-integer b (remainder a b))))
+
   ;; methods
-  (put 'add '(integer integer) (lambda (x y) (tagme (make (+ x y)))))
-  (put 'neg '(integer) (lambda (x) (tagme (- x))))
-  (put 'sub '(integer integer) (lambda (x y) (tagme (make (- x y)))))
-  (put 'mul '(integer integer) (lambda (x y) (tagme (make (* x y)))))
-  (put 'div '(integer integer) (lambda (x y) (tagme (make (/ x y)))))
+  (put 'add '(integer integer) (lambda (x y) (+ x y)))
+  (put 'neg '(integer) (lambda (x) (- x)))
+  (put 'sub '(integer integer) (lambda (x y) (- x y)))
+  (put 'mul '(integer integer) (lambda (x y) (* x y)))
+  (put 'div '(integer integer) (lambda (x y) (/ x y)))
+  (put 'greatest-common-divisor '(integer integer) (lambda (a b)
+                                                     (gcd-integer a b)))
   (put 'raise '(integer) raiseme)
   ;; sqrt and trig methods for complex nums
   (put 'sqr '(integer) sqr)
diff --git a/coding-exercises/2/83/install-rational.rkt b/coding-exercises/2/83/install-rational.rkt
index 92531ec..127871a 100644
--- a/coding-exercises/2/83/install-rational.rkt
+++ b/coding-exercises/2/83/install-rational.rkt
@@ -17,6 +17,8 @@
   (define (mul a b)
     (apply-fn 'mul a b))
   (define (div a b)
+    (newline)
+    (display (list "Calling div from rat package" a b))
     (apply-fn 'div a b))
   (define (cos a)
     (apply-fn 'cos a))
@@ -29,8 +31,28 @@
   (define (atan a b)
     (apply-fn 'atan a b))
 
+  (define (gcd a b)
+    (newline)
+    (newline)
+    (display (list "GCD RATIONAL -- " a b))
+    (let ((proc (get 'greatest-common-divisor (list (type-tag a) (type-tag b)))))
+      (if proc
+        (proc (contents a) (contents b))
+        (error "Not implemented -- " (list 'greatest-common-divisor (type-tag a) (type-tag b))))))
+
+
   ;; constructor and selectors
-  (define (make-rat n d) (list n d))
+  (define (make-rat n d)
+    (let ((g (gcd n d)))
+      (let ((numer-div (get 'div (list (type-tag n) (type-tag g))))
+            (denom-div (get 'div (list (type-tag d) (type-tag g)))))
+        (if (and numer-div denom-div)
+          (list (numer-div (contents n) (contents g))
+                (denom-div (contents d) (contents g)))
+          (list n d)))))
+
+
+
   (define (numer x) (car x))
   (define (denom x) (cadr x))
 
diff --git a/coding-exercises/2/83/install-real.rkt b/coding-exercises/2/83/install-real.rkt
index d82d48a..a232e5e 100644
--- a/coding-exercises/2/83/install-real.rkt
+++ b/coding-exercises/2/83/install-real.rkt
@@ -17,6 +17,15 @@
   ;; constructor
   (put 'make 'real (lambda (x) (tagme (make x))))
   ;; methods
+
+  (define (gcd-real a b)
+    (if (and (integer? a)
+             (integer? b))
+      (if (= b 0)
+        a
+        (gcd-real b (remainder a b)))
+      a))
+
   (put 'add '(real real) (lambda (x y) (tagme (make (+ x y)))))
   (put 'neg '(real) (lambda (x) (tagme (make (- x)))))
   (put 'sub '(real real) (lambda (x y) (tagme (make (- x y)))))
@@ -25,6 +34,7 @@
   (put 'raise '(real) raiseme)
   (put 'project '(real) (lambda (n)
                           ((get 'make 'rational) n 1.0)))
+  (put 'greatest-common-divisor '(real real) (lambda (a b) (tagme (gcd-real a b))))
   ;; sqrt and trig methods for complex nums
   (put 'sqr '(real) sqr)
   (put 'sqrt '(real) sqrt)
diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt
index 25f2152..010f89d 100644
--- a/coding-exercises/2/83/install.rkt
+++ b/coding-exercises/2/83/install.rkt
@@ -31,7 +31,8 @@
          sqrme
          sqrtme
          raiseme
-         dropme)
+         dropme
+         greatest-common-divisor)
 
 (require "./install-integer.rkt"
          "./install-rational.rkt"
@@ -82,7 +83,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-polar (apply-fn 'magnitude test-complex) (apply-fn 'angle test-complex)))
+; (define test-complex-polar (make-complex-polar (apply-fn 'magnitude test-complex) (apply-fn 'angle test-complex)))
+(define test-complex-polar '())
 
 ;; polynomial
 (define (term order coeff)
@@ -133,3 +135,5 @@
   (apply-fn 'sin datum))
 (define (atanme a1 a2)
   (apply-fn 'atan a2))
+(define (greatest-common-divisor p1 p2)
+  (apply-fn 'greatest-common-divisor p1 p2))
diff --git a/coding-exercises/2/83/polynomials.rkt b/coding-exercises/2/83/polynomials.rkt
index d9d25cc..c400992 100644
--- a/coding-exercises/2/83/polynomials.rkt
+++ b/coding-exercises/2/83/polynomials.rkt
@@ -321,14 +321,22 @@
       (error "Polys not in same var -- MUL-POLY" (list p1 p2))))
 
   (define (div-terms L1 L2)
+    (newline)
+    (newline)
+    (display (list "DIV-TERMS -- " L1 L2))
+    (newline)
     (if (empty-termlist? L1)
-      (list (the-empty-termlist L1) (the-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 (sub (order t1) (order t2))))
+            (newline)
+            (display (list "NEW-TERM coeff --" new-c (type-tag (coeff t1))
+                           (type-tag (coeff t2))))
             (let ((rest-of-result (div-terms
                                     (sub-terms L1
                                                (mul-terms
@@ -341,15 +349,42 @@
                   (car rest-of-result))
                 (cadr rest-of-result))))))))
 
-  (define (div-poly p1 p2)
+  (define (remainder-terms L1 L2)
+    (let ((result-remainder-list (div-terms L1 L2)))
+      (cadr result-remainder-list)))
+
+  (define (gcd-terms a b)
+    (newline)
+    (newline)
+    (display (list a b (empty-termlist? b)))
+    (if (empty-termlist? b)
+      a
+      (gcd-terms b (remainder-terms a b))))
+
+  (define (gcd-poly p1 p2)
+    (newline)
+    (newline)
+    (display (list p1 p2))
     (if (same-variable? (variable p1)
                         (variable p2))
       (cons
         (variable p1)
-        (div-terms (term-list p1)
+        (gcd-terms (term-list p1)
                    (term-list p2)))
       (error "Polys not in same var -- DIV-POLY" (list p1 p2))))
 
+  (define (div-poly p1 p2)
+    (if (same-variable? (variable p1)
+                        (variable p2))
+      (let ((result (div-terms (term-list p1)
+                               (term-list p2))))
+        (if (empty-termlist? (cadr result))
+          (cons (variable p1)
+                (car result))
+          (cons (variable p1)
+                result)))
+      (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)
@@ -366,4 +401,6 @@
   (put 'div '(polynomial polynomial) (lambda (p1 p2) (tagme (div-poly p1 p2))))
   (put 'make 'polynomial
        (lambda (var terms) (tagme (make-poly var terms))))
+  (put 'greatest-common-divisor '(polynomial polynomial) (lambda (a b) (tagme (gcd-poly a b))))
+
   'done)