154 lines
4.4 KiB
Racket
154 lines
4.4 KiB
Racket
#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).
|