ハフマン符号 (2)
ハフマン符号の続きです。今回は実際にハフマン符号を使ってファイルを圧縮してみましょう。まず最初にデータ圧縮の基本である「エントロピー」について簡単に説明します。
●エントロピーとは？
一般に、データ圧縮アルゴリズムは「モデル化」と「符号化」という 2 つの部分に分けて考えることができます。モデルは入力された記号列から作成され、各記号の出現確率を求めます。たとえば、記号 a の確率は 1/10 で、記号 b の確率は 9/10 のように決定します。符号化は確率に基づいて符号語を割り当て、入力された記号を符号語に変換して出力します。
なお、拙作のページ Algorithms with Python 連長圧縮 (ランレングス) のように、このような考え方に当てはまらない圧縮アルゴリズムも存在します。
モデル化にはいろいろな方法がありますが、最も単純なモデルは、各記号の出現確率を求め、それに基づいて符号語を割り当てる方法です。このような単純なモデルを「無記憶情報源モデル」といいます。情報源は記号を生成する元（発生源）と考えてください。
情報源が記号を生成するとき、以前に生成した記号との間に関係がないことを「無記憶」といいます。簡単にいえば、記号 t の次は h が出るとか、t, h と続いたら次は e が出るといった関係はなく、確率でのみ記号が生成されるということです。
たとえば、記号列 "abccddeeeeffffgggggggghhhhhhhh" はアスキーコードで 240 ビットになりますが、a, b, c, d を 4 ビット、e と f を 3 ビット、g と h を 2 ビットで表すことができれば、この記号列を 80 ビットで表現することができます。このように、出現確率の高い記号に短い符号語を割り当て、出現確率の低い記号に長い符号語を割り当てることができれば、データを圧縮することができます。
ところで、データ圧縮アルゴリズムの評価する場合、圧縮率のほかに「平均符号長」という尺度があります。これは、符号化された記号列のビット長を、入力された記号数で割った値として定義されます。たとえば、先ほどの記号列を 80 ビットで表すと、平均符号長は 80 / 30 = 2.666667 ビットになります。
無記憶情報源モデルの場合、各記号 ai の出現確率 P(ai) がわかると、次の式で平均符号長の下限値を求めることができます。
H = - Σ P(ai) * log2 P(ai) (ビット)
i
この値を平均情報量、またはエントロピー (Entoropy) と呼びます。ここで、平均符号長を L とすると H <= L が成り立ちます。つまり、平均符号長 L はエントロピー H よりも短くすることはできないのです。先ほどの記号列のエントロピーを求めると次のようになります。
記号列 : abccddeeeeffffgggggggghhhhhhhh 記号 : 確率 : -P(x)*log P(x) ----------------------------- a : 1/30 : 0.163563 b : 1/30 : 0.163563 c : 1/15 : 0.2604594 d : 1/15 : 0.2604594 e : 2/15 : 0.3875854 f : 2/15 : 0.3875854 g : 4/15 : 0.5085042 h : 4/15 : 0.5085042 ----------------------------- エントロピー = 2.640224 30 * 2.640224 = 79.20672 bit
したがって、この記号列では平均符号長を 2.64 ビット以下にすることはできません。いいかえると、この記号列を表すには少なくても 30 * 2.640224 = 79.20672 ビット以上が必要になる、ということです。
これらのことをまとめると、シャノンの有名な定理になります。参考文献 [1] より引用します。
一意復号可能な平均符号長 L は、無記憶情報源のエントロピー H よりも小さくすることができない。すなわち不等式 H <= L が成り立つ。また、平均符号長 L が H <= L < H + 1 を満足する瞬時に復号可能な符号が構成できる。
情報源符号化定理は、データ圧縮の限界を示したことと、限界に近づけるような符号化法があることを示した点で、データ圧縮においてとても重要な定理なのです。
ここで、ファイルのエントロピーを求めるプログラムを作ってみましょう。次のリストを見てください。
リスト : エントロピーを求める
;;; 符号語のサイズ
(defconstant code-size 256)
;;; 記号の出現頻度を求める
(defun make-frequency (filename)
(with-open-file (in filename
:direction :input
:element-type 'unsigned-byte)
(do ((table (make-array code-size :initial-element 0))
(cnt 0 (1+ cnt))
(c (read-byte in nil) (read-byte in nil)))
((null c) (values cnt table))
(incf (aref table c)))))
;;; エントロピーを求める
(defun entoropy (filename)
(multiple-value-bind
(cnt table)
(make-frequency filename)
(let ((e (reduce (lambda (a x)
(if (zerop x)
a
(let ((p (/ x cnt)))
(+ a (- (* p (log p 2)))))))
table
:initial-value 0.0)))
(values e (ceiling (* cnt e) 8)))))
関数 make-frequency は記号の出現頻度表を作成して、記号数といっしょに返します。記号は 1 byte の無符号整数で表します。Common Lisp の場合、ファイルをオープンするときにキーワード :element-type で unsigned-byte を指定すると、関数 read-byte で 1 byte のデータを読み込み、関数 write-byte で 1 byte のデータを書き込むことができます。データの範囲は 0 から #xff までです。
関数 entoropy の引数 FILENAME はファイル名です。make-frequency を呼び出して各記号の出現頻度を求めます。あとは、各記号の出現確率 p を求め、- p * log2 p を計算し、その総和を reduce て求めます。これでエントロピー e を求めることができます。圧縮の下限値は ファイルサイズ * エントロピー で計算することができます。
それでは、実際に Canterbury Corpus で配布されているテストデータ The Canterbury Corpus のエントロピーを求めてみましょう。結果は次のようになりました。
表 : エントロピーの計算結果
ファイル名 サイズ エントロピー 下限値
----------------------------------------------
alice29.txt 152,089 4.5676794 86,837
asyoulik.txt 125,179 4.808116 75,235
cp.html 24,603 5.229136 16,082
fields.c 11,150 5.0076995 6,980
grammar.lsp 3,721 4.6322675 2,155
kennedy.xls 1,029,744 3.5734692 459,970
lcet10.txt 426,754 4.669118 249,071
plrabn12.txt 481,861 4.531362 272,936
ptt5 513,216 1.2101756 77,636
sum 38,240 5.328994 25,473
xargs.1 4,227 4.8984303 2,589
たとえば alice29.txt の場合、エントロピーは 4.5676794 で、ファイルは 86,837 バイトよりも圧縮することはできません。ただし、この結果は無記憶情報源モデルの場合であり、モデル化によってエントロピーの値は異なることに注意してください。エントロピーをより小さくするモデルを作成することがでれきば、これよりも高い圧縮率を達成することができます。逆にいうと、圧縮率を高くするには、モデル化の工夫が必要であるということです。
●ビット入出力処理の作成
それでは、ここで符号化・復号処理に必要となるビット単位の入出力ルーチンを作成します。必要な操作は、1 ビット単位と複数ビットの入出力です。
ファイルの入出力はバイト単位で入出力を行う関数 read-byte と write-byte で行い、1 バイトのバッファを介してビット入出力を行います。たとえば、バッファに 8 ビット分データをセットしたら、write-byte でファイルへ書き込みます。1 ビット読み込むときも、バッファにデータがなければ、read-byte でファイルからデータをバッファに読み込み、そこから 1 ビットリードします。
それでは、作成する操作関数の一覧表を示します。
- call-with-byte-input-file filename proc
入力用バイトストリームをオープンし、それを関数 proc に渡して呼び出します。
proc は 1 引数の関数です。filename はオープンするファイル名です。 - call-with-byte-output-file filename proc
出力用バイトストリームをオープンし、それを関数 proc に渡して呼び出します。
proc は 1 引数の関数です。filename はオープンするファイル名です。 - call-with-bit-input-file filename proc
入力用ビットストリームをオープンし、それを関数 proc に渡して呼び出します。
proc は 1 引数の関数です。filename はオープンするファイル名です。 - call-with-bit-output-file filename proc
出力用ビットストリームをオープンし、それを関数 proc に渡して呼び出します。
proc は 1 引数の関数です。filename はオープンするファイル名です。 - getbit bs
ビットストリーム bs より 1 ビット読み込みます。ファイルの終了は nil を返します。 - getbits bs b
ビットストリーム bs より n ビット読み込みます。ファイルの終了は nil を返します。 - putbit bs bit
ビットストリーム bs へ 1 ビット出力します。 - putbits bs n code
ビットストリーム bs へ code の下位 n ビットを出力します。
●ビットストリームの生成
それでは、プログラムを作りましょう。まずはビットストリームを生成する関数から作ります。
リスト : ビットストリームの生成
;;; 構造体の定義
(defstruct bit-io
direction file buff cnt)
;;; バイト入力用ファイルオープン
(defun call-with-byte-input-file (filename proc)
(with-open-file (in filename
:direction :input
:element-type 'unsigned-byte)
(funcall proc in)))
;;; バイト出力用ファイルオープン
(defun call-with-byte-output-file (filename proc)
(with-open-file (out filename
:direction :output
:if-exists :rename-and-delete
:element-type 'unsigned-byte)
(funcall proc out)))
;;; ビット入力用ファイルオープン
(defun call-with-bit-input-file (filename proc)
(call-with-byte-input-file
filename
(lambda (in)
(funcall proc (make-bit-io :direction :input
:file in
:cnt 0)))))
;;; ビット出力用ファイルオープン
(defun call-with-bit-output-file (filename proc)
(call-with-byte-output-file
filename
(lambda (out)
(let ((bs (make-bit-io :direction :output
:file out
:buff 0
:cnt 8)))
(funcall proc bs)
(if (< (bit-io-cnt bs) 8)
(write-byte (bit-io-buff bs) out))))))
call-with-byte-intput-file と call-with-byte-output-file はバイト単位で入出力を行うストリームを生成します。with-open-file のキーワード :element-type で unsigned-byte を指定します。あとは生成したストリームを PROC に渡して呼び出すだけです。
構造体 BIT-IO でビットストリームを表します。スロット BUFF がバッファで、DIRECTION はファイルのアクセスモードです。ビットデータはバッファの MSB が先頭になります。したがって、データは MSB (7 ビット目) から LSB (0 ビット目) の方向へ読み書きしていきます。
スロット CNT はカウンタで、リードモードの場合は 0 に、ライトモードの場合は 8 に初期化します。どちらの場合も CNT を -1 してから、その位置にあるビットを読み書きします。あとは、ファイル名 FILENAME のファイルを call-with-byte-input-file / call-with-byte-output-file でオープンし、ファイルオブジェクトをスロット FILE にセットします。そして、funcall で PROC を呼び出します。
ライトモードでオープンしている場合、ファイルをクローズするときにバッファをフラッシュする作業が必要になります。カウンタ CNT が 8 より小さいのであれば、バッファにデータが残っているので write-byte で出力します。
●ビットストリームからの入力
次は 1 ビット読み込むメソッド getbit を作ります。
リスト : 1 ビット読み込み
(defun getbit (bs)
(decf (bit-io-cnt bs))
(when (minusp (bit-io-cnt bs))
(setf (bit-io-buff bs)
(read-byte (bit-io-file bs) nil))
(if (null (bit-io-buff bs))
(return-from getbit nil))
(setf (bit-io-cnt bs) 7))
(if (logbitp (bit-io-cnt bs) (bit-io-buff bs)) 1 0))
getbit は簡単です。CNT を一つ減らして、その位置にあるビットをチェックするだけです。CNT を一つ減らしたら、CNT が負の値になっていないかチェックします。そうであれば、バッファにデータがなくなったので、read-byte でファイルからデータを読み込み、CNT を 7 に再設定します。値が NIL の場合は EOF (end of file) なので、return-from で NIL を返します。最後に、CNT の位置にあるビットがオンならば 1 を返し、そうでなければ 0 を返します。
次は N ビット読み込むメソッド getbits を作ります。
リスト : N ビット読み込み
(defun getbits (bs n)
(do ((pat (ash 1 (1- n)) (ash pat -1))
(val 0))
((zerop pat) val)
(case (getbit bs)
(1 (setf val (logior val pat)))
(nil (return)))))
getbits は getbit を N 回呼び出して N ビット読み込みます。変数 VAL に読み込んだビットをセットします。PAT は val にビットをセットする位置を表します。do ループで getbit を呼び出して、返り値が 1 ならば (logior val pat) でビットを 1 にセットします。そして、p を右へ 1 ビットシフトします。これで、ビットストリームから N ビット読み込むことができます。最後に VAL を返します。
●ビットストリームへの出力
次は 1 ビット書き込むメソッド putbit を作ります。
リスト : 1 ビット書き込み
(defun putbit (bs val)
(decf (bit-io-cnt bs))
(when (plusp val)
(setf (bit-io-buff bs)
(logior (bit-io-buff bs) (ash 1 (bit-io-cnt bs)))))
(when (zerop (bit-io-cnt bs))
(write-byte (bit-io-buff bs) (bit-io-file bs))
(setf (bit-io-buff bs) 0
(bit-io-cnt bs) 8)))
最初に、カウンタ CNT を一つ減らします。VAL が 0 よりも大きい場合は、BUFF の CNT の位置にビット 1 をセットします。そして、CNT が 0 であればバッファが満杯になったので write-byte で出力します。それから、BUFF を 0 に、CNT を 8 にセットします。
次は N ビット書き込むメソッド putbits を作ります。
リスト : N ビット書き込み
(defun putbits (bs n x)
(do ((pat (ash 1 (1- n)) (ash pat -1)))
((zerop pat))
(putbit bs (logand x pat))))
putbits も putbit を N 回呼び出して実現しています。PAT が出力するビットの位置を表しています。putbit は 0 よりも大きい値であれば 1 を出力するので、(logand x pat) の値を渡すだけで正常に動作します。
なお、getbits, putbits はループを使って実装しましたが、参考文献 [2] にはシフト演算子を使った方法が紹介されています。興味のある方はプログラムを書き換えてみてください。
●符号木の取り扱い
ハフマン符号でファイルを圧縮する場合、問題点が一つあります。ファイルを圧縮する場合、記号の出現頻度を調べて符号木を構成しますが、符号化されたファイルを復号する場合も、符号化した時に構成した符号木が必要になります。このため、圧縮ファイルには符号木の情報を付加しなければならず、圧縮率が低下することになります。
いちばん単純な方法は、各記号の出現頻度をそのままファイルに付加することです。ファイルを復号するときは、出現頻度から符号木を再構成すればいいのです。出現頻度を 4 バイトで格納すると 1024 byte 必要になりますが、2 バイトで収まるように工夫すると 512 byte で済みます。
また別な方法として、符号木をそのまま付加する方法があります。ファイルに書き込むときは、符号木を「行きがけ順」 [*1] で巡回します。途中の節ではフラグ 0 を出力して左右の枝をたどり、葉に到達したらフラグ 1 と記号 (8 bit) を出力します。ファイルから符号木を読み込むときは、フラグが 0 ならば節を作って左右の枝をたどっていき、1 ならば 8 bit 読み込んで記号を復号して葉にセットします。
たとえば、前回説明で用いたハフマン木を行きがけ順で巡回すると、上図に示した順番で全ての節を出力することができます。そして、このデータからハフマン木を再構成できるのです。フラグ 0 と 1 を 1 ビットで表すと、記号の種類は最大 256 種類で、節の総数は 256 * 2 - 1 = 511 になるので、この場合 256 * 8 + 511 (bit) となり 320 byte で済みます。今回はこの方法を採用することにしましょう。
プログラムは再帰を使うと簡単に作成することができます。次のリストを見てください。
リスト : 符号木の入出力
;;; 符号木の出力
(defun write-huffman-tree (bs node)
(cond ((leafp node)
(putbit bs 1)
(putbits bs 8 (node-sym node)))
(t
(putbit bs 0)
(write-huffman-tree bs (node-left node))
(write-huffman-tree bs (node-right node)))))
;;; 符号木の入力
(defun read-huffman-tree (bs)
(if (= (getbit bs) 1)
(make-node :sym (getbits bs 8))
(make-node :left (read-huffman-tree bs)
:right (read-huffman-tree bs))))
関数 write-huffman-tree は符号木を行きがけ順でたどってビットストリーム BS に出力します。述語 leafp で NODE が葉に到達したかチェックします。そうであれば、putbit で 1 を出力して、putbits で記号を出力します。枝をたどるときは、putbit で 0 を出力してから、write-huffman-tree を再帰呼び出しします。
関数 read-huffman-tree は、ビットストリーム BS からデータをリードして符号木を再構成します。BS から getbit で 1 ビット読み込みます。その値が 1 ならば「葉」なので、getbits で記号を読み込み、make-node で節を生成して返します。そうでなければ、read-huffman-tree を再帰呼び出しして木をたどります。
make-node で新しい節を生成して、左右の子に read-huffman-tree の返り値をセットします。Common Lisp の場合、関数の引数は左から右へ評価されることが規定されているので、最初に左部分木をたどり、それから右部分木をたどることになります。
[*1] まず節のデータを出力、そのあと左の子、右の子の順番で木をたどっていきます。
●符号化のプログラム
それでは、ハフマン符号のプログラムを作りましょう。圧縮ファイルの構造は次のようになります。
ファイルサイズ [4 byte] + 符号木 [不定長] + 圧縮データ [不定長]
図 : 圧縮ファイルの構造
符号化を行う関数 huffman-encode は次のようになります。
リスト : 符号化処理
(defun huffman-encode (in-file out-file)
(multiple-value-bind
(size freq)
(make-frequency in-file)
(call-with-bit-output-file
out-file
(lambda (bs)
(putbits bs 32 size)
(when (plusp size)
(let ((tree (make-huffman-tree freq))
(code (make-array code-size)))
(make-huffman-code tree 0 0 code)
(call-with-byte-input-file
in-file
(lambda (in)
(write-huffman-tree bs tree)
(dotimes (x size)
(apply #'putbits bs (aref code (read-byte in))))))))))))
関数 huffman-encode の引数 IN-FILE が入力ファイル名、OUT-FILE が出力ファイル名です。最初に記号の総数 SIZE と出現頻度表 TABLE を make-frequency で求めます。次に call-with-bit-output-file で出力用ビットストリームをオープンします。ラムダ式の引数 BS がビットストリームになります。
最初にファイルサイズを書き込みます。サイズの最大値は 32 bit 無符号整数 (4,294,967,296) とします。サイズが 0 の場合はこれで終了します。そうでなければ、符号木を make-huffman-tree で生成します。そして、関数 make-huffman-code で符号木から符号語と符号長を求めて、配列 CODE にリスト (符号長 符号語) をセットし、write-huffman-tree で符号木を出力します。あとは call-with-byte-input-file で入力ファイルをオープンし、read-byte で記号を読み込んで対応する符号語を putbits で出力します。
次は符号木から符号語を作る関数 make-huffman-code を作ります。
リスト : 符号語の生成
(defun make-huffman-code (node n cs code)
(if (leafp node)
(setf (aref code (node-sym node)) (list n cs))
(progn
(make-huffman-code (node-left node) (1+ n) (logior (ash cs 1) 1) code)
(make-huffman-code (node-right node) (1+ n) (ash cs 1) code))))
make-huffman-code は符号木を巡回し、各記号の符号長と符号語をベクタ CODE にセットします。引数の NODE は現在いる節、N はここまでの木の高さ（符号長と同じ）、CS は符号語を表します。NODE が葉に到達した場合、符号長 N と符号語 CS をリストにまとめて CODE にセットします。そうでなければ、make-huffman-code を再帰呼び出しして符号木をたどります。左の枝をたどるときは 1 なので、CODE を左へ 1 ビットシフトしてから最下位ビットを 1 にします。右の枝をたどるときは 0 なので、CODE を左へ 1 ビットシフトします。
●復号のプログラム
次は復号処理を行う関数 huffman-decode を作ります。
リスト : 復号処理
;;; 記号を復号する
(defun decode-symbol (node bs)
(do ()
((leafp node) (node-sym node))
(setf node (if (plusp (getbit bs))
(node-left node)
(node-right node)))))
;;; 復号
(defun huffman-decode (in-file out-file)
(call-with-bit-input-file
in-file
(lambda (bs)
(let* ((size (getbits bs 32))
(tree (if (plusp size) (read-huffman-tree bs))))
(call-with-byte-output-file
out-file
(lambda (out)
(dotimes (x size)
(write-byte (decode-symbol tree bs) out))))))))
huffman-decode の引数 IN-FILE が入力ファイル名で、OUT-FILE が出力ファイル名です。最初に入力用ビットストリーム BS をオープンします。次に、BS から getbits で 32 bit 読み込んで変数 SIZE にセットします。SIZE が 0 でなければ、read-huffman-tree で符号木を読み込み、変数 TREE にセットします。あとは call-with-byte-output-file で出力用ファイルをオープンし、関数 decode-symbol で記号を復号して write-byte でファイルに書き込むだけです。
decode-symbol は do ループで符号木をたどります。節 node が葉に到達したら、node に格納されている記号を返します。そうでなければ、getbit で 1 ビット読み込み、1 であれば左の子をたどり、0 であれば右の子をたどります。
あとのプログラムは簡単なので、説明は割愛いたします。詳細は プログラムリスト２ をお読みください。
●実行結果
それでは、実際に Canterbury Corpus で配布されているテストデータ The Canterbury Corpus を圧縮してみましょう。
表 : ハフマン符号の結果
ファイル名 サイズ 下限値 ハフマン
---------------------------------------------
alice29.txt 152,089 86,837 87,785
asyoulik.txt 125,179 75,235 75,895
cp.html 24,603 16,082 16,310
fields.c 11,150 6,980 7,143
grammar.lsp 3,721 2,155 2,269
kennedy.xls 1,029,744 459,970 462,856
lcet10.txt 426,754 249,071 250,673
plrabn12.txt 481,861 272,936 275,690
ptt5 513,216 77,636 106,754
sum 38,240 25,473 25,968
xargs.1 4,227 2,589 2,698
---------------------------------------------
合計 2,810,784 1,274,964 1,314,041
実行環境 : Windows XP, celeron 1.40 GHz, SBCL
圧縮率は ptt5 を除いて圧縮の限界に近い値となりました。ハフマン符号は優れた符号化方式であることがわかります。ハフマン符号の場合、1 ビットよりも短い符号語は存在しません。ptt5 は記号 0 がとても多く出現するので、記号 0 に 1 ビットの符号語を割り当てても、限界に近い圧縮率を達成することはできせん。
「算術符号」または「レンジコーダ (Range Coder)」を用いると、記号に 1 ビット未満の符号語を割り当てることができるので、このような場合でも限界に近い圧縮率を達成することができます。
●参考文献
- 植松友彦, 『文書データ圧縮アルゴリズム入門』, ＣＱ出版社, 1994
- 奥村晴彦, 『Ｃ言語による最新アルゴリズム事典』, 技術評論社, 1991
●プログラムリスト１
;;;
;;; bitio.l : ビット入出力
;;;
;;; Copyright (C) 2010 Makoto Hiroi
;;;
(provide :bitio)
(defpackage :bitio (:use :cl))
(in-package :bitio)
(export '(call-with-bit-input-file call-with-byte-input-file
call-with-bit-output-file call-with-byte-output-file
getbit getbits putbit putbits))
;;; 構造体の定義
(defstruct bit-io
direction file buff cnt)
;;; バイト入力用ファイルオープン
(defun call-with-byte-input-file (filename proc)
(with-open-file (in filename
:direction :input
:element-type 'unsigned-byte)
(funcall proc in)))
;;; バイト出力用ファイルオープン
(defun call-with-byte-output-file (filename proc)
(with-open-file (out filename
:direction :output
:if-exists :rename-and-delete
:element-type 'unsigned-byte)
(funcall proc out)))
;;; ビット入力用ファイルオープン
(defun call-with-bit-input-file (filename proc)
(call-with-byte-input-file
filename
(lambda (in)
(funcall proc (make-bit-io :direction :input
:file in
:cnt 0)))))
;;; ビット出力用ファイルオープン
(defun call-with-bit-output-file (filename proc)
(call-with-byte-output-file
filename
(lambda (out)
(let ((bs (make-bit-io :direction :output
:file out
:buff 0
:cnt 8)))
(funcall proc bs)
(if (< (bit-io-cnt bs) 8)
(write-byte (bit-io-buff bs) out))))))
;;; 1 ビット入力
(defun getbit (bs)
(decf (bit-io-cnt bs))
(when (minusp (bit-io-cnt bs))
(setf (bit-io-buff bs)
(read-byte (bit-io-file bs) nil))
(if (null (bit-io-buff bs))
(return-from getbit nil))
(setf (bit-io-cnt bs) 7))
(if (logbitp (bit-io-cnt bs) (bit-io-buff bs)) 1 0))
;;; 1 ビット出力
(defun putbit (bs val)
(decf (bit-io-cnt bs))
(when (plusp val)
(setf (bit-io-buff bs)
(logior (bit-io-buff bs) (ash 1 (bit-io-cnt bs)))))
(when (zerop (bit-io-cnt bs))
(write-byte (bit-io-buff bs) (bit-io-file bs))
(setf (bit-io-buff bs) 0
(bit-io-cnt bs) 8)))
;;; n ビット入力
(defun getbits (bs n)
(do ((pat (ash 1 (1- n)) (ash pat -1))
(val 0))
((zerop pat) val)
(case (getbit bs)
(1 (setf val (logior val pat)))
(nil (return)))))
;;; n ビット出力
(defun putbits (bs n x)
(do ((pat (ash 1 (1- n)) (ash pat -1)))
((zerop pat))
(putbit bs (logand x pat))))
●プログラムリスト２
;;;
;;; huffcode.lisp : ハフマン符号によるファイルの圧縮
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(require :heap "heap.lisp")
(use-package :heap)
(require :bitio "bitio.lisp")
(use-package :bitio)
;;; 符号語のサイズ
(defconstant code-size 256)
;;; 符号木の節
(defstruct node
(sym nil) (cnt 0) (left nil) (right nil))
;;; 葉か
(defun leafp (node) (numberp (node-sym node)))
;;; 記号の出現頻度を求める
(defun make-frequency (filename)
(call-with-byte-input-file
filename
(lambda (in)
(do ((table (make-array code-size :initial-element 0))
(cnt 0 (1+ cnt))
(c (read-byte in nil) (read-byte in nil)))
((null c) (values cnt table))
(incf (aref table c))))))
;;; 符号木の生成
(defun make-huffman-tree (freq)
(let ((hp (make-heap :key #'node-cnt)))
(dotimes (x code-size)
(when (plusp (aref freq x))
(heap-push hp (make-node :sym x :cnt (aref freq x)))))
(case (heap-length hp)
((0) nil)
((1)
(let ((node (heap-pop hp)))
(make-node :left node
:right (make-node :sym (if (plusp (node-sym node)) 0 1)))))
(t
(do ()
((= (heap-length hp) 1) (heap-pop hp))
(let ((a (heap-pop hp)) (b (heap-pop hp)))
(heap-push hp
(make-node :cnt (+ (node-cnt a) (node-cnt b))
:left a
:right b))))))))
;;; ハフマン符号の生成
(defun make-huffman-code (node n cs code)
(if (leafp node)
(setf (aref code (node-sym node)) (list n cs))
(progn
(make-huffman-code (node-left node) (1+ n) (logior (ash cs 1) 1) code)
(make-huffman-code (node-right node) (1+ n) (ash cs 1) code))))
;;; ハフマン木の出力
(defun write-huffman-tree (bs node)
(cond ((leafp node)
(putbit bs 1)
(putbits bs 8 (node-sym node)))
(t
(putbit bs 0)
(write-huffman-tree bs (node-left node))
(write-huffman-tree bs (node-right node)))))
;;; ハフマン木の入力
(defun read-huffman-tree (bs)
(if (= (getbit bs) 1)
(make-node :sym (getbits bs 8))
(make-node :left (read-huffman-tree bs)
:right (read-huffman-tree bs))))
;;; 符号化
(defun huffman-encode (in-file out-file)
(multiple-value-bind
(size freq)
(make-frequency in-file)
(call-with-bit-output-file
out-file
(lambda (bs)
(putbits bs 32 size)
(when (plusp size)
(let ((tree (make-huffman-tree freq))
(code (make-array code-size)))
(make-huffman-code tree 0 0 code)
(call-with-byte-input-file
in-file
(lambda (in)
(write-huffman-tree bs tree)
(dotimes (x size)
(apply #'putbits bs (aref code (read-byte in))))))))))))
;;; 記号を復号する
(defun decode-symbol (node bs)
(do ()
((leafp node) (node-sym node))
(setf node (if (plusp (getbit bs))
(node-left node)
(node-right node)))))
;;; 復号
(defun huffman-decode (in-file out-file)
(call-with-bit-input-file
in-file
(lambda (bs)
(let* ((size (getbits bs 32))
(tree (if (plusp size) (read-huffman-tree bs))))
(call-with-byte-output-file
out-file
(lambda (out)
(dotimes (x size)
(write-byte (decode-symbol tree bs) out))))))))
改訂 2020 年 5 月 31 日
All rights reserved.