weima learns to program

my attempt to do the exercises in sicp.

Tuesday, July 29, 2008

sicp exercise 2.72

;; Exercise 2.72.  Consider the encoding procedure that you designed in exercise 2.68. What is the order of growth in the number of steps needed to encode a symbol? Be sure to include the number of steps needed to search the symbol list at each node encountered. To answer this question in general is difficult. Consider the special case where the relative frequencies of the n symbols are as described in exercise 2.71, and give the order of growth (as a function of n) of the number of steps needed to encode the most frequent and least frequent symbols in the alphabet.

;; If the relative frequencies are 1, 2, 4, ..., 2^n-1 , the order of growth is O(n^2)

sicp exercise 2.71

;; Exercise 2.71.  Suppose we have a Huffman tree for an alphabet of n symbols, and that the relative frequencies of the symbols are 1, 2, 4, ..., 2^n-1. Sketch the tree for n=5; for n=10. In such a tree (for general n) how may bits are required to encode the most frequent symbol? the least frequent symbol?

;; huffman tree for n=5 (below)

;; huffman tree for n=10 is also similar.

;; bits to encode most frequent symbol = n-1
;; bits to encode least frequent symbol = 1

sicp exercise 2.70

;; Exercise 2.70.  The following eight-symbol alphabet with associated relative frequencies was designed to efficiently encode the lyrics of 1950s rock songs. (Note that the ``symbols'' of an ``alphabet'' need not be individual letters.)

;; A         2         NA         16
;; BOOM 1         SHA         3
;; GET         2         YIP         9
;; JOB         2         WAH         1
;; Use generate-huffman-tree (exercise 2.69) to generate a corresponding Huffman tree, and use encode (exercise 2.68) to encode the following 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

;; How many bits are required for the encoding? What is the smallest number of bits that would be needed to encode this song if we used a fixed-length code for the eight-symbol alphabet?

