M.Hiroi's Home Page

Common Lisp Programming

お気楽 Common Lisp プログラミング入門

[ PrevPage | Common Lisp | NextPage ]

バイナリレンジコーダ

レンジコーダの続きです。今回は「バイナリレンジコーダ」を取り上げます。記号 {0, 1} だけを符号化する方法に「二値算術符号」があります。これに対し、3 つ以上の記号を符号化する方法を「多値算術符号」と呼びます。一般に、二値算術符号は多値算術符号よりも簡単にプログラムすることができます。

レンジコーダの場合、二値でも多値でも簡単にプログラムできますが、モデル化によっては、バイナリレンジコーダ (Binary Range Coder) を用いた方が効率的にデータを圧縮できる場合があります。今回はバイナリレンジコーダを用いて実際にファイルを圧縮してみましょう。

●バイナリレンジコーダと数値の対応

バイナリレンジコーダは 2 種類の記号 {0, 1} しか扱うことができないので、このままでは 0 と 1 以外の数値(多値)を表すことができません。このため、バイナリレンジコーダで多値を表す方法を考えなければいけません。

一番簡単な方法は、0 から N までの数値を表すのに N 個の「コンテキスト (context)」を用意することです。コンテキストはバイナリレンジコーダで使用する記号 {0, 1} の出現頻度表と考えてください。たとえば、0 から 7 までの数値を符号化する場合を考えてみましょう。次の図を見てください。

  Context\ N |  0  1  2  3  4  5  6  7
  ------------+--------------------------
  [Context 0] |  1  0  0  0  0  0  0  0
  [Context 1] |     1  0  0  0  0  0  0
  [Context 2] |        1  0  0  0  0  0
  [Context 3] |           1  0  0  0  0
  [Context 4] |              1  0  0  0
  [Context 5] |                 1  0  0
  [Context 6] |                    1  0


図 : バイナリレンジコーダによる数値の符号化

符号化する数値とコンテキストの番号を対応させるところがポイントです。数値 N を符号化する場合、0 から N - 1 までのコンテキストでは 0 を符号化し、N 番目のコンテキストで 1 を符号化します。そして、1 を符号化した時点で処理を終了します。復号も簡単です。0 番目のコンテキストから順番に復号していき、1 を復号したときのコンテキストの番号が復号する数値になります。

たとえば 0 を符号化する場合、Context 0 で 1 を符号化して終了します。6 を符号化する場合は、Context 0 から 5 までは 0 を符号化し、Context 6 で 1 を符号化します。7 を符号化する場合、Context 7 は必要ありません。数値は 0 から 7 までなので、すべてのコンテキストが 0 であれば、数値は 7 であることがわかるからです。つまり、復号するときに Context 6 が 1 であれば 6 に、0 であれば 7 に復号します。

この方法は拙作のページ 正整数の符号化 で説明した Elias 符号 (α符号) と呼ばれる符号と同じ考え方です。Elias 符号は「小さな正整数ほど短い符号語が割り当てられる」という特徴があります。バイナリレンジコーダを用いる場合、これらの Elias 符号に基づいて符号化を行うモデルを考えることができます。このページでは、α符号に基づくモデルを「αモデル」と呼ぶことにします。

●αモデル

αモデルでファイルを圧縮する場合、記号の種類は 256 個 (0 - 255) あるので、255 個のコンテキストを用意します。多数のコンテキストを使いますが、静的符号化の場合、各記号の出現確率は多値レンジコーダと変わらないことに注意してください。次の図を見てください。

                          頻度
 記号 頻度 確率     記号  0  1  確率
 --------------     ----------------------------------
  a    1   1/8       a    7  1   1/8
  b    1   1/8       b    6  1   7/8 * 1/7 = 1/8
  c    2   1/4       c    4  2   7/8 * 6/7 * 2/6 = 1/4
  d    4   1/2       d           7/8 * 6/7 * 4/6 = 1/2

(A) 多値の場合    (B) αモデルの場合


    図 : 静的符号化の出現頻度表

たとえば、静的符号化で記号 {a, b, c, d} の出現頻度が {1, 1, 2, 4} だったとしましょう。多値レンジコーダの場合、出現確率は上図 (A) のようになります。αモデルの場合、記号 a のコンテキストは、0 が a 以外の記号の個数を表すので 7 になり、1 が a の個数になるので 1 なります。したがって、確率は 1/8 になります。記号 b の場合、0 が a, b 以外の記号の個数 (6) で、1 が b の個数 (1) になるので、確率は 7/8 * 1/7 = 1/8 になります。このように計算していくと上図 (B) のようになり、記号の出現確率は (A) と同じになります。

