2010/08/28

Common Lisp で実装された全文検索エンジン Montezuma

Common Lisp で実装された全文検索エンジン Montezuma を動かす。

MeCab を使った analyzer を実装して、日本語を扱えるところまで確認した。

タイトルやボディ等の構造を持った文書も扱える。検索は and, or, not, 部分一致等結構柔軟。ただし、範囲検索(2010-4-26〜2010-9-26のような)はできない。しっかりちゃんと動く。十分実務に使えると思った。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :montezuma))

(defpackage :try-montezuma
(:use :cl))

(in-package :try-montezuma)

;;; MeCab
(defun run-mecab (stream)
(with-output-to-string (out)
(sb-ext:run-program "mecab" nil :search t :input stream :output out)))

(defgeneric mecabaku (input)
(:method ((stream stream))
(with-input-from-string (in (run-mecab stream))
(loop for i = (read-line in)
until (string= "EOS" i) collect (collect-mecabu-output i))))
(:method ((string string))
(with-input-from-string (stream string)
(mecabaku stream))))

(defmacro collect-mecabu-output-macro ()
(let ((x '(表層形 品詞 品詞細分類1 品詞細分類2 品詞細分類3 活用形 活用型 原形 読み 発音)))
`(defun collect-mecabu-output (one-line)
(ppcre:register-groups-bind ,x
("(.*)\\t([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+)(?:,([^,]+),([^,]+),([^,]+))?"
one-line)
(list ,@(loop for i in x
append `(',i ,i)))))))
(collect-mecabu-output-macro)

;;(mecabaku "桜が咲いた。Hello")
;;(loop for i in (mecabaku "桜が咲いた。") collect (getf i '原形))
;; => ("桜" "が" "咲く" "た" "。")

;;; tokenizer
(defclass mecab-tokenizer (montezuma::tokenizer)
((tokens :initform :unbound)
(position :initform 0)))

(defmethod montezuma::next-token :before ((self mecab-tokenizer))
(with-slots (montezuma::input tokens) self
(when (eq tokens :unbound)
(setf tokens (mecabaku montezuma::input)))))

(defmethod montezuma::next-token ((self mecab-tokenizer))
(with-slots (tokens position) self
(let ((token (pop tokens)))
(if token
(let* ((表層形 (getf token '表層形))
(new-position (+ position (length 表層形)))
(token (or (getf token '原形) 表層形)))
(prog1 (montezuma::make-token
(montezuma::normalize self token)
position new-position)
(setf position new-position)))
nil))))

(defmethod montezuma::normalize ((self mecab-tokenizer) str)
str)

;;; analyzer
(defclass mecab-analyzer (montezuma::standard-analyzer)
())

(defmethod montezuma::token-stream ((self mecab-analyzer) field string-or-stream)
(declare (ignore field))
(reduce (lambda (acc x) (make-instance x :input acc))
'(mecab-tokenizer
montezuma::lowercase-filter
montezuma::stop-filter)
:initial-value string-or-stream))

;;; index 作成
(defparameter *index*
(make-instance 'montezuma:index
:path "/tmp/montezuma"
:analyzer (make-instance 'mecab-analyzer)))

;;; 使ってみる。
(loop for i in '("貘の鼻は長い。" "亀の甲羅は固い。" "This is a new document to be indexed"
(("title" . "Programming Lisp")
("content" . "car cdr cons loop is"))
(("title" . "Programming Forth")
("content" . "dup swap is")))
do (montezuma:add-document-to-index *index* i))
(loop for i in '("貘" "の" "甲羅" "長い" "貘の鼻" "貘 鼻 長さ"
"this" "to be indexed" "is"
"title:Lisp" "Lisp")
collect (montezuma:search-each
*index* i (lambda (doc score)
(print (list i doc score)))))

;; + をつけると must
(loop for i in '("title:Lisp"
"title:Lisp content:xaxa" ; or
"title:Lisp +content:car" ; and
"title:Lisp +content:xaxa" ; and
"title:\"Programming Forth\"" ; フレーズ
)
for acc = nil
collect (progn
(montezuma:search-each
*index* i
(lambda (doc score)
(push (montezuma:document-value (montezuma:get-document *index* doc)
"content")
acc)))
acc))

2010/08/26

Common Lisp から MeCab を手抜きで使う方法(SBCL 限定)

(defun run-mecab (string)
(with-output-to-string (out)
(with-input-from-string (in string)
(sb-ext:run-program "mecab" nil :search t :input in :output out))))

(defun mecabaku (string)
(with-input-from-string (in (run-mecab string))
(loop for i = (read-line in)
until (string= "EOS" i) collect (collect-mecabu-output i))))

(defmacro collect-mecabu-output-macro ()
(let ((x '(表層形 品詞 品詞細分類1 品詞細分類2 品詞細分類3 活用形 活用型 原形 読み 発音)))
`(defun collect-mecabu-output (one-line)
(ppcre:register-groups-bind ,x
("(.*)\\t(.*),(.*),(.*),(.*),(.*),(.*),(.*),(.*),(.*)" one-line)
(list ,@(loop for i in x
append `(',i ,i)))))))
(collect-mecabu-output-macro)

(mecabaku "桜が咲く。")
;; => ((表層形 "桜" 品詞 "名詞" 品詞細分類1 "一般" 品詞細分類2 "*" 品詞細分類3 "*" 活用形 "*" 活用型 "*" 原形 "桜" 読み "サクラ" 発音 "サクラ")
;; (表層形 "が" 品詞 "助詞" 品詞細分類1 "格助詞" 品詞細分類2 "一般" 品詞細分類3 "*" 活用形 "*" 活用型 "*" 原形 "が" 読み "ガ" 発音 "ガ")
;; (表層形 "咲く" 品詞 "動詞" 品詞細分類1 "自立" 品詞細分類2 "*" 品詞細分類3 "*" 活用形 "五段・カ行イ音便" 活用型 "基本形" 原形 "咲く" 読み "サク" 発音 "サク")
;; (表層形 "。" 品詞 "記号" 品詞細分類1 "句点" 品詞細分類2 "*" 品詞細分類3 "*" 活用形 "*" 活用型 "*" 原形 "。" 読み"。" 発音 "。"))

(loop for i in (mecabaku "桜が咲く。") collect (getf i '原形))
;; => ("桜" "が" "咲く" "。")

2010/08/25

Wilbur

Common Lisp のセマンティック Web ライブラリ。 AllegroGraph しかないかと思っていたら Wilbur というのがあった。

aserve に依存している部分はコメントアウトして動かした。

(let ((*db* (make-instance 'wilbur:indexed-db))
(file "/tmp/a.rdf"))
(with-open-file (out file :direction :output :if-exists :supersede)
(write-string "<rdf:RDF
xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
<rdf:Description rdf:about=\"http://en.wikipedia.org/wiki/Tony_Benn\">
<dc:title>Tony Benn</dc:title>
<dc:publisher>Wikipedia</dc:publisher>
</rdf:Description>
</rdf:RDF>"
out))
(db-load *db* (format nil "file://~a" file))
(all-values !"http://en.wikipedia.org/wiki/Tony_Benn" :any))
;; => (#"Tony Benn" #"Wikipedia")

2010/08/14

さいきんのまとめ

うー、Opera でまともに日本語入力できないために、ひらがなで入力するくせがつきつつある。

借りぐらしのアリエッティを観た。よかった。なにかしらいさぎよい。

車で帰省した。行きは渋滞がひどく19時間もかかった。帰りは13時間半くらい。蒜山の下り SA がよかった。地元の海は近くて人がいなくて快適だった。がいな祭の花火がよかった。小さい花火もした。またフォーゲルパークに行った。すこし足をのばしてゴビウスにもいった。娘もたいへん満足したようだ。

cl-pdf で日本語を表示できるようにした。

糠漬はじめました。