問題2-67〜68
Huffman符号化木に関する問題を解いています。可変長の符号をどのように定義して、decode/encodeをどのような処理で表現するのか、という点に面白味を感じました。以下は、本書に掲載されていた、Huffman木を作成する手続きと、decodeの手続きです。
(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))))
問題2-67では、上記の手続きが正しく動いているかを確認せよと言われていますので、それをやってみます。
(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)) (decode sample-message sample-tree) ;=>(a d a b b c a)
次は、問題2-68です。記号の並びから可変長データを生成するencodeを実装します。
(define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) (define (encode-symbol given-symbol tree) (define (next-bit current-branch) (if (include-symbol? given-symbol (left-branch current-branch)) 0 1)) (define (encode-symbol-1 current-branch) (if (leaf? current-branch) '() (cons (next-bit current-branch) (encode-symbol-1 (choose-branch (next-bit current-branch) current-branch))))) (if (include-symbol? given-symbol tree) (encode-symbol-1 tree) (error "not found symbol" given-symbol))) (define (include-symbol? given-symbol tree) (if (leaf? tree) (equal? given-symbol (car (symbols tree))) (element-of-set? given-symbol (symbols tree)))) (define (element-of-set? x set) (cond ((null? set) #f) ((equal? x (car set)) #t) (else (element-of-set? x (cdr set))))) (define sample-symbols '(A D A B B C A)) (encode sample-symbols sample-tree) ;=>(0 1 1 0 0 1 0 1 0 1 1 1 0)
ターゲットとなっている記号が、どちらのブランチに含まれているかをチェックして木の下る方向を決めつつ、追加すべき符号をconsしています。next-bitの部分が微妙な感じになってしまいましたが、内部定義やletを使おうとするとエラーがでてしまい、上手いこと表現することができませんでした。束縛変数の有効範囲については、しっかりと復習する必要がありそうです。