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

Lisp でレンジコーダ

今回はデータ圧縮法のひとつである「レンジコーダ (RangeCoder)」を取り上げます。レンジコーダは 1998 年に Michael Schindler が発表し、「高性能、高速、特許フリー」の方法として注目を集めるようになりました。Michael Schindler のレンジコーダは計算の途中で「桁上がり」が発生します。ところが、ロシアの Dmitry Subbotin が発表した「桁上げのないレンジコーダ」は、その名のごとく桁上がりが発生しません。現在、レンジコーダは主にこの 2 種類の形式が存在するようです。

レンジコーダは原理的には算術符号と同じ方法です。性能は算術符号に比べるとわずかに劣化しますが、実現方法はとても簡単で実行速度も高速です。もちろん、ハフマン符号よりも高性能です。今回はレンジコーダのプログラムを Common Lisp で作成しましょう。これから作成するプログラムは学習用なので実用性はまったくありませんが、実際にプログラムを作ることでレンジコーダの理解は深まると思います。

●レンジコーダの基本的な考え方

最初に、レンジコーダの基本的な考え方について説明しましょう。ここで説明するレンジコーダは「桁上がり」が発生するバージョンです。

算術符号は区間 [0, 1) を分割していきますが、レンジコーダは [0, 1) を分割するのではなく、最初に大きな区間たとえば [0, 1000) を設定して、それを小さな区間に分割していくことで符号化を行います。レンジコーダは整数で演算するので、記号列が長くなると当然ですが区間が狭くなって分割できなくなります。そのときは区間を引き伸ばすことで対応します。

たとえば、[0, 1000) を分割していくと [123, 124) になりました。もうこれ以上分割できませんね。そこで、区間をたとえば 100 倍して [12300, 12400) を分割することにします。このとき、区間全体の大きさは [0, 1000) ではなく、それを 1000 倍した [0, 100000) と考えるわけです。

単純に考えると、区間を表すために多倍長整数が必要になりますが、区間を引き伸ばすタイミングを定めることにより、通常の整数演算でレンジコーダをプログラムすることができます。また、区間全体の大きさも覚えておく必要はありません。レンジコーダは分割した区間の幅 (range) と下限値だけで符号化することができます。復号の処理でも、符号化と同じタイミングで range を引き伸ばしていくことで、符号語を記号列に復号することができます。レンジコーダは区間の下限値を符号語として出力します。

●レンジコーダの符号化

それでは具体的に説明しましょう。最初は区間の幅 range を 0x1000000 に設定し、下限値 low は 0 に初期化します。区間は [low, low + range) と表すことができるので、最初の区間は [0, 0x1000000) となります。また、range の初期値が 0x1000000 なので、low の値は 0 から 0xffffff までの範囲 (24 bit) になります。

記号の出現確率により区間を分割するところは算術符号と同じです。レンジコーダは range が一定の値より小さくなった時点で、range を引き伸ばすところがポイントです。レンジコーダでは、range が初期値の 1/256 (0x10000) より小さくなったら 256 倍します。これは処理をバイト単位で行うための工夫です。次の例を見てください。

[0x123456, 0x123456 + 0xabcd) = 256 倍 => [0x12345600, 0x12345600 + 0xabcd00)

いま low の値が 0x123456 で range の値が 0xabcd だとします。0xabcd < 0x10000 なので range を 256 倍します。このとき、low の値もいっしょに 256 倍すればいいわけです。これで区間を正しく表すことができますが、このままでは low の値がどんどん大きくなる一方ですね。そこで、low の値を一定の範囲内 (24 bit) に収めることを考えます。

range の値は 24 bit の範囲内に収まるので、low の計算は 24 bit の足し算になります。桁上がりの処理を工夫すれば、low を 24 bit で保持することが可能です。たとえば、次のように low の上位 8 bit (0x12) をバッファへ出力します。