このように、複数のコンテキストを使っても、記号の出現確率は多値レンジコーダの場合と変わりありません。それでは、多値レンジコーダと同様に圧縮できるかといえば、実はそうではないのです。レンジコーダは整数で演算するので、計算の精度が問題になるからです。αモデルの場合、大きな記号ほど計算回数が多くなるので、多値レンジコーダよりも精度は劣化してしまいます。このため、圧縮率は多値レンジコーダよりも悪くなると思われます。

ただし、適応型符号化でαモデルを実装する場合、出現頻度表を 1 に初期化すると多値レンジコーダとは異なる出現確率になります。次の図を見てください。

                          頻度
 記号 頻度 確率     記号  0  1  確率
 --------------     ----------------------------------
  a    1   1/4       a    1  1   1/2
  b    1   1/4       b    1  1   1/2 * 1/1 = 1/4
  c    1   1/4       c    1  1   1/2 * 1/2 * 1/2 = 1/8
  d    1   1/4       d           1/2 * 1/2 * 1/2 = 1/8

(A) 多値の場合    (B) αモデルの場合


    図 : 適応型符号化の出現頻度表

多値レンジコーダの場合、記号 {a, b, c, d} の出現頻度を 1 に初期化するので、出現確率は上図 (A) のように、どの記号でも 1/4 になります。ところがαモデルの場合、各コンテキストの出現頻度を 1 に初期化すると、各記号の出現確率は同じになりません。上図 (B) を見てください。記号 a の出現確率は 1/2 になりますが、記号 b の出現確率は 1/2 * 1/2 = 1/4 になります。つまり、小さな記号は出現確率が大きく、大きな記号になるほど出現確率は小さくなるのです。

αモデルの特徴はこれだけではありません。出現頻度の更新をコンテキストごとに行うことも特徴のひとつです。たとえば、初期状態から記号 a の個数を +1 してみましょう。多値レンジコーダの場合、記号 a の出現確率は 2/5 になりますが、αモデルでは記号 a のコンテキストを更新するだけなので、出現確率は 2/3 になります。さらに +1 すると、αモデルでは出現確率が 3/4 になりますが、多値レンジコーダの場合は 3/6 = 1/2 にしかなりません。出現確率はαモデルの方が大きくなりますね。

このように、αモデルを適応型符号化で実装すると、入力された記号数が少ない状態でも、小さな記号の出現確率が大きくなり、大きな記号の出現確率は小さくなる特徴があります。αモデルは小さな整数値ほど出現確率が高い場合に適しているモデルといえます。

●バイナリモデル

それから、もう一つ簡単な方法として「符号木」に基づいたモデルを考えることができます。次の図を見てください。

0 から 7 の記号は上図に示す符号木(二分木)で表すことができます。左の枝には符号 0 を、右の枝には符号 1 を割り当てます。葉に記号を割り当て、木のルートから葉までの経路が符号語になります。木を配列で表すと、節の親子関係は次に示す式で表すことができるので、木をたどる処理は簡単です。

節 N :
  左の子 : 2 * N + 1
  右の子 : 2 * N + 2
  親     : (N - 1) / 2

記号数を N とすると、葉の番号は記号に N - 1 を足した値になります。図 7 の場合、記号 4 は葉 11 に対応し、その親は (11 - 1) / 2 = 5 になります。節 5 の親は 2 で、節 2 の親はルートの 0 になります。

ルートから葉までの経路は 0 - 2 - 5 - 11 になるので、符号語は "1 0 0" になります。節ごとにコンテキストを用意し、経路に沿ってバイナリレンジコーダで符号化を行えば、0 から 7 までの記号を符号化することができます。

復号も簡単です。ルートからバイナリレンジコーダで復号を行い、0 ならば左の子を、1 ならば右の子をたどります。そして、葉に到達したら復号を終了します。葉に対応する記号が求める記号になります。

このページでは、符号木に基づくモデルを「バイナリモデル (Binary Model)」と呼ぶことにします。Elias 符号に基づくモデルは、小さな整数値ほど出現確率が高い場合に適しています。一般的なテキストファイルの場合は、バイナリモデルの方が適しています。

●バイナリレンジコーダのプログラム

それではプログラムを作りましょう。最初に、記号 {0, 1} の出現頻度表を表す構造体 bit-context を定義します。

リスト : bit-context の定義

;;; 出現頻度表の定義
(defstruct bit-context (c0 1) (c1 1))

