SICP-Huffman

Huffman编码

以下是SICP关于Huffman编码的描述：

一个Huffman编码可以表示为一棵二叉树，其中的树叶是被编码的符号。树中每个非叶结点代表一个集合，其中包含了这一结点之下的所有树叶上的符号。除此之外，位于树叶的每个符号还被赋予一个权重（也就是它的相对频度），非叶结点所包含的权重是位于它之下的所有叶结点的权重之和。

以下是一个示例：

代码示例

将书中代码转换成common lisp：

;;将一棵树表示为包含符号leaf，叶中符号和权重的表
(defun make-leaf (symb weight)
	(list 'leaf symb weight))
;;判断是否是叶子
(defun leafp (obj)
	(equal (car obj) 'leaf))
;;取出叶中符号
(defun symbol-leaf (x) (cadr x))
;;取出叶中权重
(defun weight-leaf (x) (caddr x))
;;选择函数：左枝
(defun left-branch (tree) (car tree))
;;选择函数：右枝
(defun right-branch (tree) (cadr tree))
;;取出结点的符号集合，即这一结点之下所有树叶的符号
(defun symbols (tree)
	(if (leafp tree)
		(list (symbol-leaf tree))
	  (caddr tree)))
;;取出结点的权重，即其下所有树叶权重之和
(defun weight (tree)
	(if (leafp tree)
		(weight-leaf tree)
	  (cadddr tree)))
;;归并两个结点做出一棵树，将符号取并集，权重相加
(defun make-code-tree (left right)
	(list left
		  right
		  (append (symbols left) (symbols right))
		  (+ (weight left) (weight right))))
;;bits是二进制位的表，调用选择函数，一但到达叶结点，即把此处的符号加入到随后的解码结果
(defun decode (bits tree)
	(defun decode-1 (bits current-branch)
		(if (null bit)
			'()
		  (let ((next-branch (choose-branch (car bits) current-branch)))
		    (if (leafp next-branch)
		        (cons (symbol-leaf next-branch)
		        	  (decode-1 (cdr bits) tree))
		      (decode-1 (cdr bits) next-branch)))))
	(decode-1 bits tree))
;;选择分支函数，根据是0还是1选择树的左分支或右分支
(defun choose-branch (bit branch)
	(cond ((= bit 0) (left-branch branch))
	      ((= bit 1) (right-branch branch))
	      (t (error "bad bit --CHOOSE-BRANCH"))))
;;将树叶和树的集合表示为元素的表，这里我按照权重下降顺序排列（和书中不同）
(defun adjoin-set (x set)
	(cond ((null set) (list x))
		  ((> (weight x) (weight (car set)))
		  	  (cons x set))
		  (t (cons (car set)
		  		   (adjoin-set x (cdr set))))))
;;以一个符号-权重表为参数，构造出树叶的初始排序集合
(defun make-leaf-set (pairs)
	(if (null pairs)
		'()
	  (let ((pair (car pairs)))
	    (adjoin-set (make-leaf (car pair) (cadr pair))
	                (make-leaf-set (cdr pairs))))))

下面是练习2.67，2.68，2.69的实现：

;;译码，由给定符号串译成二进制数
(defun encode (message tree)
	(if (null message)
		'()
	  (append (encode-symbol (car message) tree)
	  		  (encode (cdr message) tree))))
;;将给定字符译码
(defun encode-symbol (char tree)
	(defun find-in (x lst)
		(if (null lst)
			nil
		    (or (equal x (car lst))
		    	(find-in x (cdr lst)))))
    (defun encode-iter (char tree)
    	(if (leafp tree)
    		'()
    	    (if (find-in char (symbols (left-branch tree)))
    	    	(append (list 0) (encode-iter char (left-branch tree)))
    	    	(append (list 1) (encode-iter char (right-branch tree))))))
    (if (find-in char (symbols tree))
    	(encode-iter char tree)
    	(error "No such element")))
;;由符号-频度对偶表生成编码树
(defun generate-huffman-tree (pairs)
	(successive-merge (make-leaf-set pairs)))
;;反复归并集合
(defun successive-merge (lst)
	(if (null (cdr lst))
		(car lst)
		(make-code-tree (car lst)
						(successive-merge (cdr lst)))))
;;示例树
(setf 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)))))
;;示例消息，待解码
(setf sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
;;示例符号-权重对偶表
(setf sample-pairs '((a 4) (b 2) (c 1) (d 1)))

运行结果（lispbox-0.7）：