M.Hiroi's Home Page

Common Lisp Programming

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

[ PrevPage | Common Lisp | NextPage ]

整数の符号化

データを圧縮するとき、任意の正整数またはある範囲の正整数をできるだけ短い符号語で符号化すると、圧縮率を改善できる場合があります。これを「整数の符号化」といいます。有名なところでは P. Elias が開発した「γ符号」と「δ符号」があります。今回は整数の符号化について説明します。

●符号の種類

最初に符号の種類について簡単に説明します。今までは符号長が等しい符号語を考えてきました。ASCII コードの場合、全ての符号語は 8 ビットと一定です。このような符号を「FF (Fixed-to-Fiexd) 符号」と呼びます。これに対して、各符号語に異なるビット長を割り当てる「可変長符号」を考えてみましょう。頻繁に出てくる記号には短い符号語を割り当て、あまり出てこない記号には長い符号語を割り当てます。

たとえば、記号列 abccddeeeeffffgggggggghhhhhhhh を、a, b, c, d を 4 ビット、e と f を 3 ビット、g と h を 2 ビットで表すことができれば、この記号列は 80 ビットで表現できるはずです。このような符号を「FV (Fixed-to-Variable) 符号」と呼びます。

ただし、問題が一つあります。それは符号語の区切りをどのように表現するかです。たとえば、a, b, c, d の 4 つの記号を、次のように符号化してみましょう。

        表 : 符号の例
+---------------------------+
|   |CODE1|CODE2|CODE3|CODE4|
|---+-----+-----+-----+-----|
| a | 00  | 0   | 0   | 0   |
|---+-----+-----+-----+-----|
| b | 01  | 10  | 01  | 10  |
|---+-----+-----+-----+-----|
| c | 10  | 110 | 011 | 110 |
|---+-----+-----+-----+-----|
| d | 11  | 1110| 111 | 111 |
+---------------------------+

CODE1 は固定長の符号語です。これは 2 ビット読み込んだ時点で、記号を簡単に復号することができます。次の CODE2 は、符号語の終端として 0 を使っています。これも 0 が表れた時点で、読み込んだビット数から簡単に復号できます。ところが、記号の種類が多くなると符号長が長くなるので、テキストデータの圧縮にはあまり向いていない方式です。これに対し、CODE3 は簡単に復号することができません。次の例を見てください。

符号語の列:000110110010

CODE1 ==> 00 01 10 11 00 10   abcdac
          a  b  c  d  a  a

CODE2 ==> 0 0 0 110 110 0 10  aaaccab
          a a a c   c   a b

CODE3 ==> 0 0 011 011 0 01 0  aaccaba
          a a c   c   a b  a

0 -> a と直ぐに復号できない

CODE4 => 0 0 0 110 110 0 10   aaaccab
         a a a c   c   a b


            図 : 復号の様子

上図に示すように、CODE3 でも入力された符号語列を復号することができます。ですが、最初の 0 を読み込んだ時点では、それを直ぐに記号 a に復号することができません。さらに先の符号語 0 を読み込んだ時点で、最初の符号を a と確定することができるのです。これを「瞬時に復号不可能な符号」といいます。

ところが CODE4 の場合では、0 を読み込んだ時点で直ぐに a と復号することができます。CODE3 では a の符号語 0 が b の符号語 01 の先頭と同じになっているので、0 を読み込んだ時点では a と b のどちらの符号語か区別することができません。これに対して、CODE4 では先頭が 0 である符号語がほかにはないので、すぐに a と復号することができるのです。これを「瞬時に復号可能な符号」といいます。

一般に、どの符号語もほかの符号語の先頭からの部分列と一致していなければ、符号語列を先頭から順番に読み込んいくことで一語ずつ記号に復号することができます。このような符号を「接頭符号 (prefix code) 」といいます。身近な例では「電話番号」が接頭符号です。市内局番は地方によって桁数が違いますし、110 番や 119 番は 3 桁しかありません。このような可変長な番号でも、最後までダイヤルすれば相手につながります。

2 進数の接頭符号は二分木を使って表すことができます。CODE3 と CODE4 を二分木で表すと、次のようになります。

符号語を二分木で表す場合、左右の枝にラベル 0 と 1 を割り当てます。葉を記号とすると、その符号語は根から葉に向かってたどった枝のラベルを並べたものに対応します。途中の節に記号を対応させると、それより下にある葉に対応する記号と接頭部が等しくなってしまうので、接頭符号を構成することはできなくなります。