[0x12345600, 0x12345600 + 0xabcd00) => [0x345600, 0x345600 + 0xabcd00)
low (0x12345600) の上位 8 bit (0x12) をバッファへ出力 => (0x12)

値をバッファに溜めておけば、桁上がりには簡単に対応することができます。また、桁上がりが発生しないように工夫することができれば、上位 8 bit (0x12) をそのまま符号語としてファイルなどへ出力することができます。あとは、記号を読み込んで区間の分割と引き伸ばしを繰り返して、最後に low の値 (24 bit) を出力します。

簡単な例を示しましょう。記号列 "dcbbaaaa" を符号化します。記号の出現確率は次のようになります。

符号化の過程は次のようになります。

low   = low + (range * 記号の下限値)
range = range * 記号の出現確率

[   low,  range]        [   low,  range] (数値は 16 進数)
[     0,1000000] - d -> [e00000, 200000]
[e00000, 200000] - c -> [f80000,  40000]
[f80000,  40000] - b -> [fa0000,  10000]
[fa0000,  10000] - b -> [fa8000,   4000]  256 倍して fa を出力
[800000, 400000] - a -> [800000, 200000]
[800000, 200000] - a -> [800000, 100000]
[800000, 100000] - a -> [800000,  80000]
[800000,  80000] - a -> [800000,  40000]  low [80, 00, 00] を出力  

  符号語 => [fa, 80, 00, 00]

            図 : 符号化の過程（レンジコーダ）

記号を読み込むたびに、range の値は小さくなり low の値は増えていきます。d, c, b, b まで記号を読み込むと、range は 0x4000 になり 0x10000 より小さくなります。ここで range と low を 256 倍して、low の上位 8 ビット (0xfa) を出力します。次に記号 a を読み込みます。range の値は小さくなりますが、a の下限値が 0 なので low の値は増えません。最後に low の値を出力して終了です。符号語は [0xfa, 0x80, 0, 0] になります。

●レンジコーダの復号

次は復号について説明します。下限値 low と幅 range は符号化と同様に 0 と 0x1000000 に初期化します。符号語を code とすると、最初 low は 0 なので [0, range) の範囲で code に対応する記号を探すことになります。見つけた記号を c1 とすると、low と range の値は符号化と同様に次式で更新します。

low1   = low (0) + (range * 記号 c1 の下限値)
range1 = range * 記号 c1 の出現確率

こんどは [low1, low1 + range1) の範囲で code に対応する記号を探します。ここで code から下限値の増分を引き算した値 code1 を求めてみます。すると、次の図に示すように code1 は区間 [0, range1) の符号語に対応していることがわかります。つまり、次は [0, range1) の範囲で code1 に対応する記号を探せばよいのです。

0            low1      code          low1+range1       range  
├──────┼────┼───────┼───────┤
┌──────┘        │              │
│        ┌──────┘              │
│        │              ┌──────┘
↓        ↓              ↓
├────┼───────┤
0        code1          range1

                図 : 区間の更新

このように、符号語 code から下限値の増分を引き算することで、区間を [low, low + range) から [0, range) に変換することができるわけです。したがって、復号処理では下限値 low の値を覚えておく必要はありません。

range が 0x10000 より小さくなったら range を 256 倍するのは符号化と同じです。このとき符号語 code も 256 倍して、新しい符号語を 1 バイト読み込んで code に加算します。これで符号語を復号することができます。

それでは、復号の過程を具体的に説明しましょう。次の図を見てください。

code  = code - (range * 記号の下限値)
range = range * 記号の出現確率

符号語を 3 バイト [fa, 80, 00] 読み込み code を初期化

[  code,   range]        [  code,   range] (数値は 16 進数)
[fa8000, 1000000] - d -> [1a8000,  200000]
[1a8000,  200000] - c -> [ 28000,   40000]
[ 28000,   40000] - b -> [  8000,   10000]
[  8000,   10000] - b -> [     0,    4000]  256 倍する
                                            符号語を 1 バイト (00) code に加算  
