gzip圧縮
gzip圧縮/解凍器作成の４。
ようやくgzip圧縮器の作成に着手。
gzipパッケージ
今回は、DEFLATEフォーマットに準拠したデータの作成/書き出し部分の実装が主となるが、それに取りかかる前にgzipファイル作成用のユーティリティパッケージを定義しておく。コード的には、非圧縮gzipファイル作成に載せたものとほぼ同様。ただし若干修正している。
gzipフォーマットに関する詳細は、RFC1952(日本語訳)を参照のこと。
参照: crc, read-binary-file, octet
(defpackage :gzip (:use :common-lisp) (:export :create-default-gzip-file)) (in-package :gzip) (defun write-n-byte (n value binary-output-stream) ;; gzipはリトルエンディアン (dotimes (i n) (write-byte (ldb (byte 8 (* i 8)) value) binary-output-stream))) (defun write-default-gzip-header (#1=binary-output-stream) (write-byte #x1F #1#) ; ID1 (write-byte #x8B #1#) ; ID2 (write-byte #x08 #1#) ; Compression Method: deflate (write-byte #x00 #1#) ; Flags (write-n-byte 4 #x00000000 #1#) ; Modification Time (write-byte #x00 #1#) ; Extra Flags (write-byte #xFF #1#)) ; Operating System(OS): unknown (defun write-gzip-footer (crc isize #1=binary-output-stream) (write-n-byte 4 crc #1#) (write-n-byte 4 isize #1#)) ;; source-fileのデータに対して、圧縮関数compress-fnを適用し、結果をdestination-fileに出力する (defun create-default-gzip-file (source-file destination-file compress-fn) (with-open-file (in source-file :element-type 'octet) (with-open-file (out destination-file :element-type 'octet :direction :output :if-exists :supersede) ;; header (write-default-gzip-header out) ;; data (funcall compress-fn (read-binary-file in) out) ;; crc and isize (write-gzip-footer (crc (read-binary-file in)) ; CRC (mod (file-length in) #x100000000) ; ISIZE out))))
DEFLATEパッケージ
DEFLATEデータ作成/書き出しコード。
まずは、パッケージの作成とユーティリティ関数の定義など。
DEFLATEデータフォーマットの仕様に関する詳細は、RFC1951(日本語訳)を参照のこと。
参照: nlet, hash-trie, length-limited-huffman(修正版), bit-stream, lz77
;;;;;;;;;;;;;;; ;;;; パッケージ (defpackage :deflate (:use :common-lisp :bit-stream) (:export :deflate-fix :deflate-custom)) (in-package :deflate) ;;;;;;;;;;;;;;;;;;;;;;; ;;;; パッケージに別名を定義 (rename-package #1=:hash-trie #1# '(:trie)) (rename-package #1=:length-limited-huffman #1# '(:llh)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ユーティリティ関数など ;; アナフォリックwhen (defmacro a.when (expr &body body) `(let ((it ,expr)) (when ,expr ,@body))) ;; lz77:to-deflate-codes(=データ圧縮)の結果を、bit-streamに書き込む ;; "リテラル/長さ"コードおよび"戻り距離"コードは、それぞれlile-huffman-table、dist-huffman-tableに従って符号化される ;; この関数は以降の「固定ハフマン符号を使った圧縮」と「カスタムハフマン符号を使った圧縮」の両方で使用される (defun write-codes (deflate-codes lile-huffman-table dist-huffman-table bit-stream) (macrolet ((next-code (code rest) `(setf ,code (car ,rest) ,rest (cdr ,rest)))) (nlet self ((codes deflate-codes)) (when codes (destructuring-bind (code . rest) codes ;; "リテラル/長さ"コードの符号ビットを出力する (write-bits (aref lile-huffman-table code) bit-stream :reverse t) (when (lz77:length-code? code) ;; コードが"長さ"コードだった場合は、拡張ビットの有無をチェックする (a.when (lz77:extra-length code) (next-code code rest) ;; "長さ"の拡張ビットを出力 (write-bits (bits code it) bit-stream)) ;; "戻り距離"コードの符号ビットを出力する (next-code code rest) (write-bits (aref dist-huffman-table code) bit-stream :reverse t) ;; "戻り距離"コードの拡張ビットの有無をチェックする (a.when (lz77:extra-distance code) (next-code code rest) ;; "戻り距離"コードの拡張ビットを出力する (write-bits (bits code it) bit-stream))) (self rest))))) ;; ブロック終端コード(256)の符号ビットを出力する (write-bits (aref lile-huffman-table 256) bit-stream :reverse t))
固定ハフマン符号を使った圧縮
DEFLATEの圧縮には二種類の方法がある。
一つはあらかじめ決まっている固定のハフマン符号表を用いてコード列(lz77:to-deflate-codesの結果)の変換/出力(上記write-codes呼び出し)を行う方法で、もう一つはコード列から適切なハフマン符号を計算し、それを用いてコード列の変換/出力を行う方法。
より簡単なので、固定のハフマン符号表を用いる圧縮方法から始めることにする。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; 固定ハフマン符号を使った圧縮 ;;;; 参照: http://www.futomi.com/lecture/japanese/rfc1951.html#s3_2_6 ;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; 固定ハフマン符号作成 ;; "リテラル/長さ"用の固定ハフマン符号木 ※ lile = LIteral/LEngth (defvar *lile-fix-huffman-trie* (let ((trie (trie:make-trie))) (loop FOR i FROM 0 TO 143 DO ; 0-143のリテラルコードは、#b00110000から始まる8bit列に対応 (setf (trie:get-elem (bits (+ #b00110000 i) 8) trie) i)) (loop FOR i FROM 144 TO 255 DO ; 144-255のリテラルコードは、#b110010000から始まる9bit列に対応 (setf (trie:get-elem (bits (+ #b110010000 (- i 144)) 9) trie) i)) (loop FOR i FROM 256 TO 279 DO ; 257-279の"長さ"コードは、#b0000001から始まる7bit列に対応。ブロック終端コード(256)は#b0000000 (setf (trie:get-elem (bits (+ #b0000000 (- i 256)) 7) trie) i)) (loop FOR i FROM 280 TO 287 DO ; 280 - 287の"長さ"コードは、#b11000000から始まる8bit列に対応 (setf (trie:get-elem (bits (+ #b11000000 (- i 280)) 8) trie) i)) trie)) ;; "戻り距離"用の固定ハフマン符号木 ;; ※ 0-31の5bit表現が、そのまま使われる (defvar *dist-fix-huffman-trie* (let ((trie (trie:make-trie))) (dotimes (i 32 trie) (setf (trie:get-elem (bits i 5) trie) i)))) ;; ハフマン符号木から、ハフマン符号表を作成する (defun trie-to-code->bits-table (trie table-size) (let ((table (make-array table-size :element-type '#1=simple-bit-vector :initial-element #*))) (trie:map-trie (lambda (bit-list code) (setf (aref table code) (coerce bit-list '#1#))) trie) table)) ;; "リテラル/長さ"ハフマン符号表および"戻り距離"ハフマン符号表を作成 (defvar *lile-fix-huffman-table* (trie-to-code->bits-table *lile-fix-huffman-trie* 288)) (defvar *dist-fix-huffman-table* (trie-to-code->bits-table *dist-fix-huffman-trie* 32)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; DEFLATE圧縮(固定ハフマン符号) (defun deflate-fix (octets out) (with-bit-stream (out out) (write-bits #*1 out) ; BFINAL: 最終ブロックを指定 (write-bits #*01 out) ; BTYPE: 固定ハフマン符号を指定 ;; 固定ハフマン符号を使って、圧縮コードを出力する (write-codes (lz77:to-deflate-codes (lz77:encode octets)) *lile-fix-huffman-table* *dist-fix-huffman-table* out)))
gzip圧縮ファイル作成。
;; 夏目漱石の『こころ』(UTF-8)を固定ハフマン符号を使って圧縮 > (gzip:create-default-gzip-file "/path/to/kokoro" "kokoro.fix.gz" #'deflate-fix)
カスタムハフマン符号を使った圧縮
次は、コード列に対して最適なハフマン符号を計算して、それを用いる方法。※ RFC1951にはカスタムハフマン符号という名前。
計算したハフマン符号を(出力データの先頭に)保存しておくところが若干複雑。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; カスタムハフマン符号を使った圧縮 ;;;; 参照: http://www.futomi.com/lecture/japanese/rfc1951.html#s3_2_7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ハフマン符号関連 ;; コード列から、"リテラル/長さ"コードおよび"戻り距離"コードの出現数をカウントする ;; その結果は、length-limited-huffman:calc-code-bit-lengthに渡され、適切なハフマン符号を求めるために使用される ;; codes: lz77:to-deflate-codesの返り値 (defun count-frequency (codes) (let ((literal-length-freq (make-array 286 :initial-element 0)) (distance-freq (make-array 32 :initial-element 0))) ;; 以下のコードの構造は、概ね既出のwrite-codes関数と等しい ;; この関数の場合は、write-codesでコードを出力している箇所で、代わりにその出現数をカウントしている (macrolet ((next-code (code rest) `(setf ,code (car ,rest) ,rest (cdr ,rest)))) (nlet self ((codes codes)) (when codes (destructuring-bind (code . rest) codes (incf (aref literal-length-freq code)) ; "リテラル/長さ"コードのカウント (when (lz77:length-code? code) (and (lz77:extra-length code) (next-code code rest)) (next-code code rest) (incf (aref distance-freq code)) ; "戻り距離"コードのカウント (and (lz77:extra-distance code) (next-code code rest))) (self rest))))) (values literal-length-freq distance-freq))) ;; ハフマン符号表の未使用の末尾部分を取り除く ;; 未使用=符号ビット長が0 (defun remove-no-use-tail (huffman-table) (subseq huffman-table 0 (1+ (or (position-if #'plusp huffman-table :from-end t :key #'length) -1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; カスタムハフマン符号表保存関連 ;; ユーティリティ関数 ;; リスト内で同じ数値が続いた場合、(数値 . 連続する個数)形式に置換する ;; '(0 1 1 1 1 2 3 3) => '(0 (1 . 4) 2 (3 . 2)) (defun compact-number-list (list &aux (beg (car list))) (labels ((get-eql-num-count (num list &optional (cnt 1)) (if (eql num (car list)) (get-eql-num-count (car list) (cdr list) (1+ cnt)) (values cnt list)))) (when (consp list) (multiple-value-bind (cnt rest) (get-eql-num-count beg (cdr list)) (cons (if (= 1 cnt) beg `(,beg . ,cnt)) (compact-number-list rest)))))) ;; ハフマン符号表を受け取り、表の各コードの符号長を(圧縮した形式で)保持したリストを返す ;; 符号長リストの圧縮形式に関しては、http://www.futomi.com/lecture/japanese/rfc1951.html#s3_2_7を参照 (defun huffman-code-length-list (huffman-table) ;; 符号長0が複数続いた場合の圧縮を行う (labels ((zero-len-codes (count) (cond ((< count 3) (loop REPEAT count COLLECT 0)) ((< count 11) `(17 ,(bits (- count 3) 3))) ((< count 139) `(18 ,(bits (- count 11) 7))) (t `(18 #*1111111 ,@(zero-len-codes (- count 138)))))) ;; 同じ符号長が複数続いた場合の圧縮を行う (n-len-codes (n count) (cond ((< count 3) (loop REPEAT count COLLECT n)) ((< count 7) `(16 ,(bits (- count 3) 2))) (t `(16 #*11 ,@(n-len-codes n (- count 6))))))) (mapcan (lambda (n) (if (numberp n) (list n) (destructuring-bind (n . cnt) n (if (zerop n) (zero-len-codes cnt) `(,n ,@(n-len-codes n (1- cnt))))))) (compact-number-list (loop FOR bits ACROSS huffman-table COLLECT (length bits)))))) ;; "リテラル/長さ"及び"戻り距離"のハフマン符号長の情報を保存する (defun save-huffman-code-lengths (lile-huf-table dist-huf-table out) (let ((lile-len (length lile-huf-table)) (dist-len (length dist-huf-table))) (write-bits (bits (- lile-len 257) 5) out) ; HLIT: リテラル/長さ符号の個数 - 257 (write-bits (bits (- dist-len 1) 5) out) ; HDIST: 距離符号の個数 - 1 (write-bits (bits (- 19 4) 4) out)) ; HCLEN: 長さ符号の個数 - 4 ※ 簡単のためにこの値は固定 ;; "リテラル/長さ"及び"戻り距離"の符号長リストを取得 (let ((len-codes (huffman-code-length-list (concatenate 'vector lile-huf-table dist-huf-table))) ;; 符号長リスト(len-codes)用のハフマン符号を求め、出力する(以下7行) (len-freq (make-array 19 :initial-element 0))) (dolist (len (remove-if-not #'numberp len-codes)) (incf (aref len-freq len))) (let ((len-huf-table (llh:make-code->bits-table (llh:calc-code-bit-length len-freq 7)))) (dolist (i '(16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15)) (write-bits (bits (length (aref len-huf-table i)) 3) out)) ;; "リテラル/長さ"及び"戻り距離"の符号長リストを出力する (dolist (c len-codes) (if (numberp c) (write-bits (aref len-huf-table c) out :reverse t) (write-bits c out)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; DEFLATE圧縮(カスタムハフマン符号) (defun deflate-custom (octets out) (with-bit-stream (out out) (write-bits #*1 out) ; BFINAL: 最終ブロックを指定 (write-bits #*10 out) ; BTYPE: カスタムハフマン符号を指定 (let ((codes (lz77:to-deflate-codes (lz77:encode octets)))) (multiple-value-bind (lile-freq dist-freq) (count-frequency (cons 256 codes)) (let ((lile-huf-table (remove-no-use-tail ; "リテラル/長さ"コード用のハフマン符号表 (llh:make-code->bits-table (llh:calc-code-bit-length lile-freq 15)))) (dist-huf-table (remove-no-use-tail ; "戻り距離"コード用のハフマン符号表 (llh:make-code->bits-table (llh:calc-code-bit-length dist-freq 15))))) ;; ハフマン符号表の情報を(解凍時に復元できるように)保存する (save-huffman-code-lengths lile-huf-table dist-huf-table out) (write-codes codes ; カスタムハフマン符号を使ってlz77圧縮コードを出力 lile-huf-table dist-huf-table out))))))
gzip圧縮ファイル作成。
;; 夏目漱石の『こころ』(UTF-8)をカスタムハフマン符号を使って圧縮 > (gzip:create-default-gzip-file "/path/to/kokoro" "kokoro.custom.gz" #'deflate-custom)
以上で、固定ハフマン符号とカスタムハフマン符号を使ったDEFLATEの実装は終了。
圧縮率
各圧縮方法(+ gzipコマンド)での圧縮率を簡単に比較してみる。
### # まずは、ちゃんと圧縮できているかをチェック $ if gzip -dc kokoro.fix.gz | diff /path/to/kokoro - >/dev/null; then echo OK; fi OK $ if gzip -dc kokoro.custom.gz | diff /path/to/kokoro - >/dev/null; then echo OK; fi OK # 大丈夫っぽい ### # 圧縮率比較 # gzipコマンドを使って、デフォルト・低圧縮率・高圧縮率、の三種類のgzipファイルを作成する $ gzip -c /path/to/kokoro > kokoro.gz # デフォルト $ gzip -1c /path/to/kokoro > kokoro.1.gz # 低圧縮率 $ gzip -9c /path/to/kokoro > kokoro.9.gz # 高圧縮率 # 比較 $ du -h /path/to/kokoro *.gz 548K /path/to/kokoro 228K kokoro.1.gz 172K kokoro.9.gz 180K kokoro.custom.gz 212K kokoro.fix.gz 176K kokoro.gz
冬休み中にできたのはここまで。
残るはgzip解凍器。