上図に示したように、CODE3 の場合は a と b が途中の節に対応しているため、接頭符号になっていないことがわかります。CODE4 の場合は各記号が二分木の葉に対応していて、接頭符号を構成しています。このように、符号語を表す木を「符号木」といいます。

符号語を復号する場合、符号木の根から枝をたどり、葉に達したところで記号に復号することができます。たとえば CODE4 の場合、最初が 0 であれば葉に到達するので、すぐに a と復号できます。111 ならば、1 の枝をたどっていって、葉に達したところで d と復号できるわけです。

●γ符号とδ符号

それでは、整数の符号化について説明しましょう。整数の符号化にはいろいろな方法がありますが、ここでは瞬時に復号可能な符号で、小さな整数ほど短い符号語が割り当てられる、という特徴を持つ方法を紹介します。

もっとも簡単な方法は、「α符号」または「unary 符号」と呼ばれるものです。次の表を見てください。

        表 : 正整数の符号化

 N :   α符号   :  γ符号  :  δ符号
---------------------------------------
 1 : 1          : 1        : 1
 2 : 01         : 01 0     : 010 0
 3 : 001        : 01 1     : 010 1
 4 : 0001       : 001 00   : 011 00
 5 : 00001      : 001 01   : 011 01
 6 : 000001     : 001 10   : 011 10
 7 : 0000001    : 001 11   : 011 11
 8 : 00000001   : 0001 000 : 00100 000
 9 : 000000001  : 0001 001 : 00100 001
10 : 0000000001 : 0001 010 : 00100 010

α符号で整数 N を表す場合、N - 1 個の 0 を符号化した後に 1 を符号化します。つまり、0 の個数で整数を表しているのです。実際には、P. Elias が開発した「γ符号」と「δ符号」がよく使われます。γ符号は整数 x のビット数をα符号で表し、その後ろに x の最上位ビットを除いた残りの下位ビットを続けます。

たとえば、5 は 3 ビット (101) で表すことができるので、最初の 001 で 3 ビットを表し、その後ろに残りの下位 2 ビット (01) を続けます。最初に連続する 0 の個数で、1 の後ろに続くビット数を表していると考えてもらってもかまいません。δ符号は、ビット数を表すのにα符号の代わりにγ符号を使ったものです。

γ符号は整数 x を 1 + 2 * log(x) で表すことができ、δ符号は 1 + log(x) + 2 * log(1 + log(x)) で表すことができます。通常、小さい整数が多い場合はγ符号のほうが、大きい整数が多い場合はδ符号のほうが高い圧縮率になります。

●CBT 符号

CBT (Complete Binary Tree) 符号は固定長の符号を改良したものです。たとえば、0 から 2k - 1 以下の数値は k ビットの固定長で表すことができます。ところが、数値 n (0 <= n < m) の上限値 m が 2k - 1 よりも小さい場合、m 以上 2k - 1 以下の符号語は使われていません。CBT 符号はこの部分を有効に利用する方法です。

CBT 符号は 0 <= n < 2k - m の数値 n を k - 1 ビットで表し、2k - m <= n < m の数値 n を k ビットで表します。具体的には次のように符号化します。

CBT 符号の一例を示します。

                    表 : CBT 符号の例

    k = 4, m = 10    k = 4, m = 11    k = 4, m = 12 
    n   符号語       n   符号語       n   符号語    
  ---------------   ---------------  ---------------
    0    0 0 0       0    0 0 0       0    0 0 0    
    1    0 0 1       1    0 0 1       1    0 0 1    
    2    0 1 0       2    0 1 0       2    0 1 0    
    3    0 1 1       3    0 1 1       3    0 1 1    
    4    1 0 0       4    1 0 0       4  1 0 0 0    
    5    1 0 1       5  1 0 1 0       5  1 0 0 1    
    6  1 1 0 0       6  1 0 1 1       6  1 0 1 0    
    7  1 1 0 1       7  1 1 0 0       7  1 0 1 1    
    8  1 1 1 0       8  1 1 0 1       8  1 1 0 0    
    9  1 1 1 1       9  1 1 1 0       9  1 1 0 1    
                    10  1 1 1 1      10  1 1 1 0    
                                     11  1 1 1 1    

このように、CBT 符号は 24 - m 未満の数値を 1 ビット少ない 3 ビットで表すことができます。CBT 符号の復号も簡単です。最初に k - 1 ビット読み込み、その値が 2k - m 以上であれば、もう 1 ビット読み込んだ k ビットの値から 2k - m を引き算するだけです。

