2
Help us understand the problem. What are the problem?

More than 5 years have passed since last update.

posted at

updated at

# 2.3.4 ハフマン符号木

``````;; ハフマン符号木

;一般的に、符号化するメッセージの相対頻度を利用した可変長接頭符号を
;使えば、かなりの節約ができます。これを行う戦略のひとつにハフマン符号化
;法というものがあります。 p174

;左の枝を下りるたびに符号に 0 を追加し、右の枝を下りるたびに 1 を追加します p175
;まず、符号構築対象の初期データによって決まる、記号と頻度
;を持つ葉ノードの集合から始めます。ここで、重みが小さいほうから二つの葉
;を選び、二つをくっつけて新しいノードを作り、新しいノードの左と右の枝が
;その二つのノードになるようにします。

(define (make-leaf symbol weight) (list 'leaf symbol weight))
(define (leaf? object) (eq? (car object) 'leaf))

;listの頭に'leaf つけて leaf オブジェクトであることを伝えてる

(define (make-code-tree left right)
(list
left
right
(append (symbols left) (symbols right)) ; シンボルの集合
(+ (weight left) (weight right))        ; シンボルの合計weight
)
)

(define (left-branch tree) (car tree))
(define (symbols tree)
(if
(leaf? tree)
(list (symbol-leaf tree))
)
)

(define (weight tree)
(if
(leaf? tree)
(weight-leaf 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))))

; treeのmergeの手続き
(cond
((null? set) (list x))
((< (weight x) (weight (car set))) (cons x set))
(else (cons (car set)

; リストをleftのリストに変換
(define (make-leaf-set pairs)
(if
(null? pairs)
'()
(let
((pair (car pairs)))
(make-leaf-set (cdr pairs)))
)
)
)

(define _pairs '((A 4) (B 2) (C 1) (D 1)) )
(print "pairs:" _pairs)
(print "  => make-leaf-set:" (make-leaf-set _pairs))

``````

## Ex 2.67

やるだけ〜

``````(print "===Ex.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))

(print (decode sample-message sample-tree)) ;(A D A B B C A)
``````

## Ex 2.68

とりあえず毎回２つ小さいのを探しては、

``````
(print "===Ex 2.68===")
;encode-symbolを設計する

(define (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree) (encode (cdr message) tree))))

(define (encode-symbol char tree)
(define (itr char tree code)
;(print "left: " (left-branch tree) " right: " (right-branch tree))
(cond
((leaf? tree) code)
((contains-symbol? char (left-branch tree)) (itr char (left-branch tree) (cons 0 code)))
((contains-symbol? char (right-branch tree)) (itr char (right-branch tree) (cons 1 code)))
(else #f)
)
)
(reverse (itr char tree '()))
)

(define (contains-symbol? char tree)
(memq char (symbols tree))
)

(define sample-message '(A D A B B C A))
(print (encode sample-message sample-tree))
; 正解：(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)
``````

(別解)hioさんみたいにconsの中でitr呼び出す形にすれば、
reverseしなくてつなげる！
↓↓

``````(define (encode-symbol char tree)
(define (iter current-tree)
(cond
((leaf? current-tree)
'())
((memq char (symbols (left-branch current-tree)))
(cons 0 (iter (left-branch current-tree))))
((memq char (symbols (right-branch current-tree)))
(cons 1 (iter (right-branch current-tree))))
(else
(error "NEVER REACH HERE"))))

(if
(memq char (symbols tree))
(iter tree)
(error "bad char:" char "not in tree" tree)))
``````

## Ex 2.69

``````(print "===Ex 2.69===")
; ハフマン符号木実装

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

; 最小のもの同士をmerge
(define (successive-merge leafs)
(define (join x lst)
(if
(null? x)
lst
(cons x lst)))
(define (create-min-tree leafs lst l1 l2)
(print "leafs:" leafs " lst:" lst " l1:" l1 " l2:" l2)
(cond
((null? leafs)
(if
(null? lst)
(make-code-tree l1 l2)
(create-min-tree (join (make-code-tree l1 l2) lst) '() '() '())))
((null? l1) (create-min-tree (cdr leafs) lst (car leafs) l2))
((null? l2) (create-min-tree (cdr leafs) lst l1 (car leafs)))
((> (weight l1) (weight (car leafs)))
(create-min-tree (cdr leafs) (join l1 lst) (car leafs) l2))
((> (weight l2) (weight (car leafs)))
(create-min-tree (cdr leafs) (join l2 lst) l1 (car leafs)))
(else (create-min-tree (cdr leafs) (join (car leafs) lst) l1 l2))))
(create-min-tree leafs '() '() '())
)

(define _pairs '((A 4) (B 2) (C 1) (D 1) (E 1)) )
(print (make-leaf-set _pairs))
(print (generate-huffman-tree _pairs))
``````

``````((leaf E 1) (leaf D 1) (leaf C 1) (leaf B 2) (leaf A 4))
leafs:((leaf E 1) (leaf D 1) (leaf C 1) (leaf B 2) (leaf A 4)) lst:() l1:() l2:()
leafs:((leaf D 1) (leaf C 1) (leaf B 2) (leaf A 4)) lst:() l1:(leaf E 1) l2:()
leafs:((leaf C 1) (leaf B 2) (leaf A 4)) lst:() l1:(leaf E 1) l2:(leaf D 1)
leafs:((leaf B 2) (leaf A 4)) lst:((leaf C 1)) l1:(leaf E 1) l2:(leaf D 1)
leafs:((leaf A 4)) lst:((leaf B 2) (leaf C 1)) l1:(leaf E 1) l2:(leaf D 1)
leafs:() lst:((leaf A 4) (leaf B 2) (leaf C 1)) l1:(leaf E 1) l2:(leaf D 1)
leafs:(((leaf E 1) (leaf D 1) (E D) 2) (leaf A 4) (leaf B 2) (leaf C 1)) lst:() l1:() l2:()
leafs:((leaf A 4) (leaf B 2) (leaf C 1)) lst:() l1:((leaf E 1) (leaf D 1) (E D) 2) l2:()
leafs:((leaf B 2) (leaf C 1)) lst:() l1:((leaf E 1) (leaf D 1) (E D) 2) l2:(leaf A 4)
leafs:((leaf C 1)) lst:((leaf A 4)) l1:((leaf E 1) (leaf D 1) (E D) 2) l2:(leaf B 2)
leafs:() lst:(((leaf E 1) (leaf D 1) (E D) 2) (leaf A 4)) l1:(leaf C 1) l2:(leaf B 2)
leafs:(((leaf C 1) (leaf B 2) (C B) 3) ((leaf E 1) (leaf D 1) (E D) 2) (leaf A 4)) lst:() l1:() l2:()
leafs:(((leaf E 1) (leaf D 1) (E D) 2) (leaf A 4)) lst:() l1:((leaf C 1) (leaf B 2) (C B) 3) l2:()
leafs:((leaf A 4)) lst:() l1:((leaf C 1) (leaf B 2) (C B) 3) l2:((leaf E 1) (leaf D 1) (E D) 2)
leafs:() lst:((leaf A 4)) l1:((leaf C 1) (leaf B 2) (C B) 3) l2:((leaf E 1) (leaf D 1) (E D) 2)
leafs:((((leaf C 1) (leaf B 2) (C B) 3) ((leaf E 1) (leaf D 1) (E D) 2) (C B E D) 5) (leaf A 4)) lst:() l1:() l2:()
leafs:((leaf A 4)) lst:() l1:(((leaf C 1) (leaf B 2) (C B) 3) ((leaf E 1) (leaf D 1) (E D) 2) (C B E D) 5) l2:()
leafs:() lst:() l1:(((leaf C 1) (leaf B 2) (C B) 3) ((leaf E 1) (leaf D 1) (E D) 2) (C B E D) 5) l2:(leaf A 4)
((((leaf C 1) (leaf B 2) (C B) 3) ((leaf E 1) (leaf D 1) (E D) 2) (C B E D) 5) (leaf A 4) (C B E D A) 9)
``````

(別解) hioさんの

``````(define (successive-merge leaves)
(cond
; 要素数 == 0:
((null? leaves)
(error "leaves must have at least one element"))
; 要素数 == 1:
((null? (cdr leaves))
(car leaves))
; 要素数 >= 2:
(else
(successive-merge
(make-code-tree
(car leaves)
(cddr leaves))))))

``````

## Ex 2.70

``````(print "===Ex 2.70===")
(define _pairs '((na 16) (yip 9) (sha 3) (a 2) (get 2) (job 1) (wah 1) (boom 1)))
(define tree (generate-huffman-tree _pairs))
(print tree)

(define sample-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))
(print sample-message)
(define encoded (encode sample-message tree))
(print encoded)
;(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 1 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 0)
(print (length encoded)) ;84
``````

``````3 * (16 + 9 + 3 + 2 + 2 + 2 + 1 + 1)
= 3 * 36
= 108
``````

count
na 16
yip 9
Sha 3
a 2
Get 2
job 2
Wah 1
boom 1

## Ex. 2.71

``````(print "===Ex 2.71===")
;n 記号のアルファベットに対するハフマン木があ
;り、記号の相対頻度は 1, 2, 4, . . . , 2^n−1 であるとする。n = 5、n = 10
;の場合の木をスケッチせよ。そのような木では、(一般の n につい
;て) 最も頻度の高い記号を符号化するのに何ビット必要になるだ
;ろうか。最も頻度の低い記号はどうだろうか。

(define n_3_sample '((A 1) (B 2) (C 4)))
(define tree (generate-huffman-tree n_3_sample))
(print (encode '(A) tree)) ;(0 0 0 0)

(define n_5_sample '((A 1) (B 2) (C 4) (D 8) (E 16)))
(define tree (generate-huffman-tree n_5_sample))
(print (encode '(A) tree)) ;(0 0 0 0)

(define n_10_sample '((A 1) (B 2) (C 4) (D 8) (E 16) (F 32) (G 64) (H 128) (I 256) (J 512)))
(define tree (generate-huffman-tree n_10_sample))
(print (encode '(A) tree)) ;(0 0 0 0 0 0 0 0 0) 長さ9
``````
• 最も頻度が高い 1bit
• 最も頻度が低い n-1 bit

## Ex.2.72

### 頻度細大の記号の符号化

• encode-symbol 1回
• ontains-symbol? 1回
``````O(1)
``````

### 頻度最小の記号の符号化

encode-symbol n回
ontains-symbol? n回

``````O(n^2)
``````
Why not register and get more from Qiita?
1. We will deliver articles that match you
By following users and tags, you can catch up information on technical fields that you are interested in as a whole
2. you can read useful information later efficiently
By "stocking" the articles you like, you can search right away