scheme实现huffman编码的完整代码

来自sicp的完整代码，包括书中给出的代码以及习题，实现了huffman树的生成、解码、编码过程，总共67行代码，同样的代码有空用java、ruby改写下，看看会有什么不同。 (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))) ;解码 (define (decode bits tree)   (define (decode - 1  bits current - branch)     ( if  (null? bits)          ' ()         (let ((next - branch               (choose - branch (car bits) current - branch)))           ( if  (leaf? next - branch)               (cons (symbol - leaf next - branch)                     (decode - 1  (cdr bits) tree))               (decode - 1  (cdr bits) next - branch)))))   (decode - 1  bits tree)) (define (choose - branch bit branch)   (cond (( =  bit 0) (left - branch branch))         (( =  bit  1 ) (right - branch branch))         ( else  (display  " bad bit --CHOOSE-BRANCH " )))) (define (adjoin - set x set)   (cond ((null? set) (list x))         (( <  (weight x) (weight (car set))) (cons x set))         ( else            (cons (car set) (adjoin - set x (cdr set)))))) (define (make - leaf - set pairs)   ( if  (null? pairs)        ' ()       (let ((pair (car pairs)))         (adjoin - set (make - leaf (car pair) (cadr pair)) (make - leaf - set (cdr pairs)))))) ;编码 (define (encode message tree)   ( if  (null? message)        ' ()       (append (encode - symbol (car message) tree)               (encode (cdr message) tree)))) (define (encode - symbol symbol tree)   (define (iter branch)     ( if  (leaf? branch)          ' ()         ( if  (memq symbol (symbols (left - branch branch)))             (cons 0 (iter (left - branch branch)))             (cons  1  (iter (right - branch branch))))         ))   ( if  (memq symbol (symbols tree))       (iter tree)       (display  " bad symbol -- UNKNOWN SYMBOL " ))) ;生成hufman树 (define (generate - huffman - tree pairs)   (successive - merge (make - leaf - set pairs))) (define (successive - merge leaf - set)   ( if  (null? (cdr leaf - set))       (car leaf - set)       (successive - merge (adjoin - set (make - code - tree (car leaf - set)                                                     (cadr leaf - set))                                     (cddr leaf - set))))) 文章转自庄周梦蝶  ，原文发布时间 2007-07-23 相关资源：敏捷开发V1.0.pptx