●ゴロム・ライス符号

ゴロム (Golumb) 符号は Solomon W. Golumb が開発した符号です。ライス (Rice) 符号はゴロム符号の特別な場合で、Rice がのちに再発見したことから、ゴロム・ライス符号と呼ばれています。ゴロム符号はパラメータ b を使って整数 n を符号化します。アルゴリズムは次のようになります。

  1. 商 p = n / b, 剰余 q = n % b を求める。
  2. p をα符号で符号化する。
  3. b が 2k で表せる場合、q の下位 k ビットを出力する。
  4. b < 2k の場合、q を CBT 符号で符号化する。

3 の場合、剰余は n の下位 k ビットになるので、それをそのまま出力することができます。この場合をライス符号といいます。ライス符号は実装が簡単なので、画像や音声の圧縮アルゴリズムの中で使われることがあります。ライス符号の簡単な例を示します。

    表 : Rice 符号の例

 b = 4           b = 8
 n    p   q      n   p   q
-------------   ------------
 0     1  00     0   1  000
 1     1  01     1   1  001
 2     1  10     2   1  010
 3     1  11     3   1  011
 4    01  00     4   1  100
 5    01  01     5   1  101
 6    01  10     6   1  110
 7    01  11     7   1  111
 8   001  00     8  01  000
 9   001  01     9  01  001
10   001  10    10  01  010
11   001  11    11  01  011
12  0001  00    12  01  100
13  0001  01    13  01  101
14  0001  10    14  01  110
15  0001  11    15  01  111

このように、ゴロム・ライス符号はパラメータ b を変更すると符号語も変化します。小さな整数と大きな整数で出現確率の変化が緩やかな場合はパラメータ b の値を大きくするといいでしょう。

●プログラムの作成

では、整数の符号化を行うプログラムを作ります。符号化・復号処理は ハフマン符号 (2) で作成したパッケージ bitio の関数として定義します。また、0 を符号化できると便利なので、今回のプログラムは 0 以上の整数を符号化することにします。

最初はα符号です。

リスト : α符号

(defun alpha-encode (bs n)
  (putbits bs n 0)
  (putbit bs 1))

(defun alpha-decode (bs)
  (do ((n 0 (1+ n)))
      ((plusp (getbit bs)) n)))

符号化は関数 alpha-encode で行います。putbits で 0 を n 個出力したあと、最後に 1 を出力します。数値 0 は 1 だけの出力になります。復号は関数 alpha-decode で行います。これは getbit で 1 ビット読み込み、0 をカウントしてその値を返すだけです。

次はγ符号のプログラムを作ります。符号化する数値に 0 を含める場合、数値 n を次のように変換します。

     n (n+1) bit数  bit列      N      (n+1) bit数  bit列
   ----------------------   --------------------------------------
     0    1   0     none      11      1100   3     1 0 0
     1   10   1     0         12      1101   3     1 0 1
     2   11   1     1         13      1110   3     1 1 0
     3  100   2     0 0       14      1111   3     1 1 1
     4  101   2     0 1       15     10000   4     0 0 0 0
     5  110   2     1 0       16     10001   4     0 0 0 1
     6  111   2     1 1        :     :       :
     7 1000   3     0 0 0    127  10000000   7     0 0 0 0 0 0 0
     8 1001   3     0 0 1      :     :       :
     9 1010   3     0 1 0    255 100000000   8     0 0 0 0 0 0 0 0
    10 1011   3     0 1 1    256 100000001   8     0 0 0 0 0 0 0 1

γ符号は bit 数をα符号で符号化して、bit 列をそのまま出力します。数値 0 は bit 数 (0) だけで表します。γ符号のプログラムは次のようになります。

リスト : γ符号

(defun gamma-encode (bs n)
  (do ((n1 0 (1+ n1))
       (n2 (ash (1+ n) -1) (ash n2 -1)))
      ((zerop n2)
       (alpha-encode bs n1)
       (if (plusp n1) (putbits bs n1 (1+ n))))))

(defun gamma-decode (bs)
  (let ((n1 (alpha-decode bs)))
    (if (zerop n1)
        0
      (+ (ash 1 n1) (getbits bs n1) -1))))

符号化は関数 gamma-encode で行います。変数 n1 が bit 数を表します。変数 n2 を (n + 1) / 2 に初期化し、do ループで 1 ビット左へシフトします。その回数を n1 でカウントし、n2 が 0 になったときの n1 が bit 数になります。したがって、bit 列は数値 n + 1 の下位 n1 ビットになります。

