refactor to use arithmetic package for working with polys

7 files changed, 249 insertions, 0 deletions

diff --git a/coding-exercises/2/83.rkt b/coding-exercises/2/83.rkt
index bba4a57..502aadc 100644
--- a/coding-exercises/2/83.rkt
+++ b/coding-exercises/2/83.rkt
@@ -331,6 +331,7 @@
 ;;   So we are going to add these generic operations to the complex package.
 ;;   NOTE(mike): mixed types are not supported in my system, but they could be if we use the raising apply generic probably!
 ;;               for example we can mul a real and rational with the raising applier
+;;              in a tower of types you could also define some methods only for types where other types can be raised to, but this puts the burden on the type hierarchy.
 (apply-and-drop 'angle (make-complex-rect test-rat test-rat))
 (apply-and-drop 'magnitude (make-complex-rect test-rat test-rat))
 (apply-and-drop 'real-part (make-complex-polar test-rat test-rat))
diff --git a/coding-exercises/2/83/install-complex.rkt b/coding-exercises/2/83/install-complex.rkt
new file mode 100644
index 0000000..17b479f
--- /dev/null
+++ b/coding-exercises/2/83/install-complex.rkt
@@ -0,0 +1,9 @@
+#lang racket
+(provide install-complex)
+(require "../78/install-complex-package.rkt"
+         "../../../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)))))
diff --git a/coding-exercises/2/83/install-integer.rkt b/coding-exercises/2/83/install-integer.rkt
new file mode 100644
index 0000000..2fabf3a
--- /dev/null
+++ b/coding-exercises/2/83/install-integer.rkt
@@ -0,0 +1,33 @@
+#lang racket
+(provide install-integer)
+(require "../../../shared/data-directed-programming.rkt")
+
+(define (install-integer put get)
+  ;; local methods
+  (define (tagme datum)
+    (attach-tag 'integer datum))
+  (define (make i)
+    (inexact->exact (round i)))
+  (define (raiseme i)
+    (if (equal? (type-tag i) 'integer)
+      ((get 'make 'rational) i 1)
+      (error "cannot raise non integer in integer package")))
+  ;; constructor
+  (put 'make 'integer (lambda (x) (tagme (make x))))
+  ;; methods
+  (put 'add '(integer integer) (lambda (x y) (tagme (make (+ x y)))))
+  (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 'raise '(integer) raiseme)
+  ;; sqrt and trig methods for complex nums
+  (put 'sqr '(integer) sqr)
+  (put 'sqrt '(integer) sqrt)
+  (put 'atan '(integer) atan)
+  (put 'cos  '(integer) cos)
+  (put 'sin '(integer) sin)
+  ;; predicates
+  (put 'equ? '(integer integer) (lambda (x y) (= x y)))
+  (put '=zero? '(integer) (lambda (x) (= 0 x)))
+  'done)
+
diff --git a/coding-exercises/2/83/install-rational.rkt b/coding-exercises/2/83/install-rational.rkt
new file mode 100644
index 0000000..96dcef1
--- /dev/null
+++ b/coding-exercises/2/83/install-rational.rkt
@@ -0,0 +1,70 @@
+#lang racket
+(provide install-rational)
+(require "../../../shared/data-directed-programming.rkt")
+
+(define (install-rational put get)
+  ;; local methods
+  (define (tagme x) (attach-tag 'rational x))
+  (define (numer x) (car x))
+  (define (denom x) (cdr x))
+  (define (add-rat x y)
+    (make-rat (+ (* (numer x) (denom y))
+                 (* (numer y) (denom x)))
+              (* (denom x) (denom y))))
+  (define (sub-rat x y)
+    (make-rat (- (* (numer x) (denom y))
+                 (* (numer y) (denom x)))
+              (* (denom x) (denom y))))
+  (define (mul-rat x y)
+    (make-rat (* (numer x) (numer y))
+              (* (denom x) (denom y))))
+  (define (div-rat x y)
+    (make-rat (* (numer x) (denom y))
+              (* (denom x) (numer y))))
+  (define (equ? x y)
+    (and (= (numer x) (numer y))
+         (= (denom x) (denom y))))
+  (define (=zero? x)
+    (equal? (numer x) 0))
+
+  (define (make-rat n d)
+    (define (sign x)
+      (cond
+        ((and (< x 0) (< d 0)) (* -1 x))
+        ((and (< 0 x) (< d 0)) (* -1 x))
+        (else x)))
+    (let ((g (gcd n d)))
+      (cons (sign (/ n g)) (abs (/ d g)))))
+
+  (define (raiseme rat)
+    ((get 'make 'real) (/ (numer rat) (denom rat))))
+
+  ;; constructor
+  (put 'make 'rational
+       (lambda (x y) (tagme (make-rat x y))))
+
+  ;; interface
+  (put 'add '(rational rational)
+       (lambda (x y) (tagme (add-rat x y))))
+  (put 'sub '(rational rational)
+       (lambda (x y) (tagme (sub-rat x y))))
+  (put 'mul '(rational rational)
+       (lambda (x y) (tagme (mul-rat x y))))
+  (put 'div '(rational rational)
+       (lambda (x y) (tagme (div-rat x y))))
+  (put 'raise '(rational) raiseme)
+  (put 'project '(rational) (lambda (rat)
+                              ((get 'make 'integer) (/ (numer rat) (denom rat)))))
+  ;; sqrt and trig methods for complex nums
+  (put 'sqr '(rational) (lambda (r) (sqr (raiseme r))))
+  (put 'sqrt '(rational) (lambda (r) (sqrt (raiseme r))))
+  (put 'cos  '(rational) (lambda (r) (cos (raiseme r))))
+  (put 'sin '(rational) (lambda (r) (sin (raiseme r))))
+  (put 'atan '(rational rational) (lambda (r1 r2) (atan (raiseme r1) (raiseme r2))))
+
+  ;; predicates
+  (put 'equ? '(rational rational)
+       (lambda (x y) (equ? x y)))
+  (put '=zero? '(rational)
+       (lambda (x) (=zero? x)))
+  'done)
diff --git a/coding-exercises/2/83/install-real.rkt b/coding-exercises/2/83/install-real.rkt
new file mode 100644
index 0000000..68f5e31
--- /dev/null
+++ b/coding-exercises/2/83/install-real.rkt
@@ -0,0 +1,32 @@
+#lang racket
+(provide install-real)
+(require "../../../shared/data-directed-programming.rkt")
+
+(define (install-real put get)
+  ;; local methods
+  (define (tagme datum)
+    (attach-tag 'real datum))
+  (define (make i)
+    (exact->inexact i))
+  (define (raiseme r)
+    ((get 'make-from-real-imag 'complex) r 0))
+  ;; constructor
+  (put 'make 'real (lambda (x) (tagme (make x))))
+  ;; methods
+  (put 'add '(real real) (lambda (x y) (tagme (make (+ x y)))))
+  (put 'sub '(real real) (lambda (x y) (tagme (make (- x y)))))
+  (put 'mul '(real real) (lambda (x y) (tagme (make (* x y)))))
+  (put 'div '(real real) (lambda (x y) (tagme (make (/ x y)))))
+  (put 'raise '(real) raiseme)
+  (put 'project '(real) (lambda (n)
+                          ((get 'make 'rational) (round n) 1)))
+  ;; sqrt and trig methods for complex nums
+  (put 'sqr '(real) sqr)
+  (put 'sqrt '(real) sqrt)
+  (put 'cos  '(real) cos)
+  (put 'sin '(real) sin)
+  (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)))
+  'done)
diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt
new file mode 100644
index 0000000..109862e
--- /dev/null
+++ b/coding-exercises/2/83/install.rkt
@@ -0,0 +1,62 @@
+#lang racket
+(provide install-arithmetic-package
+         make-integer
+         test-integer
+         make-rat
+         test-rat
+         make-real
+         test-real
+         make-complex
+         test-complex
+         make-complex-rect
+         test-complex-rect
+         make-complex-polar
+         test-complex-polar)
+(require "./install-integer.rkt"
+         "./install-rational.rkt"
+         "./install-real.rkt"
+         "./install-complex.rkt"
+         "../../../shared/data-directed-programming.rkt")
+
+
+(define pkg (make-dispatch-table))
+(define get (getter pkg))
+(define put (putter pkg))
+(define print-tbl (printer pkg))
+(define apply-fn (make-apply-with-raising-and-drop
+                   get))
+
+(install-integer put get)
+(install-rational put get)
+(install-real put get)
+(install-complex apply-fn get put)
+
+(define (install-arithmetic-package)
+  (list get put apply-fn))
+
+;; test running
+;; integer
+(define (make-integer n)
+  ((get 'make 'integer) n))
+(define test-integer (make-integer 3))
+
+;; rational
+(define (make-rat n d)
+  ((get 'make 'rational) n d))
+(define test-rat (make-rat 5 2))
+
+;; real
+(define (make-real n)
+  ((get 'make 'real) n))
+(define test-real (make-real 1.5))
+
+;; complex
+(define (make-complex x y)
+  ((get 'make-from-real-imag 'complex) x y))
+(define (make-complex-rect x y)
+  ((get 'make-from-real-imag 'complex) x y))
+(define (make-complex-polar x y)
+  ((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))
diff --git a/coding-exercises/2/87.rkt b/coding-exercises/2/87.rkt
index cda82ce..6c2a3f6 100644
--- a/coding-exercises/2/87.rkt
+++ b/coding-exercises/2/87.rkt
@@ -1,2 +1,44 @@
 #lang racket
+(require "./83/install.rkt")
+;; arithmetic package
+(define get-put-apply (install-arithmetic-package))
+(define get (car get-put-apply))
+(define put (cadr get-put-apply))
+(define apply-fn (caddr get-put-apply))
+
+(define (install-polynomial-package put)
+  ;; internal procedures
+  (define (tagme p)
+    (attach-tag 'polynomial p))
+  ;;repr
+  (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-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-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)
+
+
+