| Song's profileSICP自留地BlogListsNetwork | Help |
|
|
July 16 sicp 2.69(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))) ;********************************************* my work begin from here
(define (generate-huffman-tree pairs)
(successive-merge (make-leaf-set pairs))) (define (successive-merge treeset);the treeset here must be in ascending order
(if (null? (cddr treeset));test if treeset has only two elements (make-code-tree (car treeset) (cadr treeset)) (successive-merge (merge-then-arrange treeset)))) (define (merge-then-arrange treeset) (addjoin-ascending (make-code-tree (car treeset) (cadr treeset)) (cddr treeset))) (define (addjoin-ascending tree treeset)
(cond ((null? treeset) (list tree)) ((> (weight tree) (weight (car treeset))) (cons (car treeset) (addjoin-ascending tree (cdr treeset)))) (else (cons tree treeset)))) (define (make-leaf-set pairs)
(if (null? pairs) '() (let ((pair (car pairs))) (addjoin-ascending (make-leaf (car pair) ; symbol (cadr pair)) ; frequency (make-leaf-set (cdr pairs)))))) ;********************************************* for testing (define sample-pairs '((A 4) (B 2) (C 2) (D 1))) (generate-huffman-tree sample-pairs) TrackbacksThe trackback URL for this entry is: http://mysicp.spaces.live.com/blog/cns!76113039590E11D7!156.trak Weblogs that reference this entry
|
|
|