長さ制限付きハフマン符号化 : 整理
長さ制限付きのハフマン符号化のソースコードは、以前にも載せたが、結構無駄が多かったので書き直し。
ついでに、整理中に気づいたこと(間違っているかもしれない!)を注釈として残しておく。
;;;;;;;;;;; ;;;; 構造体 (defstruct obj ; コスト値を持つオブジェクト (cost 0 :type fixnum)) (defstruct (code-obj (:include obj)) ; コードとコスト値を持つオブジェクト (code 0 :type fixnum)) (defstruct (packaged-obj ; 二つのobjをまとめたオブジェクト (cf. 二分木) (:include obj) (:constructor package-obj (a b &aux (cost (+ (obj-cost a) (obj-cost b))) (pair (cons a b))))) (pair '() :type list :read-only t)) ;;;;;;;;;;;;;;; ;;;; 主要な関数 ;; objのリストを受け取りパッケージングを行う ;; objのリストは、コストが低い順番に並んでいる ;; (length objs)が奇数の場合、一番最後の(= コストが最も高い)要素が捨てられる ;; ex: (obj1 obj2 obj3 obj4) --> (pacakged-obj-1+2 packaged-obj-3+4) (defun packaging (objs &aux (head (cons :head objs))) "この関数は次の式と(equal関数で)等価な結果を返す。ただし、破壊的で、コンシングが少ない。 (loop FOR (1st 2nd) IN objs WHEN 2nd COLLECT (package-obj 1st 2nd))" (labels ((recur (objs rlt &aux (1st (first objs)) (2st (second objs)) (rest (cddr objs))) (if (null 2st) (setf (cdr rlt) nil) (progn (setf (second rlt) (package-obj 1st 2st)) (recur rest (cdr rlt)))))) (recur objs head)) (cdr head)) ;; package & merge (defun package-and-merge (objs next-objs) (merge 'list (packaging objs) next-objs #'< :key #'obj-cost)) ;; コードの出現頻度表と最大ビット長を受け取り、コードの最適符号ビット長のテーブルを返す ;; ※ ビット長テーブルがあれば、実際にコードに対応する符号ビットを算出可能 ;; その方法は、「Canonical Huffman code」等のキーワードで検索を行えば見つかると思うので、そちらを参照のこと (defun calc-code->bitlength-table (#1=code-frequency-table bit-length-limit) (declare ((simple-array fixnum) #1#) (fixnum bit-length-limit)) (let ((src-objs (sort (loop FOR i FROM 0 BELOW (length #1#) WHEN (plusp (aref #1# i)) COLLECT (make-code-obj :code i :cost (aref #1# i))) #'< :key #'obj-cost)) (bitlen-table (make-array (length #1#) :initial-element 0 :element-type 'fixnum))) ;;(assert (>= bit-length-limit (ceiling (log (length src-objs) 2))) ;; () "~A個のコードを符号化するには、最低~Aビット必要です。(指定ビット長は~A)" ;; (length src-objs) (ceiling (log (length src-objs) 2)) bit-length-limit) ;; 最大ビット長の回数だけ、パッケージ&マージ処理を繰り返す ※1 (loop REPEAT bit-length-limit FOR objs = (package-and-merge objs (copy-list src-objs)) FINALLY ;; 最適符号ビット長を取得する ;; コードの符号ビット長 = objsの先頭N要素に、そのコード(に対応するcode-obj)が何個あるか (objs-each (o (packaging objs)) ; ※2 (incf (aref bitlen-table (code-obj-code o))))) bitlen-table)) ;;;;;;;;;;;;;;;;; ;;;; 補助的な関数 ;; objのリストを受け取り、先頭からloop-cnt個を走査する ;; objがpackaged-obj型の場合は、パッケージされた元のobjを辿る ;; 基本的にただの二分木走査。 (defmacro objs-each ((obj objs) &body body) (let ((self (gensym))) `(labels ((,self (,obj) (if (packaged-obj-p ,obj) (progn (,self (car (packaged-obj-pair ,obj))) (,self (cdr (packaged-obj-pair ,obj)))) (progn ,@body)))) (dolist (,obj ,objs) (,self ,obj))))) ;;;;;;;;; ;; [注釈] ;; ※1 objsのサイズについての注釈。 ;; objsのサイズは、一定回数のループを経ると、(1- (* (length src-objs) *))の値で安定する。 ;; この理由は、package-and-merge関数が行っていることをみれば分かる(以下参照)。 ;; 1] objsを半分にする。 ※ サイズが奇数になった場合は、末尾の要素を取り除く。 ;; 2] objsにsrc-objsを足す。 ;; つまり、サイズを(ほぼ)半分にした後に元のサイズを足す、ということを繰り返しており、 ;; その結果、上述の値で、objsのサイズが安定することになる。 ;; ;; このobjsのサイズが最初に安定するのは、(log objs 2)回のループを経た後。 ;; (log objs 2)は、(length objs)個のコードをエンコードするのに最低必要なビット長。 ;; ;; そして、--昨日の記事で作成した-- (optimal-bit-length #1#)回のループを経た後は、objsの要素は常に等しくなる。 ;; ;; 各ループでのpackage処理は、各コードを符号化する際に要するビット長を1増やすことに対応する。 ;; また、package処理でobjsのサイズが奇数の場合、出現回数(コスト)が大きいコードは ;; リストから除外されることになるので、結果として出現回数が小さいコードが残り易く(= 符号ビット長が長く)なる。 ;; ;; ;; ※2 bit-length-limitの指定が、各コードに最適な符号を割り当てるのに十分な長さとなっていた場合、 ;; packaging関数を適用する前のobjsの最後の要素(これは常にpackaged-obj型)は、 ;; 通常のハフマン符号を適用した場合に得られるハフマン木と同様の構造を有している。 ;; ;; つまり、長さ制限付きハフマン符号化のアルゴリズムも、内部的にはハフマン木の生成を行っていることになる。 ;; ※ そして、このハフマン木は、packaing関数によってobjsから取り除かれる ;; ;; 上の各ループは、ハフマン木の部分木をボトムアップに(?)作成してことに対応している。 ;; 以下は、その過程の大まかなイメージ。 ※ 適当 ;; 1] 一回目のループでは、最大ビット長(深さ)が1になる部分木のリストを作成 ;; 2] 二回目のループでは、最大ビット長(深さ)が1もしくは2になる部分木のリストを作成 ;; 3] 三回目のループでは、最大ビット長(深さ)が1もしくは2もしくは3になる部分木のリストを作成 ;; ... ;; N] N回目では、最大ビット長(深さ)が1もしくは、...、もしくはNになる部分木のリストを作成 ;; --> Nは、コード群に対して最適なハフマン符号を割り当てた場合の最大ビット長 ;; したがって、深さがNの部分木 = ハフマン木、となる
以前書いたコードでは、制限付きと制限無しのハフマン符号化アルゴリズムの類似性が良く分からなかったが、今回のコードではなんとなくそれが分かるように思う。
要は、
- 制限無しハフマン: 一番出現頻度(cost)が小さい二つの要素(コード)をまとめる(package)、ということをリストの要素が一つになるまで繰り返す
- 制限付きハフマン: 出現頻度が小さい順にリストの要素を二つずつまとめる(+ 毎ループでの要素補充)、ということを一定回数分(bit-length-limit)だけ繰り返す
- 制限無しは、ループ回数に制限がなく、制限付きは制限がある。 ※ その制限値が十分大きい場合は、制限無しハフマンと同じ結果となる
- 制限無しは、最低限必要なpackagingしか行わないが、制限付きは毎回全部(?)の要素のpackagingを行う。
- 出現頻度が低い要素(コード)から順にまとめていくのは同様。
とかそういった感じ。
残りは、上の関数の実行例。
計時などは、後で普通のハフマン符号とまとめて行う予定。
参照: read-binary-file
;; コードの出現頻度カウント関数 (defun count-frequency (file-path) (loop WITH freq = (make-array #x100 :element-type 'fixnum :initial-element 0) FOR c ACROSS (read-binary-file file-path) DO (incf (aref freq c)) FINALLY (return freq))) ;; 夏目漱石の『こころ』(UTF-8)のハフマン符号 ;; 最大13ビット > (calc-code->bitlength-table (count-frequency "/path/to/kokoro") 13) --> #(0 0 0 0 0 0 0 0 0 0 8 0 0 8 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0 0 0 0 0 11 13 13 13 13 13 13 13 13 13 13 13 13 13 0 0 0 0 0 0 0 0 0 0 0 0 0 0 13 13 0 0 0 0 0 0 0 0 13 0 0 0 0 13 0 0 0 0 0 0 0 0 13 0 0 0 0 0 13 13 13 13 0 0 13 0 13 13 0 13 0 13 13 0 13 0 13 13 0 0 0 0 0 4 3 4 8 6 8 7 8 7 7 6 5 6 7 9 7 8 8 7 7 8 8 8 6 9 7 9 8 9 7 10 6 8 8 10 7 8 8 6 6 7 8 7 6 9 8 6 7 8 9 10 9 10 9 9 9 7 9 7 8 8 8 7 8 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 11 2 7 5 6 6 7 7 0 0 0 0 0 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) ;; lsコマンド ;; 最大11ビット > (calc-code->bitlength-table (count-frequency "/bin/ls") 11) --> #(3 6 8 8 5 5 9 9 5 9 9 11 7 10 11 6 8 10 9 11 8 10 11 11 9 10 11 11 8 10 11 10 5 11 11 11 6 8 9 10 10 9 11 10 9 8 9 10 9 8 11 10 9 11 11 11 10 8 10 9 9 9 11 11 10 9 9 9 7 7 9 10 10 10 11 11 9 9 10 10 9 11 10 9 9 7 9 10 9 11 11 9 8 7 10 9 9 8 9 8 8 7 8 9 8 7 11 10 8 9 8 7 8 11 7 7 6 7 9 9 9 9 11 11 9 8 10 9 8 10 11 6 7 6 10 10 9 5 11 5 10 7 11 11 7 11 11 11 10 8 11 11 10 11 11 11 11 9 11 11 10 9 11 10 11 9 10 11 10 10 11 11 10 11 11 11 10 11 11 11 9 10 8 11 8 10 9 10 9 8 10 10 7 8 9 8 9 11 8 6 9 9 10 11 10 11 11 11 8 10 9 9 10 11 11 11 8 10 10 9 9 10 11 9 8 9 9 8 8 8 10 11 6 7 9 7 8 11 11 11 8 10 10 10 8 11 9 9 8 10 9 7 7 9 9 4)
###
何で上のアルゴリズム(コード)が、bit-length-limitの値が最適な符号化を行うために必要な最大ビット長よりも短い場合でも、その制限下で最適な符号を求められることが保証されるのかは、理解していない。
何となくそういう風になりそうなコードだな、とは思うのだが...。
いつかちゃんと理解したい。
