開発環境
- macOS Sierra - Apple (OS)
- Emacs (Text Editor)
- Scheme (プログラミング言語)
- kscheme (ksi)(github) (処理系)
計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原著: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の第2章(データによる抽象の構築)、2.3(記号データ)、2.3.4(例: Huffman 符号化木)、Huffman 木の生成、Huffman 木の表現、符号化手続き、重みつき要素の集合、問題2.67、68、69、70、71、72.を取り組んでみる。
その他参考書籍
問題2.67、68、69、70、71、72.
コード(Emacs)
((lambda ()
(load "procedures.scm")
(newline)
(define (p obj) (display obj) (newline))
(define (make-leaf symbol weight) (list 'leaf symbol weight))
(define (leaf? obj) (eq? (car obj) '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)
'()
((lambda (next-branch)
(if (leaf? next-branch)
(cons (symbol-leaf next-branch)
(decode-1 (cdr bits) tree))
(decode-1 (cdr bits) next-branch)))
(choose-branch (car bits) current-branch))))
(decode-1 bits tree))
(define (choose-branch bit branch)
(if (= bit 0)
(left-branch branch)
(if (= bit 1)
(right-branch branch)
(error "bad bit -- choose-branch" bit))))
(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))
(p 2.67)
(define message (decode sample-message sample-tree))
(p message)
(define (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))
(define (encode-symbol symbol tree)
(define (iter tree)
(if (leaf? tree)
'()
(if (memq symbol (symbols (left-branch tree)))
(cons 0 (iter (left-branch tree)))
(cons 1 (iter (right-branch tree))))))
(if (memq symbol (symbols tree))
(iter tree)
(error "bad symbol -- encode-symbol" symbol)))
(p 2.68)
(define bits (encode message sample-tree))
(p bits)
(p sample-message)
(p (equal? bits sample-message))
(p 2.69)
(define (make-leaf-set pairs)
(if (null? pairs)
'()
((lambda (pair)
(adjoin-set (make-leaf (car pair)
(cadr pair))
(make-leaf-set (cdr pairs))))
(car pairs))))
(define (adjoin-set x set)
(if (null? set)
(list x)
(if (< (weight x) (weight (car set)))
(cons x set)
(cons (car set) (adjoin-set x (cdr set))))))
(define (generate-huffman-tree pairs)
(successive-merge (make-leaf-set pairs)))
(define (successive-merge set)
(if (null? (cdr set))
(car set)
((lambda (a b)
(successive-merge (adjoin-set (make-code-tree a b)
(cddr set))))
(car set) (cadr set))))
(define pairs '((A 8) (B 3) (C 1) (D 1) (E 1) (F 1) (G 1) (H 1)))
(define tree (generate-huffman-tree pairs))
(p tree)
(define sample-message '(B A C A D A E A F A B B A A A G A H))
(define bits (encode sample-message tree))
(define message (decode bits tree))
(p bits)
(p message)
(p (equal? sample-message message))
(p "2.70")
(define pairs '((a 2) (boom 1) (get 2) (job 2)
(na 16) (sha 3) (yip 9) (wah 1)))
(define tree (generate-huffman-tree pairs))
(define message '(get a job
sha na na na na na na na na
get a job
sha na na na na na na na na
wah yip yip yip yip yip yip yip yip yip
sha boom))
(define bits (encode message tree))
(p bits)
(p (length bits))
(p "八記号アルファベットの固定長符号(3ビット)を使う場合")
(define pairs '((a "000") (boom "001") (get "010") (job "011")
(na "100") (sha "101") (yip "110") (wah "111")))
(p (* 3 (length message)))
(p 2.71)
(define pairs-5 '((a 1) (b 2) (c 4) (d 8) (e 16)))
(define pairs-10 '((a 1) (b 2) (c 4) (d 8) (e 16)
(f 32) (g 64) (h 128) (i 256) (j 512)))
(define tree-5 (generate-huffman-tree pairs-5))
(define tree-10 (generate-huffman-tree pairs-10))
(p tree-5)
(p tree-10)
(p "最高頻度の記号を符号かするのに必要なビット数は1")
(p "最低頻度の記号を符号かするのに必要なビット数はn-1")
(p (encode '(e) tree-5))
(p (encode '(j) tree-10))
(p (encode '(a) tree-5))
(p (encode '(a) tree-10))
(p 2.72)
'done))
入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))
$ ksi < sample67.scm ksi> 2.67 (A D A B B C A) 2.68 (0 1 1 0 0 1 0 1 0 1 1 1 0) (0 1 1 0 0 1 0 1 0 1 1 1 0) #t 2.69 ((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) (1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0) (B A C A D A E A F A B B A A A G A H) #t 2.70 (1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1) 84 八記号アルファベットの固定長符号(3ビット)を使う場合 108 2.71 (((((leaf a 1) (leaf b 2) (a b) 3) (leaf c 4) (a b c) 7) (leaf d 8) (a b c d) 15) (leaf e 16) (a b c d e) 31) ((((((((((leaf a 1) (leaf b 2) (a b) 3) (leaf c 4) (a b c) 7) (leaf d 8) (a b c d) 15) (leaf e 16) (a b c d e) 31) (leaf f 32) (a b c d e f) 63) (leaf g 64) (a b c d e f g) 127) (leaf h 128) (a b c d e f g h) 255) (leaf i 256) (a b c d e f g h i) 511) (leaf j 512) (a b c d e f g h i j) 1023) 最高頻度の記号を符号かするのに必要なビット数は1 最低頻度の記号を符号かするのに必要なビット数はn-1 (1) (1) (0 0 0 0) (0 0 0 0 0 0 0 0 0) 2.72 => done ksi> $
0 コメント:
コメントを投稿