問題 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))) (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 (error "bad bit -- CHOOSE-BRANCH" bit)))) (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) (define (iter p leaves) (if (null? p) leaves (let ((pair (car p))) (iter (cdr p) (adjoin-set (make-leaf (car pair) ; 記号 (cadr pair)) ; 頻度 leaves))))) (iter pairs '()))
make-leaf-set 手続きは再帰プロセスで書かれているため、重みが同じ場合に作られる葉リストが反転してしまいます。
なので反復プロセス版で書き直しました。
(define (generate-huffman-tree pairs) (successive-merge (make-leaf-set pairs))) (define (successive-merge leaves) (if (null? (cdr leaves)) (car leaves) (successive-merge (adjoin-set (make-code-tree (car leaves) (cadr leaves)) (cddr leaves))))) ;;;;; (define 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))))) (define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
successive-merge 手続きは、葉リストの最初の二つからハフマン符号化木の部分木を作り、
adjoin-set 手続きを使って葉リストに追加していきます。
次の準備として cddr を使い葉リストの最初の二つを取り除きます。
ということを再帰的に繰り返して、葉リストの要素が 1 つになったとき、ハフマン符号化木が完成しています。
generate-huffman-tree 手続きを評価します。
葉リストの与え方は行きがけ順で指定します。
make-leaf-pair が本書に掲載されているもの(再帰プロセス版)を
そのまま使用する場合では、葉リストの与え方が異なりますので注意してください。
gosh> (generate-huffman-tree '((A 4) (B 2) (D 1) (C 1))) ((leaf A 4) ((leaf B 2) ((leaf D 1) (leaf C 1) (D C) 2) (B D C) 4) (A B D C) 8) gosh> sample-tree ((leaf A 4) ((leaf B 2) ((leaf D 1) (leaf C 1) (D C) 2) (B D C) 4) (A B D C) 8)
sample-tree と同じ結果になりました。合ってそうです。