[     0,  400000] - a -> [     0,  200000]
[     0,  200000] - a -> [     0,  100000]
[     0,  100000] - a -> [     0,   80000]
[     0,   80000] - a -> [     0,   40000]

  記号列 => "dcbbaaaa"

            図 : 復号の過程（レンジコーダ）

最初に range と code を初期化します。code の範囲は 24 bit なので、3 バイト読み込んで 0xfa8000 に初期化します。次に、「記号の下限値 <= code / range < 記号の上限値」を満たす記号を探します。この場合、記号は d になります。そして、range を記号 d の出現確率で縮小して、code から (range * d の下限値) を引き算します。今度は 0x200000 の幅の中で 0x1a8000 に相当する記号を探すわけです。

d, c, b, b まで復号すると、range は 0x4000 になり 0x10000 より小さくなります。ここで range と code を 256 倍して、新しい符号語を 1 バイト読み込んで code に足し算します。この場合、符号語は 0 なので code の値は増えません。あとは、同じ処理を繰り返して記号列 "dcbbaaaa" を求めることができます。

●符号化のプログラム

それではプログラムを作りましょう。最初に記号の出現確率を求める関数を作ります。記号と記号列はシンボルとリストで表します。レンジコーダは整数で演算するので、出現確率は各記号の個数と記号の総数から求めます。記号と個数は連想リストに格納します。たとえば、記号列 (a b c c d d d d) は次のようになります。

((A 1 0 1) (B 1 1 2) (C 2 2 4) (D 4 4 8)
 (E 0 8 8) (F 0 8 8) (G 0 8 8) (H 0 8 8))

先頭要素が記号、2 番目の要素が記号の個数、3, 4 番目の要素が区間 (下限値と上限値) を表します。記号の下限値と上限値は分数ではなく累積度数で表しています。出現頻度表を作成する関数 make-frequency は次のようになります。

リスト : 出現頻度表の作成

;;; 記号のカウント
(defun count-symbol (xs)
  (let ((table (mapcar (lambda (x) (cons x 0)) syms)))
    (dolist (x xs table)
      (let ((code (assoc x table)))
        (unless code
          (error "invalid symbol ~a~%" x))
        (incf (cdr code))))))

;;; 累積度数表
(defun make-cumulative (xs &optional (a 0))
  (if (null xs)
      nil
    (cons (list (caar xs)         ; 記号
                (cdar xs)         ; 個数
                a                 ; 下限
                (+ a (cdar xs)))  ; 上限
          (make-cumulative (cdr xs) (+ a (cdar xs))))))

;;; 出現頻度表の作成
(defun make-frequency (xs)
  (make-cumulative (count-symbol xs)))

make-frequency は拙作のページ「Lisp で算術符号」のプログラムとほとんど同じなので説明は不要でしょう。

次は記号列を符号化する関数 range-encode を作ります。次のリストを見てください。

リスト : レンジコーダの符号化

