From a72f7f9b7cd292334cbe85a825ea655c589d207f Mon Sep 17 00:00:00 2001
From: Oliver Payne <ompayne@gmail.com>
Date: Thu, 27 Jan 2022 22:20:58 +0000
Subject: [PATCH] Update to include up to 2.74

---
 2_56.rkt | 133 +++++++++++++++++++++++++++++++++++++++++++++
 2_59.rkt |  75 ++++++++++++++++++++++++++
 2_63.rkt | 147 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2_66.rkt |  34 ++++++++++++
 2_67.rkt | 153 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2_73.rkt | 143 ++++++++++++++++++++++++++++++++++++++++++++++++
 2_74.rkt | 161 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 846 insertions(+)
 create mode 100644 2_56.rkt
 create mode 100644 2_59.rkt
 create mode 100644 2_63.rkt
 create mode 100644 2_66.rkt
 create mode 100644 2_67.rkt
 create mode 100644 2_73.rkt
 create mode 100644 2_74.rkt

diff --git a/2_56.rkt b/2_56.rkt
new file mode 100644
index 0000000..2651239
--- /dev/null
+++ b/2_56.rkt
@@ -0,0 +1,133 @@
+#lang sicp
+
+(define (deriv exp var)
+  (cond ((number? exp) 0)
+        ((variable? exp)
+         (if (same-variable? exp var) 1 0))
+        ((sum? exp)
+         (make-sum (deriv (addend exp) var)
+                   (deriv (augend exp) var)))
+        ((product? exp)
+         (make-sum
+           (make-product (multiplier exp)
+                         (deriv (multiplicand exp) var))
+           (make-product (deriv (multiplier exp) var)
+                         (multiplicand exp))))
+        ((exponentiation? exp) ;;(make-product (exponent exp) (deriv (base exp) var))
+         (let ((e (exponent exp))
+               (b (base exp)))
+           (make-product e
+                         (make-product
+                          (make-exponentiation b (- e 1))
+                          (deriv b var)))))
+        (else
+         (error "unknown expression type -- DERIV" exp))))
+
+;; representing algebraic expressions
+
+(define (variable? x) (symbol? x))
+
+(define (same-variable? v1 v2)
+  (and (variable? v1) (variable? v2) (eq? v1 v2)))
+
+;;(define (make-sum a1 a2) (list '+ a1 a2))
+
+;;(define (make-product m1 m2) (list '* m1 m2))
+
+(define (more-than-2-terms x) (pair? (cdddr x)))
+
+;;(define (sum? x)
+;;  (and (pair? x) (eq? (car x) '+)))
+;;
+;;(define (addend s) (cadr s))
+;;
+;;(define (augend s)
+;;  (if (more-than-2-terms s)
+;;      (cons '+ (cddr s))
+;;      (caddr s)))
+;;
+;;(define (product? x)
+;;  (and (pair? x) (eq? (car x) '*)))
+;;
+;;(define (multiplier p) (cadr p))
+;;
+;;(define (multiplicand p)
+;;  (if (more-than-2-terms p)
+;;      (cons '* (cddr p))
+;;      (caddr p)))
+
+
+;: (deriv '(+ x 3) 'x)
+;: (deriv '(* x y) 'x)
+;: (deriv '(* (* x y) (+ x 3)) 'x)
+
+
+;; With simplification
+
+;;(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 (=number? exp num)
+  (and (number? exp) (= exp num)))
+
+;;(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))))
+
+
+;; Exercise 2.56
+
+(define (make-exponentiation b p) 
+ (cond ((=number? p 0) 1)
+       ((=number? p 1) b)
+       ((and (number? b) (number? p)) (expt b p))
+       (else (list '** b p))))
+
+(define (base e) (cadr e))
+(define (exponent e) (caddr e))
+
+(define (exponentiation? x) (and (pair? x) (eq? (car x) '**)))
+
+
+;; Exercise 2.58
+
+(define (make-sum a1 a2)
+  (cond ((=number? a1 0) a2)
+        ((=number? a2 0) a1)
+        ((and (number? a1) (number? a2)) (+ a1 a2))
+        ((product? a2) (list a1 '+ (multiplier a2) '* (multiplicand a2)))
+        (else (list a1 '+ a2))))
+
+(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 (sum? x)
+  (and (pair? x) (eq? (cadr x) '+)))
+
+(define (addend s) (car s))
+
+;; Special case of multiplication distributing across addition.  It
+;; should be possible to rewrite augend and/or multiplicand to deal
+;; with this case
+
+(define (augend s)
+  (if (product? (cddr s))
+      (cddr s)
+      (caddr s)))
+
+(define (product? x)
+  (and (pair? x) (eq? (cadr x) '*)))
+
+(define (multiplier p) (car p))
+
+(define (multiplicand p) (caddr p))
diff --git a/2_59.rkt b/2_59.rkt
new file mode 100644
index 0000000..985c7f4
--- /dev/null
+++ b/2_59.rkt
@@ -0,0 +1,75 @@
+#lang sicp
+
+
+;;(define (element-of-set? x set)
+;;  (cond ((null? set) false)
+;;        ((equal? x (car set)) true)
+;;        (else (element-of-set? x (cdr set)))))
+
+;;(define (adjoin-set x set)
+;;  (if (element-of-set? x set)
+;;      set
+;;      (cons x set)))
+
+;;(define (intersection-set set1 set2)
+;;  (cond ((or (null? set1) (null? set2)) '())
+;;        ((element-of-set? (car set1) set2)
+;;         (cons (car set1)
+;;               (intersection-set (cdr set1) set2)))
+;;        (else (intersection-set (cdr set1) set2))))
+
+
+;;(define (union-set set1 set2)
+;;  (cond ((null? set1) set2)
+;;        ((null? set2) set1)
+;;        ((not (element-of-set? (car set1) set2))
+;;         (cons (car set1) (union-set (cdr set1) set2)))
+;;        (else (union-set (cdr set1) set2))))
+
+;; With duplicates
+
+;;(define (adjoin-set x set) (cons x set))
+
+;;(define (union-set set1 set2) (append set1 set2))
+
+;; Efficiency is dependent on the number duplicates in the underlying list
+;; This increases with each operation.  For smaller numbers of duplicates
+;; adjoin and union should be much cheaper than the no-duplicate versions.
+
+;; ORDERED
+
+(define (element-of-set? x set)
+  (cond ((null? set) false)
+        ((= x (car set)) true)
+        ((< x (car set)) false)
+        (else (element-of-set? x (cdr set)))))
+
+(define (intersection-set set1 set2)
+  (if (or (null? set1) (null? set2))
+      '()
+      (let ((x1 (car set1)) (x2 (car set2)))
+        (cond ((= x1 x2)
+               (cons x1
+                     (intersection-set (cdr set1)
+                                       (cdr set2))))
+              ((< x1 x2)
+               (intersection-set (cdr set1) set2))
+              ((< x2 x1)
+               (intersection-set set1 (cdr set2)))))))
+
+(define (adjoin-set x set)
+  (cond ((null? set) (list x))
+        ((equal? x (car set)) set)
+        ((< x (car set)) (cons x set))
+        (else (adjoin-set x (cdr set)))))
+
+(define (union-set set1 set2)
+  (cond ((null? set1) set2)
+        ((null? set2) set1)
+        (else
+         (let ((x1 (car set1))
+               (x2 (car set2)))
+          (cond ((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2))))
+                ((< x1 x2) (cons x1 (union-set (cdr set1) set2)))
+                (else (cons x2 (union-set set1 (cdr set2)))))))))
+               
diff --git a/2_63.rkt b/2_63.rkt
new file mode 100644
index 0000000..83ec931
--- /dev/null
+++ b/2_63.rkt
@@ -0,0 +1,147 @@
+#lang sicp
+
+;; BINARY TREES
+(define (entry tree) (car tree))
+
+(define (left-branch tree) (cadr tree))
+
+(define (right-branch tree) (caddr tree))
+
+(define (make-tree entry left right)
+  (list entry left right))
+
+(define (element-of-set? x set)
+  (cond ((null? set) false)
+        ((= x (entry set)) true)
+        ((< x (entry set))
+         (element-of-set? x (left-branch set)))
+        ((> x (entry set))
+         (element-of-set? x (right-branch set)))))
+
+(define (adjoin-set x set)
+  (cond ((null? set) (make-tree x '() '()))
+        ((= x (entry set)) set)
+        ((< x (entry set))
+         (make-tree (entry set) 
+                    (adjoin-set x (left-branch set))
+                    (right-branch set)))
+        ((> x (entry set))
+         (make-tree (entry set)
+                    (left-branch set)
+                    (adjoin-set x (right-branch set))))))
+
+;; Ordered
+(define (intersection-ordered-list set1 set2)
+  (if (or (null? set1) (null? set2))
+      '()
+      (let ((x1 (car set1)) (x2 (car set2)))
+        (cond ((= x1 x2)
+               (cons x1
+                     (intersection-ordered-list (cdr set1)
+                                       (cdr set2))))
+              ((< x1 x2)
+               (intersection-ordered-list (cdr set1) set2))
+              ((< x2 x1)
+               (intersection-ordered-list set1 (cdr set2)))))))
+
+(define (union-ordered-list set1 set2)
+  (cond ((null? set1) set2)
+        ((null? set2) set1)
+        (else
+         (let ((x1 (car set1))
+               (x2 (car set2)))
+          (cond ((= x1 x2) (cons x1 (union-ordered-list (cdr set1) (cdr set2))))
+                ((< x1 x2) (cons x1 (union-ordered-list (cdr set1) set2)))
+                (else (cons x2 (union-ordered-list set1 (cdr set2)))))))))
+               
+
+;; EXERCISE 2.63
+(define (tree->list-1 tree)
+  (if (null? tree)
+      '()
+      (append (tree->list-1 (left-branch tree))
+              (cons (entry tree)
+                    (tree->list-1 (right-branch tree))))))
+
+(define (tree->list-2 tree)
+  (define (copy-to-list tree result-list)
+    (if (null? tree)
+        result-list
+        (copy-to-list (left-branch tree)
+                      (cons (entry tree)
+                            (copy-to-list (right-branch tree)
+                                          result-list)))))
+  (copy-to-list tree '()))
+
+(define (list->tree elements)
+  (car (partial-tree elements (length elements))))
+
+(define (partial-tree elts n)
+  (if (= n 0)
+      (cons '() elts)
+      (let ((left-size (quotient (- n 1) 2)))
+        (let ((left-result (partial-tree elts left-size)))
+          (let ((left-tree (car left-result))
+                (non-left-elts (cdr left-result))
+                (right-size (- n (+ left-size 1))))
+            (let ((this-entry (car non-left-elts))
+                  (right-result (partial-tree (cdr non-left-elts)
+                                              right-size)))
+              (let ((right-tree (car right-result))
+                    (remaining-elts (cdr right-result)))
+                (cons (make-tree this-entry left-tree right-tree)
+                      remaining-elts))))))))
+
+(define tree1
+  (make-tree 7
+             (make-tree 3
+                        (make-tree 1 '() '())
+                        (make-tree 5 '() '()))
+             (make-tree 9
+                        '()
+                        (make-tree 11 '() '()))))
+
+(define tree2
+  (make-tree 3
+             (make-tree 1 '() '())
+             (make-tree 7
+                        (make-tree 5 '() '())
+                        (make-tree 9
+                                   '()
+                                   (make-tree 11 '() '())))))
+
+(define tree3
+  (make-tree 5
+             (make-tree 3
+                        (make-tree 1 '() '())
+                        '())
+             (make-tree 9
+                        (make-tree 7 '() '())
+                        (make-tree 11 '() '()))))
+                        
+(define tree4
+  (make-tree 1 '()
+             (make-tree 3 '()
+                        (make-tree 5 '()
+                                   (make-tree 7 '()
+                                              (make-tree 9 '()
+                                                         (make-tree 11 '() '())))))))
+
+(define set1 (list->tree '(1 2 3 4)))
+(define set2 (list->tree '(3 4 5 6)))
+
+;; 2.65
+
+;; list->tree and tree->list-2 are O(n).  So are intersection and union for
+;; ordered lists.  So the following are O(n).
+(define (intersection-set set1 set2)
+  (list->tree
+   (intersection-ordered-list
+    (tree->list-2 set1)
+    (tree->list-2 set2))))
+
+(define (union-set set1 set2)
+  (list->tree
+   (union-ordered-list
+    (tree->list-2 set1)
+    (tree->list-2 set2))))
diff --git a/2_66.rkt b/2_66.rkt
new file mode 100644
index 0000000..b6c9454
--- /dev/null
+++ b/2_66.rkt
@@ -0,0 +1,34 @@
+#lang sicp
+
+(define (entry tree) (car tree))
+
+(define (left-branch tree) (cadr tree))
+
+(define (right-branch tree) (caddr tree))
+
+(define (make-tree entry left right)
+  (list entry left right))
+
+(define (element-of-set? x set)
+  (cond ((null? set) false)
+        ((= x (entry set)) true)
+        ((< x (entry set))
+         (element-of-set? x (left-branch set)))
+        ((> x (entry set))
+         (element-of-set? x (right-branch set)))))
+
+(define key car)
+
+(define (lookup given-key set-of-records)
+  (cond ((null? set-of-records) false)
+        ((= given-key (key (entry set-of-records))) (entry set-of-records))
+        ((< given-key (key (entry set-of-records)))
+         (lookup given-key (left-branch set-of-records)))
+        (else (lookup given-key (right-branch set-of-records)))))
+
+(define records
+  (make-tree '(3 three)
+             (make-tree '(1 one) '() '())
+             (make-tree '(5 five)
+                        (make-tree '(4 four) '() '())
+                        (make-tree '(7 seven) '() '()))))
diff --git a/2_67.rkt b/2_67.rkt
new file mode 100644
index 0000000..7240337
--- /dev/null
+++ b/2_67.rkt
@@ -0,0 +1,153 @@
+#lang sicp
+
+;;;SECTION 2.3.3
+
+;; representing
+
+(define (make-leaf symbol weight)
+  (list 'leaf symbol weight))
+
+(define (leaf? object)
+  (eq? (car object) 'leaf))
+
+(define (symbol-leaf x) (cadr x))
+
+(define (weight-leaf x) (caddr x))
+
+(define (make-code-tree left right)
+  (list left
+        right
+        (append (symbols left) (symbols right))
+        (+ (weight left) (weight right))))
+
+(define (left-branch tree) (car tree))
+
+(define (right-branch tree) (cadr tree))
+
+(define (symbols tree)
+  (if (leaf? tree)
+      (list (symbol-leaf tree))
+      (caddr tree)))
+
+(define (weight tree)
+  (if (leaf? tree)
+      (weight-leaf tree)
+      (cadddr tree)))
+
+;; decoding
+(define (decode bits tree)
+  (define (decode-1 bits current-branch)
+    (if (null? bits)
+        '()
+        (let ((next-branch
+               (choose-branch (car bits) current-branch)))
+          (if (leaf? next-branch)
+              (cons (symbol-leaf next-branch)
+                    (decode-1 (cdr bits) tree))
+              (decode-1 (cdr bits) next-branch)))))
+  (decode-1 bits tree))
+
+(define (choose-branch bit branch)
+  (cond ((= bit 0) (left-branch branch))
+        ((= bit 1) (right-branch branch))
+        (else (error "bad bit -- CHOOSE-BRANCH" bit))))
+
+;; sets
+
+(define (adjoin-set x set)
+  (cond ((null? set) (list x))
+        ((< (weight x) (weight (car set))) (cons x set))
+        (else (cons (car set)
+                    (adjoin-set x (cdr set))))))
+
+(define (make-leaf-set pairs)
+  (if (null? pairs)
+      '()
+      (let ((pair (car pairs)))
+        (adjoin-set (make-leaf (car pair)
+                               (cadr pair))
+                    (make-leaf-set (cdr pairs))))))
+
+
+(define sample-tree
+  (make-code-tree (make-leaf 'A 4)
+                  (make-code-tree
+                   (make-leaf 'B 2)
+                   (make-code-tree (make-leaf 'D 1)
+                                   (make-leaf 'C 1)))))
+
+(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
+
+(define (memq item x)
+  (cond ((null? x) false)
+        ((eq? item (car x)) x)
+        (else (memq item (cdr x)))))
+
+(define (encode-branch symbol tree)
+  (let ((left-sym (symbols (left-branch tree)))
+        (right-sym (symbols (right-branch tree))))
+    (cond ((memq symbol left-sym) (cons 0 (left-branch tree)))
+          ((memq symbol right-sym) (cons 1 (right-branch tree)))
+          (else (cons '() '())))))
+  
+(define (encode-symbol symbol tree)
+  (if (null? tree) '()
+      (let ((code (car (encode-branch symbol tree)))
+            (branch (cdr (encode-branch symbol tree))))
+        (if (not (null? code))
+            (if (leaf? branch)
+                (list code)
+                (cons code (encode-symbol symbol branch)))
+            (error symbol "not in tree")))))
+      
+
+(define (encode message tree)
+  (if (null? message)
+      '()
+      (append (encode-symbol (car message) tree)
+              (encode (cdr message) tree))))
+
+;; EXERCISE 2.69
+
+(define (successive-merge leaf-set)
+  (if (null? (cdr leaf-set))
+      (car leaf-set)
+      (let ((element1 (car leaf-set))
+            (element2 (cadr leaf-set)))
+        (successive-merge
+         (adjoin-set (make-code-tree element1 element2)
+                     (cddr leaf-set))))))
+    
+
+(define (generate-huffman-tree pairs)
+  (successive-merge (make-leaf-set pairs)))
+
+;; 2.70
+
+(define song-pairs '((a 2) (get 2) (sha 3) (wah 1) (boom 1) (job 2) (na 16) (yip 9)))
+
+(define song-tree (generate-huffman-tree song-pairs))
+
+(define song '(get a job sha na na na na na na na na get a job sha na na na na na na na na sha yip yip yip yip yip yip yip yip yip sha boom))
+
+(define encoded-length (length (encode song song-tree))) ;; 83 bits
+
+;; Song is 36 symobls long.  A fixed-length code would require 3-bits per symbol (8 symbols).  So the
+;; song would need 36*3=108 bits.
+
+;; 2.71
+
+(define pairs-5 '((a 1) (b 2) (c 4) (d 8) (e 16)))
+
+(define pairs-10 (append pairs-5
+                         '((f 32) (g 64) (h 128) (i 256) (j 512))))
+
+;; To encode the most frequent symbol requires 1 bit.  To encode the most frequent symbol requires
+;; n-1 bits (where there are n symbols with weights 1,...,2^{n-1}).  The resulting huffman tree in this
+;; case is the most unbalanced tree possible, so is n-1 deep.
+
+;; 2.72
+;; To encode the most frequent symbol requires a single lookup into n-1 symbols plus a lookup of
+;; 1 symbol.  The tree is only 1 deep for this case, so O(n).
+;; For the least frequent symbol, we need to look up from (n-1) symbols and 1 symbol, then (n-2) symbols
+;; and one symbol.  This repeats n times, so O(n^2).
diff --git a/2_73.rkt b/2_73.rkt
new file mode 100644
index 0000000..aa38053
--- /dev/null
+++ b/2_73.rkt
@@ -0,0 +1,143 @@
+#lang sicp
+
+(define (variable? x) (symbol? x))
+
+(define (same-variable? v1 v2)
+  (and (variable? v1) (variable? v2) (eq? v1 v2)))
+
+(define (=number? exp num)
+  (and (number? exp) (= exp 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 (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 (sum? x)
+  (and (pair? x) (eq? (cadr x) '+)))
+
+(define (addend s) (car s))
+
+;; Special case of multiplication distributing across addition.  It
+;; should be possible to rewrite augend and/or multiplicand to deal
+;; with this case
+
+(define (augend s)
+  (if (product? (cddr s))
+      (cddr s)
+      (caddr s)))
+
+(define (product? x)
+  (and (pair? x) (eq? (cadr x) '*)))
+
+(define (multiplier p) (car p))
+
+(define (multiplicand p) (caddr p))
+
+;; 2.73: (a) The logic to decide how to derive expressions was moved from the derive
+;; procedure into the table.  It isn't possible to use number and variable in the data
+;; dispatch because they don't have a tag that could be used to distinguish them.
+
+;; (b)
+
+;;;-----------
+;;;from section 3.3.3 for section 2.4.3
+;;; to support operation/type table for data-directed dispatch
+
+(define (assoc key records)
+  (cond ((null? records) false)
+        ((equal? key (caar records)) (car records))
+        (else (assoc key (cdr records)))))
+
+(define (make-table)
+  (let ((local-table (list '*table*)))
+    (define (lookup key-1 key-2)
+      (let ((subtable (assoc key-1 (cdr local-table))))
+        (if subtable
+            (let ((record (assoc key-2 (cdr subtable))))
+              (if record
+                  (cdr record)
+                  false))
+            false)))
+    (define (insert! key-1 key-2 value)
+      (let ((subtable (assoc key-1 (cdr local-table))))
+        (if subtable
+            (let ((record (assoc key-2 (cdr subtable))))
+              (if record
+                  (set-cdr! record value)
+                  (set-cdr! subtable
+                            (cons (cons key-2 value)
+                                  (cdr subtable)))))
+            (set-cdr! local-table
+                      (cons (list key-1
+                                  (cons key-2 value))
+                            (cdr local-table)))))
+      'ok)    
+    (define (dispatch m)
+      (cond ((eq? m 'lookup-proc) lookup)
+            ((eq? m 'insert-proc!) insert!)
+            (else (error "Unknown operation -- TABLE" m))))
+    dispatch))
+
+(define operation-table (make-table))
+(define get (operation-table 'lookup-proc))
+(define put (operation-table 'insert-proc!))
+
+;;;-----------
+
+(define (deriv exp var)
+   (cond ((number? exp) 0)
+         ((variable? exp) (if (same-variable? exp var) 1 0))
+         (else ((get 'deriv (operator exp)) (operands exp)
+                                            var))))
+
+(define (operator exp) (car exp))
+
+(define (operands exp) (cdr exp))
+
+
+(define (deriv-sum operands var)
+  (cond ((null? operands) 0)
+        ((null? (cdr operands)) (deriv (car operands) var))
+        (else (make-sum (deriv (car operands) var)
+                        (deriv (cadr operands) var)))))
+
+(define (deriv-prod operands var)
+  (cond ((null? operands) 1)
+        ((null? (cdr operands)) (deriv (car operands) var))
+        (else
+         (let ((op1 (car operands))
+               (op2 (cadr operands)))
+           (make-sum (make-product op1 (deriv op2 var))
+                     (make-product (deriv op1 var) op2))))))
+
+(define (make-exponentiation b p) 
+ (cond ((=number? p 0) 1)
+       ((=number? p 1) b)
+       ((and (number? b) (number? p)) (expt b p))
+       (else (list '** b p))))
+
+(define (base e) (cadr e))
+(define (exponent e) (caddr e))
+
+(define (exponentiation? x) (and (pair? x) (eq? (car x) '**)))
+
+(define (deriv-exp operands var)
+  (let ((base (car operands))
+        (exponent (cadr operands)))
+    (make-product exponent
+                  (make-product
+                   (make-exponentiation base (- exponent 1))
+                   (deriv base var)))))
+
+(put 'deriv '+ deriv-sum)
+(put 'deriv '* deriv-prod)
+(put 'deriv '** deriv-exp)
diff --git a/2_74.rkt b/2_74.rkt
new file mode 100644
index 0000000..b38f90f
--- /dev/null
+++ b/2_74.rkt
@@ -0,0 +1,161 @@
+#lang sicp
+
+;; UNORDERED
+
+(define (element-of-set? x set)
+  (cond ((null? set) false)
+        ((equal? x (car set)) true)
+        (else (element-of-set? x (cdr set)))))
+
+(define (adjoin-set x set)
+  (if (element-of-set? x set)
+      set
+      (cons x set)))
+
+(define (list->set l)
+  (if (null? l) '()
+      (adjoin-set (car l) (list->set (cdr l)))))
+
+;;;-----------
+;;;from section 3.3.3 for section 2.4.3
+;;; to support operation/type table for data-directed dispatch
+
+(define (assoc key records)
+  (cond ((null? records) false)
+        ((equal? key (caar records)) (car records))
+        (else (assoc key (cdr records)))))
+
+(define (make-table)
+  (let ((local-table (list '*table*)))
+    (define (lookup key-1 key-2)
+      (let ((subtable (assoc key-1 (cdr local-table))))
+        (if subtable
+            (let ((record (assoc key-2 (cdr subtable))))
+              (if record
+                  (cdr record)
+                  false))
+            false)))
+    (define (insert! key-1 key-2 value)
+      (let ((subtable (assoc key-1 (cdr local-table))))
+        (if subtable
+            (let ((record (assoc key-2 (cdr subtable))))
+              (if record
+                  (set-cdr! record value)
+                  (set-cdr! subtable
+                            (cons (cons key-2 value)
+                                  (cdr subtable)))))
+            (set-cdr! local-table
+                      (cons (list key-1
+                                  (cons key-2 value))
+                            (cdr local-table)))))
+      'ok)    
+    (define (dispatch m)
+      (cond ((eq? m 'lookup-proc) lookup)
+            ((eq? m 'insert-proc!) insert!)
+            (else (error "Unknown operation -- TABLE" m))))
+    dispatch))
+
+(define operation-table (make-table))
+(define get (operation-table 'lookup-proc))
+(define put (operation-table 'insert-proc!))
+
+;;;-----------
+(define (attach-tag type-tag contents)
+  (cons type-tag contents))
+
+(define (type-tag datum)
+  (if (pair? datum)
+      (car datum)
+      (error "Bad tagged datum -- TYPE-TAG" datum)))
+
+(define (contents datum)
+  (if (pair? datum)
+      (cdr datum)
+      (error "Bad tagged datum -- CONTENTS" datum)))
+
+;;(define (lookup given-key set-of-records)
+  ;;(cond ((null? set-of-records) false)
+        ;;((equal? given-key (key (car set-of-records)))
+         ;;(car set-of-records))
+        ;;(else (lookup given-key (cdr set-of-records)))))
+
+
+
+
+;; Division a
+;; File is a tagged set of records.  Because we don't mix record types
+;; within files, there is no need to tag the records as well.
+;;
+;; (tag {record1,...,record2})
+
+;;(define (make-file-a records)
+  ;;(attach-tag 'div-a
+              ;;(cond ((null? records) 
+
+(define (lookup key)
+  (lambda (given-key set-of-records)
+    (cond ((null? set-of-records) false)
+          ((equal? given-key (key (car set-of-records)))
+           (car set-of-records))
+          (else ((lookup key) given-key (cdr set-of-records))))))
+    
+
+(define (install-div-a-package)
+  (define (key record) (car (contents record)))
+  (define (tag x) (attach-tag 'div-a x))
+  (define (name record) (car record))
+  (define (address record) (cadr record))
+  (define (salary record) (caddr record))
+  (define (make-record name address salary)
+    (tag (list name address salary)))
+
+  (put 'name 'div-a name)
+  (put 'address 'div-a address)
+  (put 'salary 'div-a salary)
+  (put 'lookup 'div-a (lookup key))
+  (put 'make-record 'div-a make-record)
+  (put 'make-file 'div-a (lambda (l) (tag (list->set l))))
+  (put 'get-record 'div-a (lookup key)))
+
+(install-div-a-package)
+(define r1 ((get 'make-record 'div-a) "Bob" "Bob's address" 12345))
+(define r2 ((get 'make-record 'div-a) "Alice" "Alice's address" 54321))
+(define file-a ((get 'make-file 'div-a) (list r1 r2)))
+
+(define (install-div-b-package)
+  (define (key record) (car (contents record)))
+  (define (tag x) (attach-tag 'div-b x))
+  (define (name record) (car record))
+  (define (address record) (caddr record))
+  (define (salary record) (cadr record))
+  (define (make-record name address salary)
+    (tag (list name salary address)))
+
+  (put 'name 'div-b name)
+  (put 'address 'div-b address)
+  (put 'salary 'div-b salary)
+  (put 'lookup 'div-b (lookup key))
+  (put 'make-record 'div-b make-record)
+  (put 'make-file 'div-b (lambda (l) (tag (list->set l))))
+  (put 'get-record 'div-b (lookup key)))
+
+(install-div-b-package)
+(define r3 ((get 'make-record 'div-b) "Peter" "Peter's address" 1111))
+(define r4 ((get 'make-record 'div-b) "Paul" "Paul's address" 2222))
+(define file-b ((get 'make-file 'div-b) (list r3 r4)))
+
+(define (get-record name file)
+  ((get 'get-record (type-tag file)) name (contents file)))
+
+(define (get-salary record)
+  ((get 'salary (type-tag record)) (contents record)))
+
+(define (find-employee-record name files)
+  (if (null? files) #f
+      (let ((file (car files)))
+        (or ((get 'get-record (type-tag file)) name (contents file))
+            (find-employee-record name (cdr files))))))
+      
+;; To add a new division, it is necessary to put the corresponding constructors
+;; and selectors into the table with put, ensuring that each record and file is
+;; tagged.