SICP_2.67-2.72

  1 #lang racket
  2 
  3 (define (make-leaf symbol weight)
  4   (list 'leaf symbol weight))
  5 
  6 (define (leaf? object)
  7   (eq? (car object) 'leaf))
  8 
  9 (define (symbol-leaf x) (cadr x))
 10 (define (weight-leaf x) (caddr x))
 11 
 12 (define (make-code-tree left right)
 13   (list left
 14         right
 15         (append (symbols left) (symbols right))
 16         (+ (weight left) (weight right))))
 17 
 18 (define (left-branch tree) (car tree))
 19 (define (right-branch tree) (cadr tree))
 20 
 21 (define (symbols tree)
 22   (if (leaf? tree)
 23       (list (symbol-leaf tree))
 24       (caddr tree)))
 25 
 26 (define (weight tree)
 27   (if (leaf? tree)
 28       (weight-leaf tree)
 29       (cadddr tree)))
 30 
 31 ;;;;;;;;;解码
 32 (define (decode bits tree)
 33   (define (decode-1 bits current-branch)
 34     (if (null? bits)
 35         '()
 36         (let ((next-branch
 37                (choose-branch (car bits) current-branch)))
 38           (if (leaf? next-branch)
 39               (cons (symbol-leaf next-branch)
 40                     (decode-1 (cdr bits) tree))
 41               (decode-1 (cdr bits) next-branch)))))
 42   (decode-1 bits tree))
 43 
 44 (define (choose-branch bit branch)
 45   (cond ((= bit 0) (left-branch branch))
 46         ((= bit 1) (right-branch branch))
 47         (else (error "bad bit --CHOOSE-BRANCH" bit))))
 48 
 49 
 50 ;;;;;;;;带权重的元素集合
 51 (define (adjoin-set x set)
 52   (cond ((null? set) (list x))
 53   ((< (weight x) (weight (car set))) (cons x set))
 54   (else (cons (car set) (adjoin-set x (cdr set))))))
 55 
 56 (define (make-leaf-set pairs)
 57   (if (null? pairs)
 58       '()
 59       (let ((pair (car pairs)))
 60         (adjoin-set (make-leaf (car pair)
 61                                (cadr pair))
 62                     (make-leaf-set (cdr pairs))))))
 63 
 64 ;;;;;;;;;;;;;2.67
 65 (define sample-tree
 66   (make-code-tree (make-leaf 'A 4)
 67                   (make-code-tree
 68                    (make-leaf 'B 2)
 69                    (make-code-tree (make-leaf 'D 1)
 70                                    (make-leaf 'C 1)))))
 71 
 72 (define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
 73 
 74 ;sample-tree
 75 ;(decode sample-message sample-tree)
 76 
 77 ;;;;;;;;;;;2.68
 78 (define (encode message tree)
 79   (if (null? message)
 80       '()
 81       (append (encode-symbol (car message) tree)
 82               (encode (cdr message) tree))))
 83 
 84 (define (encode-symbol symbol tree)
 85   (cond ((not (have? symbol tree))
 86         (error "false symbol" symbol))
 87         ((leaf? tree) '())
 88         ((have? symbol (left-branch tree))
 89          (cons 0 (encode-symbol symbol (left-branch tree))))
 90         ((have? symbol (right-branch tree))
 91          (cons 1 (encode-symbol symbol (right-branch tree))))))
 92 
 93 (define (have? symbol tree)
 94   (if (leaf? tree)
 95       (eq? (symbol-leaf tree) symbol)
 96       (tree-have? symbol (symbols tree))))
 97 
 98 (define (tree-have? symbol set)
 99   (cond ((null? set) false)
100         ((eq? symbol (car set)) true)
101         (else (tree-have? symbol (cdr set)))))
102 
103 
104 ;;;;;;;;;;;;;;test
105 ;(encode '(A D A B B C A) sample-tree)
106 
107 ;;;;;;;;;;;;;;2.69
108 (define (generate-huffman-tree pairs)
109   (successive-merge (make-leaf-set pairs)))
110 
111 (define (successive-merge leaf-set)
112   (cond ((= 0 (length leaf-set)) '())
113         ((= 1 (length leaf-set)) (car leaf-set))
114         (else (let ((sub (make-code-tree (car leaf-set)
115                                          (cadr leaf-set)))
116                     (rem (cddr leaf-set)))
117                 (successive-merge (adjoin-set sub rem))))))
118 
119 ;(define (successive-merge2 leaf-set)
120  ; (if (null? (cdr leaf-set))
121   ;    (car leaf-set)
122    ;   (make-code-tree (car leaf-set) (successive-merge (cdr leaf-set)))))
123 
124 (define pairs '((A 4) (B 2) (C 1) (D 1)))
125 
126 ;(generate-huffman-tree pairs)
127 
128 
129 ;;;;;;;;;;;;;2.70
130 (define rock-tree (generate-huffman-tree '((boom 1) (Wah 1) (a 2)
131                                                    (Get 2) (job 2)
132                                                    (Sha 3) (yip 9) (na 16))))
133 
134 
135 (define rock-message '(Get a job
136                            Sha na na na na na na na na
137                            Get a job
138                            Sha na na na na na na na na
139                            Wah yip yip yip yip yip yip yip yip yip
140                            Sha boom))
141 
142 (length (encode rock-message rock-tree))
143 ;(encode rock-message rock-tree)
144 ;不定长需要84位
145 ;定长需要108位
146 
147 ;;;;;;;;;;;2.71
148 (define pairsn5 '((a 1) (b 2) (c 4) (d 8) (e 16)))
149 (define pairsn10 '((a 1) (b 2) (c 4) (d 8) (e 16) (f 32) (g 64)
150                          (h 128) (i 256) (j 512)))
151 
152 (generate-huffman-tree pairsn5)
153 (generate-huffman-tree pairsn10)
154 ;;;;;;;;;;n=5 时最小的要用4位,最大要用1位
155 ;;;;;;;;;;n=10 时最小用用9位,最大用1位
156 
157 ;;;;;;;;;;;;;2.72

 

对于2.69 首先要有清晰的思路,不然就会写出注释掉的那种不明觉厉的东西

1.当leaf-set为空集时返回空集

2.当leaf-set只有一个元素时表示所有元素已经组合成了一棵哈夫曼树

3.不断重复,取出最小的两个权重的叶子或树构成一棵新树(由于make-leaf-set 中有adjoin-set 过程,所以最小的和次小权重的树或叶子都会放在头部)

然后并到剩下的集合中

 

另外:对于检查一个list是否为空集还可以利用length

 

对于2.72:

一种符号的步长分析可得 n=一个符号的二进制位数*符号出现的频数

(一个符号二进制位数对应append过程)

 

一个符号出现的二进制位数还涉及encode-symbol过程,由于要考虑检查符号在不在集合中,所以n=encode-symbol的步数*符号出现频数

 

注意题目是说  一个  符号,所以不用考虑符号出现的频数,也不用考虑append过程了,剩下的就是encode-symbol的步数

 

对于频数最大的一定会在哈夫曼树第n-1(根为n层)层,所以二进制位数为1,由我写的encode-symbol过程,检查需要n步所以步长O(n)

 

对于频数最小的一定在哈夫曼树的第1(根为n层)层,所以总步数为n+n-1+n-2+。。。。+2 +1 即步长O(n^2)

posted @ 2017-03-05 10:07  lan126  阅读(182)  评论(0编辑  收藏  举报