2009年11月18日水曜日

マルコフ連鎖をCommonLisp+MeCabで

バイト中にエントリーシート(の自己PR)を生成するプログラムをつくろうぜ、というネタが出たのでやってみた。思えば去年も現実逃避ぎみに似たようなことをしていた気がする。

(asdf:oos 'asdf:load-op :kmrcl)
(defpackage es
(:use :cl :kmrcl)
(:export store-word store-string emit-es print-ht
write-ht-to-file read-ht-from-file))
(in-package es)

(defvar *ht* (make-hash-table :test 'equal))

(defun store-word (word prev2 prev1 &optional (ht *ht*))
(push
word
(gethash (cons prev2 prev1) ht)))

(defun get-word (prev2 prev1 &optional (ht *ht*))
(let ((word-list (gethash (cons prev2 prev1) ht)))
(nth (random (length word-list)) word-list)))

(defun store-word-list (word-list &optional (ht *ht*))
(let ((lst (append (list :start :start)
word-list
(list :end :end))))
(loop :for rest = lst then (cdr rest)
:for word = (third rest)
:for prev1 = (second rest)
:for prev2 = (first rest)
:until (and (eq prev1 :end ) (eq word :end))
:do (store-word word prev2 prev1 ht))))

(defun parse-string-to-word-list (str)
(mecab
;;改行や空白はさようならする
(remove-if
#'(lambda (ch) (or (char= ch #\space)
(char= ch #\newline)
(char= ch #\IDEOGRAPHIC_SPACE)
(char= ch #\tab)))
str)))

(defun mecab (str)
(cl-ppcre:split
"[\\n| ]"
(let ((sb-impl::*default-external-format* :eucjp))
(kmrcl:command-output "echo ~A|mecab -O wakati" str))))

(defun store-string (str &optional (ht *ht*))
(store-word-list (parse-string-to-word-list str) ht))

(defun emit-es (&optional (ht *ht*))
(loop
:for prev2 = :start then prev1
:for prev1 = :start then word
:for word = (get-word prev2 prev1 ht)
:until (eq word :end)
:do (format t "~A " word)))

(defun print-ht (&optional (ht *ht*))
(maphash #'(lambda (k v) (format t "~A:~A~%" k v)) ht))

(defun write-ht-to-file (filename &optional (ht *ht*))
(with-open-file (s filename :direction :output :if-exists :overwrite
:if-does-not-exist :create)
(maphash
#'(lambda (key val)
(write (cons key val) :stream s))
ht)))

(defun read-ht-from-file (filename &optional (ht *ht*))
(with-open-file (s filename :direction :input)
(loop :for obj = (read s nil :eof)
:until (eq obj :eof)
:do
(setf
(gethash (car obj) ht)
(cdr obj)))))

接頭語は2つで、consしてハッシュテーブルのキーにしている。なので、ハッシュテーブルの生成時にキーワードパラメータtestにequalを指定している。

ファイルへの書き出しと読み込みは、Lispなのでwrite/readを用いた。楽ちん。

形態素解析はmecabを用いているが、すごくやっつけ仕事状態になっている。 mecabはデフォルトだとeucを使うらしいので、UTF-8な私のSBCLの環境とあわないため、一時的にexternal-formatの設定を変えて対処した。

とりあえず、hunchentootを使ってwebから使えるようにしてみた。

(asdf:oos 'asdf:load-op :hunchentoot)

(defvar *server* nil)

(setf
hunchentoot:*hunchentoot-default-external-format*
:utf8)
(setf
hunchentoot:*default-content-type*
"text/html; charset=utf-8")

(setf hunchentoot:*access-log-pathname*
"/home/kurohuku/es.log")

(defun start-server (port)
(setf *server*
(hunchentoot:start
(make-instance 'hunchentoot:acceptor :port port))))

(start-server 9999)

(hunchentoot:define-easy-handler (es-main :uri "/es") ()
(setf (hunchentoot:content-type*) "text/html; charset=utf-8")
(format nil
"
<html>
<head> <title> ES main </title> </head>
<body>
<form action=\"/store\" method=\"post\">
<input type=\"submit\" value=\"send\">
<textarea name=\"str\" rows=\"4\" cols=\"40\"></textarea>
</form>
</body>
</html>"))

(hunchentoot:define-easy-handler (store-string :uri "/store") (str)
(setf (hunchentoot:content-type*) "text/plain; charset=utf-8")
(format t "str=~A~%" str)
(es:store-string str)
(format nil "store string:~%~A~%" str))

(hunchentoot:define-easy-handler (emit-es :uri "/emit") ()
(setf (hunchentoot:content-type*) "text/plain; charset=utf-8")
(with-output-to-string (*standard-output*)
(es:emit-es)))

さて、問題はサンプルをどこから持ってくるか、だ。

0 件のコメント:

コメントを投稿