SICP学习笔记（2.3.4）
周银辉
1，霍夫曼编码
这节的主要内容是如何用霍夫曼编码算法对消息进行编码和解码，关于这个算法的一些背景知识可以看这里：http://en.wikipedia.org/wiki/Huffman_coding
为了避免我在叙述的时候“断章取义”和你“不知所云”，下面先贴出本节的完整代码（在drscheme4.2.2下编译通过）
;构造叶子节点
(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)))
;解码，其中bits是编码串，root是编码树的根，tree是当前节点（子树）
(define (decode bits root tree)
(if (null? bits)
'()
(let ((next-branch (choose-branch (car bits) tree)))
(if (leaf? next-branch)
(cons (symbol-leaf next-branch)
(decode (cdr bits) root root))
(decode (cdr bits) root next-branch)))))
;向左走，向右走
(define (choose-branch bit branch)
(cond ((= bit 0) (left-branch branch))
((= bit 1) (right-branch branch))
(else (display "error"))))
;编码消息串，其中message是带编码的消息，root为编码树的根
(define (encode message root)
(if (null? message)
'()
(append (encode-symbol (car message) root)
(encode (cdr message) root))))
;编码单个字符，其中symbol为待编码字符，,tree是当前节点(子树)
(define (encode-symbol symbol tree)
(if (leaf? tree)
;如果树是叶子节点，则返回'()
'()
(let ((left-symbols (symbols (left-branch tree)))
(right-symbols (symbols (right-branch tree))))
(cond
;如果符号在左子树的符号集合中，那么添加编码0，然后用左子树继续编码
((element-of-set? symbol left-symbols)
(cons '0 (encode-symbol symbol (left-branch tree))))
;如果符号在右子树的符号集合中,那么添加编码1，然后用右子树继续编码
((element-of-set? symbol right-symbols)
(cons '1 (encode-symbol symbol (right-branch tree))))
(else
(display "symbol is not in the tree"))))))
(define (element-of-set? x set)
(cond ((null? set) #f)
((eq? x (car set)) #t)
(else
(element-of-set? x (cdr set)))))
;将树插入到一个树的集合中（森林），按照权重升序排列
(define (adjion-set x set)
(cond ((null? set) (list x))
((< (weight x) (weight (car set))) (cons x set))
(else (cons (car set) (adjion-set x (cdr set))))))
;由序对的集合，构造一个有叶子节点构成的集合（最简单的森林)
(define (make-leaf-set pairs)
(if (null? pairs)
'()
(let ((pair (car pairs)))
(adjion-set (make-leaf (car pair) (cadr pair))
(make-leaf-set (cdr pairs))))))
;由序对构造霍夫曼树
(define (generate-huffman-tree pairs)
(successive-merge (make-leaf-set pairs)))
;由叶子节点的集合构造霍夫曼树
(define (successive-merge leaves)
(cond ((= 0 (length leaves)) (display "error at successive-merge"))
((= 1 (length leaves)) (car leaves))
(else
(let
;first为第一个元素，也就是权值最小的树
((first (car leaves))
;second为第二个元素，也就是权值第二小的树
(second (cadr leaves))
;remain为除去第一个与第二个元素后，剩下的元素构成的集合
(remain (cddr leaves)))
(successive-merge
;由权值最小的两个元素构成一棵新的树并添加到剩余集合中
(adjion-set (make-code-tree first second) remain))))))
;-------------------test-----------------------------
(define myTree
(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 myMessage '(0 1 1 0 0 1 0 1 0 1 1 1 0))
(decode myMessage myTree myTree)
(define myPairs '((A 4) (B 2) (C 1) (D 1)))
(make-leaf-set myPairs)
(define myHuffmanTree (generate-huffman-tree myPairs))
(decode myMessage myHuffmanTree myHuffmanTree)
(encode '(a d a b b c a) myHuffmanTree)
(decode (encode '(a d a b b c a) myHuffmanTree) myHuffmanTree myHuffmanTree)
(display "--------------\n")
(define rockPairs '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (YIP 9) (JOB 2) (WAH 1)))
(define rockHuffmanTree (generate-huffman-tree rockPairs));
(define rockMessage
'(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))
(encode rockMessage rockHuffmanTree)
(decode (encode rockMessage rockHuffmanTree) rockHuffmanTree rockHuffmanTree)
(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)))
;解码，其中bits是编码串，root是编码树的根，tree是当前节点（子树）
(define (decode bits root tree)
(if (null? bits)
'()
(let ((next-branch (choose-branch (car bits) tree)))
(if (leaf? next-branch)
(cons (symbol-leaf next-branch)
(decode (cdr bits) root root))
(decode (cdr bits) root next-branch)))))
;向左走，向右走
(define (choose-branch bit branch)
(cond ((= bit 0) (left-branch branch))
((= bit 1) (right-branch branch))
(else (display "error"))))
;编码消息串，其中message是带编码的消息，root为编码树的根
(define (encode message root)
(if (null? message)
'()
(append (encode-symbol (car message) root)
(encode (cdr message) root))))
;编码单个字符，其中symbol为待编码字符，,tree是当前节点(子树)
(define (encode-symbol symbol tree)
(if (leaf? tree)
;如果树是叶子节点，则返回'()
'()
(let ((left-symbols (symbols (left-branch tree)))
(right-symbols (symbols (right-branch tree))))
(cond
;如果符号在左子树的符号集合中，那么添加编码0，然后用左子树继续编码
((element-of-set? symbol left-symbols)
(cons '0 (encode-symbol symbol (left-branch tree))))
;如果符号在右子树的符号集合中,那么添加编码1，然后用右子树继续编码
((element-of-set? symbol right-symbols)
(cons '1 (encode-symbol symbol (right-branch tree))))
(else
(display "symbol is not in the tree"))))))
(define (element-of-set? x set)
(cond ((null? set) #f)
((eq? x (car set)) #t)
(else
(element-of-set? x (cdr set)))))
;将树插入到一个树的集合中（森林），按照权重升序排列
(define (adjion-set x set)
(cond ((null? set) (list x))
((< (weight x) (weight (car set))) (cons x set))
(else (cons (car set) (adjion-set x (cdr set))))))
;由序对的集合，构造一个有叶子节点构成的集合（最简单的森林)
(define (make-leaf-set pairs)
(if (null? pairs)
'()
(let ((pair (car pairs)))
(adjion-set (make-leaf (car pair) (cadr pair))
(make-leaf-set (cdr pairs))))))
;由序对构造霍夫曼树
(define (generate-huffman-tree pairs)
(successive-merge (make-leaf-set pairs)))
;由叶子节点的集合构造霍夫曼树
(define (successive-merge leaves)
(cond ((= 0 (length leaves)) (display "error at successive-merge"))
((= 1 (length leaves)) (car leaves))
(else
(let
;first为第一个元素，也就是权值最小的树
((first (car leaves))
;second为第二个元素，也就是权值第二小的树
(second (cadr leaves))
;remain为除去第一个与第二个元素后，剩下的元素构成的集合
(remain (cddr leaves)))
(successive-merge
;由权值最小的两个元素构成一棵新的树并添加到剩余集合中
(adjion-set (make-code-tree first second) remain))))))
;-------------------test-----------------------------
(define myTree
(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 myMessage '(0 1 1 0 0 1 0 1 0 1 1 1 0))
(decode myMessage myTree myTree)
(define myPairs '((A 4) (B 2) (C 1) (D 1)))
(make-leaf-set myPairs)
(define myHuffmanTree (generate-huffman-tree myPairs))
(decode myMessage myHuffmanTree myHuffmanTree)
(encode '(a d a b b c a) myHuffmanTree)
(decode (encode '(a d a b b c a) myHuffmanTree) myHuffmanTree myHuffmanTree)
(display "--------------\n")
(define rockPairs '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (YIP 9) (JOB 2) (WAH 1)))
(define rockHuffmanTree (generate-huffman-tree rockPairs));
(define rockMessage
'(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))
(encode rockMessage rockHuffmanTree)
(decode (encode rockMessage rockHuffmanTree) rockHuffmanTree rockHuffmanTree)