fixup

7 files changed, 189 insertions, 57 deletions

diff --git a/coding-exercises/2/30.rkt b/coding-exercises/2/30.rkt
index 785a8dc..b9f079a 100644
--- a/coding-exercises/2/30.rkt
+++ b/coding-exercises/2/30.rkt
@@ -1,6 +1,6 @@
 #lang racket
 (define (scale-tree tree factor)
-  (cond ((null? tree) nil)
+  (cond ((null? tree) '())
         ((not (pair? tree)) (* tree factor))
         (else (cons (scale-tree (car tree) factor)
                     (scale-tree (cdr tree) factor)))))
@@ -18,7 +18,7 @@
 ;;     (list)
 ;;     (cons (square (car items)) (square-list (cdr items)))))
 (define (square-tree tree)
-  (cond ((null? tree) nil)
+  (cond ((null? tree) '())
         ((not (pair? tree)) (* tree tree))
         (else (cons (square-tree (car tree))
                     (square-tree (cdr tree))))))
diff --git a/coding-exercises/2/73.rkt b/coding-exercises/2/73.rkt
index f8b4fad..26e456a 100644
--- a/coding-exercises/2/73.rkt
+++ b/coding-exercises/2/73.rkt
@@ -44,19 +44,20 @@
           (error "Not found or bad entry -- GET" op type op-entry))))
   (define (put op type item)
     (if (find-first (make-eq-type? op) dispatch-table)
-      (set! dispatch-table (map (lambda (op-entry) ;;just copy the table for now, don't want to mutate yet
-                                  (if (not (eq? (type-tag op-entry) op))
-                                    op-entry
-                                    (attach-tag op
-                                      (let ((installed-types (map (lambda (type-entry)
-                                                                   (if (not (eq? (type-tag type-entry) type))
-                                                                     type-entry
-                                                                     (attach-tag type item)))
-                                                              (cdr op-entry))))
-                                        (if (find-first (make-eq-type? type) installed-types)
-                                          installed-types
-                                          (cons (attach-tag type item) installed-types))))))
-                             dispatch-table))
+      (set! dispatch-table 
+        (map (lambda (op-entry) ;;just copy the table for now, don't want to mutate yet
+               (if (not (eq? (type-tag op-entry) op))
+                 op-entry
+                 (attach-tag op
+                   (let ((installed-types (map (lambda (type-entry)
+                                                (if (not (eq? (type-tag type-entry) type))
+                                                  type-entry
+                                                  (attach-tag type item)))
+                                           (cdr op-entry))))
+                     (if (find-first (make-eq-type? type) installed-types)
+                       installed-types
+                       (cons (attach-tag type item) installed-types))))))
+          dispatch-table))
       (set! dispatch-table (cons
                              (attach-tag op
                                 (list (attach-tag type item)))
@@ -67,57 +68,83 @@
 (define (putter t)
   (caddr t))
 
+(define t (make-dispatch-table))
+(define get (getter t))
+(define put (putter t))
+
 ;; prefix combination notation of expression? (+ a b)
 (define (operator ex)
-  (car ex))
-
+   (car ex))
 (define (operands ex)
   (cdr ex))
-
-(define t (make-dispatch-table))
-(define get (getter t))
-(define put (putter t))
 (define (deriv ex var)
   (cond ((number? ex) 0)
         ((variable? ex) (if (same-variable? ex var) 1 0))
         (else ((get 'deriv (operator ex)) (operands ex) var))))
 
-(define (=number? x num)
-  (and (number? x) (= x num)))
-(define (make-sum a1 a2)
-  (cond ((=number? a1 0) a2)
-        ((=number? a2 0) a1)
-        ((and (number? a1)
-              (number? a2)) (+ a1 a2))
-        (else (list '+ a1 a2))))
-(define (addend s) (car s))
-(define (augend s)
-  (cond ((null? (cddr s)) (cadr s))
-        (else (cons '+ (cdr s)))))
+(define (install-basic-deriv-rules)
+
+  (define (=number? x num)
+      (and (number? x) (= x num)))
+  (define (make-sum a1 a2)
+    (cond ((=number? a1 0) a2)
+          ((=number? a2 0) a1)
+          ((and (number? a1)
+                (number? a2)) (+ a1 a2))
+          (else (list '+ a1 a2))))
+  (define (addend s) (car s))
+  (define (augend s)
+    (cond ((null? (cddr s)) (cadr s))
+          (else (cons '+ (cdr s)))))
+
+  (define (make-product m1 m2)
+    (cond ((or (=number? m1 0) (=number? m2 0)) 0)
+          ((=number? m1 1) m2)
+          ((=number? m2 1) m1)
+          ((and (number? m1) (number? m2)) (* m1 m2))
+          (else (list '* m1 m2))))
+  (define (multiplier p)
+    (car p))
+  (define (multiplicand p)
+    (cond ((null? (cddr p))
+           (cadr p))
+          (else (cons '* (cdr p)))))
+
+  (define (make-exponent e p)
+    (cond ((=number? p 0) 1)
+          ((=number? p 1) e)
+          (else (list '** e p))))
+  (define (base expo)
+    (car expo))
+  (define (exponent expo)
+    (cadr expo))
 
-(put 'deriv '+ (lambda (ex var)
-                 (make-sum
-                   (deriv (addend ex) var)
-                   (deriv (augend ex) var))))
-(define (make-product m1 m2)
-  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
-        ((=number? m1 1) m2)
-        ((=number? m2 1) m1)
-        ((and (number? m1) (number? m2)) (* m1 m2))
-        (else (list '* m1 m2))))
-(define (multiplier p)
-  (car p))
-(define (multiplicand p)
-  (cond ((null? (cddr p))
-         (cadr p))
-        (else (cons '* (cdr p)))))
+  ;;b
+  (put 'deriv '+ (lambda (ex var)
+                   (make-sum
+                     (deriv (addend ex) var)
+                     (deriv (augend ex) var))))
+  (put 'deriv '* (lambda (ex var)
+                   (make-sum
+                     (make-product
+                       (multiplier ex)
+                       (deriv (multiplicand ex) var))
+                     (make-product
+                       (deriv (multiplier ex) var)
+                       (multiplicand ex)))))
+  ;;c
+  (put 'deriv '** (lambda (ex var)
+                    (make-product
+                     (deriv (base ex) var)
+                     (make-product
+                       (exponent ex)
+                       (make-exponent (base ex) (- (exponent ex) 1)))))))
 
-(put 'deriv '* (lambda (ex var)
-                 (make-sum
-                   (make-product
-                     (multiplier ex)
-                     (deriv (multiplicand ex) var))
-                   (make-product
-                     (deriv (multiplier ex) var)
-                     (multiplicand ex)))))
+(install-basic-deriv-rules)
 (deriv '(+ (* 3 x) (* 2 x)) 'x)
+(deriv '(** x 2) 'x)
+;;d
+;; No changes to the derivative system are necessary so long as (op, 'deriv) points
+;; to the same method as ('deriv, op) in the dispatch table of the consuming package.
+;; I guess you could argue that the put arguments should be reversed in the derivative system.
+;; But the actual items in the dispatch table don't have to change since the call signature is the same.
diff --git a/coding-exercises/2/74.rkt b/coding-exercises/2/74.rkt
new file mode 100644
index 0000000..c6bc137
--- /dev/null
+++ b/coding-exercises/2/74.rkt
@@ -0,0 +1,62 @@
+#lang racket
+(require "../../shared/data-directed-programming.rkt")
+(require "../../shared/lists.rkt")
+
+(define test-dispatch (make-dispatch-table))
+(define get (getter test-dispatch))
+(define put (putter test-dispatch))
+
+;; Example implementations
+(define test-division (attach-tag 
+                          'division-a
+                          (list (attach-tag 
+                                  'henk 
+                                  (list (attach-tag 'salary 100))))))
+(put 'record 'division-a (lambda (file-set employee) 
+                           (let ((record (find-first 
+                                           (make-eq-type? employee) 
+                                           file-set)))
+                             (if record
+                               record
+                               (error "Employee record not found -- GET-RECORD DIVISION-A" employee)))))
+(put 'salary 'division-a (lambda (record)
+                           (let ((salary (find-first
+                                           (make-eq-type? 'salary)
+                                           record)))
+                             (if salary
+                               salary
+                               (error "Salary not found -- GET-SALARY DIVISION-A" record)))))
+
+;;a Each divisions file must be a datum tagged with the divisions name.
+;;  Together with the division type tag and an operation type tag
+;;  we can get a procedure that knows how to do that operation for the given employee.
+(define (get-record file employee)
+  ((get 'record (type-tag file)) (contents file) employee))
+
+(define test-record (get-record test-division 'henk))
+
+;; b The record can have any structure that is handled by the salary procedure of the
+;; division we dispatch the procedure from
+(define (get-salary file record)
+  ((get 'salary (type-tag file)) (contents record)))
+
+
+(get-salary test-division test-record)
+
+;;c
+(define (find-employee-record files employee)
+   (define (search fi)
+     (if (null? fi)
+       false
+       (let ((result (with-handlers
+                       ([exn:fail? (lambda (exn)
+                                     false)])
+                       (get-record (car fi) employee))))
+         (if result
+           result
+           (search (cdr fi))))))
+   (search files))
+(find-employee-record (list test-division test-division) 'henk)
+
+;;d
+;; new implementations for the division representation for the existing operations on a type
diff --git a/coding-exercises/2/75.rkt b/coding-exercises/2/75.rkt
new file mode 100644
index 0000000..4a5cf23
--- /dev/null
+++ b/coding-exercises/2/75.rkt
@@ -0,0 +1,25 @@
+#lang racket
+
+(define (make-from-mag-ang mag ang)
+  (define (dispatch op)
+    (cond ((eq? op 'real-part) (* mag (cosine ang)))
+          ((eq? op 'imag-part) (* mag (sine ang)))
+          ((eq? op 'magnitude) mag)
+          ((eq? op 'angle) ang)
+          (else (error "Unknown op -- MAKE-FROM-MAG-ANG" op))))
+  dispatch)
+
+;; Explicit dispatch
+;; The logic for dispatching has to be repeated for every operation and every type.
+;; If there are a number of representations for a type or multiple operations, this is not what you want.
+;;
+;; data dispatch
+;; If new operations need to be added then we have to extend all existing type packages to support dispatching the operation to those types.
+;; When adding new types we need to install a dispatchable procedure for every operation only in the new type package. 
+;;
+;; message passing
+;; If new operations need to be added then we have to add a message handling case to all data representations.
+;; When adding new types we need to make a procedure that handles all operation messages.
+;;
+;; In general I think if the operation is less smart then it is easier to add to a system, that's why message passing is more appropriate if you often need to add operations.
+;; The same goes for data dispatching, if the operations are smart, the data doesn't have to be. This makes adding more data representations more convenient. 
diff --git a/coding-exercises/2/76.rkt b/coding-exercises/2/76.rkt
new file mode 100644
index 0000000..6f1f7b4
--- /dev/null
+++ b/coding-exercises/2/76.rkt
@@ -0,0 +1 @@
+#lang racket
diff --git a/coding-exercises/2/77.rkt b/coding-exercises/2/77.rkt
new file mode 100644
index 0000000..65feaf3
--- /dev/null
+++ b/coding-exercises/2/77.rkt
@@ -0,0 +1,9 @@
+#lang racket
+
+;; (apply-generic 'magnitude z)
+;; This strips the complex type-tag from z and passes the contents to the generic magnitude procedure defined in the complex package.
+;; The magnitude procedure is responsible for dispatching the operation to the magnitude procedure of either the rectangular or the polar form representation.
+;; (apply-generic 'magnitude z)
+;; This strips away the rectangular type tag of the args and passes the contents of the args to the corresponding 'magnitude '(rectangular) procedure.
+;; In the end the rectangular magnitude procedure's return value is bubbled up to the calling function.
+(print "hi")
diff --git a/coding-exercises/2/78.rkt b/coding-exercises/2/78.rkt
new file mode 100644
index 0000000..3a4b100
--- /dev/null
+++ b/coding-exercises/2/78.rkt
@@ -0,0 +1,8 @@
+#lang racket
+(require "../../shared/data-directed-programming.rkt")
+;; We are basically making a data directed framework for arithmethic operations in this module
+(define pkg (make-dispatch-table))
+(define put (putter pkg))
+(define get (getter pkg))
+(define apply-generic (make-apply put get))
+