;;; 合計値を求める
(defun bit-context-sum (bct)
  (+ (bit-context-c0 bct) (bit-context-c1 bct)))

;;; 出現頻度表の更新
(defun bit-update (bct bit inc)
  (if (zerop bit)
      (incf (bit-context-c0 bct) inc)
    (incf (bit-context-c1 bct) inc))
  (when (<= rangecoder::max-range (bit-context-sum bct))
    (setf (bit-context-c0 bct)
          (logior (ash (bit-context-c0 bct) -1) 1)
          (bit-context-c1 bct)
          (logior (ash (bit-context-c1 bct) -1) 1))))

スロット c0 は記号 0 の出現頻度、c1 は記号 1 の出現頻度を表します。なお、今回のバイナリレンジコーダは適応型符号化です。

関数 bit-update は bit-context を更新します。bit が 0 の場合は c0 に inc を加算します。そうでなければ c1 に inc を加算します。c0 + c1 が rangecoder::max-range 以上になったら、c0 と c1 の値を半分にします。

次はビットを符号化する関数 bit-encode を作ります。

リスト : ビットの符号化

;;; ビットの符号化
(defun bit-encode (rc bit c0 sum)
  (let* ((temp (floor (range-coder-range rc) sum))
         (n (* temp c0)))
    (cond ((plusp bit)
           (incf (range-coder-low rc) n)
           (decf (range-coder-range rc) n))
          (t
           (setf (range-coder-range rc) n)))
    (encode-normalize rc)))

引数 rc がレンジコーダを表すオブジェクト、bit が復号するビット、c0 が記号 0 の出現頻度、sum が記号 0 と 1 の合計値です。

ポイントは記号 1 の符号化・復号の処理です。range の幅を狭めるとき、今までは range = range * c1 / (c0 + c1) としましたが、この式は次のように変形することができます。

  range * c1 / (c0 + c1)
= range * (1 - c0/(c0 + c1))
= range - range * c0 / (c0 + c1)

したがって、range = range * c1 / (c0 + c1) は range -= range * c0 / (c0 + c1) と表すことができます。レンジコーダは整数で演算しているので、range0 = range * c0 / (c0 + c1) と range1 = range * c1 / (c0 + c1) の値を足しても range になるとは限りません。記号 1 で range の値を更新するとき、c1 を使って range1 を計算するよりも、range から range0 を引いた残り全てを range1 に割り当てたほうが、圧縮率が向上する場合があります。

bit が 1 の場合は、low と range の値を更新し、0 の場合は range の値だけ更新します。あとは正規化を行うだけです。バイナリレンジコーダの場合、記号が 2 種類 {0, 1} しかないので、多値レンジコーダのように累積度数を求める処理は不要になります。このため、プログラムはとても簡単になります。

次はビットの復号を行うメソッド decode を作ります。

リスト : ビットの復号

(defun bit-decode (rc c0 sum)
  (let* ((temp (floor (range-coder-range rc) sum))
         (n (* temp c0))
         (bit nil))
    (cond ((< (floor (range-coder-low rc) temp) c0)
           (setf bit 0)
           (setf (range-coder-range rc) n))
          (t
           (setf bit 1)
           (decf (range-coder-low rc) n)
           (decf (range-coder-range rc) n)))
    (decode-normalize rc)
    bit))

復号処理も簡単です。low / temp の値が c0 よりも小さい場合は記号 0 を復号し、そうでなければ 1 を復号します。1 を復号した場合は low と range の値を更新し、0 を復号した場合は range の値だけを更新します。あとは、正規化を行って復号した bit を返します。

●バイナリモデルの作成

次はバイナリモデルを表す構造体を作成します。次のリストを見てください。

リスト : バイナリモデル

