レンジコーダ (3)
今回は適応型レンジコーダを使って、実際にファイルを圧縮してみましょう。
●静的符号化と動的符号化
今まで説明したハフマン符号やレンジコーダは「静的符号化 (static coding)」といい、あらかじめ記号の出現確率を調べておいて、それに基づいて入力記号列を符号化していく方法です。この方法では、ハフマン符号がもっとも有名でしょう。これに対し、「動的符号化 (dynamic coding)」は入力記号列の符号化を行いながら記号の出現確率を変化させる方法で、「適応型符号化 (adaptive coding)」とも呼ばれています。最初は、どの記号も同じ確率で出現すると仮定して、記号列を読み込みながら記号の出現確率を修正し、その時点での出現確率に基づいて記号の符号化を行います。なお、辞書法の LZ 符号も動的符号化の一つです。
動的符号化の特徴は入力記号列の性質 (出現確率) の変化に適応できることですが、このほかにも長所があります。静的符号化の場合、復号するときに符号化で用いた記号の出現確率が必要になります。このため、レンジコーダのプログラムでは、記号の出現頻度表を出力ファイルの先頭に付加しています。ところが、動的符号化では復号しながら記号の出現確率を求めることができるので、出現頻度表をファイルに付加する必要はありません。
また、静的符号化でファイルを圧縮する場合、記号の出現頻度を求めるときにファイルからデータを読み込み、符号化を行うときに再度ファイルからデータを読み込む必要があります。このようにデータの入力が 2 回必要な圧縮アルゴリズムを「2 パスの圧縮アルゴリズム」といいます。動的符号化は 1 パスで済むので、オンラインでのデータ圧縮にも対応することができます。
このように、動的符号化には有利な点があるため、ハフマン符号を動的符号化に対応させた「適応型ハフマン符号」が考案されています。しかしながら、適応型ハフマン符号は実装方法が難しく、処理速度も遅いという欠点があります。これに対し、「適応型算術符号 (レンジコーダ)」は簡単な方法で実装することができ、適応型レンジコーダは処理速度もそれほど遅くありません。とても優れた実装方法なのです。
ただし、適応型レンジコーダにもひとつだけ問題点があります。単純な方法では累積度数の取得や更新に時間がかかるのです。たとえば、記号の出現頻度表をベクタで表す場合、出現頻度の更新は簡単できますが、記号 c の累積度数を求めるとき、その都度 0 から c - 1 までの頻度を加算するようでは、実行時間が遅くなってしまいます。そこで、今回は Binary Indexed Tree というデータ構造を使うことにします。
●Binary Indexed Tree
Yuta Mori さんによると、『累積度数の取得・更新なら、P. Fenwick氏のBinary Indexed Tree (BIT)という方法が比較的高速』 とのことです。BIT は二分木をベースにした方法です。簡単な例として、記号の種類が 16 (0 - 15) の場合を考えてみましょう。BIT は下図のように二分木を構成します。
BIT の場合、二分木の節に記号を対応させます。ただし、記号 0 は二分木の中に入れません。そして、節には記号の出現頻度を格納するのではなく、左部分木にある記号の出現頻度とその節の記号の出現頻度の合計値を格納します。たとえば、記号の出現頻度を 0 から順番に {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16} とすると、BIT の各節の値は次のようになります。
記号 0 と「葉」にあたる節はその記号の出現頻度を表します。BIT の場合、奇数の記号は葉になります。葉以外の節は、左部分木にある記号の出現頻度の合計値にその節の記号の出現頻度を足した値を保持します。たとえば、節 10 の値は記号 9 と記号 10 の出現頻度を足した 21 になります。節 12 の値は、記号 9, 10, 11 と記号 12 の出現頻度を足した 46 になります。節 8 は記号 1 から 8 の出現頻度の合計 44 になります。このように二分木を構成すると、記号の出現頻度と累積度数を簡単に求めることができます。
●構造体の定義
それではプログラムを作りましょう。最初に BIT を表す構造体を定義します。次のリストを見てください。
リスト : 構造体の定義
;;; 中央値 (ルート) を求める
(defun get-mid (size)
(do ((mid 1 (ash mid 1))
(limit (ash size -1)))
((<= limit mid) mid)))
;;; bitree の定義
(defstruct (bitree
(:constructor make-bitree
(size
&aux
(table (make-array size :initial-element 0))
(mid (get-mid size))
(sum 0))))
size table mid sum)
構造体の名前は BITREE としました。スロット SIZE は記号の種類、TABLE はベクタ、MID はルートを表す中央値、SUM は出現頻度の合計値です。:CONSTRUCTOR で独自のコンストラクタ make-bitree を定義します。その中でベクタを生成して TABLE にセットし、中央値を計算して MID にセットします。:constructor の使い方は拙作のページ 構造体 をお読みください。
SIZE が 2 の累乗の場合、MID は SIZE / 2 で求めることができますが、そうでない場合は SIZE / 2 <= 2N を満たす最も小さな整数値 N を求めます。このときの 2N が中央値になります。それを関数 get-mid で求めています。
●累積度数の求め方
次は記号の累積度数を求めてみましょう。記号 12 の累積度数は記号 0 から 11 までの出現頻度の合計値になります。BIT の場合、記号 1 から 11 までの出現頻度の合計値は、節 11 からルート方向に木をたどり、記号 11 以下の節の値を足し算すると求めることができます。
この場合、経路は 11 - 10 - 12 - 8 で、足し算する節は 11, 10, 8 になります。節 11 は記号 11 の出現頻度、節 10 は記号 9, 10 の出現頻度の合計値、節 8 は記号 1 - 8 の出現頻度の合計値なので、これで記号 1 - 11 の出現頻度の合計値を求めることができます。あとは、記号 0 の出現頻度を足し算すれば、累積度数を求めることができます。
BIT の場合、次の式を使って値を足し算する節を求めることができます。
(logand c (1- c))
実際に計算してみると次のようになります。
1 : 1 2 : 2 3 : 3 2 4 : 4 5 : 5 4 6 : 6 4 7 : 7 6 4 8 : 8 9 : 9 8 10 : 10 8 11 : 11 10 8 12 : 12 8 13 : 13 12 8 14 : 14 12 8 15 : 15 14 12 8
上図の二分木をたどってみてください。同じ結果になります。このように、簡単な式で節をたどることができるとはちょっと驚きました。式についての説明は割愛いたしますので、興味のある方は P. Fenwick 氏 の論文 "A New Data Structure for Cumulative Probability Tables" をお読みください。
累積度数を求めるプログラムは次のようになります。
リスト : 累積度数を求める
(defun bitree-cumul (bt c)
(if (zerop c)
0
(let ((n (aref (bitree-table bt) 0)))
;; c - 1 までの頻度を加算する
(do ((x (1- c) (logand x (1- x))))
((zerop x) n)
(incf n (aref (bitree-table bt) x))))))
引数 BT が BIT を表す構造体のオブジェクト、C が記号です。C が 0 の場合は 0 を返します。そうでなければ、変数 N に記号 0 の出現頻度をセットします。そのあと、変数 X を C - 1 に初期化し、(logand x (1- x)) で節をたどりながら、N に節の値を加算していきます。これで記号 C の累積度数を求めることができます。
●出現頻度の求め方
記号の出現頻度も簡単に求めることができます。記号 0 と記号が奇数の場合は、節の値をそのまま返せばいいですね。その他の場合、記号 c の累積度数から記号 c - 1 の累積度数を引き算すれば、記号 c の出現頻度を求めることができます。たとえば、記号 12 の出現頻度を求めてみましょう。次の式を見てください。
12の累積度数 - 11の累積度数 = ([12] + [8] + [0]) - ([11] + [10] + [8] + [0]) = [12] - [11] - [10] = 46 - 12 - 21 = 13
このように、節 12 の次の節 8 以下の節は共通になるので計算する必要はありません。したがって、節 12 の値から節 11 と 10 の値を引き算すればいいわけです。これをプログラムすると次のようになります。
リスト : 記号の出現頻度を求める
(defun bitree-frequency (bt c)
(let ((n (aref (bitree-table bt) c)))
(if (or (zerop c) (oddp c))
n
(do ((p (logand c (1- c)))
(x (1- c) (logand x (1- x))))
((= x p) n)
(decf n (aref (bitree-table bt) x))))))
節の値を変数 N にセットします。記号 0 と奇数の記号は N をそのまま返します。それ以外の場合、記号 C の次の節を変数 P に C - 1 の値を X にセットし、X の節の値を N から引き算します。あとは、(logand x (1- x)) で節をたどりながら、節の値を N から引き算すればいいわけです。X が P と等しくなったら do ループを終了して N を返します。
●出現頻度の更新
更新処理も簡単です。たとえば、記号 11 の出現頻度を +1 する場合、節 11 からルート方向に木をたどり、記号 11 以上の節の値を +1 します。この場合、経路は 11 - 10 - 12 - 8 で、+1 する節は 11, 12 になります。節 11 は記号 11 の出現頻度、節 12 は記号 9 から 12 の出現頻度の合計値で、他の節には記号 11 の値は含まれていません。節 11 と 12 の値を + 1 すればいいわけです。
BIT の場合、次の式を使って更新する節を求めることができます。
(+ c (logand c (- c)))
実際に計算してみると次のようになります。
1 : 1 2 4 8 2 : 2 4 8 3 : 3 4 8 4 : 4 8 5 : 5 6 8 6 : 6 8 7 : 7 8 8 : 8 9 : 9 10 12 10 : 10 12 11 : 11 12 12 : 12 13 : 13 14 14 : 14 15 : 15
上図の二分木をたどってみてください。同じ結果になることがわかります。これをプログラムすると次のようになります。
リスト : 出現頻度の更新
(defun bitree-update (bt c inc)
(if (zerop c)
(incf (aref (bitree-table bt) c) inc)
(do ()
((<= (bitree-size bt) c))
(incf (aref (bitree-table bt) c) inc)
(incf c (logand c (- c)))))
(incf (bitree-sum bt) inc))
(incf c (logand c (- c))) で節をたどりながら、節の値に INC を加算していきます。C が SIZE 以上になったら終了です。最後に、記号の総数を表す SUM に INC を加算します。
●記号の探索
最後に累積度数表 CUMUL から CUMUL[C] <= VAL < CUMUL[C + 1] を満たす記号 C を求める関数 bitree-find を作ります。
リスト : 記号の探索
(defun bitree-find (bt val)
(let ((n (aref (bitree-table bt) 0)))
(if (< val n)
(values 0 0)
(do ((h (bitree-mid bt) (ash h -1))
(c 0))
((zerop h) (values (1+ c) n))
(when (and (< (+ c h) (bitree-size bt))
(<= (+ n (aref (bitree-table bt) (+ c h))) val))
(incf n (aref (bitree-table bt) (+ c h)))
(incf c h))))))
bitree-find は変数 N に累積度数を求めながら、復号する記号を二分探索します。記号 C を 0 に、変数 H を MID に初期化し、do ループで (C + H) の位置から二分探索を行い、VALUE <= 累積度数 を満たす一番大きな記号 C を探します。したがって、求める記号は C + 1 になります。探索の範囲は下限値が C で上限値が (C + H) になります。繰り返すたびに H を半分にすることで二分探索を実現しています。最後に C + 1 と N を返します。
●簡単な実行例
それでは簡単な実行例を示します。
* (defvar *bt* (make-bitree 16)) *BT* * *bt* #S(BITREE::BITREE :SIZE 16 :TABLE #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) :MID 8 :SUM 0) * (dotimes (x 16) (bitree-update *bt* x 2)) NIL * *bt* #S(BITREE::BITREE :SIZE 16 :TABLE #(2 2 4 2 8 2 4 2 16 2 4 2 8 2 4 2) :MID 8 :SUM 32) * (dotimes (x 16) (format t "~D: ~D~%" x (bitree-frequency *bt* x))) 0: 2 1: 2 2: 2 3: 2 4: 2 5: 2 6: 2 7: 2 8: 2 9: 2 10: 2 11: 2 12: 2 13: 2 14: 2 15: 2 NIL * (dotimes (x 16) (format t "~D: ~D~%" x (bitree-cumul *bt* x))) 0: 0 1: 2 2: 4 3: 6 4: 8 5: 10 6: 12 7: 14 8: 16 9: 18 10: 20 11: 22 12: 24 13: 26 14: 28 15: 30 NIL * (dotimes (x 32) (format t "~D: ~D~%" x (bitree-find *bt* x))) 0: 0 1: 0 2: 1 3: 1 4: 2 5: 2 6: 3 7: 3 8: 4 9: 4 10: 5 11: 5 12: 6 13: 6 14: 7 15: 7 16: 8 17: 8 18: 9 19: 9 20: 10 21: 10 22: 11 23: 11 24: 12 25: 12 26: 13 27: 13 28: 14 29: 14 30: 15 31: 15 NIL
正常に動作していますね。
●出現頻度表の初期化と更新
適応型レンジコーダの場合、出現頻度表をファイルに付加する必要がないため、記号の出現頻度を 2 バイトに丸める必要はありません。これは大きな利点です。あとは、出現頻度の合計値が幅 range の最小値 min-range より大きくならないように、出現頻度表を調整するだけです。この処理は、合計値 sum が min-range に達したときに、各記号の出現頻度を半分にすることで実現できます。プログラムは次のようになります。
リスト : 出現頻度表の初期化と更新
;;; 初期化
(defun initialize-bitree ()
(let ((bt (make-bitree code-size)))
(dotimes (x code-size bt)
(bitree-update bt x 1))))
;;; 更新
(defun update (bt c inc)
(bitree-update bt c inc)
(when (<= rangecoder::min-range (bitree-sum bt))
(dotimes (x code-size)
(let ((n (ash (bitree-frequency bt x) -1)))
(when (plusp n)
(bitree-update bt x (- n)))))))
出現頻度表を初期化する関数 initialize-bitee は簡単です。make-bitree で BIT を生成し、各記号の出現頻度を 1 に設定するだけです。
出現頻度表を更新する関数 update も簡単です。bitree-update で記号 C の出現頻度を +INC します。そして、合計値 SUM が MIN-RANGE 以上になったならば、各記号の出現頻度を半分にします。変数 N に 出現頻度 / 2 をセットします。もし N が 0 ならば出現頻度は 1 なので、値を半分にする必要はありません。そうでなければ、bitree-update で出現頻度から N を減算します。これで各記号の値を半分にすることができます。
●適応型レンジコーダの符号化
次は符号化を行うメソッド encode を作ります。プログラムは次のようになります。
リスト : 記号の符号化
(defun encode (rc bt c)
(let ((temp (floor (range-coder-range rc)
(bitree-sum bt))))
(incf (range-coder-low rc)
(* (bitree-cumul bt c) temp))
(setf (range-coder-range rc)
(* (bitree-frequency bt c) temp))
(encode-normalize rc)
(update bt c 1)))
記号 C の累積度数は bitree-cumul で、出現頻度は bitree-frequency で求めます。あとの処理は前回のプログラムとほぼ同じです。最後にメソッド update を呼び出して出現頻度表を更新します。
適応型レンジコーダでファイルを符号化する関数 encode-file は次のようになります。
リスト : 適応型レンジコーダによる符号化
(defun encode-file (in-file out-file)
(call-with-byte-output-file
out-file
(lambda (out)
(call-with-byte-input-file
in-file
(lambda (in)
(let ((size (file-length in))
(bt (initialize-bitree)))
(write-file-size out size)
(when (plusp size)
(call-with-range-encoder
out
(lambda (rc)
(dotimes (x size)
(encode rc bt (read-byte in))))))))))))
関数 file-length でファイルサイズを求め、initialize-bitree で出現頻度表を生成します。あとは前回のプログラムとほとんど同じです。
●適応型レンジコーダの復号
次は復号を行うメソッド decode を作ります。次のリストを見てください。
リスト : 記号の復号
(defun decode (rc bt)
(let ((temp (floor (range-coder-range rc)
(bitree-sum bt))))
(multiple-value-bind
(c cumul)
(bitree-find bt (floor (range-coder-low rc) temp))
(decf (range-coder-low rc)
(* cumul temp))
(setf (range-coder-range rc)
(* (bitree-frequency bt c) temp))
(decode-normalize rc)
(update bt c 1)
c)))
bitree-find で記号 C と累積度数を求めます。記号 C の出現頻度は bitree-frequency で求めます。あとの処理は前回のプログラムとほぼ同じです。最後に update を呼び出して出現頻度表を更新します。
最後に、適応型レンジコーダでファイルを復号する関数 decode-file を作ります。
リスト : 適応型レンジコーダによる復号
(defun decode-file (in-file out-file)
(call-with-byte-input-file
in-file
(lambda (in)
(let ((size (read-file-size in))
(bt (initialize-bitree)))
(call-with-byte-output-file
out-file
(lambda (out)
(when (plusp size)
(call-with-range-decoder
in
(lambda (rc)
(dotimes (x size)
(write-byte (decode rc bt) out)))))))))))
read-file-size でファイルサイズを取り出し、initialize-bitree で出現頻度表を生成します。あとは前回のプログラムとほとんど同じです。
なお、今回は記号の種類を 256 (0 - 255) としましたが、終端記号 (256 : END) を含めて 257 種類とする方法もあります。この場合は、元のファイルサイズをファイルに付加する必要はありません。符号化のときは最後に END を符号化し、復号のときは END を復号した時点で処理を終了するようにします。興味のある方は試してみてください。
●実行結果
それでは、実際に Canterbury Corpus で配布されているテストデータ The Canterbury Corpus を圧縮してみましょう。結果は次にようになりました。
表 : 適応型レンジコーダの結果
ファイル名 サイズ ARC 下限値
---------------------------------------------
alice29.txt 152,089 87,147 86,837
asyoulik.txt 125,179 75,533 75,235
cp.html 24,603 16,299 16,082
fields.c 11,150 7,164 6,980
grammar.lsp 3,721 2,305 2,155
kennedy.xls 1,029,744 460,734 459,971
lcet10.txt 426,754 249,491 249,071
plrabn12.txt 481,861 273,392 272,936
ptt5 513,216 78,090 77,636
sum 38,240 25,638 25,473
xargs.1 4,227 2,743 2,589
---------------------------------------------
合計 2,810,784 1,278,536 1,274,965
適応型レンジコーダの圧縮率は、静的なレンジコーダと同様に圧縮の限界に近い値になりました。出現頻度表を付加しない分だけ、多くのファイルで静的なレンジコーダよりも高い圧縮率になりましたが、小さなファイルは逆に圧縮率が悪くなるようです。
適応型符号化の場合、出現しない記号が多数あると、圧縮率が少し悪くなるという欠点があります。たとえば、記号が 0 と 1 しかないデータを符号化してみましょう。適応型レンジコーダでは記号 0 - 255 の出現頻度を 1 に初期化しています。このため、記号数が少ないうちは記号 2 - 255 の出現頻度の影響が大きくなり、圧縮率はどうしても悪くなってしまいます。
ようするに、記号をたくさん読み込まないと、その出現頻度表の確率はあてにならないというわけです。したがって、小さなファイルの圧縮率は静的なレンジコーダよりも悪くなる場合が多いようです。逆に、大きなファイルであれば、静的なレンジコーダと同様に高い圧縮率を達成することができます。
次は静的なレンジコーダと適応型レンジコーダの実行時間を比較して見ましょう。The Canterbury Corpus の 11 ファイルすべてを処理する時間を計測しました。
表 : 符号化と復号の処理時間 (単位：秒)
| 符号化 | 復号
-------------------+--------+------
静的レンジコーダ | 0.35 | 1.26
適応型レンジコーダ | 0.73 | 1.34
実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz
符号化は適応型レンジコーダのほうがかなり遅くなりましたが、復号はそれほど遅くなっていません。Binary Indexed Tree の効果は十分に出ていると思います。
なお、実行時間の結果は M.Hiroi のコーディング、実行したマシン、プログラミング言語などの環境に大きく依存しています。また、これらの環境だけではなく、データの種類によっても実行時間はかなり左右されます。興味のある方は、いろいろなデータをご自分の環境で試してみてください。
●プログラムリスト１
;;;
;;; bitree.lisp : binary indexed tree
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;
(provide :bitree)
(defpackage :bitree (:use :cl))
(in-package :bitree)
(export '(make-bitree bitree-frequency bitree-cumul
bitree-sum bitree-update bitree-find))
;;; 中央値 (ルート) を求める
(defun get-mid (size)
(do ((mid 1 (ash mid 1))
(limit (ash size -1)))
((<= limit mid) mid)))
;;; 構造体の定義
(defstruct (bitree
(:constructor make-bitree
(size
&aux
(table (make-array size :initial-element 0))
(mid (get-mid size))
(sum 0))))
size table mid sum)
;;; 出現頻度を求める
(defun bitree-frequency (bt c)
(let ((n (aref (bitree-table bt) c)))
(if (or (zerop c) (oddp c))
n
(do ((p (logand c (1- c)))
(x (1- c) (logand x (1- x))))
((= x p) n)
(decf n (aref (bitree-table bt) x))))))
;;; 累積度数を求める
(defun bitree-cumul (bt c)
(if (zerop c)
0
(let ((n (aref (bitree-table bt) 0)))
;; c - 1 までの頻度を加算する
(do ((x (1- c) (logand x (1- x))))
((zerop x) n)
(incf n (aref (bitree-table bt) x))))))
;;; 出現頻度の更新
(defun bitree-update (bt c inc)
(if (zerop c)
(incf (aref (bitree-table bt) c) inc)
(do ()
((<= (bitree-size bt) c))
(incf (aref (bitree-table bt) c) inc)
(incf c (logand c (- c)))))
(incf (bitree-sum bt) inc))
;;; 探索 (cumul[c] <= val < cumul[c + 1])
(defun bitree-find (bt val)
(let ((n (aref (bitree-table bt) 0)))
(if (< val n)
(values 0 0)
(do ((h (bitree-mid bt) (ash h -1))
(c 0))
((zerop h) (values (1+ c) n))
(when (and (< (+ c h) (bitree-size bt))
(<= (+ n (aref (bitree-table bt) (+ c h))) val))
(incf n (aref (bitree-table bt) (+ c h)))
(incf c h))))))
●プログラムリスト２
;;;
;;; rangecoder.lisp : レンジコーダー
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(provide :rangecoder)
(defpackage :rangecoder (:use :cl))
(in-package :rangecoder)
(export '(call-with-byte-input-file
call-with-byte-output-file
call-with-range-encoder
call-with-range-decoder
encode-normalize decode-normalize
range-coder-range range-coder-low
code-size))
;;; バイト入力用ファイルオープン
(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)))
;;; 定数
(defconstant max-range #x100000000)
(defconstant min-range #x1000000)
(defconstant mask #xffffffff)
(defconstant ff-check #xff000000)
(defconstant code-size 256)
;;; 構造体の定義
(defstruct range-coder
direction file range low buff cnt)
;;; buff と記号 c を n 個書き出す
(defun flush-buff (rc c n)
(write-byte (range-coder-buff rc) (range-coder-file rc))
(dotimes (x n)
(write-byte c (range-coder-file rc))))
;;; 終了処理
(defun finish (rc out)
(if (< (range-coder-low rc) max-range)
(flush-buff rc #xff (range-coder-cnt rc))
;; 桁上がり
(progn
(incf (range-coder-buff rc))
(flush-buff rc 0 (range-coder-cnt rc))))
;;
(write-byte (logand (ash (range-coder-low rc) -24) #xff) out)
(write-byte (logand (ash (range-coder-low rc) -16) #xff) out)
(write-byte (logand (ash (range-coder-low rc) -8) #xff) out)
(write-byte (logand (range-coder-low rc) #xff) out))
;;; 符号化用レンジコーダ
(defun call-with-range-encoder (out proc)
(let ((rc (make-range-coder :direction :encode
:file out
:range max-range
:low 0
:buff 0
:cnt 0)))
(funcall proc rc)
;; 終了処理
(finish rc out)))
;;; 復号用レンジコーダ
(defun call-with-range-decoder (in proc)
(let ((rc (make-range-coder :direction :decode
:file in
:range max-range
:buff 0
:cnt 0)))
;; buff の初期値 (0) を読み捨てる
(read-byte in)
;; 4 byte read
(setf (range-coder-low rc)
(+ (ash (read-byte in) 24)
(ash (read-byte in) 16)
(ash (read-byte in) 8)
(read-byte in)))
;;
(funcall proc rc)))
;;; 符号化の正規化
(defun encode-normalize (rc)
(when (>= (range-coder-low rc) max-range)
;; 桁上がり
(incf (range-coder-buff rc))
(setf (range-coder-low rc)
(logand (range-coder-low rc) mask))
(when (plusp (range-coder-cnt rc))
(flush-buff rc 0 (1- (range-coder-cnt rc)))
(setf (range-coder-buff rc) 0
(range-coder-cnt rc) 0)))
(do ()
((>= (range-coder-range rc) min-range))
(cond ((< (range-coder-low rc) ff-check)
(flush-buff rc #xff (range-coder-cnt rc))
(setf (range-coder-buff rc)
(logand (ash (range-coder-low rc) -24) #xff)
(range-coder-cnt rc)
0))
(t (incf (range-coder-cnt rc))))
(setf (range-coder-low rc)
(logand (ash (range-coder-low rc) 8) mask)
(range-coder-range rc)
(ash (range-coder-range rc) 8))))
;;; 復号の正規化
(defun decode-normalize (rc)
(do ()
((>= (range-coder-range rc) min-range))
(setf (range-coder-range rc)
(ash (range-coder-range rc) 8)
(range-coder-low rc)
(logand (+ (ash (range-coder-low rc) 8)
(read-byte (range-coder-file rc)))
mask))))
●プログラムリスト３
;;;
;;; rca.lisp : 適応型レンジコーダ
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(require :rangecoder "rangecoder.lisp")
(use-package :rangecoder)
(require :bitree "bitree.lisp")
(use-package :bitree)
;;; ファイルサイズの書き込み
(defun write-file-size (out size)
(write-byte (logand (ash size -24) #xff) out)
(write-byte (logand (ash size -16) #xff) out)
(write-byte (logand (ash size -8) #xff) out)
(write-byte (logand size #xff) out))
;;; ファイルサイズの読み込み
(defun read-file-size (in)
(+ (ash (read-byte in) 24)
(ash (read-byte in) 16)
(ash (read-byte in) 8)
(read-byte in)))
;;; 更新
(defun update (bt c inc)
(bitree-update bt c inc)
(when (<= rangecoder::min-range (bitree-sum bt))
(dotimes (x code-size)
(let ((n (ash (bitree-frequency bt x) -1)))
(when (plusp n)
(bitree-update bt x (- n)))))))
;;; 初期化
(defun initialize-bitree ()
(let ((bt (make-bitree code-size)))
(dotimes (x code-size bt)
(bitree-update bt x 1))))
;;; 符号化
(defun encode (rc bt c)
(let ((temp (floor (range-coder-range rc)
(bitree-sum bt))))
(incf (range-coder-low rc)
(* (bitree-cumul bt c) temp))
(setf (range-coder-range rc)
(* (bitree-frequency bt c) temp))
(encode-normalize rc)
(update bt c 1)))
;;; 復号
(defun decode (rc bt)
(let ((temp (floor (range-coder-range rc)
(bitree-sum bt))))
(multiple-value-bind
(c cumul)
(bitree-find bt (floor (range-coder-low rc) temp))
(decf (range-coder-low rc)
(* cumul temp))
(setf (range-coder-range rc)
(* (bitree-frequency bt c) temp))
(decode-normalize rc)
(update bt c 1)
c)))
;;; ファイルの符号化
(defun encode-file (in-file out-file)
(call-with-byte-output-file
out-file
(lambda (out)
(call-with-byte-input-file
in-file
(lambda (in)
(let ((size (file-length in))
(bt (initialize-bitree)))
(write-file-size out size)
(when (plusp size)
(call-with-range-encoder
out
(lambda (rc)
(dotimes (x size)
(encode rc bt (read-byte in))))))))))))
;;; ファイルの復号
(defun decode-file (in-file out-file)
(call-with-byte-input-file
in-file
(lambda (in)
(let ((size (read-file-size in))
(bt (initialize-bitree)))
(call-with-byte-output-file
out-file
(lambda (out)
(when (plusp size)
(call-with-range-decoder
in
(lambda (rc)
(dotimes (x size)
(write-byte (decode rc bt) out)))))))))))
;;; 簡単なテスト
(defun test-en ()
(dolist (file '("alice29.txt" "asyoulik.txt" "cp.html" "fields.c" "grammar.lsp"
"kennedy.xls" "lcet10.txt" "plrabn12.txt" "ptt5" "sum" "xargs.1"))
(encode-file file (format nil "~a.en" file))))
(defun test-de ()
(dolist (file '("alice29.txt" "asyoulik.txt" "cp.html" "fields.c" "grammar.lsp"
"kennedy.xls" "lcet10.txt" "plrabn12.txt" "ptt5" "sum" "xargs.1"))
(decode-file (format nil "~a.en" file)
(format nil "~a.de" file))))
改訂 2020 年 6 月 7 日
All rights reserved.