SICP 2.5 exercises


When the user calls one of the procedures, such as (magnitude z), apply-generic is invoked and discovers the ‘(complex) tag. It looks in the table and discovers that the magnitude procedure needs to be run on the contents, which is (‘rectangular 3 . 4). The same magnitude procedure as before is called, which invoked apply-generic a second time. This time it sees the ‘(rectangular) tag and calls the magnitude procedure that was defined in install-rectangular-package on the contents, which is (3 . 4), and the result is 5.


(define (attach-tag type-tag contents)
  (if (number? contents)
      (cons type-tag contents)))

(define (type-tag datum)
  (cond ((number? datum) 'scheme-number)
        ((pair? datum)(car datum))
        (else (error "Bad tagged datum -- TYPE-TAG" datum))))

(define (contents datum)
  (cond ((number? datum) datum)
        ((pair? datum) (cdr datum))
        (else (error "Bad tagged datum -- CONTENTS" datum))))

Essentially we add a new condition in each procedure to deal with the special case when we’re dealing with a native number type. type-tag has to attach a scheme-number tag to keep the dispatch table happy.


Define procdures to deal with each data type and put them into the table. These are defined in their corresponding install procedures.

(put 'equ? '(scheme-number scheme-number)
       (lambda (x y) (= x y)))

(define (equ?-rational x y)
   (= (/ (numer x) (denom x)) (/ (numer y) (denom y))))
(put 'equ? '(rational rational) equ?-rational)
(define (equ?-complex z1 z2)
    (and (= (real-part z1) (real-part z2))
         (= (imag-part z1) (imag-part z2))))
(put 'equ? '(complex complex) equ?-complex)

The generic operation also needs to be defined.

(define (equ? a b) (apply-generic 'equ? a b))


Same thing is done as before in 2.79.

(put '=zero? '(scheme-number)
       (lambda (x) (= x 0)))
(put '=zero? '(rational) (lambda (x) (= 0 (numer x))))
(define (=zero?-complex z)
    (and (= (real-part z) 0)
         (= (imag-part z) 0)))
(put '=zero? '(complex) =zero?-complex)

(define (=zero? a) (apply-generic '=zero? a))

Comments:: Quite disappointed in my own progress lately. A mix of obligations for school/work and being unable to concentrate and understand what the chapter was talking about. One thing I’ve noticed about this book is that it requires a lot of concentration to understand the content even though it seems short and simple at first.


SICP 2.4 exercises cont. 3


(define (make-from-mag-ang 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)
           (error "Unknown op -- MAKE-FROM-MAG-ANG" op))))

(define (apply-generic op arg) (arg op))

Easy enough, but implementing this gave a much clearer idea of what the book meant by message passing.


Generic operations with explicit dispatch
New Type – For each operation, create procedures that deal with the new type. For each generic operation, add a conditional statement that tests if the tag corresponds to the new type and calls the correct procedure that was just defined.
New Operation – For each type, create a procedure that deals with the new operation. Create a new generic operation that deals with each type currently in the system correctly using conditional statements.

Data Directed Style
New Type – Create procedures for the new type for each operation and put them into the table indexed by the procedure name and the type name.
New Operation – Create procedures for the new operation for each type and put them into the table indexed by the procedure name and type name.

Message Passing Style
New Type – Create a new procedure/data object which deals with existing operations through conditional statements and returns a correct procedure representing the type.
New Operation – For each data object defined, create a new conditional statement that handles the new operation.

Message passing is most appropriate when new types are added frequently, because it only requires defining one new procedure.

Data Directed is most appropriate for when new operations are added frequently as new values can be placed into the table as needed.

Finally finished section 2,4! This took much longer than expected thanks to the start of school and all the obligations that came with it. Still, my time management can be improved. Hopefully I can work through the book more consistently from now on.

SICP 2.4 exercises cont. 2


Full code listing below for all 4 parts. The annoying thing about this problem was I needed to implement two different representation of the files and records. I just did something simple, where the name-information pairs in the records are represented by cons in the alpha division and list in the beta division.

a) Individual division’s file need to have their division name tagged to the front of the records so that the generic get-record procedure can identify which specific get-record procedure to use.

b) Each record should be tagged with the division name in front of the name and the information pairs.

c) Can be implemented in terms of the procedures in a) and b)

d) When a new division is added, all it’s records and files need to be tagged. Functions need to be defined for getting the salary from records and the records from files and then put into the table.

My procedures were a little bit hackish in that the individual get-record and get-salary procedures need to deal with the tag in the records. This is invisible to the user of the generic procedures however.

(define (make-record-beta name . pairs)
  (define (make-info kv-pair)
    (if (null? kv-pair)
        (cons (list (car kv-pair) (cadr kv-pair)) (make-info (cddr kv-pair)))))
  (list name (make-info pairs)))