;;; 初期化
(defun initialize-bit-context-table (size)
  (map-into (make-array (1- size)) #'make-bit-context))

;;; バイナリモデルの定義
(defstruct (binary-model
            (:constructor make-binary-model
             (size
              &aux (table (initialize-bit-context-table size)))))
  size table)

名前は binary-model としました。引数 size は記号の種類を表します。この値をスロット size に格納します。この場合、size - 1 個の節が必要になるので、節に対応する bit-context のオブジェクトを size - 1 個用意します。この処理を関数 initialize-bit-context-table で行います。

次は符号化を行うメソッド encode を作ります。

リスト : バイナリモデルの符号化

(defun bm-encode (rc bm c)
  (labels ((encode-sub (node)
             (when (plusp node)
               (let* ((p (ash (1- node) -1))
                      (bct (aref (binary-model-table bm) p)))
                 (encode-sub p)
                 ;; 奇数は左の子 (1), 偶数は右の子 (0)
                 (bit-encode rc
                             (logand node 1)
                             (bit-context-c0 bct)
                             (bit-context-sum bct))
                 (bit-update bct (logand node 1) 1)))))
    (encode-sub (+ c (binary-model-size bm) -1))))

引数 rc はレンジコーダのオブジェクト、bm はバイナリモデルのオブジェクト、c は符号化する記号です。実際の処理は局所関数 encode-sub で行います。引数 node は節の番号を表します。最初に呼び出すときは葉の番号 c + size - 1 を渡します。ここから再帰呼び出しでルート方向に木をたどります。

符号化を行う場合、node が親節の左の子ならば 1 を符号化し、右の子ならば 0 を符号化します。説明とは逆になっていることに注意してください。奇数の節は左の子、偶数の節は右の子になります。あとは、親節のコンテキスト bct で bit を符号化し、bit-update でコンテキスト bct を更新します。

次は復号を行うメソッド decode を作ります。

リスト : バイナリモデルの復号

(defun bm-decode (rc bm)
  (do ((node 0)
       (node-size (1- (binary-model-size bm))))
      ((<= node-size node) (- node node-size))
    (let* ((bct (aref (binary-model-table bm) node))
           (bit (bit-decode rc (bit-context-c0 bct) (bit-context-sum bct))))
      (if (plusp bit)
          (setf node (+ (* node 2) 1))
        (setf node (+ (* node 2) 2)))
      (bit-update bct bit 1))))

変数 node はルート (0) に初期化します。そして、節 node のコンテキストでビットを復号します。bit が 1 ならば左の子を、0 ならば右の子をたどります。node が node-size よりも大きくなったならば、node は葉に到達したので復号を終了します。記号の値は node - node-size になります。bit を復号したあと、コンテキスト bct の更新をお忘れなく。

あとはとくに難しいところはないと思います。説明は割愛しますので、詳細は下記プログラムリストをお読みください。

●実行結果

それでは、実際に Canterbury Corpus で配布されているテストデータ The Canterbury Corpus を圧縮してみましょう。結果は次にようになりました。

      表 : バイナリレンジコーダの結果

           ARC : 適応型レンジコーダ (多値)
           Binary : バイナリレンジコーダ (Binary-Model)

  ファイル名      サイズ      ARC      Binary   下限値
  ------------------------------------------------------
  alice29.txt    152,089     87,147    86,921    86,837
  asyoulik.txt   125,179     75,533    75,320    75,235
  cp.html         24,603     16,299    16,152    16,082
  fields.c        11,150      7,164     7,043     6,980
  grammar.lsp      3,721      2,305     2,206     2,155
  kennedy.xls  1,029,744    460,734   460,167   459,971
  lcet10.txt     426,754    249,491   249,157   249,071
  plrabn12.txt   481,861    273,392   273,046   272,936
  ptt5           513,216     78,090    77,762    77,636
  sum             38,240     25,638    25,599    25,473
  xargs.1          4,227      2,743     2,642     2,589
  ------------------------------------------------------
  合計         2,810,784  1,278,536 1,276,015 1,274,965
 表 : 符号化と復号の処理時間 (単位:秒)

                       | 符号化 | 復号 
  ---------------------+--------+------
  静的レンジコーダ     |  0.27  | 0.92
  適応型レンジコーダ   |  0.58  | 1.06
  バイナリレンジコーダ |  1.99  | 2.24

実行環境 : SBCL 2.1.11, Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz

バイナリレンジコーダの圧縮率は静的なレンジコーダや適応型レンジコーダと同様に圧縮の限界に近い値になりました。多値レンジコーダ (適応型) よりも少しですが圧縮率は高くなっています。そのかわり、実行時間はとても遅くなりました。バイナリレンジコーダは 1 ビットずつ処理しているので、符号化・復号ともに時間がかかるのは仕方がないでしょう。

なお、実行時間の結果は M.Hiroi のコーディング、実行したマシン、プログラミング言語などの環境に大きく依存しています。また、これらの環境だけではなく、データの種類によっても実行時間はかなり左右されます。興味のある方は、いろいろなデータをご自分の環境で試してみてください。


●プログラムリスト1

;;;
;;; rangecoder.lsp : レンジコーダー
;;;
;;;                  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))))

●プログラムリスト2

