Add exercises from section 2.4

chapter-2/ex-2.67.scm

@@ -0,0 +1,67 @@
+#lang sicp
+
+(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)))
+
+(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))))
+
+(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)   ; symbol
+                               (cadr pair)) ; frequency
+                    (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))
+
+; (decode sample-message sample-tree)
+; (A D A B B C A)

chapter-2/ex-2.68.scm

@@ -0,0 +1,99 @@
+#lang sicp
+
+(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)))
+
+(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))))
+
+(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)   ; symbol
+                               (cadr pair)) ; frequency
+                    (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))
+
+; (decode sample-message sample-tree)
+; (A D A B B C A)
+
+; until now previous exercise
+
+; setup for the current one
+(define (encode message tree)
+  (if (null? message)
+      '()
+      (append (encode-symbol (car message) tree)
+              (encode (cdr message) tree))))
+
+; my procedure
+; assumes that a tree is well formed, ie. that if a symbol appears in a
+; parent node's list it must be in one of the child branches
+; not the most efficient since it checks symbol lists at almost every level
+; twice
+(define (encode-symbol symbol tree)
+  (cond ((not (member-set symbol (symbols tree)))
+         (error "encode-symbol: no seq for the symbol in tree" symbol tree))
+        ((leaf? tree)
+         '())
+        ((member-set symbol (symbols (left-branch tree)))
+         (cons 0 (encode-symbol symbol (left-branch tree))))
+        ((member-set symbol (symbols (right-branch tree)))
+         (cons 1 (encode-symbol symbol (right-branch tree))))))
+
+(define member-set member)
+; since a set is represented as a list, we can simply use the member procedure
+
+;test:
+; input: (A D A B B C A)
+; output:(0 1 1 0 0 1 0 1 0 1 1 1 0)
+; it works!

chapter-2/ex-2.69.scm

@@ -0,0 +1,66 @@
+#lang sicp
+
+(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)))
+
+(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))))
+
+(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)   ; symbol
+                               (cadr pair)) ; frequency
+                    (make-leaf-set (cdr pairs))))))
+
+; actual exercise
+(define (generate-huffman-tree pairs)
+  (successive-merge (make-leaf-set pairs)))
+
+(define (successive-merge tree-set)
+  (if (null? (cdr tree-set)) ; (= (length tree-list) 1)
+      (car tree-set)
+      (let ((tree1 (car tree-set))
+            (tree2 (cadr tree-set)))
+        (successive-merge (adjoin-set (make-code-tree tree1 tree2)
+                                      (cddr tree-set))))))

chapter-2/ex-2.70.scm

@@ -0,0 +1,109 @@
+#lang sicp
+
+(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)))
+
+(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))))
+
+(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)   ; symbol
+                               (cadr pair)) ; frequency
+                    (make-leaf-set (cdr pairs))))))
+
+(define (generate-huffman-tree pairs)
+  (successive-merge (make-leaf-set pairs)))
+
+(define (successive-merge tree-set)
+  (if (null? (cdr tree-set)) ; (= (length tree-list) 1)
+      (car tree-set)
+      (let ((tree1 (car tree-set))
+            (tree2 (cadr tree-set)))
+        (successive-merge (adjoin-set (make-code-tree tree1 tree2)
+                                      (cddr tree-set))))))
+
+; the encode functionality from 2.68
+(define (encode message tree)
+  (if (null? message)
+      '()
+      (append (encode-symbol (car message) tree)
+              (encode (cdr message) tree))))
+
+(define (encode-symbol symbol tree)
+  (cond ((not (member-set symbol (symbols tree)))
+         (error "encode-symbol: no seq for the symbol in tree" symbol tree))
+        ((leaf? tree)
+         '())
+        ((member-set symbol (symbols (left-branch tree)))
+         (cons 0 (encode-symbol symbol (left-branch tree))))
+        ((member-set symbol (symbols (right-branch tree)))
+         (cons 1 (encode-symbol symbol (right-branch tree))))))
+
+(define member-set member)
+; since a set is represented as a list, we can simply use the member procedure
+
+; actual exercise 2.70
+
+(define sample-tree
+  (generate-huffman-tree '((a 2)
+                           (get 2)
+                           (sha 3)
+                           (wah 1)
+                           (boom 1)
+                           (job 2)
+                           (na 16)
+                           (yip 9))))
+
+(define sample-message
+  '(get a job
+	sha na na na na na na na na
+        get a job
+	sha na na na na na na na na
+        wah yip yip yip yip yip yip yip yip yip
+        sha boom))
+
+; (length (encode sample-message sample-tree)) -> 84
+; if we used a fixed length code, it would have to have length of >=3
+; since there are 36 words here, the answer would be 108

