DoubleArray(3-3): BASEとCHECK配列圧縮
以前DoubleArrayのTAIL圧縮を取り扱った時に参考にした『ダブル配列におけるキャッシュの効率化』*1という論文には、TAIL配列の他に、BASE配列とCHECK配列を圧縮する方法も載っていた*2。
それほど長くないので、該当個所を引用させてもらう。
ダブル配列は、葉ノードを除くあらゆるノードの組{s,t}において、BASE[s]≠BASE[t]が成立するとき、遷移文字を用いて遷移を確認することができる。そのため、遷移元のノード番号(4bytes)の代わりとして、遷移文字(1byte)をCHECKに格納することにより、ダブル配列を圧縮できる。このとき、ダブル配列の各要素を4bytes境界に揃えるため、BASEには3bytesの整数を割り当てる。以上の圧縮により、各要素のサイズは半減する。(p.71)
今までは、BASEとCHECKにそれぞれ4byteずつの配列を使っていたのを、BASEを3byte配列に、CHECKを1byte配列にすることで、使用領域を半分にできる、ということらしい。
今回はこれを試してみた。
実際の実装
「これを試してみた」と上には書いたが、実際には引用した箇所の通りに実装したわけではない。
CHECKを4byte配列から1byte配列に変更したり、BASE配列とCHECK配列を一つにまとめたり、という変更は、ロジック的(?)に何かが変わるわけではないのに、既存のコードにあるBASEやCHECKへのアクセス箇所を全て修正しなくてはいけなくなるので、省いた。
なので、今回実装(変更)したのは、「CHECK配列に格納する要素を遷移元のノード番号から、遷移に使用した遷移文字に変更する」というところだけだ。
ノード番号から遷移文字に変わったことによる影響
実装に取り組む前は、「CHECK配列に格納する要素を遷移文字に変更する」だけならCHECK配列に値を設定している箇所と、その他若干を変更するだけで大丈夫かな、と軽く考えていたのだが、実際にはもっといろいろ修正しなければいけない箇所があった。(どうやら、ノード番号よりも遷移文字の方が、保持する情報が少なかったようだ。)
取り合えず、今日試した限りで分かった「CHECK配列に格納する要素を遷移元のノード番号から遷移文字に変更する」ことによる影響を、書いておく。
### CHECK[ノード番号] => ?
第一に、この変更により、CHECK配列から遷移元のノード番号を(直接)計算できなくなった(多分)。
下にCHECK配列から遷移元のノード番号を取得する方法を(擬似コードで)書いてみた。
/* 変更前 */ CHECK[現在のノード番号]=遷移元のノード番号 /* 変更後 */ 遷移文字 = CHECK[現在のノード番号] for(i=0; i < BASE.size; i++) if(遷移文字+BASE[i] == 現在のノード番号) return i; // i := 遷移元のノード番号
変更前は1ステップで取得できたのに、変更後はBASE.sizeに比例するステップ数が必要となってしまう。
変更前の実装では、collision-caseという関数の中で、CHECK配列から遷移元のノードを取得するということを行っていたのだが、上記理由により変更後の実装では(それが一番楽なので取り合えず)外した。
幸い、この関数で遷移元のノードを取得していたのはもっぱら挿入効率を挙げるためだったので、それを無くしても大きな問題は出なかった。
;;; 変更前 ;; 挿入処理時に、既存のキー群と新たなキーの間で衝突が起こるとここに来る ;; node := 新たなキーを使った場合の遷移元ノード ;; @*chck*#next := 既存のキーを使った場合の遷移元ノード ;; 上の二つのノードの内で、そこから遷移するノードが少ない方のノードを書き換えることで衝突を解消する ;; 少ない方のノードを使うのは、挿入効率を挙げるため(だと思う) (defun collision-case (i node next) (let ((lst-a (correspond-codes node)) (lst-b (correspond-codes @*chck*#next))) ; ここで遷移元ノードを取得 (if (< (1+ (length lst-a)) (length lst-b)) (setf node (modify-nodes node node lst-a @*octs*#i)) (setf node (modify-nodes node @*chck*#next lst-b))) ; ここでも (set-check-and-insert-tail node (get-next @*octs*#i node) (1+ i)))) ;;; 変更後 ;; 新旧のノードを比較することはしないで、nodeを必ず使う (defun collision-case (i node) (let ((lst-a (correspond-codes node))) (setf node (modify-nodes node lst-a @*octs*#i)) (set-check-and-insert-tail node (get-next @*octs*#i node) (1+ i))))
### 遷移元ノードを確定するための条件
冒頭の引用の中には「葉ノードを除くあらゆるノードの組{s,t}において、BASE[s]≠BASE[t]が成立するとき、遷移文字を用いて遷移を確認することができる。」という記述があった。(最初実装していた時は、このくだりに気づいていなくて、結構はまった。)
確かに、CHECK配列に遷移元ノード番号が入っている場合は、それと比較すれば遷移元ノードを一意に特定できるので問題はないのだが、遷移文字の場合だと、(上のBASE[s]≠BASE[t]という条件を満たしていない場合)遷移に使われた文字が合っているかどうかは判定できても、遷移元のノードが合っているかどうかは判定できない。
この辺りは文章だけだとややこしいので、コメント付きの擬似コードも載せておくことにする。
############ ## 変更前 ## BASE[nodeA]=1 # '1'は何でも良い BASE[nodeB]=1 # BASE[s]≠BASE[t]が不成立(問題無し) CHECK[1+'a']=nodeA # 文字'a'なら、nodeAからの遷移 CHECK[1+'b']=nodeB # 文字'b'なら、nodeBからの遷移 # nodeAから遷移する文字を知りたい場合 ※ 遷移文字の最大値は0xFF for(i=BASE[nodeA]+1; i < BASE[nodeA]+0xFF; i++) { if(CHECK[i] == nodeA) { ch = i-BASE[nodeA] # 遷移文字 print(ch) # 'a'が出力される } } ############ ## 変更後 ## BASE[nodeA]=1 # '1'は何でも良い BASE[nodeB]=1 # BASE[s]≠BASE[t]が不成立(問題有り) CHECK[1+'a']='a' # 遷移元ノードではなく、遷移文字をセット CHECK[1+'b']='b' # 同 # nodeAから遷移する文字を知りたい場合 ※ 遷移文字の最大値は0xFF for(i=BASE[nodeA]+1; i < BASE[nodeA]+0xFF; i++) { ch = i-BASE[nodeA] # 遷移文字(候補) if(CHECK[i] == ch) { print(ch) # 'a'と'b'が出力される # => nodeAとnodeBが混同されてしまう(識別不可能) # # BASE[s]≠BASE[t]が成立していれば、複数のノードを混同することはない } } ### 補足メモ ### ## 変更前 ## # [遷移先取得 ] 遷移先ノード番号 := BASE[ノード番号]+遷移文字 # [遷移チェック] ノード番号 == CHECK[遷移先ノード番号] ## 変更後 ## # [遷移先取得 ] 遷移先ノード番号 := BASE[ノード番号]+遷移文字 # [遷移チェック] 遷移文字 == CHECK[遷移先ノード番号] # ※ BASE[ノード番号] == BASE[ノード番号2] == BASE[ノード番号3]の場合、 # ノード番号2やノード番号3でも、上のチェックに通ってしまう
実装的には、これに関連してx-check関数を修正した(BASE[x]=BASE[y]となるxは使わないように)。
制限
今回の変更で加わる制限を書いておく(思いついたもののみ)。
- BASE・CHECK配列の最大サイズが0xFFFFFFに制限される
- 実用上問題があるかどうかは分からないが、扱えるデータサイズが小さくなってしまう
- 文字列(キー)を1byteずつ扱うことが前提
- DoubleArray(3-2)でやったこととは相反する。
- サイズ的には(ほぼ)間違いなく今回の方法を採用した方が良いと思うのが、0xFFFFFFの範囲内で扱えるデータなら、それほどサイズが問題になることもないと思うので、処理速度によってはキーを(例えば)2byteずつ扱うというのもありかもしれない。
- 「葉ノードを除くあらゆるノードの組{s,t}において、BASE[s]≠BASE[t]が成立」という制限
- これはあまり影響は無さそうに思うのだが、若干気になる。
ソースコード
ソースコードを変更があった箇所のみ載せておく。
ベースとなるのは、DoubleArray(2): 挿入速度改善のソース。
ちなみに、今回の実装は、効率は良くない(上で書いてきたようなことを動かして確認するためだけのものなので)。
一応、DoubleArrayに関してやってみたかったことは一通りやり終えた感じなので、そろそろ作り込みに入っても良いかもしれない。
allocatorパッケージ
(defpackage :double-array-allocator (:use :cl :common-utils) (:export :*memory* :init :alloc :free :x-check :x-check2) ; 追加 (:nicknames :allocator)) ;; (defun x-check2 (set test &optional (mem *memory*)) (when (cdr set) (setf set (sort (copy-list set) #'<))) (a.mapl (a.when (and (> (car $) (car set)) (allocable? set $)) (when (funcall test it) ; 値を返す前に、test関数を呼び出す (return-from x-check2 it))) (cdr (mem-availables mem))) (let ((last (last (mem-availables mem)))) (setf (cdr last) (gen-list #1=(mem-size mem) (* #1# 2)) #1# (* #1# 2)) (x-check set mem)))
common-lisp-userパッケージ
(defun set-node (code prev x &aux (next (+ x code))) (allocator:alloc next) (setf @*base*#prev x @*chck*#next code) ; codeをセット next) ;; 第一引数を遷移元ノードから遷移文字に変更 (defun set-check-and-insert-tail (code node i) (allocator:alloc node) (setf @*chck*?node code) ; codeをセット (insert-tail node i)) (defun x-check (set) (let ((x (allocator:x-check2 set (lambda (x) (not (find x *base*)))))) ; BASE[s]≠BASE[t]を満たす、遅いけど簡単な方法 @*chck*?(+ x (apply #'max set)) x)) (defun correspond-codes (node &aux (base @*base*#node)) (loop for i from (1+ base) to (1- (min (length *chck*) (+ base MAX-CODE))) when (= (- i base) @*chck*#i) ; 遷移文字を比較 collect (- i base))) ;; 不要な箇所を削除 (defun modify-nodes (node codes c &aux (old-base @*base*#node)) (let ((new-base (x-check (cons c codes)))) (setf @*base*#node new-base) (dolist (code codes) (let ((old (+ old-base code)) (new (+ new-base code))) (shiftf @*base*?new @*base*#old NULL) (shiftf @*chck*?new @*chck*#old NULL) (allocator:free old) (allocator:alloc new)))) node) (defun collision-case (i node) (let ((lst-a (correspond-codes node))) (setf node (modify-nodes node lst-a @*octs*#i)) (set-check-and-insert-tail @*octs*#i (get-next @*octs*#i node) (1+ i)))) (defun insert (target da) (let ((*da* da) (*octs* (eos-terminated-octets (make-octets target)))) (nlet self ((node 1) (i 0)) (let ((next (get-next @*octs*#i node))) (cond ((zerop @*chck*?next) (set-check-and-insert-tail @*octs*#i next (1+ i))) ((= @*octs*#i @*chck*#next) ; 遷移文字を比較 (cond ((plusp @*base*?next) (self next (1+ i))) ((tail= *octs* (1+ i) (- @*base*#next))) (t (tail-collision-case (1+ i) next)))) (t (collision-case i node))))))) (defun member? (target *da*) (let* ((octets (eos-terminated-octets (make-octets target))) (limit (1- (length octets)))) (nlet self ((node 1) (i 0)) (let ((next (get-next @octets#i node))) (and (= @octets#i @*chck*?next) ; 遷移文字を比較 (cond ((plusp @*base*?next) (when (< i limit) (self next (1+ i)))) ((tail= octets (1+ i) (- @*base*#next)) next)))))))