n1 を alpha-encode で符号化します。そして、n1 が 0 よりも大きければ、n + 1 の下位 n1 ビットを putbits でそのまま出力します。復号を行うメソッド gamma-decode も簡単です。alpha_decode で bit 数を復号して n1 にセットします。n1 が 0 よりも大きければ、getbits で n1 ビット読み込んで n2 を復号します。そして元の数値を計算します。

次はδ符号です。

リスト : δ符号

(defun delta-encode (bs n)
  (do ((n1 0 (1+ n1))
       (n2 (ash (1+ n) -1) (ash n2 -1)))
      ((zerop n2)
       (gamma-encode bs n1)
       (if (plusp n1) (putbits bs n1 (1+ n))))))

(defun delta-decode (bs)
  (let ((n1 (gamma-decode bs)))
    (if (zerop n1)
        0
      (+ (ash 1 n1) (getbits bs n1) -1))))

符号化を行う関数が delta-encode で、復号を行う関数が delta-decode です。γ符号は bit 数をα符号で符号化しましたが、δ符号はそれをγ符号で符号化するだけです。プログラムは alpha-encode と alpha-decode を gamma-encode と gamma-decode に変更するだけです。

次は CBT 符号を作ります。

リスト : CBT 符号

(defun cbt-encode (bs n m k)
  (let ((limit (- (ash 1 k) m)))
    (if (< n limit)
        (putbits bs (1- k) n)
      (putbits bs k (+ n limit)))))

(defun cbt-decode (bs m k)
  (let ((limit (- (ash 1 k) m))
        (n (getbits bs (1- k))))
    (if (< n limit)
        n
      (+ (ash n 1) (getbit bs) (- limit)))))

符号化を行うメソッド cbt-encode の引数 n が数値、m が数値の最大値、k がビット数です。CBT 符号で符号化する場合、最初に 2k - m を求めて変数 limit にセットします。次に、n が limit より小さい場合は n を k - 1 ビットで符号化します。そうでなければ、n + limit を k ビットで符号化します。

復号を行うメソッド cbt-decode も簡単です。最初に 2k - m を求めて変数 limit にセットします。次に、getbits で k - 1 ビットを読み込んで復号して変数 n にセットします。n が limit 以上であれば、もう 1 ビット読み込んで k ビットの値を求め、その値から limit を引き算するだけです。

最後にライス符号を作ります。

リスト : ライス符号

(defun rice-encode (bs n k)
  (alpha-encode bs (ash n (- k)))
  (putbits bs k n))

(defun rice-decode (bs k)
  (let ((n (alpha-decode bs)))
    (+ (ash n k) (getbits bs k))))

符号化を行うメソッド rice-encode の引数 n が数値、k がパラメータを表していて、値は b = 2k になります。ライス符号の場合、商の計算はビットシフトで実現できます。n を k ビット右シフトして、その値を alpha-encode で符号化します。そして、n の下位 k ビットが剰余になるので、そのまま putbits で出力します。復号を行うメソッド rice-decode は、alpha-decode で商を復号し、getbits で剰余を求めます。

●MTF (Move To Front) 法

それでは簡単な例題として、MTF (Move To Front) 法と整数の符号化を組み合わせてファイルを圧縮してみましょう。MTF は「同じ記号がいくつ前に現れたか」を符号にする方法で、最近現れた記号ほど小さな値に変換することができます。

MTF は記号の出現表を作ることで簡単に実現できます。たとえば、記号の種類が a, b, c, d の 4 つしかない場合で、記号列 "abccddddd" を MTF で符号化してみましょう。次の図を見てください。

  baccdddd   [a, b, c, d] -> [b, a, c, d]  MTF: 1
  *              * b を先頭に移動

  baccdddd   [b, a, c, d] -> [a, b, c, d]  MTF: 11
   *             * a を先頭に移動

  baccdddd   [a, b, c, d] -> [c, a, b, d]  MTF: 112
    *               * c を先頭に移動

  baccdddd   [c, a, b, d] -> [c, a, b, d]  MTF: 1120
     *        * c を先頭に移動

  baccdddd   [c, a, b, d] -> [d, c, a, b]  MTF: 11203
      *                * d を先頭に移動

  baccdddd   [d, c, a, b] -> [d, c, a, b]  MTF: 112030  
       *      * d を先頭に移動

  同じことを繰り返す。 baccdddd => 11203000


        図 : MTF による符号化