(define (get-record-beta name file)
  (cond ((null? file) #f)
        ((eq? (caar file) name) (car file))
        (else (get-record-beta name (cdr file)))))

(define (get-salary-beta record)
  (define (retrieve pairs)
    (if (eq? (caar pairs) 'salary)
        (cadar pairs)
        (retrieve (cdr pairs))))
  (retrieve (cadr record)))

(define (get-tag tagged-file)
  (car tagged-file))

(define (contents tagged-file)
  (cdr tagged-file))

(define (tag-file tag file)
  (cons tag file))

(define (make-record-alpha name . pairs)
  (define (make-info kv-pair)
    (if (null? kv-pair)
      (cons (cons (car kv-pair) (cadr kv-pair))
            (make-info (cddr kv-pair)))))
  (tag-file 'alpha (cons name (make-info pairs))))

(define (make-file-alpha . records)
  (tag-file 'alpha records))

(define (make-file-beta . records)
  (tag-file 'beta records))

(define (install-division-alpha)
  (define (get-record-alpha name file)
    (cond ((null? file) #f)
          ((eq? name (cadar file)) (car file))
          (else (get-record-alpha name (cdr file)))))

  (define (get-salary-alpha record)
    (define (retrieve pairs)
      (if (eq? (caar pairs) 'salary)
          (cdar pairs)
        (retrieve (cdr pairs))))
    (retrieve (cdr record)))
  (put 'get-record 'alpha get-record-alpha)
  (put 'get-salary 'alpha get-salary-alpha))

(define (install-division-beta)
  (define (get-record name file)
    (cond ((null? file) #f)
          ((eq? name (cadar file)) (car file))
          (else (get-record name (cdr file)))))
  (define (get-salary record)
    (define (retrieve pairs)
      (if (eq? 'salary (car pairs))
          (cadr pairs)
          (retrieve (cddr pairs))))
    (retrieve (cdr record)))
  (put 'get-record 'beta get-record)
  (put 'get-salary 'beta get-salary))

(define (get-record name file)
  ((get 'get-record (get-tag file)) name (contents file)))

(define (get-salary record)
  ((get 'get-salary (get-tag record)) (contents record)))

(define (find-employee-record name files)
  (if (null? files)
    (let ((result (get-record name (car files))))
      (if result result
        (find-employee-record name (cdr files))))))

Comments: Skipped two days, which is too bad, Despite there being so few problems in this chapter, I seem to be taking a very long time. I suppose that is what happens when there are other obligations to meet.

SICP 2.4 exercises cont.


(define (install-deriv-package)
  (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) (cadr s))
  (define (sum exp var)
    (make-sum (deriv (addend exp) var)
              (deriv (augend exp) var)))

  (define (multiplier p) (car p))
  (define (multiplicand p) (cadr p))
  (define (product exp var)
     (make-product (multiplier exp)
                   (deriv (multiplicand exp) var))
     (make-product (deriv (multiplier exp) var)
                   (multiplicand exp))))
  (put 'deriv '+ sum)
  (put 'deriv '* product))


Simply change the put arguments:

(put '+ 'deriv sum)
(put '* 'deriv product)
(put '** 'deriv exponentiation)

Spent most of my time learning ruby on rails today, but I got the second half of the problem done.

SICP 2.4 exercises


a) The dispatch is based on the operator symbol, and when the expression is a single number or a variable, there is no operator to identify. In general, the general procedure tests is the expression is a number or variable and deals with it accordingly. If there is an operator, then the operator symbol is used to retrieve the procedure needed to deal with the expression.


(define (install-deriv-package)
  (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) (cadr s))
  (define (sum exp var)
    (make-sum (deriv (addend exp) var)
              (deriv (augend exp) var)))

  (define (multiplier p) (car p))
  (define (multiplicand p) (cadr p))
  (define (product exp var)
     (make-product (multiplier exp)
                   (deriv (multiplicand exp) var))
     (make-product (deriv (multiplier exp) var)
                   (multiplicand exp))))
  (put 'deriv '+ sum)
  (put 'deriv '* product))

Really busy these days, so this is a record low rate of progress… 1/2 of a problem! Although b) is a decently large problem in itself. Weekend starts though so hopefully I can blast through the problems in the next couple days.

SICP 2.3 exercises cont. 4


(define (successive-merge elements)
  (if (null? (cdr elements)) (car elements)
   (let ((e1 (car elements))
         (e2 (cadr elements))
         (rest (cddr elements)))
     (successive-merge (adjoin-set (make-code-tree e1 e2) rest)))))

(define song (generate-huffman-tree '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (YIP 9) (JOB 2) (WAH 1))))
(1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1)

84 bits using huffman encoding above.
fixed length encoding would require 3 bit per word for 36 words, which is 108 bits.

Just going to have the diagram for n=5 here, as n=10 looks the same, just longer.


1 bit for the most frequent symbol
n bits for least frequent symbol

Most frequent symbol will be encoded in O(1) time because it is always the first symbol that the encode procedure encounters as shown in 2.71.

The least frequent symbol will be encoded in O(n^2) time because at each level of the tree, encode must scan through up to n symbols to check which branch to encode, and there are n levels in the tree.

Comments: Finally done with 2.3. These questions made me realized I implemented encode incorrectly as my answer yesterday raises an error inappropriately. In fact I was overcomplicating it as I had forgotten that parent node has information about what symbols are represented by the branch. Correct answer below.

(define (encode-symbol symbol tree)
  (cond ((leaf? tree)
        ((element-of-set? symbol (symbols (left-branch tree)))
         (cons 0 (encode-symbol symbol (left-branch tree))))
        ((element-of-set? symbol (symbols (right-branch tree)))
         (cons 1 (encode-symbol symbol (right-branch tree))))
        (else (error "No such symbol in tree:" symbol))))

SICP 2.3 exercises cont. 3


(decode sample-message sample-tree)
(A D A B B C A)


(define (encode-symbol symbol tree)
  (if (leaf? tree)
      (if (eq? (symbol-leaf tree) symbol)
    (let ((left-result (encode-symbol symbol (left-branch tree))))
      (if left-result
          (cons 0 left-result)
        (let ((right-result (encode-symbol symbol (right-branch tree))))
          (if right-result
              (cons 1 right-result)
            (error "No such symbol in tree:" symbol)))))))

(encode '(A D A B B C A) sample-tree)
(0 1 1 0 0 1 0 1 0 1 1 1 0)

Snail’s pace now due to school. Oh well, as long as it’s consistent.