chapter-2/ex-2.71.txt

@@ -0,0 +1,36 @@
+(A 1), (B 2), (C 4), ...
+Tree sketch (n=5):
+
+      *
+   /     \
+(E 16)    *
+       /     \
+    (D 8)     *
+           /     \
+        (C 4)     *
+               /     \
+            (B 2)   (A 1)
+
+tree sketch (n=10):
+       *
+    /     \
+(J 512)   *
+       /     \
+   (I 256)    *
+           /     \
+       (H 128)    *
+               /     \
+            (G 64)    *
+                   /     \
+                (F 32)    *
+                       /     \
+                    (E 16)    *
+                           /     \
+                        (D 8)     *
+                               /     \
+                            (C 4)     *
+                                   /     \
+                                (B 2)   (A 1)
+
+The most frequent symbol always requires exactly 1 bit.
+The two least frequent symbols will always require exactly n-1 bits.

chapter-2/ex-2.72.txt

@@ -0,0 +1,12 @@
+Searching a single node requires on the order of k operations, where
+k is the number of symbols given at that node.
+If the tree is roughly balanced, then the number of symbols listed in
+each node on the way down should decrease exponentially, and the number
+of these searches would be on the order of O(log(n)), where n is the
+number of symbols generally available for encoding.
+
+If this is true, than each encoding of a symbol would take on the order
+of O(n*log(n)) operations, however if the tree is very unbalanced,
+which is the case in exercise 2.71, the order of growth is roughly
+O(n^2), for the least frequent symbols, and O(n), for the most common
+symbol.

chapter-2/ex-2.73.txt

