ヒープ
今回は簡単な例題として、「ヒープ (heap) 」というデータ構造を作ってみましょう。拙作の Scheme 入門講座 ヒープとハッシュ法 ではベクタとクロージャを使ってヒープを実装しましたが、オブジェクト指向を使っても簡単にプログラムを作ることができます。そして、ヒープを使った例題として「ハフマン符号」という古典的なデータ圧縮アルゴリズムを取り上げます。
●ヒープとは？
「ヒープ (heap) 」は「半順序木 (partial ordered tree) 」をベクタで実現したデータ構造です。一般的な二分木では、親よりも左側の子のほうが小さく、親よりも右側の子が大きい、という関係を満たすように作ります。「半順序木」の場合、親は子より小さいか等しい、という関係を満たすように作ります。したがって、木の根（ベクタの添字 0）には、必ず最小値のデータが格納されます。下図にヒープとベクタの関係を示します。
図 1 : ヒープとベクタの対応関係
ヒープを利用すると、最小値をすぐに見つけることができ、新しくデータを挿入する場合も、高々要素の個数 (n) の対数 (log2 n) に比例する程度の時間で済みます。アルゴリズムの説明は拙作のページ ヒープとハッシュ法 をお読みください。
●ヒープの仕様
クラス名は <heap> としました。ヒープはデータの大小関係を比較する関数が必要になりますが、ここでデータの比較に算術演算子を使うと、そのヒープは数値データだけにしか適用できなくなります。データの種類に合わせて比較関数を選択できると便利です。
この場合、2 つの方法が考えられます。ひとつは比較関数をメソッドで定義する方法です。たとえば、データの大小関係をメソッド compare で比較するようにプログラムを作成します。データの種類に合わせてメソッド compare を定義しておけば、あとは Gauche の方で適切なメソッドを選択してくれます。
もうひとつは、ヒープを生成するときに比較関数を指定する方法です。たとえば、比較関数を格納するスロット compare を用意し、引数で指定した比較関数をそこにセットします。データを比較するときは、スロット compare に格納されている関数を呼び出せばいいわけです。どちらの方法でも簡単にプログラムできますが、今回は Scheme らしく後者の方法でプログラムを作ってみましょう。
ところで、これだけでは面白くないので、要素からキーを取り出す関数をキーワード :key で指定できるようにします。たとえば、コンスセル (a . b) を要素とする場合、:key に car を指定すると、コンスセルの CAR 部をキーとしてヒープが構成されるわけです。:key のデフォルトは (lambda (x) x) とします。
次はクラス <heap> で公開するメソッドを表 1 に示します。
| メソッド | 機能 |
|---|---|
| heap-push! h x | ヒープ h にデータ x を追加する |
| heap-pop! h | ヒープ h からデータを取り出す |
| heap-peek h | ヒープ h の先頭データを参照する |
| heap-length h | ヒープ h に格納されている要素数を返す |
| heap-clear! h | ヒープ h を空にする |
| heap-empty? h | ヒープ h が空ならば #t を返す |
ヒープは可変長配列クラス <vlvector> を使って実装することにします。
●クラスの定義
まず最初にクラス <heap> を定義します。次のリストを見てください。
リスト 1 : クラス定義 (define-class <heap> () ((buff :accessor heap-buff :init-form (make <vlvector>)) (key :accessor get-key :init-value (lambda (x) x) :init-keyword :key) (obj>? :accessor get-obj>? :init-value > :init-keyword :obj>?)))
スロット buff にはデータを格納する <vlvector> のインスタンスを、key にはキーを取り出す関数を、obj>? にはデータを比較する関数をセットします。obj>? は第 1 引数が第 2 引数よりも大きいとき #t を返す関数で、デフォルト値は > とします。これで小さいデータから順番に取り出すことができます。
●メソッドの定義
次はメソッド heap-push!, heap-peek, heap-pop! を作ります。次のリストを見てください。
リスト 2 : メソッドの定義
; データの追加
(define-method heap-push! ((h <heap>) x)
(vlvector-push! (heap-buff h) x)
(upheap (heap-buff h) (- (heap-length h) 1) (get-obj>? h)))
; 先頭データの参照
(define-method heap-peek ((h <heap>))
(if (heap-empty? h)
(error "<heap> : heap is empty")
(vlvector-ref (heap-buff h) 0)))
; データの取り出し
(define-method heap-pop! ((h <heap>))
(begin0
(heap-peek h)
(if (positive? (heap-length h))
(let ((buff (heap-buff h)))
(vlvector-set! buff 0 (vlvector-pop! buff))
(downheap buff 0 (vlvector-length buff) (get-obj>? h))))))
heep-push! は vlvector-push! で可変長ベクタの末尾にデータ x を追加します。それから、関数 upheap で x をルート方向に移動してヒープを修正します。upheap にはスロット obj>? に格納されている比較関数を渡します。処理内容は拙作のページ ヒープとハッシュ法 と同じです。
heap-peek! は heap-empty? を呼び出してヒープが空かチェックします。空の場合はエラーを送出します。データがある場合は可変長ベクタの 0 番目の要素を返します。heap-pop! は heap-peek で可変長ベクタの 0 番目の要素を求め、その後で 0 番目の要素を削除します。vlvector-pop! で最後尾のデータを求め、それを 0 番目にセットします。そして、そのデータを関数 downheap でルートから葉の方向へ移動してヒープを修正します。downheap も ヒープとハッシュ法 のプログラムと同じです。
後のメソッドは簡単なので説明は割愛いたします。詳細は プログラムリスト１ をお読みください。
●実行例
それでは簡単な実行例を示します。
gosh> (use heap) #<undef> gosh> (define a (make <heap>)) a gosh> (heap-length a) 0 gosh> (heap-empty? a) #t gosh> (dolist (x '(5 6 4 7 3 8 2 9 1 0)) (heap-push! a x)) () gosh> (heap-length a) 10 gosh> (heap-empty? a) #f gosh> (heap-peek a) 0 gosh> (dotimes (x 10) (format #t "~D " (heap-pop! a))) 0 1 2 3 4 5 6 7 8 9 #t gosh> (heap-empty? a) #t gosh> (heap-length a) 0
このように、ヒープを使うと最小値のデータを簡単に求めることができます。
●ハフマン符号
それでは、簡単な例題として「ハフマン符号」を取り上げます。ハフマン符号は 1952 年にハフマン (D. Huffman) が考案した、平均符号長を最小にすることができる符号化法です。古典的なデータ圧縮アルゴリズムですが、ほかのアルゴリズムと簡単に組み合わせることができるため、ハフマン符号は今でも現役のアルゴリズムです。
最初にハフマン符号のアルゴリズムを簡単に説明します。なお、この説明は拙作のページ Algorithms with Python シャノン符号とハフマン符号 と同じ内容です。ハフマン符号について理解されている方は読み飛ばしてもらってかまいません。
●ハフマン符号のアルゴリズム
ハフマン符号の構成は符号木を作ることで行います。ハフマン符号を構成するアルゴリズムを以下に示します。
- 各記号に対応する葉を作成する。この葉には、記号の出現頻度をあらかじめ格納しておく。
- 出現頻度の小さい方から 2 つの葉を取り出す。この葉を格納する新しい節を一つ作り、左右の枝に符号 0 と 1 を割り当てる。この節には 2 つの葉の出現頻度を足した値を格納し、新しい葉として追加する。
- 葉が一つになるまで手順 2 を繰り返すと、二分木を作成することができる。これをハフマン木と呼ぶ。根から記号に達するまでの枝をたどったときに得られる 0 と 1 の系列が、その記号の符号となる。
それでは、記号列 abccddeeeeffffgggggggghhhhhhhh を入力したときの、ハフマン符号化の具体的な構成例を示しましょう。
まず、各記号の出現頻度を求めて「節」の集合を構成します。この集合の中から、出現頻度の小さい方から 2 つ取り出して、新しい節に格納します。最初は、a と b を取り出して N1 に格納します。このとき、N1 の出現頻度は a と b を足した値をセットします。そして、この節 N1 を節の集合に登録します。この時点で節の集合は、{ c, d, N1, e, f, g, h } となります。あとは、この操作を節が一つになるまで繰り返します。
同様に、節の集合の中から d と c を取り出して、新しい節 N2 にセットして集合に登録します。節の集合は {N1, e, f, N2, g, h} となり、この中から頻度 2 の N1 と頻度 4 の e を取り出して N3 を登録します。すると、節の集合は {f, N2, N3, g, h} となり、その中から頻度 4 の N2 と f を取り出して N4 を登録します。
この時点で節の集合は {N3, g, h, N4} の 4 つあります。小さい方から N3 と g を取り出して N5 を登録します。次に、h と N4 を取り出して N6 を登録します。節の集合は {N5, N6} となり、この 2 つを一つにまとめてハフマン木が完成します。
各記号の符号語は、ハフマン木の ROOT から葉に向かってたどっていくことで求めることができます。左右の枝にラベル 0 と 1 を割り当てることにすると、記号 a は「右、右、左、右」と枝をたどって葉に到達するので、符号語は 1101 となります。ほかの記号も同様に求めることができます。
なお、シャノン・ファノ符号のときにも説明しましたが、ハフマン符号も「葉」の組み合わせ方によって、異なる符号が得られます。しかしながら、どのハフマン符号でも同一の平均符号長が得られるので、圧縮率は同じになります。
●節の定義
それでは、ハフマン符号のプログラムを作りましょう。最初に二分木の節を定義します。
リスト 3 : 符号木の節 (define-class <node> () ((sym :accessor get-sym :init-value #f :init-keyword :sym) (cnt :accessor get-cnt :init-value 0 :init-keyword :cnt) (left :accessor node-left :init-value #f :init-keyword :left) (right :accessor node-right :init-value #f :init-keyword :right)))
節を表すクラスは <node> としました。スロット sym に記号を、cnt に出現回数をセットします。left と right には左右の子を格納します。終端は #f で表します。ハフマン符号は、ヒープを使うと簡単にプログラムを作ることができます。
●出現頻度表の作成
次は記号の出現頻度表を作成する関数 make-frequency を作ります。
リスト 4 : 出現頻度表の作成
(define (make-frequency ls)
(let loop ((ls ls) (a '()))
(if (null? ls)
a
(let ((cell (assoc (car ls) a)))
(cond (cell
(inc! (cdr cell))
(loop (cdr ls) a))
(else
(loop (cdr ls) (cons (cons (car ls) 1) a))))))))
出現頻度表は連想リストで表します。コンスセルの CAR 部に記号を、CDR 部に出現回数を格納します。符号化するデータはリスト ls で受け取ります。ls から要素をひとつずつ取り出し、assoc で連想リスト a から記号を探索します。連想リスト内に記号がある場合、inc! で出現回数を +1 します。見つからなかった場合、新しいセル (cons (car ls) 1) を生成して、連想リスト a に追加します。
それでは実際に実行してみましょう。
gosh> (make-frequency '(a a a a b c c c d d)) ((d . 2) (c . 3) (b . 1) (a . 4)) gosh> (make-frequency '(a b c d a b c d e a b)) ((e . 1) (d . 2) (c . 2) (b . 3) (a . 3))
●ハフマン木の生成
次は符号木を作る関数 make-huffman-tree を作ります。
リスト 5 : ハフマン木の生成
(define (make-huffman-tree ls)
(if (null? (cdr ls))
(push! ls (cons 'eof 0)))
(let ((hp (make <heap> :key get-cnt)))
(for-each
(lambda (x) (heap-push! hp (make <node> :sym (car x) :cnt (cdr x))))
ls)
(let loop ()
(if (= (heap-length hp) 1)
(heap-pop! hp)
(let ((a (heap-pop! hp)) (b (heap-pop! hp)))
(heap-push!
hp
(make <node> :cnt (+ (get-cnt a) (get-cnt b))
:left a
:right b))
(loop))))))
引数 ls には make-frequency で作成した出現頻度表 (連想リスト) を渡します。ls に要素がひとつしかないとハフマン木を構成できないので、ダミーのデータ (eof . 0) を追加します。次に、make <heap> でヒープを生成して変数 hp にセットします。このとき、キーは記号の出現回数になるので、節 node から出現回数を求めるメソッド get-cnt を :key に指定します。それから、make <node> で節を生成し、heap-push! でヒープに追加ます。
次に、ヒープからデータを取り出して、ハフマン木を構成します。ヒープにデータがひとつしかない場合、それがハフマン木のルートになります。heap-pop! で節を取り出して返します。そうでなければ、ヒープから節を 2 つ取り出して変数 a と b にセットします。そして、新しい節を生成してヒープに追加します。このとき、a と b を左右の子にセットし、その節の出現回数は (+ (get-cnt a) (get-cnt b)) となります。これで、ハフマン木を構成することができます。
それでは、ここでハフマン木を表示する関数 print-huffman-tree を作成し、簡単なテストを行ってみましょう。
リスト 6 : ハフマン木の表示
(define (print-huffman-tree node n)
(if node
(begin
(print-huffman-tree (node-left node) (+ n 1))
(dotimes (x n) (display " "))
(display (get-sym node))
(newline)
(print-huffman-tree (node-right node) (+ n 1)))))
gosh> (print-huffman-tree (make-huffman-tree
(make-frequency '(a a b a b c a b c d))) 0)
a
#f
b
#f
d
#f
c
#<undef>
このように、ハフマン符号では出現回数が多い記号ほど経路長 (符号語長) が短くなります。
●符号化と復号
最後に、符号化と復号を行う関数 huffman-encode と huffman-decode を作ります。符号化を行う関数 huffman-encode は次のようになります。
リスト 7 : 符号化処理
; ハフマン符号を求める
(define (make-huffman-code node cs code)
(if (leaf? node)
(cons (cons (get-sym node) (reverse cs)) code)
(make-huffman-code (node-right node)
(cons 1 cs)
(make-huffman-code (node-left node)
(cons 0 cs)
code))))
; 符号化
(define (huffman-encode ls)
(let* ((tree (make-huffman-tree (make-frequency ls)))
(code (make-huffman-code tree '() '())))
(values tree (apply append (map (lambda (x) (cdr (assoc x code))) ls)))))
関数 make-huffman-code は符号木を巡回して、記号と符号語を連想リストに格納して返します。code が連想リストで、cs が記号の符号語を表します。node が葉の場合、記号と符号語を cons でセルにまとめて code に追加します。そうでなければ、make-huffman-code を再帰呼び出しして符号木をたどります。左の枝をたどるときは cs に 0 を追加し、右の枝をたどるときは cs に 1 を追加します。
符号化を行う huffman-encode は簡単です。変数 tree にハフマン木を、code にハフマン符号をセットします。あとは、map で記号を符号語に変換するだけです。(apply append ,,,) でリストを平坦化していることに注意してください。最後に values でハフマン木と符号を返します。
復号を行う関数 huffman-decode は次のようになります。
リスト 8 : 復号
(define (huffman-decode tree ls)
(let loop ((node tree) (ls ls) (a '()))
(cond ((leaf? node)
(loop tree ls (cons (get-sym node) a)))
((null? ls) (reverse a))
((zero? (car ls))
(loop (node-left node) (cdr ls) a))
(else
(loop (node-right node) (cdr ls) a)))))
引数 tree がハフマン木で ls が符号を格納したリストです。loop でハフマン木をたどり、node が葉に到達したら記号を get-sym で取り出して累積変数 a にセットします。ls が空リストになれば復号は終了です。累積変数 a を reverse で反転して返します。あとは、符号 0 の場合は左の部分木をたどり、1 の場合は右の部分木をたどります。
それでは簡単な実行例を示します。
gosh> (receive (a b) (huffman-encode '(a a b a b c a b c d a b c d e))
(print-huffman-tree a 0) (print b) (huffman-decode a b))
c
#f
e
#f
d
#f
b
#f
a
(1 1 1 1 1 0 1 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 0)
(a a b a b c a b c d a b c d e)
正常に動作していますね。ところで、実際にハフマン符号でデータを圧縮する場合、問題点がひとつあります。データを圧縮する場合、記号の出現頻度を調べて符号木を構成しますが、符号化されたデータを復号する場合も、符号化した時に構成した符号木が必要になります。このため、圧縮データには符号木の情報を付加しなければならず、圧縮率が低下することになります。
簡単な方法は出現頻度表をそのまま付加することですが、そのほかに符号木を符号化して付加する方法もあります。詳しい説明は拙作のページAlgorithms with Python シャノン符号とハフマン符号 の「符号木の取り扱い」をお読みください。
●プログラムリスト１
;
; heap.scm : ヒープ
;
; Copyright (C) 2010 Makoto Hiroi
;
(define-module heap
(use vlvector)
(export <heap>
heap-push! heap-pop! heap-peek
heap-empty? heap-length heap-clear!))
(select-module heap)
;;; クラス定義
(define-class <heap> ()
((buff :accessor heap-buff :init-form (make <vlvector>))
(key :accessor get-key :init-value (lambda (x) x) :init-keyword :key)
(obj>? :accessor get-obj>? :init-value > :init-keyword :obj>?)))
;;; 操作関数
; 要素の交換
(define (swap buff x y)
(let ((temp (vlvector-ref buff x)))
(vlvector-set! buff x (vlvector-ref buff y))
(vlvector-set! buff y temp)))
; ヒープの構築
(define (upheap buff n key-of object>?)
(let loop ((n n) (p (quotient (- n 1) 2)))
(cond ((and (<= 0 p)
(object>? (key-of (vlvector-ref buff p))
(key-of (vlvector-ref buff n))))
(swap buff p n)
(loop p (quotient (- p 1) 2))))))
; ヒープの再構築
(define (downheap buff n nums key-of object>?)
(let loop ((n n) (c (+ (* n 2) 1)))
(cond ((< c nums)
(if (and (< (+ c 1) nums)
(object>? (key-of (vlvector-ref buff c))
(key-of (vlvector-ref buff (+ c 1)))))
(inc! c))
(cond ((object>? (key-of (vlvector-ref buff n))
(key-of (vlvector-ref buff c)))
(swap buff n c)
(loop c (+ (* c 2) 1))))))))
;;; メソッドの定義
; 空か
(define-method heap-empty? ((h <heap>))
(vlvector-empty? (heap-buff h)))
; 要素数
(define-method heap-length ((h <heap>))
(vlvector-length (heap-buff h)))
; クリア
(define-method heap-clear! ((h <heap>))
(vlvector-clear! (heap-buff h)))
; データの追加
(define-method heap-push! ((h <heap>) x)
(vlvector-push! (heap-buff h) x)
(upheap (heap-buff h) (- (heap-length h) 1) (get-key h) (get-obj>? h)))
; 先頭データの参照
(define-method heap-peek ((h <heap>))
(if (heap-empty? h)
(error "<heap> : heap is empty")
(vlvector-ref (heap-buff h) 0)))
; データの取り出し
(define-method heap-pop! ((h <heap>))
(begin0
(heap-peek h)
(if (positive? (heap-length h))
(let ((buff (heap-buff h)))
(vlvector-set! buff 0 (vlvector-pop! buff))
(downheap buff 0 (vlvector-length buff) (get-key h) (get-obj>? h))))))
(provide "heap")
●プログラムリスト２
;
; huffman.scm : ハフマン符号
;
; Copyright (C) 2010 Makoto Hiroi
;
(use heap)
;;; 二分木の定義
(define-class <node> ()
((sym :accessor get-sym :init-value #f :init-keyword :sym)
(cnt :accessor get-cnt :init-value 0 :init-keyword :cnt)
(left :accessor node-left :init-value #f :init-keyword :left)
(right :accessor node-right :init-value #f :init-keyword :right)))
; 葉のチェック
(define (leaf? node) (get-sym node))
; 出現頻度表の作成
(define (make-frequency ls)
(let loop ((ls ls) (a '()))
(if (null? ls)
a
(let ((cell (assoc (car ls) a)))
(cond (cell
(inc! (cdr cell))
(loop (cdr ls) a))
(else
(loop (cdr ls) (cons (cons (car ls) 1) a))))))))
; ハフマン木の生成
; ls = ((sym . num) ...)
(define (make-huffman-tree ls)
(if (null? (cdr ls))
(push! ls (cons 'eof 0)))
(let ((hp (make <heap> :key get-cnt)))
(for-each
(lambda (x) (heap-push! hp (make <node> :sym (car x) :cnt (cdr x))))
ls)
(let loop ()
(if (= (heap-length hp) 1)
(heap-pop! hp)
(let ((a (heap-pop! hp)) (b (heap-pop! hp)))
(heap-push!
hp
(make <node> :cnt (+ (get-cnt a) (get-cnt b))
:left a
:right b))
(loop))))))
; ハフマン木の表示
(define (print-huffman-tree node n)
(if node
(begin
(print-huffman-tree (node-left node) (+ n 1))
(dotimes (x n) (display " "))
(display (get-sym node))
(newline)
(print-huffman-tree (node-right node) (+ n 1)))))
; ハフマン符号を求める
(define (make-huffman-code node cs code)
(if (leaf? node)
(cons (cons (get-sym node) (reverse cs)) code)
(make-huffman-code (node-right node)
(cons 1 cs)
(make-huffman-code (node-left node)
(cons 0 cs)
code))))
; 符号化
(define (huffman-encode ls)
(let* ((tree (make-huffman-tree (make-frequency ls)))
(code (make-huffman-code tree '() '())))
(values tree (apply append (map (lambda (x) (cdr (assoc x code))) ls)))))
; 復号
(define (huffman-decode tree ls)
(let loop ((node tree) (ls ls) (a '()))
(cond ((leaf? node)
(loop tree ls (cons (get-sym node) a)))
((null? ls) (reverse a))
((zero? (car ls))
(loop (node-left node) (cdr ls) a))
(else
(loop (node-right node) (cdr ls) a)))))