まず、表を [a, b, c, d] に初期化します。MTF は、この表に現れる記号の位置を符号にします。最初の記号は b ですね。b の位置は 1 番目なので 1 を出力します。ここで、記号 b を表の先頭へ移動します。このように、記号を表の先頭へ移動することから "Move To Front" と呼ばれています。この結果、頻繁に現れる記号は表の先頭付近に集まるので、それらの記号は小さな値に変換されるわけです。

この値をγ符号やδ符号などで符号化すれば、データを圧縮することができます。ただし、ハフマン符号やレンジコーダのように高い圧縮率を実現することはできません。

●MTF 法のプログラム

それでは MTF のプログラムを作りましょう。MTF はとても簡単にプログラムできます。次のリストを見てください。

リスト : Move To Front 法

;;; n 番目の要素を先頭へ移動する
(defun move-to-front (table n)
  (when (plusp n)
    (do ((c (aref table n))
         (x n (1- x)))
        ((zerop x)
         (setf (aref table x) c))
      (setf (aref table x)
            (aref table (1- x))))))

;;; MTF による符号化
(defun mtf-encode (table c)
  (let ((n (position c table)))
    (move-to-front table n)
    n))

;;; MTF による復号
(defun mtf-decode (table n)
  (prog1
      (aref table n)
    (move-to-front table n)))

関数 mtf-encode で符号化、関数 mtf-decode で復号を行います。引数 table は MTF で使用する表 (ベクタ) で、c が符号化する記号、n が復号する整数値を表します。符号化は関数 position で table にある c の位置 n を求めたあと、関数 move-to-front で n 番目の要素を先頭に移動します。復号は prog1 で n 番目の要素を返し、move-to-front で先頭に移動します。move-to-front も簡単で、0 から n - 1 番目の要素をひとつずつ do ループで後ろへ移動してから、先頭に n 番目の要素 c をセットします。

ファイルの符号化と復号を行うプログラムは次のようになります。

リスト : ファイルの符号化と復号

;;; 初期化
(defun initialize-mtf-table (size)
  (let ((table (make-array size)))
    (dotimes (x size table)
      (setf (aref table x) x))))

;;; ファイルの符号化
(defun encode-file (in-file out-file)
  (call-with-bit-output-file
   out-file
   (lambda (bs)
     (call-with-byte-input-file
      in-file
      (lambda (in)
        (let ((size (file-length in))
              (table (initialize-mtf-table 256)))
          (putbits bs 32 size)
          (when (plusp size)
            (dotimes (x size)
              (gamma-encode bs (mtf-encode table (read-byte in)))))))))))

;;; ファイルの復号
(defun decode-file (in-file out-file)
  (call-with-bit-input-file
   in-file
   (lambda (bs)
     (let ((size (getbits bs 32))
           (table (initialize-mtf-table 256)))
       (call-with-byte-output-file
        out-file
        (lambda (out)
          (when (plusp size)
            (dotimes (x size)
              (write-byte (mtf-decode table (gamma-decode bs))
                          out)))))))))

MTF 用の表 table は関数 initialize-mtf-table で行います。符号化は mtf-encode で記号を数値に変換したあと、gamma-encode で数値を符号化します。復号は gamma-decode で数値を求め、mtf-decode で記号に変換してから write-byte で出力します。

●実行結果

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

      表 : Move To Front 法 + 整数の符号化 の実行結果

  ファイル名      サイズ    γ符号     δ符号    rice(2)   rice(3)   rice(4)
  -------------------------------------------------------------------------
  alice29.txt    152,089   127,306   133,084   108,834    97,488   102,298
  asyoulik.txt   125,179   110,855   114,467    97,015    83,922    85,977
  cp.html         24,603    22,767    23,047    21,290    17,594    17,408
  fields.c        11,150     9,391     9,699     8,849     7,616     7,715
  grammar.lsp      3,721     2,993     3,127     2,722     2,424     2,522
  kennedy.xls  1,029,744   583,363   621,135   983,376   788,237   778,910
  lcet10.txt     426,754   352,109   370,334   301,565   272,016   285,874
  plrabn12.txt   481,861   415,204   434,319   345,633   308,223   324,041
  ptt5           513,216   119,162   122,033   223,581   270,200   325,906
  sum             38,240    28,482    29,145    34,723    28,505    27,906
  xargs.1          4,227     3,722     3,900     3,290     2,847     2,891
  -------------------------------------------------------------------------
  合計         2,810,784 1,775,354 1,864,290 2,130,878 1,879,072 1,961,448

