scheme实现huffman编码的完整代码

    来自sicp的完整代码，包括书中给出的代码以及习题，实现了huffman树的生成、解码、编码过程，总共67行代码，同样的代码有空用java、ruby改写下，看看会有什么不同。

ruby 代码

 

1. (define (make-leaf symbol weight)  
2.   (list 'leaf symbol weight))  
3. (define (leaf? object)  
4.   (eq? (car object) 'leaf))  
5. (define (symbol-leaf x) (cadr x))  
6. (define (weight-leaf x) (caddr x))  
7. ;合并最低权重的两个节点  
8. (define (make-code-tree left right)  
9.   (list left right (append (symbols left) (symbols right)) (+ (weight left) (weight right))))  
10. (define (left-branch tree) (car tree))  
11. (define (right-branch tree) (cadr tree))  
12. (define (symbols tree)  
13.   (if (leaf? tree)  
14.       (list (symbol-leaf tree))  
15.       (caddr tree)))  
16. (define (weight tree)  
17.   (if (leaf? tree)  
18.       (weight-leaf tree)  
19.       (cadddr tree)))  
20. ;解码  
21. (define (decode bits tree)  
22.   (define (decode-1 bits current-branch)  
23.     (if (null? bits)  
24.         '()  
25.         (let ((next-branch  
26.               (choose-branch (car bits) current-branch)))  
27.           (if (leaf? next-branch)  
28.               (cons (symbol-leaf next-branch)  
29.                     (decode-1 (cdr bits) tree))  
30.               (decode-1 (cdr bits) next-branch)))))  
31.   (decode-1 bits tree))  
32. (define (choose-branch bit branch)  
33.   (cond ((= bit 0) (left-branch branch))  
34.         ((= bit 1) (right-branch branch))  
35.         (else (display "bad bit --CHOOSE-BRANCH"))))  
36. (define (adjoin-set x set)  
37.   (cond ((null? set) (list x))  
38.         ((< (weight x) (weight (car set))) (cons x set))  
39.         (else  
40.            (cons (car set) (adjoin-set x (cdr set))))))  
41. (define (make-leaf-set pairs)  
42.   (if (null? pairs)  
43.       '()  
44.       (let ((pair (car pairs)))  
45.         (adjoin-set (make-leaf (car pair) (cadr pair)) (make-leaf-set (cdr pairs))))))  
46.   
47. ;编码  
48. (define (encode message tree)  
49.   (if (null? message)  
50.       '()  
51.       (append (encode-symbol (car message) tree)  
52.               (encode (cdr message) tree))))  
53. (define (encode-symbol symbol tree)  
54.   (define (iter branch)  
55.     (if (leaf? branch)  
56.         '()  
57.         (if (memq symbol (symbols (left-branch branch)))  
58.             (cons 0 (iter (left-branch branch)))  
59.             (cons 1 (iter (right-branch branch))))  
60.         ))  
61.   (if (memq symbol (symbols tree))  
62.       (iter tree)  
63.       (display "bad symbol -- UNKNOWN SYMBOL")))  
64. ;根据符号权重列表，生成hufman树  
65. (define (generate-huffman-tree pairs)  
66.   (successive-merge (make-leaf-set pairs)))  
67.   
68. (define (successive-merge leaf-set)  
69.   (if (null? (cdr leaf-set))  
70.       (car leaf-set)  
71.       (successive-merge (adjoin-set (make-code-tree (car leaf-set)  
72.                                                     (cadr leaf-set))  
73.                                     (cddr leaf-set)))))