DAWG2(2): ソート済みファイルからのDAWG構築
前回はトライだったけど、今回はDAWGを構築。
Nをキーセットに含まれる文字の総数*1だとして、DAWGはトライと同様にO(N)で構築可能(多分間違っていないはず...)。
ただし、子ノード(サブトライ)が共有可能かどうかの判定が入るので、実際には一桁程度遅くなる。※ 今回の実装では。あとGCの処理時間は考えないものとしての話。
DAWGの作り方
基本的な流れはトライの場合と同様。
ただし、各サブトライが確定した段階で、既に構築済みのものの中に共有可能(構造的に等価)なサブトライがないかどうかをチェックし、もしあればその(既存の)サブトライを流用する、という点が異なる。
共有可能かどうかの判定にはハッシュテーブルを用いるが、各サブトライのハッシュ値の計算や等価性のチェックは、ダイナミックプログラミング的なことを行うことでO(1)で実行可能。
;;;; ノード(サブトライ)の等価性チェックとハッシュ値計算のコード ;; ノードの構造体定義 ;; 前回から少し変更している ;; - 前回は子ノード群をlist型に格納して保持。(car children)の次の兄弟は、(cadr children) ;; => 今回は、リンクリストを自前で実装。兄弟はsiblingスロットを辿ることで取得する ;; - hashスロットを追加。一度計算したノードのハッシュ値をキャッシュしておく (defstruct node (label 0 :type octet) (sibling nil :type (or null node)) (child nil :type (or null node)) (hash -1 :type fixnum)) ;; 二つのノード(サブトライ)が等しいかどうかをチェックする ;; - 子ノードと兄弟ノードのチェックはeqチェックで行う ;; -- もし二つの子(兄弟)ノードが等しいなら、既に共有されており、参照先は同じとなっているため。 (defun node= (node1 node2) (and (= (node-label node1) (node-label node2)) ; ラベル(バイト値)が等しい (eq (node-child node1) (node-child node2)) ; 同じ子ノードを参照している (eq (node-sibling node1) (node-sibling node2)))) ; 同じ(次の)兄弟ノードを参照している ;; ハッシュ値計算 (defun sxhash-node (node) (if (null node) (sxhash nil) (with-slots (hash) node (when (= -1 hash) ;; ハッシュ値を計算してキャッシュ ;; 一つのノードにつき、この部分が実行されるのは一度だけ (setf hash (logxor (sxhash (node-label node)) (* (sxhash-node (node-child node)) 7) (* (sxhash-node (node-sibling node)) 13)))) hash)))
ソースコードの場所
ソースコードは末尾に掲載。
前回から(DAWG部分以外の)基本的なロジックには変化はないが、いろいろと整理したため、構成が結構(若干?)変わっている。
現状のものに対応するソースはgithubのcl-dawgからも参照可能*2。
計測
計測。
データは前回使ったWikipediaのタイトルに加えて、二千万個程度の文字四グラムも使用する。
# 適当なテキストデータから集めた文字四グラム $ wc -l 4gram 21139008 4gram $ ls -lh 4gram -rw-r--r-- 1 user user 251M 2010-08-23 23:28 4gram $ ls -lh wiki.title.* -rw-r--r-- 1 user user 52M 2010-10-15 23:38 wiki.title.250 -rw-r--r-- 1 user user 11M 2010-10-15 23:38 wiki.title.50 -rw-r--r-- 1 user user 103M 2010-10-15 23:37 wiki.title.500 $ head -10000000 4ngram | tail シを露出 シを頂い シを頂き シを頂戴 シを食っ シを食べ シを飲み シを飲ん シを飼っ シを飼料
;;;; sbcl-1.0.40 ;; (require :dawg) ;; Wikipediaタイトル: 50万行 (let ((dawg)) (time (setf dawg (dawg:build-from-file "wiki.title.50"))) (dawg:node-count dawg)) Evaluation took: 11.546 seconds of real time 11.516720 seconds of total run time (10.960685 user, 0.556035 system) [ Run times consist of 5.248 seconds GC time, and 6.269 seconds non-GC time. ] 99.75% CPU 23,034,806,052 processor cycles 333,611,112 bytes consed --> 3226450 ; ノード数: 323万 ;; Wikipediaタイトル: 250万行 (let ((dawg)) (time (setf dawg (dawg:build-from-file "wiki.title.250"))) (dawg:node-count dawg)) Evaluation took: 45.157 seconds of real time 44.906806 seconds of total run time (43.354709 user, 1.552097 system) [ Run times consist of 18.469 seconds GC time, and 26.438 seconds non-GC time. ] 99.45% CPU 90,096,322,491 processor cycles 1,370,862,696 bytes consed --> 10406702 ; ノード数: 1041万 ;; Wikipediaタイトル: 500万行 ;; - 前回(トライ)ではメモリが足りなくなったが、今回は無事終了 (let ((dawg)) (time (setf dawg (dawg:build-from-file "wiki.title.500"))) (dawg:node-count dawg)) Evaluation took: 82.800 seconds of real time 82.437152 seconds of total run time (80.297018 user, 2.140134 system) [ Run times consist of 37.622 seconds GC time, and 44.816 seconds non-GC time. ] 99.56% CPU 165,198,822,447 processor cycles 1,900,704,328 bytes consed --> 16180565 ; ノード数: 1618万 ;; 四グラム: 2000万行 (let ((dawg)) (time (setf dawg (dawg:build-from-file "4gram"))) (dawg:node-count dawg)) Evaluation took: 125.930 seconds of real time 123.807738 seconds of total run time (120.575536 user, 3.232202 system) [ Run times consist of 55.635 seconds GC time, and 68.173 seconds non-GC time. ] 98.31% CPU 251,251,154,700 processor cycles 2,613,241,344 bytes consed --> 16660713 ; ノード数: 1666万
構築時間は、キー数に対してだいたい線形で、トライに比べると遅いが(自分的には)許容可能な範囲。
ノード数はWikipediaのタイトルの場合は2〜3分の1に減っている*3。
四グラムの方は比較対象がないので何とも云えないが、データの性質上、末尾の重複も多いはずなので、Wikipediaのタイトルよりも圧縮率は高そう。
ソースコード
ハッシュ関数を独自実装するために、SBCLの拡張機能を使っているので、SBCL依存。
;;;; ファイル名: package.lisp ;;;; ;;;; パッケージ/スペシャル変数/型/定数 の定義 (defpackage dawg (:use :common-lisp) (:export build-from-file member? node-count)) (in-package :dawg) ; ver 0.0.3 ;; 宣言(declare)用のスペシャル変数 (defvar *fastest* '(optimize (speed 3) (safety 0) (debug 0))) (defvar *interface* '(optimize (speed 3) (safety 2) (debug 1))) (defvar *muffle-warning* #+SBCL '(sb-ext:muffle-conditions sb-ext:compiler-note) #-SBCL '()) ;; 型定義 (deftype octet () '(unsigned-byte 8)) (deftype octets () '(vector octet)) (deftype simple-octets () '(simple-array octet)) (deftype array-index () `(mod ,array-dimension-limit)) ;; 何ビットまでがfixnumに収まるか (defconstant +FIXNUM-LENGTH+ (integer-length most-positive-fixnum))
;;;; ファイル名: util.lisp ;;;; ;;;; 雑多なユーティリティ関数/マクロ (in-package :dawg) (defconstant +LINE-FEED+ #\Newline) (defconstant +BUFFER-SIZE-LIMIT+ 102400) (declaim (inline string-to-octets each-file-line-bytes-impl fixnumize)) (defmacro package-alias (package &rest alias-list) `(eval-when (:compile-toplevel :load-toplevel :execute) (rename-package ,package ,package ',alias-list))) (defun string-to-octets (str) #+SBCL (sb-ext:string-to-octets str) #-SBCL (error "TODO: error message")) (defun fixnumize (n) (ldb (byte +FIXNUM-LENGTH+ 0) n)) (defmacro each-file-line-bytes ((line-bytes start end filepath) &body body) `(each-file-line-bytes-impl (lambda (,line-bytes ,start ,end) (declare (simple-octets ,line-bytes) ((mod #.array-dimension-limit) ,start ,end)) ,@body) ,filepath)) (defun each-file-line-bytes-impl (fn filepath) (declare #.*muffle-warning* #.*fastest* (function fn)) (with-open-file (in filepath :element-type 'octet) (let* ((buffer-size (min (or (file-length in) #1=+BUFFER-SIZE-LIMIT+) #1#)) (buf (make-array buffer-size :element-type 'octet)) (read-start 0) (lf (char-code +LINE-FEED+)) (stack '())) (loop FOR read-len = (read-sequence buf in :start read-start) DO (loop WITH start = 0 FOR lf-pos = (position lf buf :start read-start :end read-len) THEN (position lf buf :start start :end read-len) WHILE lf-pos DO (if (null stack) (funcall fn buf start lf-pos) (let ((bytes (apply #'concatenate 'octets (nreverse (cons (subseq buf start lf-pos) stack))))) (funcall fn bytes 0 (length bytes)) (setf stack nil))) (setf start (1+ lf-pos)) FINALLY (setf read-start 0) (if (zerop start) (push (copy-seq buf) stack) (progn (setf read-start (- read-len start)) (replace buf buf :end1 read-start :start2 start :end2 read-len)))) (when (< read-len buffer-size) (return))))))
;;;; ファイル名: byte-stream.lisp ;;;; ;;;; バイト列をストリームとして扱うための構造体や関数定義 (defpackage dawg.byte-stream (:use :common-lisp) (:shadow :common-lisp read peek) (:export make read peek eat eos?)) (in-package :dawg.byte-stream) (declaim (inline make read peek eat eos?)) (defstruct (byte-stream (:constructor make (bytes &key (start 0) (end (length bytes)) &aux (cur start)))) (bytes #() :type dawg::simple-octets) (cur 0 :type dawg::array-index) (end 0 :type dawg::array-index)) (defun eat (in) (declare #.dawg::*fastest*) (incf (byte-stream-cur in)) in) (defun eos? (in) (declare #.dawg::*fastest*) (>= (byte-stream-cur in) (byte-stream-end in))) (defun peek (in) (declare #.dawg::*fastest*) (if (eos? in) 0 (with-slots (bytes cur) in (aref bytes cur)))) (defun read (in) (declare #.dawg::*fastest*) (prog1 (peek in) (eat in)))
(in-package :dawg) (package-alias :dawg.byte-stream :byte-stream) (declaim (inline make-node)) (defstruct node (label 0 :type octet) (sibling nil :type (or null node)) (child nil :type (or null node)) (hash -1 :type fixnum)) ;; ハッシュテーブル用: 二つのノードの等価性チェック (defun node= (n1 n2) (declare #.*fastest*) (and (= (node-label n1) (node-label n2)) (eq (node-child n1) (node-child n2)) (eq (node-sibling n1) (node-sibling n2)))) ;; ハッシュテーブル用: ノードのハッシュ値を計算する (defun sxhash-node (node) (declare #.*fastest*) (if (null node) #.(sxhash nil) (with-slots (hash) (the node node) (when (= -1 hash) (setf hash (logxor (sxhash (node-label node)) (fixnumize (* (sxhash-node (node-child node)) 7)) (fixnumize (* (sxhash-node (node-sibling node)) 13))))) hash))) ;; nodeと構造的に同じ既存のノード(サブトライ)が存在するかどうかをチェックし、 ;; 存在する場合は既存のノードを返す。 ;; ※ 名前は適当 (defun memoize (node memo) (declare #.*fastest*) (if (null node) nil (or (gethash node memo) ; 同じノードが存在する? (progn ;; 上のチェックで該当するノードが見つからなかった場合: ;; まず子や兄弟に対して、共有チェックを行う (setf (node-child node) (memoize (node-child node) memo) (node-sibling node) (memoize (node-sibling node) memo)) ;; 子や兄弟更新後に、もう一度チェック (gethash node memo)) ;; ユニークなノードなので、新たに追加する (setf (gethash node memo) node)))) (defun push-child (in parent) (declare #.*fastest*) (let ((new-node (make-node :label (byte-stream:peek in)))) ;; parentの先頭の子ノードを新しいノードに入れ替える ;; 今まで先頭だった子ノードは、new-nodeの兄弟ノードに (setf (node-sibling new-node) (node-child parent) (node-child parent) new-node) (unless (byte-stream:eos? in) (push-child (byte-stream:eat in) new-node)))) (defun insert (in parent memo) (declare #.*fastest*) (let ((node (node-child parent))) (if (or (null node) (/= (byte-stream:peek in) (node-label node))) (progn ;; 以下の一行以外は、前回と基本的に同様 (setf (node-child parent) (memoize node memo)) ; 共有チェックを行う (push-child in parent)) (insert (byte-stream:eat in) node memo)))) (sb-ext:define-hash-table-test node= sxhash-node) ; 独自のハッシュ関数を定義 (SBCL拡張機能) (defun build-from-file (filepath) (declare #.*fastest*) (let* ((trie (make-node)) (memo (make-hash-table :test #'node=)) ; 共有可能かどうかを判定するためのハッシュテーブル (cnt 0)) (declare (fixnum cnt)) (each-file-line-bytes (bytes beg end filepath) ;; 進捗表示: 外し忘れてた ... (when (zerop (mod (incf cnt) 5000)) (print (list (hash-table-count memo) cnt))) (let ((in (byte-stream:make bytes :start beg :end end))) (declare (dynamic-extent in)) (values (insert in trie memo)))) (setf trie (memoize trie memo)) ; 共有チェックを行う trie)) (defun member?-impl (in node) (declare #.*fastest*) (cond ((null node) nil) ((= (byte-stream:peek in) (node-label node)) (or (byte-stream:eos? in) (member?-impl (byte-stream:eat in) (node-child node)))) ((< (byte-stream:peek in) (node-label node)) (member?-impl in (node-sibling node))))) (defun member? (key trie) (declare #.*fastest*) (let ((in (byte-stream:make (string-to-octets key)))) (member?-impl in (node-child trie)))) (defun node-count-impl (node memo) (when (and node (not (gethash node memo))) (setf (gethash node memo) t) (node-count-impl (node-child node) memo) (node-count-impl (node-sibling node) memo))) (defun node-count (trie) (let ((memo (make-hash-table :test #'eq))) (node-count-impl trie memo) (hash-table-count memo))) (package-alias :dawg.byte-stream)