テキストデータは rice 符号 (b = 3) の圧縮率がよく、バイナリデータはγ符号の圧縮率がよくなりました。記号の出現確率を使って符号化するハフマン符号やレンジコーダにはかないませんが、このような簡単な方法でもデータを圧縮することができます。


●プログラムリスト1

;;;
;;; bitio.lsp : ビット入出力
;;;
;;;             Copyright (C) 2010-2023 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
          alpha-encode alpha-decode gamma-encode gamma-decode
          delta-encode delta-decode cbt-encode cbt-decode
          rice-encode rice-decode
          ))

;;; 構造体の定義
(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))))

;;;
;;; 整数の符号化
;;;

;;; α符号
(defun alpha-encode (bs n)
  (putbits bs n 0)
  (putbit bs 1))

(defun alpha-decode (bs)
  (do ((n 0 (1+ n)))
      ((plusp (getbit bs)) n)))

;;; γ符号
(defun gamma-encode (bs n)
  (do ((n1 0 (1+ n1))
       (n2 (ash (1+ n) -1) (ash n2 -1)))
      ((zerop n2)
       (alpha-encode bs n1)
       (if (plusp n1) (putbits bs n1 (1+ n))))))

(defun gamma-decode (bs)
  (let ((n1 (alpha-decode bs)))
    (if (zerop n1)
        0
      (+ (ash 1 n1) (getbits bs n1) -1))))

;;; δ符号
(defun delta-encode (bs n)
  (do ((n1 0 (1+ n1))
       (n2 (ash (1+ n) -1) (ash n2 -1)))
      ((zerop n2)
       (gamma-encode bs n1)
       (if (plusp n1) (putbits bs n1 (1+ n))))))

(defun delta-decode (bs)
  (let ((n1 (gamma-decode bs)))
    (if (zerop n1)
        0
      (+ (ash 1 n1) (getbits bs n1) -1))))

;;; CBT 符号
(defun cbt-encode (bs n m k)
  (let ((limit (- (ash 1 k) m)))
    (if (< n limit)
        (putbits bs (1- k) n)
      (putbits bs k (+ n limit)))))

(defun cbt-decode (bs m k)
  (let ((limit (- (ash 1 k) m))
        (n (getbits bs (1- k))))
    (if (< n limit)
        n
      (+ (ash n 1) (getbit bs) (- limit)))))

;;; Rice 符号
(defun rice-encode (bs n k)
  (alpha-encode bs (ash n (- k)))
  (putbits bs k n))

(defun rice-decode (bs k)
  (let ((n (alpha-decode bs)))
    (+ (ash n k) (getbits bs k))))

●プログラムリスト2

;;;
;;; mtf.lsp : move to front によるファイルの圧縮
;;;
;;;           Copyright (C) 2010-2023 Makoto Hiroi
;;;

(require :bitio "bitio.lsp")
(use-package :bitio)

;;; n 番目の要素を先頭へ移動する
(defun move-to-front (table n)
  (when (plusp n)
    (do ((c (aref table n))
         (x n (1- x)))
        ((zerop x)
         (setf (aref table x) c))
      (setf (aref table x)
            (aref table (1- x))))))

;;; 初期化
(defun initialize-mtf-table (size)
  (let ((table (make-array size)))
    (dotimes (x size table)
      (setf (aref table x) x))))

;;; MTF による符号化
(defun mtf-encode (table c)
  (let ((n (position c table)))
    (move-to-front table n)
    n))

;;; MTF による復号
(defun mtf-decode (table n)
  (prog1
      (aref table n)
    (move-to-front table n)))

;;; ファイルの符号化
(defun encode-file (in-file out-file)
  (call-with-bit-output-file
   out-file
   (lambda (bs)
     (call-with-byte-input-file
      in-file
      (lambda (in)
        (let ((size (file-length in))
              (table (initialize-mtf-table 256)))
          (putbits bs 32 size)
          (when (plusp size)
            (dotimes (x size)
              (delta-encode bs (mtf-encode table (read-byte in)))))))))))

;;; ファイルの復号
(defun decode-file (in-file out-file)
  (call-with-bit-input-file
   in-file
   (lambda (bs)
     (let ((size (getbits bs 32))
           (table (initialize-mtf-table 256)))
       (call-with-byte-output-file
        out-file
        (lambda (out)
          (when (plusp size)
            (dotimes (x size)
              (write-byte (mtf-decode table (delta-decode bs))
                          out)))))))))

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

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

[ PrevPage | Common Lisp | NextPage ]