ソート済みファイルからO(1)のメモリ使用量でDoubleArrayを構築する方法 #後半

昨日の続き。
今回は主に、前回のtrieパッケージでは未定義だったchange-active-node関数を埋めていくことになる。
※ ちなみに今回は'後半'となっているけど、まだ後続がある・・・。詳しくはソースコード内のコメントを参照。

実装: DoubleArray構築パッケージ

基本的な考え方は前回に説明済みなので、冒頭から実装に入る。
まずはDoubleArray構築用のパッケージから実装。

(defpackage da-build
  (:use :common-lisp)
  (:export build))
(in-package :da-build)

;;; 依存パッケージ
;; octet-stream: SBCL等のユニコード文字列をバイトストリームとして扱うためのパッケージ
;; - http://d.hatena.ne.jp/sile/20110807/1312720282
(rename-package :octet-stream :octet-stream '(:stream))

;; ファイルへのランダムアクセス(書き込み)を効率的に行うためのパッケージ
;; - DoubleArrayのファイルアクセスパターンに特化
;; - 使用メモリ量はO(1)  ※ パッケージ内で定義されている定数値に依存
;; - 機能的には(= 速度を考慮しなければ)、通常のファイルストリームとほとんど差異はない
;; - 実装は次回の記事に掲載する ※ 今回まとめて載せてしまうと煩雑なので・・・
(rename-package :buffered-output :buffered-output)

;; DoubleArrayのノード割り当てを管理するためのパッケージ
;; - 割当対象のノードの子ノードリストを受け取り、利用可能な空きノード(BASE値)を返す'allocate関数'を有する
;; - 使用メモリ量は(1) ※ パッケージ内で定義されている定数値に依存
;; - 実装は次回の記事に掲載する ※ 今回まとめて載せてしまうと煩雑なので・・・
(rename-package :node-allocator :node-allocator)

使用する構造体と定数。

;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; トライのノード関連 ;;;
;; ベースとなるノード構造体
(defstruct node
  (label 0 :type (unsigned-byte 8)))  ; ノードのラベル(遷移バイト)

;; 構築途中のノード
;; 前回の図の白色のノードに対応する
(defstruct (active-node (:include node))
  (children '() :type list))          ; 子ノードのリスト

(defmacro active-node-first-child (node)  ; 最初の子ノードにアクセスするマクロ
  `(car (active-node-children ,node)))

;; 構築済みのノード
;; 前回の図のオレンジ or 灰色のノードに対応する
(defstruct (fixed-node (:include node))
  (base-idx 0 :type (unsigned-byte 32))) ; 子ノードに遷移する際に起点となるBASEインデックス

;;;;;;;;;;;;;;;;;;;;;;;
;;; DoubleArray関連 ;;;
(defstruct da
  (alloca nil :type node-allocator:node-allocator)     ; ノードアロケーター
  (base   nil :type buffered-output:buffered-output)   ; BASE値用の出力ストリーム
  (chck   nil :type buffered-output:buffered-output))  ; CHCK値用の出力ストリーム

;;;;;;;;;;;;;
;;; 定数 ;;;
;; 文字列終端を表すラベル  
;; ※ 0x00(未使用ノード用) 及び 0xFF(終端ノード用) は特殊バイトとして予約されているためキー文字列(バイト列)に含むことはできない
(defconstant +EOS_LABEL+ #xFF) 
(defconstant +EOS_BASE_VALUE+ #x00) ; 終端ノードが保持する値。任意の値で構わないが適当に定義しておく。(通常は終端ノードのBASE値にキーのID値等を格納する)

次は(最後は)、構築用の関数。
二部に分けて、まずは前回もあった関数から。
change-active-node関数以外は、ほぼ前と同様の内容(異なる箇所にはコメントを記述)

(defun build (filepath output-dir)
  (with-da (da output-dir)  ; ノード割当 及び ファイルへの出力用に da構造体を作成する
    (with-open-file (in filepath)
      (loop WITH trie = (make-active-node)    ; (make-node) => (make-active-node)
            FOR line = (read-line in nil nil)
            WHILE line
        DO
        (insert (stream:make line) trie da)
        FINALLY
        (change-active-node trie da)
        (write-root-node trie da)))) ; ルートノードの情報をファイルに出力する
  :done)

;; 以降の二つの関数は前回と同様 (node-XXX が active-node-XXX に置換されている点以外は)
(defun insert (in parent da &aux (node (active-node-first-child parent)))
  (if (null node)
      (insert-new-nodes in parent)
    (if (/= (stream:peek in) (node-label node))
        (progn (change-active-node parent da)
               (insert-new-nodes in parent))
      (insert (stream:eat in) node da))))

(defun insert-new-nodes (in parent)
  (if (stream:eos? in)
      (push (make-active-node :label +EOS_LABEL+) (active-node-children parent))
    (let ((new-node (make-active-node :label (stream:read in))))
      (push new-node (active-node-children parent))
      (insert-new-nodes in new-node))))

;; 構造が確定したノードに対して、以下の二つの処理を行う
;; - 1] 確定したノードの子ノードをDoubleArrayに変換して、ファイルに出力する
;; - 2] 確定したノードの色を白色(active-node)からオレンジ(fixed-node)に変換する
(defun change-active-node (parent da)
  ;; 構造が確定したノード(==最初の子ノード)の子ノードをDoubleArrayに変換してファイルに出力する
  (let ((fixed-node (write-children #1=(active-node-first-child parent) da)))
    ;; 白色ノード(active-node)を、オレンジノード(fixed-node)で置換する
    ;; => この時点で (active-node-first-child parent) の子ノードは破棄されることになる (不要なメモリ解放)
    (setf #1# fixed-node)))

残りは、前回には出てこなかったの関数の定義。

;; da構造体を作成するためのマクロ
;; - output-dir: このディレクトリ以下にDoubleArray用のファイル(da.baseとda.chck)が生成される
(defmacro with-da ((da output-dir) &body body)
  (let ((base (gensym))
        (chck (gensym)))
    `(flet ((path (filename)
              (merge-pathnames ,output-dir filename)))
       (ensure-directories-exist ,output-dir)
       (buffered-output:with-output (,base (path "da.base") :byte-width 4) ; BASE用の出力ストリームを作成
         (buffered-output:with-output (,chck (path "da.chck") :byte-width 1) ; CHECK用の出力ストリームを作成
           (let ((,da (make-da :alloca (node-allocator:make) 
                               :chck ,chck    
                               :base ,base))) 
             ,@body))))))

;; nodeの子ノード(子孫ノード)をDoubleArray形式に変換して、ファイルに出力する関数
;; 戻り値としては、引数のノードに対応するfixed-node表現を返す。
(defun write-children (node da)
  (if (fixed-node-p node)  ; a] 既に処理済みの場合は、何もしない
      node
    (if (null (active-node-children node)) ; b] 子がいない場合は、終端ノードを返す
        (make-fixed-node :label +EOS_LABEL+ :base-idx +EOS_BASE_VALUE+)
      ;; c] 子がいる場合は、DoubleArray形式に変換してからファイルに出力する
      (let* ((children (loop FOR c IN (active-node-children node)
                             COLLECT (write-children c da)))  ; 子孫ノードを再帰的に処理
             (child-labels (mapcar #'node-label children))    ; 子ノードのラベルを集める
             (base-idx (node-allocator:allocate (da-alloca da) child-labels)))  ; ノード割当
        (dolist (child children)
          ;; 子ノードの情報をファイルに出力する (この処理の終了時点で、子ノードをメモリ上に保持する必要がなくなる)
          (write-node child base-idx da))  
        (make-fixed-node :label (node-label node) :base-idx base-idx))))) ; 親ノードをfixed-nodeに変換する

;; ルートノードの情報をファイルに出力する
;; => (aref base 0)に、最初にアクセスするBASEインデックスの値を書き込んでおく
(defun write-root-node (root da)
  (write-node (write-children root da) 0 da))

;; ノード情報をファイルに出力する
(defun write-node (node base-idx da &aux (label (node-label node)))
  (let ((node-idx (+ base-idx label))) ; ノードのインデックス = BASEインデックス + ラベル
    (with-slots (base chck) da
      (buffered-output:write-uint (fixed-node-base-idx node) base :position node-idx) ; BASE
      (buffered-output:write-uint label chck :position node-idx))))                   ; CHECK

以上で、DoubleArray構築用のパッケージは終了。

実装: DoubleArray検索パッケージ

DoubleArray検索用のパッケージ。
こっちは特に複雑なところもないので、全部まとめて載せてしまう。

(defpackage da
  (:use :common-lisp)
  (:shadow :common-lisp load)
  (:export da
           load
           member?))
(in-package :da)

(rename-package :octet-stream :octet-stream '(:stream))

;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DoubleArray構造体 ;;;
(defstruct da
  (base #() :type (simple-array (unsigned-byte 32)))  ; BASE用配列
  (chck #() :type (simple-array (unsigned-byte 08)))) ; CHECK用配列

(defmethod print-object ((o da) stream)
  (print-unreadable-object (o stream :type t  :identity t)
    (format stream "NODE-SIZE ~a" (length (da-base o)))))

(defconstant +EOS_LABEL+ #xFF)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DoubleArray読込み関数 ;;;
(defun load (root-path)
  (let ((*default-pathname-defaults* (pathname root-path)))
    (make-da :base (read-array "da.base" '(unsigned-byte 32))
             :chck (read-array "da.chck" '(unsigned-byte 08)))))

(defun read-array (path type)
  (with-open-file (in path :element-type type)
    (let ((buf (make-array (file-length in) :element-type type)))
      (read-sequence buf in)
      buf)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DoubleArray検索関数 ;;;
;; 引数のキーが存在するなら t を、存在しないなら nil を返す
(defun member? (key da)
  (labels ((next (node label)         ; 次のノード(のインデックス)を取得
             (+ (aref (da-base da) node) label))
           (valid-label? (node label) ; 引数のラベルを持つ子ノードが存在するかをチェックする
             (= label (aref (da-chck da) (next node label))))
           (eos-node? (node)          ; 子ノードに終端ノードがあるかどうかをチェックする
             (valid-label? node +EOS_LABEL+))
           (recur (in node) ; 検索
             (if (stream:eos? in)
                 (eos-node? node)
               (let ((label (stream:read in)))
                 (when (valid-label? node label)
                   (recur in (next node label)))))))
    (recur (stream:make key) 0)))

実行結果

以下のような入力ファイルからDoubleArrayを構築するのに要するメモリ量を計測してみた。
※ 使用したcommon lisp処理系は sbcl-1.0.49/64bit

$ wc -l word.list
44280717 word.list  # 約4400万ワード

$ ls -lh word.list
-rw-r--r-- 1 user user 818M 2011-07-29 18:28 word.list

$ head word.list
"
" "
" " "
" " " "
" " " " "
" " (
" " )
" " -
" " - ;
" " - ; )

挿入したキー数に対するメモリ使用量の図。

これを見るとキー数に対して綺麗にO(1)とはなっておらず、挿入数が1600万を越えた辺りから、だいたい一千万キーに対して5MBずつメモリ消費量が増えていっている*1
もしかしたらプログラムにバグがある(or そもそもこの方法では定数量のメモリで構築できない)可能性もあるが、とりあえずはSBCLGCの影響だと考えておくことにする。
いずれにせよ普通にオンメモリで構築するのに比べると、だいぶメモリ使用効率が良いのは間違いない*2
ちなみに、作成されたDoubleArray用のファイルのサイズは以下のようになった。

$ ls -lh da.*
合計 783M
-rw-r--r-- 1 user user 627M 2011-08-08 05:52 da.base
-rw-r--r-- 1 user user 157M 2011-08-08 05:52 da.chck

何の捻りもないDoubleArrayなのでインデックスのファイルサイズは、入力テキストのサイズとほぼ同様となっている。

###

今日はここまで。
次回は、今回省略してしまったnode-allocatorパッケージとbuffered-outputパッケージをソースコード(簡単な説明付きで)載せる予定。

*1:メモリ使用量の初期値が850MBなのは、システム全体での使用量を計測しているため

*2:ついでに云えば、適切な最適化宣言を付与さえすれば、この実装は処理速度の点でも、最適化されたオンメモリ構築のそれと同等以上となる(かもしれない。GCが軽い分有利? 逆にnode-allocatorの実装には(メモリ使用量の点で)制限が厳しくなるから不利かも)。