@@ -0,0 +1,50 @@
+a) The predicates `number?` and `variable?` can't be assimilated because they
+are checking the data type of the datum itself, not the value of a specific
+symbol which can be found in a table.
+
+b) Here I'll only write the most basic version of the procedures, since the
+more elaborate versions were done in previous exercises.
+
+(define (install-deriv-package)
+  (define (deriv-sum operands var)
+    (let ((addend (car operands))
+          (augend (cadr operands)))
+      (make-sum (deriv addend var)
+                (deriv augend var))))
+
+  (define (deriv-product operands var)
+    (let ((multiplicand (car operands))
+          (multiplier   (cadr operands)))
+      (make-sum
+        (make-product multiplier
+                      (deriv multiplicand var))
+        (make-product (deriv multiplier var)
+                      multiplicand))))
+
+  (put 'deriv '+ deriv-sum)
+  (put 'deriv '* deriv-product)
+  'done)
+
+c) exponential rule:
+...
+(define (deriv-expon operands var)
+  (let ((base (car operands))
+        (exponent (cadr operands)))
+       (if (constant? exponent var)
+           (make-product (make-product exponent
+                                       (make-exponentiation base
+                                                            (make-sum
+                                                             exponent
+                                                             -1)))
+                         (deriv base var))
+           (error "non-constant exponents not yet supported: DERIV" exponent))))
+...
+(put 'deriv '** deriv-expon)
+...
+
+d) if the dispatch line looked like this:
+((get (operator exp) 'deriv) (operands exp) var)
+
+the only part we would really have to change is the put lines for each of the
+functions, like so:
+(put 'deriv '+ deriv-sum) -> (put '+ 'deriv deriv-sum)

chapter-2/ex-2.74.txt

@@ -0,0 +1,59 @@
+This is a txt file because there's no sense in trying to make it into a proper
+runnable scheme file, unless I go out of my way to make several examples of
+data structure and record formats, complete with examples in order to actually
+run these:
+
+a) Before any of the data records in the file itself, there should be an
+identifier for what type of record it is, so each file should start with a
+symbol, number or string that uniquely identifies the file structure/format,
+for example:
+european-division-format
+(...)
+(...)
+...
+
+This piece of info should be in the same position in every file, so that a
+uniform function, say (get-file-type file) could be used to find the proper
+format. If it's not possible to change these division formats at all, then
+either this change will be done while loading the file, or, the get-file-type
+function will have to be more complicated.
+
+In any case, once we have solved the format marking issue using any kind of
+method, the files and the records could be structured any how, as long as each
+record has a unique identifier to the employee.
+
+These can then be searched with different functions for different formats, all
+of which could be organized in a table, and called by a master function, which
+will load the record, and then attach it with a tag, which will make record
+processing easier too:
+
+(define (get-record name file)
+  (let ((file-type (get-file-type file)))
+    (attach-record-type file-type
+      ((get 'get-record file-type) name))))
+
+We will also assume all these functions return nil if the record doesn't
+exist, or a single record if it does.
+
+b) The way that we've written the get-record function, it doesn't matter how a
+particular employee record is structured, because we tag it as the respective
+file type ourselves, but of course it must contain the salary field, we must
+also define a function which gets the record type, and the rest of the record:
+get-record-type and get-record-body
+
+(define (get-salary record)
+  ((get 'get-salary (get-record-type record)) (get-record-body record)))
+
+c) We assume there's only one employee for the given name
+
+(define (find-employee-record name files)
+  (let ((returns (filter (lambda (record) (not (null? record)))
+                         (map get-record files))))
+    (if (null? returns)
+        nil
+        (car returns))))
+
+d) All changes could be done in the new company's (or department's) package,
+where they would simply define a new format name, add the format name tag to
+their records, modify their get-record and get-salary functions appropriately,
+and then add these to the updated global function table.

chapter-2/ex-2.75.scm

@@ -0,0 +1,10 @@
+#lang sicp
+
+(define (make-from-real-imag r a)
+  (define (dispatch op)
+    (cond ((eq? op 'real-part) (* r (cos a)))
+          ((eq? op 'imag-part) (* r (sin a)))
+          ((eq? op 'magnitude) r)
+          ((eq? op 'angle) a)
+          (else (error "Unknown op: MAKE-FROM-MAG-ANG" op))))
+  dispatch)

chapter-2/ex-2.76.txt

@@ -0,0 +1,32 @@
+Explicit dispatch:
+  New type: A new constructor(s), must be made for the new data type, which
+    will add the necessary fields and attach a new type tag. Each of the
+    functions for the type will need to have a new condition line to check for
+    the new type.
+  New op: The new op will be written in an explicit dispatch style to process
+    all of the preexisting types
+
+Data-directed style:
+  New type: A new package will be written, complete with all the necessary
+    functions to process the new type, they will then all be added to a new
+    row in the table
+  New op: Each existing package will have the op added to it, and will also
+    add it to a new column in the table
+
+Message-passing style:
+  New type: A new dispatch function will be created, with all of the lines
+    which exist in functions of previous types
+  New op: A new line is added into each of the dispatch functions of the
+    preexisting types
+
+If new operations are often added, you may prefer the explicit dispatch style,
+since it involves only creating/modifying one place in the codebase.
+
+If new types are often added, you may instead prefer one of the other two
+styles, since here, an addition of a new type is done in one place in the
+code, while adding a new op requires changes in many places.
+
+That being said, the data-directed style has the extra advantage that it could
+(in principle) be written in a way that's more organized for adding new
+operations, since the table structure itself will work equally well in either
+case, and it's more of a matter of code organization.