ハッシュトライ
最近ちょくちょくトライを使いたくなることがあるので、少しまとまったハッシュトライの実装を書いておく。
位置付け的には開発用。使用頻度が高いようなら、もう少しちゃんとしたものに書き直す。
※ 2010/01/03: print-objectメソッド追加、common-prefix-search関数追加、hash-trieから冗長なtestフィールドを除外
ソースコード
依存: common-utils or nlet,a.when.a.if
(defpackage :hash-trie (:use :common-lisp :common-utils) ; nlet, a.if, a.whenは、common-utilsパッケージ内で定義されている (:export :make-trie :get-node :get-node1 :get-elem :get-elem1 :rem-elem :rem-elem1 :common-prefix-search :map-trie :to-list :element-count :hash-trie)) (in-package :hash-trie) (defstruct (hash-trie (:constructor make-trie (&key (test 'eql) &aux (hash (make-hash-table :test test))))) hash) (declaim (ftype (function (hash-trie) fixnum) element-count)) (defmethod print-object ((o hash-trie) stream) (print-unreadable-object (o stream :type t :identity t) (format stream "~S ~A ~S ~D" :test (hash-table-test (hash-trie-hash o)) :count (element-count o)))) (defmacro get-node1 (key trie) `(gethash ,key (hash-trie-hash ,trie))) (defmacro rem-node1 (key trie) `(remhash ,key (hash-trie-hash ,trie))) (eval-when (:compile-toplevel :load-toplevel :execute) (let ((ELEMENT-NODE-KEY '#.(gensym))) (defmacro get-elem1 (trie) `(gethash ',ELEMENT-NODE-KEY (hash-trie-hash ,trie))) (defmacro rem-elem1 (trie) `(remhash ',ELEMENT-NODE-KEY (hash-trie-hash ,trie))) (defun element-node-key-p (key) (eq key ELEMENT-NODE-KEY)))) (defun coerce-to-list (seq) (if (listp seq) seq (coerce seq 'list))) (defun get-node-force (key-seq trie) (nlet self ((keys (coerce-to-list key-seq)) (trie trie)) (if (null keys) trie (a.if #1=(get-node1 (car keys) trie) (self (cdr keys) it) (self (cdr keys) (setf #1# (make-trie :test (hash-table-test (hash-trie-hash trie))))))))) ;; --> (values key-seqに一致したノード ; 一致するノードが無かった場合はnil ;; key-seqの要素に一致した最後のノード ; ≒ 検索に失敗したノード ;; trieの中に見つかったkey-seqの最後の要素の位置+1) ; ≒ 検索に失敗した要素位置 (defun get-node (key-seq trie) (nlet self ((keys (coerce-to-list key-seq)) (trie trie) (i 0)) (if (null keys) (values trie trie i) (a.if (get-node1 (car keys) trie) (self (cdr keys) it (1+ i)) (values nil trie i))))) (defun get-elem (key-seq trie) (nlet self ((keys (coerce-to-list key-seq)) (trie trie)) (if (null keys) (get-elem1 trie) (a.if (get-node1 (car keys) trie) (self (cdr keys) it) (values nil nil))))) (defsetf get-elem (key-seq trie) (new-value) `(let ((terminal-node (get-node-force ,key-seq ,trie))) (setf (get-elem1 terminal-node) ,new-value) ,new-value)) (defun map-trie (fn trie) (nlet self ((trie trie) keys) (maphash (lambda (key val) (if (element-node-key-p key) (funcall fn (reverse keys) val) (self val (cons key keys)))) (hash-trie-hash trie)))) (defun to-list (trie) (nlet self ((trie trie)) (let ((acc '())) (maphash (lambda (key val) (push (if (element-node-key-p key) val (cons key (self val))) acc)) (hash-trie-hash trie)) acc))) (defun element-count (trie &aux (count 0)) (nlet self ((trie trie)) (maphash (lambda (key val) (if (element-node-key-p key) (incf count) (self val))) (hash-trie-hash trie))) count) ;; key-seqに対応する要素が存在した場合はtを、しなかった場合はnilを返す ;; 要素削除後にできる空ノードも合わせて削除される (defun rem-elem (key-seq trie) (nlet self ((keys (coerce-to-list key-seq)) (trie trie)) (if (null keys) (rem-elem1 trie) (a.when (get-node1 (car keys) trie) (prog1 (self (cdr keys) it) (when (zerop (hash-table-count (hash-trie-hash it))) (rem-node1 (car keys) trie))))))) (defun common-prefix-search (key-seq trie) (let ((elems '())) (nlet self ((keys (coerce-to-list key-seq)) (trie trie) (i 0)) (when keys (let ((node (get-node1 (car keys) trie))) (when node (a.when (get-elem1 node) (push (list i it node) elems)) (self (cdr keys) node (1+ i)))))) (values (nreverse elems)))) ;; [TODO] ;; - key-seqを引数に取る関数には、:startおよび:endキーワード引数を指定できるようにする ;; - リスト以外の列が渡された場合の処理の効率化 ※ 現状は全部(coerce ... 'list)しているので非効率 ;; - 整理/コメント ;; - etc
仕様説明を兼ねた使用例
> (rename-package :hash-trie :hash-trie '(:trie)) ;;;;;;;;;;;;;;;;;;; ;;;; 基本的な使い方 ;; 作成 > (defvar *trie* (trie:make-trie)) ; testキーワード引数が指定可能(デフォルトは#'eql)。test引数は、内部で利用しているハッシュテーブルに渡される --> *TRIE* ;; 要素追加 > (setf (trie:get-elem "abc" *trie*) :val1) --> :VAL1 ;; 要素取得: 返り値の形式は、gethashと同様 > (trie:get-elem "abc" *trie*) --> :VAL1 T > (trie:get-elem "ab" *trie*) --> NIL NIL ;; 要素数取得: 毎回全要素を走査するので遅い > (trie:element-count *trie*) --> 1 ;; 要素追加2: キーの列がリストでも配列でも区別しない > (setf (trie:get-elem '(#\a #\b #\e #\f) *trie*) :val2) --> VAL2 ;; リスト(ツリー)に変換 > (trie:to-list *trie*) --> ((#\a (#\b (#\e (#\f :VAL2)) (#\c :VAL1)))) ;; マッピング > (trie:map-trie (lambda (k v) (format t "KEY:~A, VAL:~A~%" k v)) *trie*) KEY:(a b c), VAL:VAL1 KEY:(a b e f), VAL:VAL2 --> NIL ;;;;;;;;;;;;;;;;; ;;;; その他の関数 ;; ノード取得(検索) ;; ※ get-nodeで取得したノードは、それ自体がhash-trieなので、hash-trieに対する任意の関数が適用可能 > (trie:get-node "ab" *trie*) --> #<HASH-TRIE:HASH-TRIE :TEST EQL :COUNT 2 {B1B4491}> ; キー列"ab"に対応するノード #<HASH-TRIE:HASH-TRIE :TEST EQL :COUNT 2 {B1B4491}> ; 同上 2 ; 検索に失敗したキー列の要素の位置。今回は成功したので、(length "ab") ;; ノード取得(検索): 失敗時 > (trie:get-node "abcd" *trie*) --> NIL ; 取得に失敗 #<HASH-TRIE:HASH-TRIE :TEST EQL :COUNT 1 {B1B46D1}> ; 最後に使われたノード ※"abc"に対応するノード 3 ; 検索に失敗した要素の位置 ※ 3=="d"の位置で失敗 ;; 呼び出しを複数に分けた場合 > (eq (trie:get-node "abef" *trie*) (trie:get-node "ef" (trie:get-node "ab" *trie*))) --> T ;; 要素削除 > (trie:rem-elem "abef" *trie*) --> T > (trie:to-list *trie*) --> ((#\a (#\b (#\c :VAL1)))) ;; - get-elem1,rem-elem1は、それぞれ空列を渡した場合のget-elem,rem-elemと等しい ;; - get-node1は、要素数が1の列を渡した場合のget-nodeと等しい > (trie:get-elem1 (trie:get-node1 #\c (trie:get-node1 #\b (trie:get-node1 #\a *trie*)))) --> :VAL1 T ;; rem-elem1(or 空列を渡したrem-elem)の場合、要素削除後に要素を持たないゴミノードが残ってしまう ;; ==> ルートノード(*trie*)に対して、(trie:rem-elem "abc" *trie*)を呼び出した方が良い > (trie:rem-elem1 (trie:get-node1 #\c (trie:get-node1 #\b (trie:get-node1 #\a *trie*)))) --> T > (trie:to-list *trie*) --> ((#\a (#\b (#\c)))) > (trie:element-count *trie*) --> 0 ;; common-prefix-search > (let ((trie (trie:make-trie))) (dolist (k '("東京都" "東京" "京都府" "東京都立図書館")) (setf (trie:get-elem k trie) k)) (setf *trie* trie)) --> #<HASH-TRIE:HASH-TRIE :TEST EQL :COUNT 4 {B07F231}> > (trie:common-prefix-search "東京都立図書館に出かける" *trie*) --> ((1 "東京" #<HASH-TRIE:HASH-TRIE :TEST EQL :COUNT 3 {B07F711}>) (2 "東京都" #<HASH-TRIE:HASH-TRIE :TEST EQL :COUNT 2 {B07F951}>) (6 "東京都立図書館" #<HASH-TRIE:HASH-TRIE :TEST EQL :COUNT 1 {B080991}>)) > (progn (princ (trie:to-list (third (first *)))) 'done) --> (東京 (都 (立 (図 (書 (館 東京都立図書館)))) 東京都))
a.when, a.if
アナフォリックwhenとアナフォリックif。
『On Lisp』のawhen,aifマクロと同機能。 ※ 個人的にはアナフォリックマクロは、'a'で始めるより'a.'で始める方が好きなので、名前は若干異なっている。
(defmacro a.when (expr &body body) `(let ((,it ,expr)) (when ,it ,@body))) (defmacro a.if (expr consequent &optional alternative) `(let ((,it ,expr)) (if ,it ,consequent ,alternative)))