;;;
;;; rcb.lsp : バイナリレンジコーダ
;;;
;;;           Copyright (C) 2010-2023 Makoto Hiroi
;;;
(require :rangecoder "rangecoder.lsp")
(use-package :rangecoder)

;;; ファイルサイズの書き込み
(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)))

;;; ビットの出現頻度表
(defstruct bit-context (c0 1) (c1 1))

(defun bit-context-sum (bct)
  (+ (bit-context-c0 bct) (bit-context-c1 bct)))

;;; ビットの符号化
(defun bit-encode (rc bit c0 sum)
  (let* ((temp (floor (range-coder-range rc) sum))
         (n (* temp c0)))
    (cond ((plusp bit)
           (incf (range-coder-low rc) n)
           (decf (range-coder-range rc) n))
          (t
           (setf (range-coder-range rc) n)))
    (encode-normalize rc)))

;;; ビットの復号
(defun bit-decode (rc c0 sum)
  (let* ((temp (floor (range-coder-range rc) sum))
         (n (* temp c0))
         (bit nil))
    (cond ((< (floor (range-coder-low rc) temp) c0)
           (setf bit 0)
           (setf (range-coder-range rc) n))
          (t
           (setf bit 1)
           (decf (range-coder-low rc) n)
           (decf (range-coder-range rc) n)))
    (decode-normalize rc)
    bit))

;;; 出現頻度表の更新
(defun bit-update (bct bit inc)
  (if (zerop bit)
      (incf (bit-context-c0 bct) inc)
    (incf (bit-context-c1 bct) inc))
  (when (<= rangecoder::min-range (bit-context-sum bct))
    (setf (bit-context-c0 bct)
          (logior (ash (bit-context-c0 bct) -1) 1)
          (bit-context-c1 bct)
          (logior (ash (bit-context-c1 bct) -1) 1))))
;;;
;;; binary-model
;;;

;;; 初期化
(defun initialize-bit-context-table (size)
  (map-into (make-array (1- size)) #'make-bit-context))

(defstruct (binary-model
            (:constructor make-binary-model
             (size
              &aux (table (initialize-bit-context-table size)))))
  size table)

;;; 符号化
(defun bm-encode (rc bm c)
  (labels ((encode-sub (node)
             (when (plusp node)
               (let* ((p (ash (1- node) -1))
                      (bct (aref (binary-model-table bm) p)))
                 (encode-sub p)
                 ;; 奇数は左の子 (1), 偶数は右の子 (0)
                 (bit-encode rc
                             (logand node 1)
                             (bit-context-c0 bct)
                             (bit-context-sum bct))
                 (bit-update bct (logand node 1) 1)))))
    (encode-sub (+ c (binary-model-size bm) -1))))

;;; 復号
(defun bm-decode (rc bm)
  (do ((node 0)
       (node-size (1- (binary-model-size bm))))
      ((<= node-size node) (- node node-size))
    (let* ((bct (aref (binary-model-table bm) node))
           (bit (bit-decode rc (bit-context-c0 bct) (bit-context-sum bct))))
      (if (plusp bit)
          (setf node (+ (* node 2) 1))
        (setf node (+ (* node 2) 2)))
      (bit-update bct bit 1))))

;;; ファイルの符号化
(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))
              (bm (make-binary-model code-size)))
          (write-file-size out size)
          (when (plusp size)
            (call-with-range-encoder
             out
             (lambda (rc)
               (dotimes (x size)
                 (bm-encode rc bm (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))
           (bm (make-binary-model code-size)))
       (call-with-byte-output-file
        out-file
        (lambda (out)
          (when (plusp size)
            (call-with-range-decoder
             in
             (lambda (rc)
               (dotimes (x size)
                 (write-byte (bm-decode rc bm) out)))))))))))

;;; 簡単なテスト
(defun test ()
  (let ((files '("alice29.txt" "asyoulik.txt" "cp.html" "fields.c" "grammar.lsp"
                 "kennedy.xls" "lcet10.txt" "plrabn12.txt" "ptt5" "sum" "xargs.1")))
    (format t "----- encode -----~%")
    (time
     (dolist (file files)
       (encode-file (format nil "./canterbury/~a" file)
                    (format nil "~a.en" file))))
    ;;
    (format t "----- decode -----~%")
    (time
     (dolist (file files)
       (decode-file (format nil "~a.en" file)
                    (format nil "~a.de" file))))))

初版 2010 年 10 月 31 日
改訂 2023 年 7 月 15 日

Copyright (C) 2010-2023 Makoto Hiroi
All rights reserved.

[ PrevPage | Common Lisp | NextPage ]