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)
转载于:https://www.cnblogs.com/tclan126/p/6504400.html
相关资源：数据结构—成绩单生成器