;;; 定数の定義
(defconstant max-range #x1000000)
(defconstant min-range #x10000)
(defconstant mask      #xffffff)

;;; 新しい range を計算する
(defun calc-range (range data sum)
  (truncate (* range (second data)) sum))

;;; 下限値を計算する
(defun calc-low (range data sum)
  (truncate (* range (third data)) sum))

;;; 上限値を計算する
(defun calc-high (range data sum)
  (truncate (* range (fourth data)) sum))

;;; 桁上がりの処理 (over は 0 or 1)
(defun overflow (code &optional (over 1))
  (cond ((zerop over) code)
        ((null code) (list over))
        ((= 255 (car code))
         (cons 0 (overflow (cdr code) 1)))
        (t (cons (+ (car code) over) (cdr code)))))

;;; 符号化
(defun range-encode (xs)
  (let ((table (make-frequency xs))
        (sum (length xs))
        (range max-range)
        (low 0) data code)
    (dolist (c xs)
      (setq data  (assoc c table))
      (incf low   (calc-low range data sum))
      (setq range (calc-range range data sum))
      ;; 桁上がりのチェック
      (when (<= max-range low)
        (setq code (overflow code))
        (decf low max-range))
      ;; range の拡張
      (loop
       while (< range min-range)
       do
       ;; コードを出力
       (push (ash low -16) code)
       ;; 8 bit shift
       (setq low   (logand (ash low 8) mask)
             range (ash range 8))))
    ;; low を出力
    (dotimes (x 3 (values table (reverse code)))
      (push (ash low -16) code)
      (setq low (logand (ash low 8) mask)))))

range-encode は引数 BUFFER から記号をひとつずつ取り出して、区間の幅 RANGE を狭めて下限値 LOW の値を計算します。RANGE の初期値は MAX-RANGE (#x1000000) で、MIN-RANGE (#x10000) より小さくなったならば RANGE と LOW の値を 256 倍するとともに、LOW の上位 8 ビットを符号語として変数 CODE のリストに格納します。

RANGE と LOW の計算は関数 calc-range と calc-low で行います。引数 SUM は記号列の長さ (記号の総数) です。RANGE は記号の出現確率で縮小すればいいので RANGE * (記号の個数 / SUM) を calc-range で計算します。LOW の増分は区間の下限値なので (RANGE * 記号の下限値) / SUM を calc-low で計算します。Common Lisp の関数 / は割り切れないと結果を分数で返すので、小数点以下を切り捨てるために関数 truncate を使っていることに注意してください。

LOW の値が MAX-RANGE 以上になったならば、桁上がりの処理を関数 overflow で行います。符号語は CODE に逆順で格納されているので、最初の要素に 1 を足して値が 256 になったならば、その要素を 0 にして次の要素に 1 を足し算します。overflow はこの処理を再帰呼び出しで実現しています。難しい処理ではないので、詳細はプログラムリストお読みください。

幅 RANGE が MIN-RANGE より小さくなったならば、RANGE と LOW を 256 倍します。最初に LOW の上位 8 bit を CODE に格納します。LOW の値は 24 bit の範囲内なので、関数 ash で LOW を 16 bit 右シフトすれば上位 8 bit の値を取り出すことができます。次に、RANGE と LOW を ash で 8 bit 左シフトします。これで値は 256 倍されます。このままでは LOW の値が 24 bit の範囲に収まらないので、論理積を求める logand で符号語として出力した部分を取り除きます。

記号列を最後まで読み込んだら、LOW の値を CODE に出力します。LOW の上位 8 bit から順番に出力していることに注意してください。これでプログラムは完成です。

簡単な実行例を示します。

* (range-encode '(d c b b a a a a))

((A 4 0 4) (B 2 4 6) (C 1 6 7) (D 1 7 8) (E 0 8 8) (F 0 8 8) (G 0 8 8)
 (H 0 8 8))
(250 128 0 0)
* (range-encode '(a b c c d d d d))

((A 1 0 1) (B 1 1 2) (C 2 2 4) (D 4 4 8) (E 0 8 8) (F 0 8 8) (G 0 8 8)
 (H 0 8 8))
(5 124 0 0)
* (range-encode '(a a a a a a a a a b))

((A 9 0 9) (B 1 9 10) (C 0 10 10) (D 0 10 10) (E 0 10 10) (F 0 10 10)
 (G 0 10 10) (H 0 10 10))
(89 66 252)

●復号のプログラム

次は復号のプログラムを作りましょう。次のプログラムを見てください。

リスト : レンジコーダの復号

(defun range-decode (n table code-list)
  (let ((range max-range) (code 0) data buffer)
    ;; code の初期化
    (dotimes (x 3)
      (setq code (+ (ash code 8) (pop code-list))))
    ;; 復号
    (dotimes (x n (reverse buffer))
      (setq data (find-if (lambda (data)
                            (and (<= (calc-low range data n) code)
                                 (< code (calc-high range data n))))
                          table))
      ;; コードを出力
      (push (first data) buffer)
      (decf code (calc-low range data n))
      (setq range (calc-range range data n))
      ;; range の拡張
      (loop
       while (< range min-range)
       do (setq range (ash range 8)
                code (+ (ash code 8) (pop code-list)))))))

;;; 復号のテスト
(defun test (xs)
  (multiple-value-bind
   (table code)
   (range-encode xs)
   (print table)
   (print code)
   (range-decode (length xs) table code)))

関数 range-decode の引数 N が復号する記号の総数、TABLE が出現頻度表、CODE-LIST が入力データ (符号語のリスト) です。RANGE は MAX-RANGE に初期化します。符号語 CODE の範囲は 24 bit なので、CODE-LIST から 3 バイト分読み込んで初期化します。

記号の復号処理は関数 find-if で TABLE から CODE に対応する記号を探します。記号の下限値と上限値 (累積度数) を CALC-LOW と CALC-HIGH で RANGE の幅に変換し、CODE がその範囲内にある記号を返します。

あとは、求めた記号を buffer にセットし、RANGE と CODE の値を更新します。RANGE が MIN-RANGE よりも小さくなったならば、RANGE と CODE の値を 256 倍します。このとき、CODE-LIST から符号語を 1 バイト分読み込んで CODE に加算します。あとはこれを N 回繰り返すだけです。

それでは実行してみましょう。

* (test '(d c b b a a a a))

((A 4 0 4) (B 2 4 6) (C 1 6 7) (D 1 7 8) (E 0 8 8) (F 0 8 8) (G 0 8 8)
 (H 0 8 8))
(250 128 0 0)
(D C B B A A A A)
* (test '(a b c c d d d d))

((A 1 0 1) (B 1 1 2) (C 2 2 4) (D 4 4 8) (E 0 8 8) (F 0 8 8) (G 0 8 8)
 (H 0 8 8))
(5 124 0 0)
(A B C C D D D D)
* (test '(a a a a a a a a a b))

((A 9 0 9) (B 1 9 10) (C 0 10 10) (D 0 10 10) (E 0 10 10) (F 0 10 10)
 (G 0 10 10) (H 0 10 10))
(89 66 252)
(A A A A A A A A A B)

きちんと復号できましたね。

●適応型レンジコーダ

ところで、適応型レンジコーダも簡単に作成することができます。基本的な考え方は適応型算術符号と同じです。符号化を行う関数 range-encode-ad は次のようになります。

リスト : 適応型レンジコーダの符号化

(defun range-encode-ad (xs)
  (let ((table (make-frequency-ad syms))
        (sum (length syms))
        (range max-range)
        (low 0) data code)
    (dolist (c xs)
      (setq data  (assoc c table))
      (incf low   (calc-low range data sum))
      (setq range (calc-range range data sum))
      ;; 桁上がりのチェック
      (when (<= max-range low)
        (setq code (overflow code))
        (decf low max-range))
      ;; range の拡張
      (loop
       while (< range min-range)
       do
       ;; コードを出力
       (push (ash low -16) code)
       ;; 8 bit shift
       (setq low   (logand (ash low 8) mask)
             range (ash range 8)))
      ;; 出現頻度表の更新
      (incf sum)
      (update-frequency c table))
    ;; low を出力
    (dotimes (x 3 (reverse code))
      (push (ash low -16) code)
      (setq low (logand (ash low 8) mask)))))

出現頻度表を作成する関数 make-frequency-ad と、それを更新する関数 update-frequency は適応型算術符号と同じです。記号を符号化したあと、記号の総数 SUM を +1 して、update-frequency で出現頻度表を更新するだけです。

復号を行う関数 rande-decode-ad は次のようになります。

リスト : 適応型レンジコーダの復号

;;; 復号
(defun range-decode-ad (n code-list)
  (let ((table (make-frequency-ad syms))
        (sum (length syms))
        (range max-range)
        (code 0) data buffer)
    ;; code の初期化
    (dotimes (x 3)
      (setq code (+ (ash code 8) (pop code-list))))
    ;; 復号
    (dotimes (x n (reverse buffer))
      (setq data (find-if (lambda (data)
                            (and (<= (calc-low range data sum) code)
                                 (< code (calc-high range data sum))))
                          table))
      ;; コードを出力
      (push (first data) buffer)
      (decf code (calc-low range data sum))
      (setq range (calc-range range data sum))
      ;; range の拡張
      (loop
       while (< range min-range)
       do (setq range (ash range 8)
                code (+ (ash code 8) (pop code-list))))
      ;; 出現頻度表の更新
      (incf sum)
      (update-frequency (first data) table))))

;;; 復号のテスト
(defun test-ad (xs)
  (let ((code (range-encode-ad xs)))
    (print code)
    (range-decode-ad (length xs) code)))

記号を一つ復号したあと、記号の総数 SUM を +1 して、update-frequency で出現頻度表を更新するだけです。

それでは実行してみましょう。

* (test-ad '(d c b b a a a a))

(103 127 188 69 0)
(D C B B A A A A)
* (test-ad '(a b c c d d d d))

(8 180 38 23 102)
(A B C C D D D D)
* (test-ad '(a a a a a a a a a b))

(0 3 94 166 0)
(A A A A A A A A A B)

適応型算術符号と同様に、出現する記号の種類が少なく記号列の長さが短いデータでは、適応型レンジコーダの圧縮率は低下します。ですが、記号列が長くて記号の出現確率の違いが大きくなると、適応型レンジコーダでも圧縮率は向上するので大丈夫です。また、出現頻度表を更新するだけで適応型符号化に対応できるのも、レンジコーダの長所だと思います。

●プログラムリスト

;;;
;;; range.lisp : レンジコーダ
;;;
;;;              Copyright (C) 2003-2020 Makoto Hiroi
;;;

;;; 記号
(defconstant syms '(a b c d e f g h))

;;; 記号のカウント
(defun count-symbol (xs)
  (let ((table (mapcar (lambda (x) (cons x 0)) syms)))
    (dolist (x xs table)
      (let ((code (assoc x table)))
        (unless code
          (error "invalid symbol ~a~%" x))
        (incf (cdr code))))))

;;; 累積度数表
(defun make-cumulative (xs &optional (a 0))
  (if (null xs)
      nil
    (cons (list (caar xs)         ; 記号
                (cdar xs)         ; 個数
                a                 ; 下限
                (+ a (cdar xs)))  ; 上限
          (make-cumulative (cdr xs) (+ a (cdar xs))))))

;;; 出現頻度表の作成
(defun make-frequency (xs)
  (make-cumulative (count-symbol xs)))

;;; 定数の定義
(defconstant max-range #x1000000)
(defconstant min-range #x10000)
(defconstant mask      #xffffff)

;;; 新しい range を計算する
(defun calc-range (range data sum)
  (truncate (* range (second data)) sum))

;;; 下限値を計算する
(defun calc-low (range data sum)
  (truncate (* range (third data)) sum))

;;; 上限値を計算する
(defun calc-high (range data sum)
  (truncate (* range (fourth data)) sum))

;;; 桁上がりの処理 (over は 0 or 1)
(defun overflow (code &optional (over 1))
  (cond ((zerop over) code)
        ((null code) (list over))
        ((= 255 (car code))
         (cons 0 (overflow (cdr code) 1)))
        (t (cons (+ (car code) over) (cdr code)))))

;;; 符号化
(defun range-encode (xs)
  (let ((table (make-frequency xs))
        (sum (length xs))
        (range max-range)
        (low 0) data code)
    (dolist (c xs)
      (setq data  (assoc c table))
      (incf low   (calc-low range data sum))
      (setq range (calc-range range data sum))
      ;; 桁上がりのチェック
      (when (<= max-range low)
        (setq code (overflow code))
        (decf low max-range))
      ;; range の拡張
      (loop
       while (< range min-range)
       do
       ;; コードを出力
       (push (ash low -16) code)
       ;; 8 bit shift
       (setq low   (logand (ash low 8) mask)
             range (ash range 8))))
    ;; low を出力
    (dotimes (x 3 (values table (reverse code)))
      (push (ash low -16) code)
      (setq low (logand (ash low 8) mask)))))

;;; 復号
(defun range-decode (n table code-list)
  (let ((range max-range) (code 0) data buffer)
    ;; code の初期化
    (dotimes (x 3)
      (setq code (+ (ash code 8) (pop code-list))))
    ;; 復号
    (dotimes (x n (reverse buffer))
      (setq data (find-if (lambda (data)
                            (and (<= (calc-low range data n) code)
                                 (< code (calc-high range data n))))
                          table))
      ;; コードを出力
      (push (first data) buffer)
      (decf code (calc-low range data n))
      (setq range (calc-range range data n))
      ;; range の拡張
      (loop
       while (< range min-range)
       do (setq range (ash range 8)
                code (+ (ash code 8) (pop code-list)))))))

;;; 復号のテスト
(defun test (xs)
  (multiple-value-bind
   (table code)
   (range-encode xs)
   (print table)
   (print code)
   (range-decode (length xs) table code)))

;;;
;;; 適応型レンジコーダ
;;;

;;; 出現頻度表の作成
(defun make-frequency-ad (xs &optional (sum 0))
  (if (null xs)
      nil
    (cons (list (car xs) 1 sum (1+ sum))
          (make-frequency-ad (cdr xs) (1+ sum)))))

;;; 出現頻度表の更新
(defun update-frequency (code freq)
  (let ((xs (member code freq :key #'car)))
    (incf (second (car xs)))
    (incf (fourth (car xs)))
    (dolist (x (cdr xs))
      (incf (third x))
      (incf (fourth x)))))

;;; 符号化
(defun range-encode-ad (xs)
  (let ((table (make-frequency-ad syms))
        (sum (length syms))
        (range max-range)
        (low 0) data code)
    (dolist (c xs)
      (setq data  (assoc c table))
      (incf low   (calc-low range data sum))
      (setq range (calc-range range data sum))
      ;; 桁上がりのチェック
      (when (<= max-range low)
        (setq code (overflow code))
        (decf low max-range))
      ;; range の拡張
      (loop
       while (< range min-range)
       do
       ;; コードを出力
       (push (ash low -16) code)
       ;; 8 bit shift
       (setq low   (logand (ash low 8) mask)
             range (ash range 8)))
      ;; 出現頻度表の更新
      (incf sum)
      (update-frequency c table))
    ;; low を出力
    (dotimes (x 3 (reverse code))
      (push (ash low -16) code)
      (setq low (logand (ash low 8) mask)))))

;;; 復号
(defun range-decode-ad (n code-list)
  (let ((table (make-frequency-ad syms))
        (sum (length syms))
        (range max-range)
        (code 0) data buffer)
    ;; code の初期化
    (dotimes (x 3)
      (setq code (+ (ash code 8) (pop code-list))))
    ;; 復号
    (dotimes (x n (reverse buffer))
      (setq data (find-if (lambda (data)
                            (and (<= (calc-low range data sum) code)
                                 (< code (calc-high range data sum))))
                          table))
      ;; コードを出力
      (push (first data) buffer)
      (decf code (calc-low range data sum))
      (setq range (calc-range range data sum))
      ;; range の拡張
      (loop
       while (< range min-range)
       do (setq range (ash range 8)
                code (+ (ash code 8) (pop code-list))))
      ;; 出現頻度表の更新
      (incf sum)
      (update-frequency (first data) table))))

;;; 復号のテスト
(defun test-ad (xs)
  (let ((code (range-encode-ad xs)))
    (print code)
    (range-decode-ad (length xs) code)))