(define (make-leaf symbol weight)
(list 'leaf symbol weight))
(define (leaf? object)
(eq? (car object) 'leaf))

(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 (symbols tree)
(if (leaf? tree)
(list (symbol-leaf tree))
(define (weight tree)
(if (leaf? tree)
(weight-leaf tree)

(cond ((null? set) (list x))
((< (weight x) (weight (car set))) (cons x set))
(else (cons (car set)

(define (make-leaf-set pairs)
(if (null? pairs)
'()
(let ((pair (car pairs)))
(adjoin-set (make-leaf (car pair)    ; symbol
(make-leaf-set (cdr pairs))))))

(define (successive-merge leaf-set)
(cond ((null? leaf-set) (list))
((null? (cdr leaf-set)) (car leaf-set))
(else (successive-merge (adjoin-set (make-code-tree (car leaf-set)
(cddr leaf-set))))))

(define (generate-huffman-tree pairs)
(successive-merge (make-leaf-set pairs)))

(define false #f)
(define true  #t)

(define (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))

(define (encode-symbol symbol tree)
(define (encode-symbol-iter symbol sub-tree)
(cond ((leaf? sub-tree) (list))
((element-of? symbol (symbols (left-branch sub-tree)))
(cons '0 (encode-symbol-iter symbol (left-branch sub-tree))))
((element-of? symbol (symbols (right-branch sub-tree)))
(cons '1 (encode-symbol-iter symbol (right-branch sub-tree))))
(else (error "error not present"))))
(if (element-of? symbol (symbols tree))
(encode-symbol-iter symbol tree)
(error "error not present")))
(define (element-of? symbol set)
(cond ((null? set) false)
((eq? symbol (car set)) true)
(else (element-of? symbol (cdr set)))))

(define pairs '((a 2) (na 16) (boom 1) (Sha 3) (Get 2) (yip 9) (job 2) (Wah 1)))

(define 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))

(define huff-tree (generate-huffman-tree pairs))
(display huff-tree) (newline)

(define encoded-message (encode message huff-tree))

(display message) (newline)
(display encoded-message) (newline)

;; number of bits with huffman encoding = 84
;; number of bits with fixed-length encoding = 108

(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 decoded-message (decode encoded-message huff-tree))
(display decoded-message) (newline)

;; decoding also works :-)

sicp exercise 2.69

;; Exercise 2.69.  The following procedure takes as its argument a list of symbol-frequency pairs (where no symbol appears in more than one pair) and generates a Huffman encoding tree according to the Huffman algorithm.

;; (define (generate-huffman-tree pairs)
;;   (successive-merge (make-leaf-set pairs)))

;; make-leaf-set is the procedure given above that transforms the list of pairs into an ordered set of leaves. Successive-merge is the procedure you must write, using make-code-tree to successively merge the smallest-weight elements of the set until there is only one element left, which is the desired Huffman tree. (This procedure is slightly tricky, but not really complicated. If you find yourself designing a complex procedure, then you are almost certainly doing something wrong. You can take significant advantage of the fact that we are using an ordered set representation.)

(define (make-leaf symbol weight)
(list 'leaf symbol weight))
(define (leaf? object)
(eq? (car object) 'leaf))

(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 (symbols tree)
(if (leaf? tree)
(list (symbol-leaf tree))
(define (weight tree)
(if (leaf? tree)
(weight-leaf tree)

(cond ((null? set) (list x))
((< (weight x) (weight (car set))) (cons x set))
(else (cons (car set)

(define (make-leaf-set pairs)
(if (null? pairs)
'()
(let ((pair (car pairs)))
(adjoin-set (make-leaf (car pair)    ; symbol
(make-leaf-set (cdr pairs))))))

(define (successive-merge leaf-set)
(cond ((null? leaf-set) (list))
((null? (cdr leaf-set)) (car leaf-set))
(else (successive-merge (adjoin-set (make-code-tree (car leaf-set)
(cddr leaf-set))))))

(define (generate-huffman-tree pairs)
(successive-merge (make-leaf-set pairs)))

(display (generate-huffman-tree '((A 4) (B 2) (C 1) (D 1)))) (newline)

sicp exercise 2.68

;; Exercise 2.68.  The encode procedure takes as arguments a message and a tree and produces the list of bits that gives the encoded message.

;; (define (encode message tree)
;;   (if (null? message)
;;       '()
;;       (append (encode-symbol (car message) tree)
;;               (encode (cdr message) tree))))

;; Encode-symbol is a procedure, which you must write, that returns the list of bits that encodes a given symbol according to a given tree. You should design encode-symbol so that it signals an error if the symbol is not in the tree at all. Test your procedure by encoding the result you obtained in exercise 2.67 with the sample tree and seeing whether it is the same as the original sample message.

(define false #f)
(define true  #t)

(define (make-leaf symbol weight)
(list 'leaf symbol weight))
(define (leaf? object)
(eq? (car object) 'leaf))

(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 (symbols tree)
(if (leaf? tree)
(list (symbol-leaf tree))
(define (weight tree)
(if (leaf? tree)
(weight-leaf 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 (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))

(define (encode-symbol symbol tree)
(define (encode-symbol-iter symbol sub-tree)
(cond ((leaf? sub-tree) (list))
((element-of? symbol (symbols (left-branch sub-tree)))
(cons '0 (encode-symbol-iter symbol (left-branch sub-tree))))
((element-of? symbol (symbols (right-branch sub-tree)))
(cons '1 (encode-symbol-iter symbol (right-branch sub-tree))))
(else (error "error not present"))))
(if (element-of? symbol (symbols tree))
(encode-symbol-iter symbol tree)
(error "error not present")))
(define (element-of? symbol set)
(cond ((null? set) false)
((eq? symbol (car set)) true)
(else (element-of? symbol (cdr set)))))

(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 encoded-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))

(display sample-tree) (newline)
(display encoded-message) (newline)
(display (decode encoded-message sample-tree)) (newline)
(display (encode '(A D A B B C A) sample-tree)) (newline)

Monday, July 28, 2008

sicp exercise 2.67

;; Exercise 2.67.  Define an encoding tree and a sample message:

;; (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))

;; Use the decode procedure to decode the message, and give the result.

(define (make-leaf symbol weight)
(list 'leaf symbol weight))
(define (leaf? object)
(eq? (car object) 'leaf))

(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 (symbols tree)
(if (leaf? tree)
(list (symbol-leaf tree))
(define (weight tree)
(if (leaf? tree)
(weight-leaf 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 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))

(display sample-tree) (newline)

(display (decode sample-message sample-tree)) (newline)

sicp exercise 2.66

;; Exercise 2.66.  Implement the lookup procedure for the case where the set of records is structured as a binary tree, ordered by the numerical values of the keys.

(define false #f)
(define true  #t)

(define (entry tree) (car tree))
(define (make-tree entry left right)
(list entry left right))

(define (element-of-set? key set)
(cond ((null? set) false)
((= key (key (entry set))) true)
((< key (key (entry set))) (element-of-set? (left-branch set)))
((> key (key (entry set))) (element-of-set? (right-branch set)))))

(define (make-record key data)
(cons key data))
(define (key record)
(car record))
(define (data record)
(cdr record))

(define (lookup given-key records)
(element-of-set? given-key records))

Sunday, July 27, 2008

sicp exercise 2.65

;; Exercise 2.65.  Use the results of exercises 2.63 and  2.64 to give O(n) implementations of union-set and intersection-set for sets implemented as (balanced) binary trees.

;; To union the two sets implemented as balanced binary trees, convert both the tree into list, compute union of the two ordered list, convert the resulting list into balanced binary tree.

(define (union-set set1 set2)
(cond ((null? set1) set2)
((null? set2) set1)
((and (null? set1) (null? set2)) (list))
(else
(let ((x1 (car set1))
(x2 (car set2)))
(cond ((> x1 x2) (cons x2
(union-set set1 (cdr set2))))
((= x1 x2) (cons x1
(union-set (cdr set1) (cdr set2))))
((< x1 x2) (cons x1
(union-set (cdr set1) set2))))))))

(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 NULL (list))

(define (make-tree item left right) (list item left right))
(define (entry tree) (car tree))

(define (tree->list 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 NULL))

(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 (union-tree tree1 tree2)
(let ((list1 (tree->list tree1))
(list2 (tree->list tree2)))
(let ((union-list (union-set list1 list2)))
(list->tree union-list))))

(define (intersection-tree tree1 tree2)
(let ((list1 (tree->list tree1))
(list2 (tree->list tree2)))
(let ((intersection-list (intersection-set list1 list2)))
(list->tree intersection-list))))

(define set1 (list 100 200 300 400 500))
(define set2 (list 10 20 30 40 50))
(define set3 (list 1 2 35 45 55))
(define set4 (list 10 20 50 70 90))

(define tree1 (list->tree set1))
(define tree2 (list->tree set2))
(define tree3 (list->tree set3))
(define tree4 (list->tree set4))

(display (union-tree tree1 tree2)) (newline)
(display (intersection-tree tree2 tree4)) (newline)

sicp exercise 2.64

;; Exercise 2.64.  The following procedure list->tree converts an ordered list to a balanced binary tree. The helper procedure partial-tree takes as arguments an integer n and list of at least n elements and constructs a balanced tree containing the first n elements of the list. The result returned by partial-tree is a pair (formed with cons) whose car is the constructed tree and whose cdr is the list of elements not included in the 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))))))))

;; a. Write a short paragraph explaining as clearly as you can how partial-tree works. Draw the tree produced by list->tree for the list (1 3 5 7 9 11).

;; b. What is the order of growth in the number of steps required by list->tree to convert a list of n elements?

;; a.
;; The height of a balanced tree of size N is of the order of log(N). The procedure stats by making tree and goes down the left path of the tree for about log(N) times and reaches a point where 'n' becomes 0, that is the point where procedure starts to return back. It places the first element of the list as the entry element of the left most node of the tree. It adjusts the list by removing the first element and starts making the right subtree in the same way. The 'n' for the right subtree is the remaining half of the 'n' for this node. The procedure similarily adjusts the element list for the right subtree and the procedure returns to one level higher.

;; b.
;; The order of growth is O(n)

(define NULL (list))

(define (make-tree item left right) (list item left right))
(define (entry tree) (car tree))

(define (tree-height tree)
(cond ((null? tree) 0)
(else (+ 1 (max (tree-height (left-branch tree))
(tree-height (right-branch 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))))))))

(display (list 1 3 5 7 9 11)) (newline)
(display (list->tree (list 1 3 5 7 9 11))) (newline)
(display (tree-height (list->tree (list 1 3 5 7 9 11)))) (newline)

(define (enumerate-list start end next)
(cond ((> start end) (list))
(else (cons start
(enumerate-list (next start) end next)))))

(define my-list (enumerate-list 1 500 (lambda(x) (+ x 2))))
(display my-list) (newline)
(define  tree-my-list (list->tree my-list))
(display tree-my-list) (newline)
(display (tree-height tree-my-list)) (newline)

Tuesday, July 22, 2008

sicp exercise 2.63

;; Exercise 2.63.  Each of the following two procedures converts a binary tree to a list.

;; (define (tree->list-1 tree)
;;   (if (null? tree)
;;       NULL
;;       (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 NULL))

;; a. Do the two procedures produce the same result for every tree? If not, how do the results differ? What lists do the two procedures produce for the trees in figure 2.16?

;; b. Do the two procedures have the same order of growth in the number of steps required to convert a balanced tree with n elements to a list? If not, which one grows more slowly?

;; a.
;;

(define NULL (list))
(define (entry tree) (car tree))
(define (make-tree item left-tree right-tree) (list item left-tree right-tree))

(define (tree->list-1 tree)
(if (null? tree)
NULL
(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 NULL))

(define tree1 (list 7 (list 3 (list 1 NULL NULL) (list 5 NULL NULL)) (list 9 NULL (list 11 NULL NULL))))
(define tree2 (list 3 (list 1 NULL NULL) (list 7 (list 5 NULL NULL) (list 9 NULL (list 11 NULL NULL)))))
(define tree3 (make-tree 5
(make-tree 3
(make-tree 1 NULL NULL)
NULL)
(make-tree 9
(make-tree 7 NULL NULL)
(make-tree 11 NULL NULL))))

(display tree1) (newline)
(display tree2) (newline)
(display tree3) (newline)

(display (tree->list-1 tree1)) (newline)
(display (tree->list-1 tree2)) (newline)
(display (tree->list-1 tree3)) (newline)
(display (tree->list-2 tree1)) (newline)
(display (tree->list-2 tree2)) (newline)
(display (tree->list-2 tree3)) (newline)

;; b.

;; the procedure tree->list-2 is faster that the tree->list-1