;;; Homework 10: Scheme
(define (check standard test-value)
(if (not (equal? standard test-value))
(error "" test-value " differs from " standard)))
;;; Question 2A
;;; Trees: Leaves
;; Leaf constructor
(define (make-leaf symbol weight)
(list 'leaf symbol weight))
(define (leaf? object)
(eq? (car object) 'leaf))
;; (symbol-leaf (make-leaf s w)) ==> s
(define (symbol-leaf x)
; *** YOUR CODE HERE ***
'a
)
;; (weight-leaf (make-leaf s w)) ==> w
(define (weight-leaf x)
; *** YOUR CODE HERE ***
0
)
;;; Trees: Internal nodes
(define (make-code-tree left right)
(list left
right
(append (symbols left) (symbols right))
(+ (weight left) (weight right))))
;; (left-branch (make-code-tree L R)) ==> L
(define (left-branch tree)
; *** YOUR CODE HERE ***
#f
)
;; (right-branch (make-code-tree L R)) ==> R
(define (right-branch tree)
; *** YOUR CODE HERE ***
#f
)
;; A list containing all symbols in tree (a leaf or internal node)
(define (symbols tree)
; *** YOUR CODE HERE ***
'()
)
;; Weight of this tree (a leaf or internal node)
(define (weight tree)
; *** YOUR CODE HERE ***
0
)
;;; Question 2A Tests
(define aleaf (make-leaf 'A 8))
(define bcd
(make-code-tree (make-leaf 'b 3)
(make-code-tree (make-leaf 'c 1) (make-leaf 'd 1))))
(define (check2a)
(check #t (leaf? aleaf))
(check #f (leaf? bcd))
(check 'a (symbol-leaf aleaf))
(check 8 (weight aleaf))
(check 5 (weight bcd))
(check 'b (symbol-leaf (left-branch bcd))))
;;; Question 2B
;; Choose the branch of subtree (an internal Huffman tree node) that
;; corresponds to bit.
(define (choose-branch bit subtree)
(cond ((= bit 0) (left-branch subtree))
((= bit 1) (right-branch subtree))
(else (error "bad bit -- CHOOSE-BRANCH" bit))))
;; Return the list of symbols denoted by the list bits (consisting of
;; 1s and 0s), according to tree, a Huffman tree.
(define (decode bits tree)
; *** YOUR CODE HERE ***
#f
)
;;; Question 2B Tests
(define efgh (make-code-tree
(make-code-tree (make-leaf 'e 1) (make-leaf 'f 1))
(make-code-tree (make-leaf 'g 1) (make-leaf 'h 1))))
(define abcdefgh (make-code-tree aleaf (make-code-tree bcd efgh)))
(define (check2b)
(check '(b a c)
(decode '(1 0 0 0 1 0 1 0) abcdefgh)))
;;; Question 2C
;; All symbols in tree and their encodings as a list of (symbol . encoding)
;; pairs
(define (encodings tree)
; *** YOUR CODE HERE ***
#f
)
;;; Question 2C Tests
(define (check2c)
(check '((b 0) (c 1 0) (d 1 1))
(encodings bcd))
(check '((A 0) (B 1 0 0) (C 1 0 1 0) (D 1 0 1 1) (E 1 1 0 0)
(F 1 1 0 1) (G 1 1 1 0) (H 1 1 1 1))
(encodings abcdefgh))
)
;;; Question 2D
;; If trees is a list of trees sorted by increasing weight, then returns
;; the result of inserting t into the list in the proper place by weight.
(define (insert-tree t trees)
(cond ((null? trees) (list t))
((< (weight t) (weight (car trees)))
(cons t trees))
(else (cons (car trees) (insert-tree t (cdr trees))))))
;; Given a set of (symbol frequency) lists, generates a list of leaves,
;; one for each pair, ordered by increasing weight.
(define (make-leaf-set pairs)
(if (null? pairs) '()
(insert-tree (make-leaf (caar pairs) ; symbol
(cadar pairs)) ; weight
(make-leaf-set (cdr pairs)))))
;; A Huffman encoding tree for a list of symbols and frequencies in the
;; same format as for make-leaf-set.
(define (huffman pairs)
(successive-merge (make-leaf-set pairs)))
;; The result of repeatedly merging together the smallest-weight elements
;; of the set, trees, of encoding trees until there is only one left.
;; Returns the sole remaining tree, which is the desired Huffman encoding tree.
(define (successive-merge trees)
; *** YOUR CODE HERE ***
#f
)
;;; Note from SICP about successive-merge:
;;; (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.)
;;; Question 2D Tests
; Note: Huffman codes are not unique; you may not get this answer exactly.
; In that case, after checking your answer by hand, change this
(define (check2d)
(check '((leaf a 2) (leaf b 4) (leaf c 6))
(insert-tree (make-leaf 'b 4) (list (make-leaf 'a 2) (make-leaf 'c 6))))
(check '((d 0 0 0) (c 0 0 1) (b 0 1) (a 1))
(encodings (huffman '((C 1) (D 1) (B 3) (A 8))))))
(define (check-all)
(check2a)
(check2b)
(check2c)
(check2d))