lequeから移動。
Trie（トライ）は検索のためにもちいられる木構造様のデータ構造である。 二分探索木などの構造が、キーの比較にもとづいて枝を決めるのに対して、 trie ではキーの値そのものをつかって分岐する枝を決める。
例として、小文字のアルファベットのみからなる単語を要素とする trie を考える。 根となるノードは空文字列をあらわし、そこからは各アルファベットに対応して 最大 26 個の枝がある。この分岐を単語の一文字目に応じて選び、 以下再帰的に単語の n 文字目に応じた枝を選んで行く。 挿入されるキーが `trie' である場合、まず最初の分岐で `t' の枝、次は `r' の枝、 `i' の枝、`e' の枝というように進んで行き、たどり着いたノードに キーが存在することの目印をつける。
trie の利点は、格納されているデータの要素数にかかわらず、探索するキーの 長さ n に対して O(n) のオーダーで探索がおこなえることである。
発端は Rui さんの
trie: Trie (トライ)を構築したりアクセスしたりするライブラリ、欲しいですね。いまは適当にアクセッサだけ書いて、trieはS式手書きしています。文字列以外のシーケンスに対してもちゃんと動き、かつノードの数は可能な限り少なく持つようなものがあるといいのですが
という発言。
要件は以下。
ひとつめについては、内部処理はリストでおこなうことにしつつ、 trie 自体に要素とするシーケンスのクラスを持たせておいて、入出力時に適宜変換するようにした。
ふたつめの空間効率については、分岐のないノードを圧縮するようなことも考えられるものの、 複雑になることを避けて、枝の管理のみについて考えた。まず、素朴な方法として考えられる ベクタを使う方法は効率もわるく、そもそもシーケンスの要素となる値の種類が前以ってわかっていなければ ならず汎用性がないため論外。つぎに連想リストを使う方法。無駄な枝はまったくできず空間効率はよいが、 探索が少し遅い。もうひとつはハッシュテーブル。連想リストに比べると空間効率はいくらか悪いものの、 気になるほどのものではない。探索速度もはやい。以上のことを踏まえて、この実装では枝の管理には ハッシュテーブルを用いることにした。あと、初期には trie の各ノードを <trie-node> クラスの インスタンスで表現していたが、そのことによる恩恵もなかったので、これを単純に値と枝のペアとした。 これによって、さらにもう少し空間使用量が小さくなった。
trie を表現するクラス
type 型のシーケンス contents... を要素とする trie を作成する。 type を省略した場合には要素の型は <string> になる。
trie 中の要素数を返す
型述語
trie の全要素を含むリストを返す
trie に seq を追加する。 seq の型は trie 作成時の make-trie の第一引き数と is-a? でなければならない。
trie 中から seq を prefix として持つ要素を検索し返す。 seq の型は trie 作成時の make-trie の第一引き数と is-a? でなければならない。
trie に seq が含まれていれば #t、さもなくは #f を返す。 seq の型は trie 作成時の make-trie の第一引き数と is-a? でなければならない。
trie から seq を削除する。要素を削除できた場合は #t を返し、 trie に seq が含まれていなかった場合には #f を返す。
horii: collect-keys 内の collect にある cond の最初の条件式についてです。
(define (collect n cs)
(cond ((not n) ; <= これです
'())
この条件はいらない気がするのですが、この条件にマッチするケースってありますか？ 消しても、test-trie.scm は全部通りました。
leque: ええと、要りませんね。消し忘れだと思います。
horii: コレクションとして使えた方が便利そうなので、実装してみました。 map-to とかで <string> の trie しか作れないので、ちょっと不便です。 いまは (define-trie <trie-vector> <vector>) とかで、 あるクラスに特化した trie を定義し、 (map-to <trie-vector> ...) するとか考えていますが、 何か良いアイディアはありますか？
--- trie.orig.scm 2005-12-26 16:13:06.922373909 +0900
+++ trie.scm 2005-12-26 16:15:36.889492852 +0900
@@ -43,11 +43,18 @@
trie-contains?
trie-delete!
trie-search
+ call-with-iterator
+ call-with-builder
+ size-of
+ lazy-size-of
))
(select-module util.trie)
-(define-class <trie> ()
+(define-class <trie-meta> (<class>)
+ ())
+
+(define-class <trie> (<collection>)
((root
:accessor root-of
:init-form (make-node))
@@ -57,7 +64,8 @@
(sequence-type
:init-value <string>
:init-keyword :sequence-type)
- ))
+ )
+ :metaclass <trie-meta>)
(define (trie? x)
(is-a? x <trie>))
@@ -82,7 +90,7 @@
(hash-table-put! ht key val)
ht)
(define table-map hash-table-map)
-
+(define table-for-each hash-table-for-each)
(define (make-trie . opts)
(let-optionals* opts ((type <string>)
@@ -145,31 +153,74 @@
(check-type prefix trie)
(or (and-let* ((cs (seq->list prefix))
(n (retrieve-node (root-of trie) cs)))
- (collect-keys (ref trie 'sequence-type) n (reverse! cs)))
+ (collect-keys (ref trie 'sequence-type) n (reverse! cs)))
'()))
-
(define (retrieve-node node objs)
(if (null? objs)
node
(and-let* ((c (child-at node (car objs))))
(retrieve-node c (cdr objs)))))
+(define (iterate-keys type node crumb proc)
+ (let ((return #f)
+ (end? #f))
+ (define (iterate)
+ (let loop ((node node)
+ (acc crumb))
+ (define (iterate-children)
+ (and-let* ((tbl (node-children node)))
+ (table-for-each tbl
+ (lambda (key child-node)
+ (loop child-node (cons key acc))))))
+ (cond ((terminal? node)
+ (call/cc (lambda (c)
+ (set! iterate c)
+ (return (reverse acc))))
+ (iterate-children))
+ (else
+ (iterate-children))))
+ (set! end? #t)
+ (return (undefined)))
+ (define (next)
+ (call/cc (lambda (c)
+ (set! return c)
+ (iterate))))
+ (let ((next-value (next)))
+ (proc (lambda () end?)
+ (lambda ()
+ (begin0 (coerce-to type next-value)
+ (set! next-value (next))))))))
+
(define (collect-keys type node crumb)
- (define (rec n cs)
- (or (and-let* ((c (node-children n)))
- (concatenate!
- (table-map c (lambda (k v)
- (collect v (cons k cs))))))
- '()))
- (define (collect n cs)
- (cond ((not n)
- '())
- ((terminal? n)
- (cons (reverse cs) (rec n cs)))
- (else
- (rec n cs))))
- (map (cut coerce-to type <>) (collect node crumb)))
+ (iterate-keys type node crumb
+ (lambda (end? next)
+ (let loop ((lst '()))
+ (if (end?)
+ lst
+ (loop (cons (next) lst)))))))
+
+;;; --------------------------------------------------
+;;; collection
+(define-method call-with-iterator ((trie <trie>) proc . opts)
+ (iterate-keys (ref trie 'sequence-type)
+ (root-of trie)
+ '()
+ (lambda (end? next)
+ (proc end? next))))
+
+(define-method call-with-builder ((class <trie-meta>) proc . opts)
+ (let* ((type (get-keyword :type opts <string>))
+ (trie (make-trie type)))
+ (proc (lambda (val)
+ (trie-add! trie val))
+ (lambda ()
+ trie))))
+
+(define-method size-of ((trie <trie>))
+ (trie-size-of trie))
+(define-method lazy-size-of ((trie <trie>))
+ (trie-size-of trie))
(provide "util/trie")
koguro (2005/12/27 06:31:06 PST): これは便利そうなクラスですね。ところで、そもそも<trie>が要素の型情報を持つ必要があるのでしょうか? trie-add!したときの型を覚えておけばいらないと思いましたので、以下のようなパッチを作ってみました。これだと (map-to <trie> ...)で何でもOKなので便利かと思いますがいかかでしょう？
--- trie.scm.orig 2005-12-27 22:55:58.000000000 +0900
+++ trie.scm 2005-12-28 23:14:09.000000000 +0900
@@ -61,9 +61,6 @@
(size
:getter trie-size-of
:init-value 0)
- (sequence-type
- :init-value <string>
- :init-keyword :sequence-type)
)
:metaclass <trie-meta>)
@@ -92,12 +89,10 @@
(define table-map hash-table-map)
(define table-for-each hash-table-for-each)
-(define (make-trie . opts)
- (let-optionals* opts ((type <string>)
- . seqs)
- (let1 t (make <trie> :sequence-type type)
- (for-each (cut trie-add! t <>) seqs)
- t)))
+(define (make-trie . seqs)
+ (let1 t (make <trie>)
+ (for-each (cut trie-add! t <>) seqs)
+ t))
(define (child-at node key)
(and-let* ((c (node-children node)))
@@ -115,14 +110,16 @@
(define (trie-add! trie seq)
(define (insert node objs)
(if (null? objs)
- (set! (terminal? node) #t)
+ (begin
+ (unless (terminal? node)
+ (inc! (ref trie 'size)))
+ (set! (terminal? node) (class-of seq)))
(let1 c (child-at node (car objs))
(unless c
(add-child! node (car objs)))
(insert (child-at node (car objs)) (cdr objs)))))
- (check-type seq trie)
- (insert (root-of trie) (seq->list seq))
- (inc! (ref trie 'size)))
+ (check-type seq)
+ (insert (root-of trie) (seq->list seq)))
(define (trie-delete! trie seq)
(and-let* ((node (retrieve-node (root-of trie) (seq->list seq)))
@@ -131,29 +128,28 @@
(dec! (ref trie 'size))
#t))
-(define (check-type seq trie)
- (unless (is-a? seq (ref trie 'sequence-type))
- (errorf "~A required but got: ~A"
- (class-name (ref trie 'sequence-type))
+(define (check-type seq)
+ (unless (is-a? seq <sequence>)
+ (errorf "<sequence> required but got: ~A"
(class-name (class-of seq)))))
-
+
(define (trie-contains? trie seq)
- (check-type seq trie)
+ (check-type seq)
(and-let* ((n (retrieve-node (root-of trie) (seq->list seq))))
- (terminal? n)))
+ (if (terminal? n) #t #f)))
(define (trie-search t seq)
(and (trie-contains? t seq) seq))
(define (trie->list trie)
- (collect-keys (ref trie 'sequence-type) (root-of trie) '()))
+ (collect-keys (root-of trie) '()))
(define (trie-common-prefix-search trie prefix)
- (check-type prefix trie)
+ (check-type prefix)
(or (and-let* ((cs (seq->list prefix))
(n (retrieve-node (root-of trie) cs)))
- (collect-keys (ref trie 'sequence-type) n (reverse! cs)))
+ (collect-keys n (reverse! cs)))
'()))
(define (retrieve-node node objs)
@@ -162,7 +158,7 @@
(and-let* ((c (child-at node (car objs))))
(retrieve-node c (cdr objs)))))
-(define (iterate-keys type node crumb proc)
+(define (iterate-keys node crumb proc)
(let ((return #f)
(end? #f))
(define (iterate)
@@ -174,10 +170,11 @@
(lambda (key child-node)
(loop child-node (cons key acc))))))
(cond ((terminal? node)
- (call/cc (lambda (c)
- (set! iterate c)
- (return (reverse acc))))
- (iterate-children))
+ => (lambda (type)
+ (call/cc (lambda (c)
+ (set! iterate c)
+ (return (coerce-to type (reverse acc)))))
+ (iterate-children)))
(else
(iterate-children))))
(set! end? #t)
@@ -189,11 +186,11 @@
(let ((next-value (next)))
(proc (lambda () end?)
(lambda ()
- (begin0 (coerce-to type next-value)
+ (begin0 next-value
(set! next-value (next))))))))
-(define (collect-keys type node crumb)
- (iterate-keys type node crumb
+(define (collect-keys node crumb)
+ (iterate-keys node crumb
(lambda (end? next)
(let loop ((lst '()))
(if (end?)
@@ -203,15 +200,13 @@
;;; --------------------------------------------------
;;; collection
(define-method call-with-iterator ((trie <trie>) proc . opts)
- (iterate-keys (ref trie 'sequence-type)
- (root-of trie)
+ (iterate-keys (root-of trie)
'()
(lambda (end? next)
(proc end? next))))
(define-method call-with-builder ((class <trie-meta>) proc . opts)
- (let* ((type (get-keyword :type opts <string>))
- (trie (make-trie type)))
+ (let* ((trie (make-trie)))
(proc (lambda (val)
(trie-add! trie val))
(lambda ()
horii: あー、terminal? の部分に型を持たせるんですか。 確かに、シーケンスなら何でも格納できるよ、という方が scheme やっている人は好みかもしれないですね。 いくつか気になったのは、
gosh> (define t (make-trie "hoge"))
t
gosh> (trie->list t)
("hoge")
gosh> (trie-add! t '(#?h #?o #?g #?e))
#<undef>
gosh> (trie->list t)
((#?h #?o #?g #?e))
上書きするときは #t なりなんなり返した方が良いかもしれないですね。
後、call-with-builder で type っていう変数を消し忘れてます。
koguro (2005/12/28 06:44:26 PST): ご指摘ありがとうございます。シーケンスかどうかのチェックを入れる、call-with-builderでのtypeの消し忘れ、値を上書きしたときでもtrie-size-ofの値が増えてしまう、の3点を修正しました（上のパッチの部分を修正してあります）。 ただ、要素を上書きしたときに値を返す件についてはちょっと微妙かと思いました。確かにJavaのMapやSetのように上書きした場合に返り値でそれと分かるようにすると便利だと思いますが、既存のhash-table-put!ではキーの上書き時にも意味のある値を返していないので、trie-add!でも挙動を合わせて返り値に意味を持たせないようにした方がよいかとも思います。
horii (2005/12/30 00:33:29 PST): 上のkoguroさんのパッチを当てたものをさらに変更してみました。 koguroさんのバージョンでは、型が異なっていても要素の並びが同じなら、上書きされたり、探索が成功したりしてました。 そこで、ターミナルに型のリストを持たせることで、型が異なっている場合は上書きされないように、また、探索の際に並びの一致だけでなく、型の一致も要求するようにしてみました。 (trie-common-prefix-search trie "foo") で、((#\f #\o #\o)) が返ってくるよりも直感的だと思うのですが、どうでしょうか？
gosh> (define t (make-trie "foo" "foobar" '(#\f #\o #\o)))
t
gosh> (trie-contains? t "foobar")
#t
gosh> (trie-contains? t (string->list "foobar"))
#f
gosh> (trie-common-prefix-search t "foo")
("foobar" "foo")
gosh> (trie->list t)
((#\f #\o #\o) "foo" "foobar")
パッチが重なってきたので、プログラムは ここ に置いておきます。 テストも追加、修正してあります。
Shiro(2006/10/14 02:55:47 PDT): 遅くなってしまいましたが、0.8.8に取り込みます。 統一性の面と、拡張性の面から、APIを変更しました。最終形はCVS HEADを参照して下さい： http://gauche.cvs.sourceforge.net/gauche/Gauche/lib/util/trie.scm?view=log
構成要素が可変長引数で与えられるコンストラクタは通常は型名と同じ (例: list, vector, string, hash-table)。一方、「make-型名」は一様に 初期化されたコンテナを返すのが普通 (例: make-list, make-vector, make-string, make-hash-table)。
なので、現在の 'make-trie' は 'trie' の方がふさわしいだろう。
collection系のオブジェクトの探索に 'search' という名前はあまり使われない。
スタンダードな範囲で使われているのは、 srfi-43のvector-binary-searchとsrfi-13のstring-kmp-partial-search。 しかしどちらも、特にサーチ向けに作られたわけではないデータ構造 (vector, string) に対して特定のサーチアルゴリズムを適用する、というものだ。 trieの場合はもともと特定の探索法に特化したデータ構造のわけで、そこに searchを使うのはちょっと違和感がある。
似たような操作の名前としてはこんな感じのがある：
(ref/getについては若干混乱あり: assoc-refなど)
そもそも現在のtrie-searchは見つかれば第二引数がそのまま返るので、 trie-contains? に比べてあんまり便利さが増していない。 後述するようにtrieの終端ノードにデータをぶら下げられるようになれば、 キー -> 値へのマッパーとして trie-get はありかもしれない。
その場合、hash-table APIとの一貫性から、trie-contains? は trie-exists? にすべきか。
文字列の場合はstring-containsがあるんだけど、これは (要素 -> bool) ではなくて (要素のならび -> bool) なのでちょっと違う。
終端ノードにデータをぶら下げるなら、要素の追加に関してもhash-table系と 併せて、-add! ではなく -put! が良いだろう。
trie-common-prefix-searchについては、trie-common-prefixでいいんじゃないかなあ。
以前は、fooというスロットに対してfoo-ofみたいなアクセサを定義することが 多かったのだけれど、最近あまりそれをしなくなった。
なので、root-of、trie-size-ofはやめる。 ただ、エントリ数を知るAPIは欲しいので、sizeスロットへのアクセサを trie-num-entriesとしてexportする (cf. hash-table-num-entries)。
枝の分岐がハッシュテーブル固定なのはうれしくない。 要素が少ない場合、比較要素によってはalistの方が速いことがある (Gaucheオブジェクトシステムのスロットルックアップがハッシュテーブルではなく alistになっているのは、ベンチマークを取って決めたのだ)。 また、要素の比較関数もアプリによって異なることが予想される。
これは、テーブルに関して make, get, put, fold の4関数を 外部から与えてやれば抽象化できる。
アプリによっては、テーブルが小さいうちはalistで、一定以上になったら 固定長ベクタで、みたいな運用もありだろう。
単に登録したシーケンスが存在するかどうかだけでなく、そこに値を 結びつけられると使い勝手が広がるだろう。
この場合、初期要素を指定する(trie <elem> ...) でキーと値の両方を 与える必要があるな。(hash-table <type> (<key> . <value>) ...) みたいに。 ちょっと面倒ではある。キーだけしか使わない、(trie-with-keys <key> ...) みたいのがあってもいいかもしれない。
Tag: util.trie