Scheme - データによる抽象の構築(記号データ(例: Huffman 符号化木(Huffman符号木を生成する手続き)))

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)
異なる出版社で予約受付中

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.3(記号データ)、2.3.4(例: Huffman 符号化木)、Huffman木の表現、復号化手続き、重みつき要素の集合、問題 2.69.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 2.69.

コード(BBEdit, Emacs)

sample.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

;; これまでに書いた手続き
(load "./huffman.scm")

(define (generate-huffman-tree pairs)
  (successive-merge (make-leaf-set pairs)))

(define (successive-merge leaf-set)
  (define (successive-merge-1 leaf-set)
    (if (null? (cdr leaf-set))
        (car leaf-set)
        (successive-merge-1 (adjoin-set (make-code-tree (car leaf-set)
                                                        (cadr leaf-set))
                                        (cddr leaf-set)))))
  (if (null? leaf-set)
      '()
      (successive-merge-1 leaf-set)))

(define (print-huffman-tree tree)
  (define (display-indent n)
    (if (= n 0)
        (display "")
        (begin (display "                      ")
               (display-indent (- n 1)))))
  (define (inner indent tree)
    (if (or (null? tree)
            (leaf? tree))
        (begin (display-indent indent)
               (print tree))
        (begin (inner (+ indent 1)
                      (left-branch tree))
               (begin (display-indent indent)
                      (print (cddr tree)))
               (inner (+ indent 1)
                      (right-branch tree)))))
  (inner 0 tree))

(define pairs0 '())
(define pairs1 (list '(A 1)))
(define pairs2 (list '(A 1) '(B 1)))
(define pairs3 (list '(A 2) '(B 1)))
(define pairs4 (list '(A 8) '(B 3) '(C 1) '(D 1) '(E 1) '(F 1) '(G 1) '(H 1)))
(define list-pairs (list pairs0 pairs1 pairs2 pairs3 pairs4))

(for-each (lambda (pairs)
            (let ((tree (generate-huffman-tree pairs)))
              (print tree)
              (print-huffman-tree tree)))
          list-pairs)

入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))

$ ./sample.scm
()
()
(leaf A 1)
(leaf A 1)
((leaf B 1) (leaf A 1) (B A) 2)
                      (leaf B 1)
((B A) 2)
                      (leaf A 1)
((leaf B 1) (leaf A 2) (B A) 3)
                      (leaf B 1)
((B A) 3)
                      (leaf A 2)
((leaf A 8) ((((leaf H 1) (leaf G 1) (H G) 2) ((leaf F 1) (leaf E 1) (F E) 2) (H G F E) 4) (((leaf D 1) (leaf C 1) (D C) 2) (leaf B 3) (D C B) 5) (H G F E D C B) 9) (A H G F E D C B) 17)
                      (leaf A 8)
((A H G F E D C B) 17)
                                                                                        (leaf H 1)
                                                                  ((H G) 2)
                                                                                        (leaf G 1)
                                            ((H G F E) 4)
                                                                                        (leaf F 1)
                                                                  ((F E) 2)
                                                                                        (leaf E 1)
                      ((H G F E D C B) 9)
                                                                                        (leaf D 1)
                                                                  ((D C) 2)
                                                                                        (leaf C 1)
                                            ((D C B) 5)
                                                                  (leaf B 3)
$