LZ77圧縮 -DEFLATE用-
gzip圧縮/解凍器作成の３。
軽く整理
- gzipはデータの圧縮に(主に)DEFLATEアルゴリズム(or DEFLATE圧縮データフォーマット)を利用している
- DEFLATEでは以下のような方法でデータの圧縮が行われる
- 入力データをLZ77アルゴリズムで圧縮する
- 上記圧縮データをさらにハフマン符号化を用いて圧縮する
- gzipはRFC1952で、DEFLATEはRFC1951で定義されている ※ 左のリンク先は、どちらもその日本語訳
今回は、この内のLZ77による圧縮(及び解凍)を扱う。
LZ77
まず、RFC1951内でLZ77の要旨について言及している箇所を引用する。
圧縮データ(LZ77圧縮データ ※引用者注)は、2 種類の連続要素から構成されます。（前の 32K 入力バイトの中に複製されたと検出されなかったストリングの）文字バイトと、複製されたストリングへのポインターです。そのポインターは、一対の <長さ、戻る距離> として表現されるものです。"deflate" フォーマットで使われるその表現は、距離を 32K バイトまでに、長さを 258 バイトまでに制限されています。
RFC 1951 DEFLATE Compressed Data Format Specification version 1.3 日本語訳 - futomi's CGI Cafe
これだけでは分かりにくいので少し補足しつつLZ77アルゴリズムをまとめてみると、多分次のようになる。※ RFC1951から判断する限り
- 入力データを順に走査する
- 現在走査している箇所から始まるデータが既にどこかで出てきているかをチェックする 重複データの検出
- 重複がある場合は、その分のデータを<長さ(重複するデータ長)、戻る距離(現在位置-重複検出位置)>で置き換える
- 例えば、"abc123abc456"という文字列の場合は、"abc123<3,6>456"と置換されることになる
- 残りのデータを走査し、同様の処理を行う
これに加えて、DEFLATEの場合は長さが最大258バイト(※最小は3バイト)、戻り距離が最大32Kバイトという制限がある。
これを実装したのが以下のコード。
参照: find-max, octet, nlet-acc, nlet
;;;;;;;;;;;;;;; ;;;; パッケージ (defpackage lz77 (:use :common-lisp) (:export :encode ; 圧縮関数 :decode ; 解凍関数 :to-deflate-codes :from-deflate-codes)) (in-package :lz77) ;;;;;;;;; ;;;; 定数 (defconstant MAX-LENGTH 258) ; LZ77の"長さ"の最大長 (defconstant MIN-LENGTH 3) ; LZ77の"長さ"の最小長 (defconstant BACKWORD-DISTANCE-LIMIT #x8000) ; LZ77の"戻り距離"の最大長 ;;;;;;;;;;; ;;;; 構造体 ;; 重複(一致)情報を保持する構造体 (defstruct (match (:constructor match (length backword-distance))) length backword-distance) ;; 簡便なアクセサ (defmacro match-len (match) `(match-length ,match)) (defmacro match-dist (match) `(match-backword-distance ,match)) (defmethod print-object ((o match) stream) (format stream "<~D,-~D>" (match-len o) (match-dist o))) ;;;;;;;;;;;;;;;; ;;;; encode関数系 ;; 候補の中から、最も長い一致を見つけて返す ;; ary: 入力データ ;; cur-pos: 現在の走査位置 ;; chained-pos-list: cur-posから始まるデータと、最初の三要素が一致した位置のリスト (defun maximal-length-match (ary cur-pos chained-pos-list) (multiple-value-bind (pos length) (find-max (lambda (chained-pos) (let ((start1 (+ MIN-LENGTH chained-pos)) (start2 (+ MIN-LENGTH cur-pos)) (end1 (min cur-pos (+ chained-pos MAX-LENGTH)))) (if (> start1 end1) ;; 開始位置が終了位置を越えている(cur-posとchained-posにデータ共有がある)場合は、0を返す 0 ;; 一致数を求める (- (or (mismatch ary ary :start1 start1 :end1 end1 :start2 start2) end1) chained-pos)))) chained-pos-list) (when (and pos (not (zerop length))) ;; 一致するデータある場合は、match構造体を作成する (match length (- cur-pos pos))))) ;; LZ77アルゴリズムを用いて入力の(一次元)配列を圧縮する ;; 重複(一致)データの判定方法は http://www.futomi.com/lecture/japanese/rfc1951.html#s4 を参考にしている ;; ※ ただし、現時点ではソースコードの可読性を優先しているため、非効率な(及び圧縮率最大ではない)実装となっている (defun encode (ary) (let ((chain (make-hash-table :test #'equalp)) ; 一致候補位置のリストを保持するchainedハッシュテーブル (acc '()) ; エンコード結果を保持するリスト (prev-end -1) ; 重複データの終了位置を保持する変数 (len (length ary))) ; 入力データ長 ;; 遠すぎる(= 32KB以上戻る必要がある)一致位置を候補から削除する関数 (flet ((chain-delete-far-pos (key cur-pos) (setf #1=(gethash key chain) (delete-if (lambda (pos) (> (- cur-pos pos) BACKWORD-DISTANCE-LIMIT)) #1#)))) (loop FOR i FROM 0 BELOW len FOR key = (subseq ary i (min (+ i MIN-LENGTH) len)) DO (unless (< i prev-end) ; 現在位置が、以前重複を検出したデータの範囲内なら、処理を飛ばす (chain-delete-far-pos key i) ;; 重複データを取得する (let ((m (maximal-length-match ary i (gethash key chain)))) (if m ;; 重複あり: match構造体を追加 (progn (push m acc) (setf prev-end (+ i (match-len m)))) ;; 重複なし: リテラルデータを追加 (push (aref ary i) acc)))) ;; chainedハッシュテーブルに一致候補位置を追加する (push i (gethash key chain))) (nreverse acc)))) ;;;;;;;;;;;;;;; ;;;; decode関連 ;; 上記encode関数により返されたリストをデコード(解凍)する ;; element-type: デコードされる配列の要素の型 ;; encoded-list: encode関数の戻り値 ;; previous-data: encoded-listの前に続くデータ。encoded-listが入力データの途中の部分から始まる場合、match構造体を実際にデータで展開するために必要 (defun decode (element-type encoded-list &optional (previous-data (make-array 0))) (let ((buf (make-array #1=(length previous-data) :element-type element-type :initial-contents previous-data :fill-pointer #1# :adjustable t))) (loop FOR e IN encoded-list COLLECT (if (not (match-p e)) ;; リテラルデータを追加 (vector-push-extend e buf) ;; match構造体は、buf[現在位置-戻り距離,長さ]のデータに展開して追加 (loop FOR i FROM (- (fill-pointer buf) (match-dist e)) REPEAT (match-len e) DO (vector-push-extend (aref buf i) buf)))) (copy-seq buf)))
例:
参照: read-file, read-binary-file
;; データ: 夏目漱石『こころ』 > (in-package :common-lisp-user) > (defvar *kokoro* (read-file "/path/to/kokoro")) > (defvar *kokoro-octets* (read-binary-file "/path/to/kokoro")) ; これは後で使う ;; オリジナルデータ > (subseq *kokoro* 0 500) "こころ 夏目漱石 ------------------------------------------------------- 【テキスト中に現れる記号について】 《》：ルビ （例）私《わたくし》はその人を常に先生と呼んでいた ｜：ルビの付く文字列の始まりを特定する記号 （例）先生一人｜麦藁帽《むぎわらぼう》を ［＃］：入力者注 主に外字の説明や、傍点の位置の指定 （数字は、JIS X 0213の面区点番号、または底本のページと行数） （例）※［＃「てへん＋劣」、第3水準1-84-77］ ------------------------------------------------------- 上 先生と私 一 私《わたくし》はその人を常に先生と呼んでいた。だからここでもただ先生 と書くだけで本名は打ち明けない。これは世間を憚《はば》かる遠慮というよ りも、その方が私にとって自然だからである。私はその人の記憶を呼び起すご とに、すぐ「先生」といいたくなる。筆を執《と》っても心持は同じ事である。 よそよそしい" ;; LZ77圧縮結果 > (format nil "~{~A~}" (lz77:encode (subseq *kokoro* 0 500))) "こころ 夏目漱石 ---<3,-3><6,-6><12,-12><24,-24><7,-7> 【テキスト中に現れる記号について】<4,-78>《》：ルビ （例）私《わたくし》はその人を常に先生と呼んでいた<4,-36>｜<3,-35>の付 く文字列の始まりを特定す<3,-66><5,-52>先生一人｜麦藁帽《むぎわらぼう》 を<4,-47>［＃］：入力者注 主に外字の説明や、傍点の位置の指定 （数字は、JIS X 0213の面区点番号、または底本のページと行数）<5,-92> ※［＃「てへん＋劣」、第3水準1-84-77］<59,-257><4,-127>上 <3,-218>私<4,-12> <5,-141> 一<5,-10><22,-253>。だからここでもただ<3,-18>書くだけで本名 は打ち明けない。これは世間を憚《はば》かる遠慮というよりも、その方が私に とって自然<3,-60>である。私<4,-84>の記憶を呼び起すごとに、すぐ「先生」と いいたくなる。筆を執《と》っても心持は同じ事<4,-50>よそよそしい" > (length (lz77:encode (subseq *kokoro* 0 500))) --> 327 ; 500文字を対象にした場合、要素数的には約65%に圧縮されている
DEFLATE用コード列に変換
ここまででLZ77の基本的な実装は終了したが、DEFLATEで利用するには、さらにlz77:encode関数の結果を加工し整数列に変換する必要がある。
変換の仕様は若干ややこしいので、オリジナルの文書(RFC1951「3.2.5. 圧縮ブロック (長さ・距離コード)」)を参照してもらうとして、ここではそのためのコードだけを載せておくことにする。
(in-package :lz77) ;;;;;;;;;;;;; ;;;; 補助関数 ;; ツリーをリストに変換する: ex. (flatten '((1) 2 ((3 4))) => '(1 2 3 4) (defun flatten (lst) (nlet-acc self ((x lst)) (if (consp x) (progn (self (car x)) (self (cdr x))) (when x (accumulate x))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; to-deflate-codes関数系 ;; lz77の"長さ"をDEFLATE用のコードに変換する (defun length-to-code (n) (let* ((n-3 (- n 3)) (len (integer-length n-3)) (len-3 (- len 3))) (case n ((3 4 5 6 7 8 9 10) (+ 254 n)) (258 285) (otherwise (multiple-value-bind (base extra) (floor n-3 (expt 2 len-3)) `(,(+ 257 (* 4 len-3) base) ,extra)))))) ;; lz77の"戻り距離"をDEFLATE用のコードに変換する (defun distance-to-code (n) (let* ((n-1 (1- n)) (len (integer-length n-1)) (len-2 (- len 2))) (case len ((0 1 2) n-1) (otherwise (multiple-value-bind (base extra) (floor n-1 (expt 2 len-2)) `(,(+ (* 2 len-2) base) ,extra)))))) ;; match構造体(<長さ,戻り距離>)をDEFLATE用のコード(コード列)に変換する (defun match-to-code (match) (list (length-to-code (match-len match)) (distance-to-code (match-dist match)))) ;; NOTE: 256(ブロック終端を示すコード)は返り値のリストに含めない ;; lz77:encode関数の結果を、DEFLATE用のコード列に変換する (defun to-deflate-codes (encoded-list) (flatten (loop FOR e IN encoded-list COLLECT (etypecase e (octet e) (match (match-to-code e)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; from-deflate-codes関数系 ;; コード列からmatch構造体を復元する (defun match-from-codes (codes) (let ((code (car codes)) (m (match 0 0))) ;; コード列から、match-lengthの値を復元する (setf (match-len m) (cond ((<= 257 code 264) (- code 254)) ((= code 285) 258) (t (let ((md (mod (1- code) 4)) (pw (ceiling (- code 264) 4))) (prog1 (+ (+ 3 (expt 2 (+ pw 2))) (* md (expt 2 pw)) (second codes)) (setf codes (cdr codes))))))) (setf codes (cdr codes) code (car codes)) ;; コード列から、match-backword-distanceの値を復元する (setf (match-dist m) (if (<= 0 code 3) (1+ code) (let ((md (mod code 2)) (pw (ceiling (- code 3) 2))) (prog1 (+ (1+ (expt 2 (1+ pw))) (* md (expt 2 pw)) (second codes)) (setf codes (cdr codes)))))) ;; 復元したmatch構造体と残りのコード列を返す (values m (cdr codes)))) ;; NOTE: codesには、256(ブロック終端を示すコード)は含まれないことが前提。 ※ codesの終端 = ブロックの終端 ;; to-deflate-codes関数の結果を、encode関数の結果に復元する ;; (equalp #1=(encode ...) (from-deflate-codes (to-deflate-codes #1#))) ==> T (defun from-deflate-codes (codes) (flet ((literal? (code) (<= 0 code 255)) (end-of-block? (code) (= code 256))) (nlet self ((codes codes) acc) (if (null codes) (nreverse acc) (destructuring-bind (code . rest) codes (cond ((literal? code) #|リテラルデータ|# (self rest (cons code acc))) ((end-of-block? code) #|終端コード:不正|# (error "Unexpected code ~A" code)) (t #|エンコードされた<長さ、戻り距離>データ|# (multiple-value-bind (match rest) (match-from-codes codes) (self rest (cons match acc))))))))))
例:
> (in-package :common-lisp-user) ;; 『こころ』のバイトデータをLZ77で圧縮 > (defvar *lz77* (lz77:encode *kokoro-octets*)) --> *LZ77* > (subseq *lz77* 10000 10050) --> (<16,-20268> <5,-1627> <11,-4572> <6,-9255> <25,-479> <4,-1456> <4,-587> <14,-10087> <15,-5807> <8,-19944> <6,-2031> <6,-4979> <8,-25767> <12,-57> <8,-13692> <7,-9410> <10,-6635> <23,-8895> <15,-6557> <18,-17588> <4,-16505> 138 177 <11,-2567> <6,-4006> <12,-2573> <7,-20087> <24,-13794> <3,-179> 233 135 <6,-1683> <3,-562> <3,-1003> <6,-14312> <10,-15528> <23,-27616> 167 <9,-997> <26,-9476> <3,-640> 183 <8,-16529> <6,-2897> <3,-536> <7,-16532> <5,-3713> <5,-365> <7,-23861> 175) ;; DEFLATE用のコード列に変換 > (lz77:to-deflate-codes *) --> (267 1 28 3883 259 21 90 265 0 24 475 260 26 1062 270 2 17 94 258 20 431 258 18 74 266 1 26 1894 267 0 24 1710 262 28 3559 260 21 494 260 24 882 262 29 1190 265 1 11 8 262 27 1403 261 26 1217 264 25 490 270 0 26 702 267 0 25 412 268 1 28 1203 258 28 120 138 177 265 0 22 518 260 23 933 265 1 22 524 261 28 3702 270 1 27 1505 257 14 50 233 135 260 21 146 257 18 49 257 19 234 260 27 2023 264 27 3239 270 0 29 3039 167 263 19 228 270 3 26 1283 257 18 127 183 262 28 144 260 22 848 257 18 23 261 28 147 259 23 640 259 16 108 261 28 7476 175) > (defvar *codes* (lz77:to-deflate-codes *lz77*)) --> *CODES* ;; 復元テスト > (equalp (lz77:from-deflate-codes *codes*) *lz77*) --> T ;; 各々の列の長さ > (length *kokoro-octets*) --> 554722 > (length *lz77*) --> 84091 > (length *codes*) --> 234288
以上で、DEFLATEのLZ77に関する実装は(ほぼ)終了。
2010/01/05: 関数追加
DEFLATE処理用の便利関数をいくつか追加。
;;;;;;;;;;;;;;; ;;;; パッケージ修正 (defpackage lz77 (:use :common-lisp) (:export :encode :decode :to-deflate-codes :from-deflate-codes ;; この下の三つを追加 :length-code? :extra-length :extra-distance)) (in-package :lz77) ;;;;;;;;;;;;; ;;;; 追加関数 ;; コードが"長さ"を表しているかどうか (defun length-code? (code) (<= 257 code 285)) ;; "長さ"コードに付随する拡張コードのビット数 ;; 拡張コードが続かない場合は、nilが返される (defun extra-length (code) (if (<= 265 code 284) (let ((base (- code 261))) (values (floor base 4))) nil)) ;; "戻り距離"コードに付随する拡張コードのビット数 ;; 拡張コードが続かない場合は、nilが返される (defun extra-distance (code) (if (<= 4 code 29) (let ((base (- code 2))) (values (floor base 2))) nil))
