読者です 読者をやめる 読者になる 読者になる

形態素解析器(2)

common lisp algorithm

形態素解析器作成の2。

前回で必要なデータの準備は終わったので、今回からは解析器の実装に入る。
この実装では、形態素解析はおおまかに次の二つの段階に分けられる。

  1. 入力テキストを形態素列に分割する。一般に、入力テキストは複数の形態素列に変換可能なので、その全てのパターンを列挙する
  2. それらの分割にコスト(優先順位)を付与する。コストが最小の形態素列が、入力テキストの最適な形態素解析結果となる。

今回はこの内の1の段階を扱う。

入力テキストの形態素列への分割

入力テキストの形態素列への分割とあるが、実際にはこの段階では、入力テキストを元に形態素をノードとするグラフを生成する。
例えば、「目玉焼きを食べる」という文章(入力テキスト)は、次のようなグラフに変換される。

  • -


※1 BOS/EOSは、それぞれ文頭/文末を表す特殊な形態素
※2 各ノードは、"形態素名#ID[テキスト中の開始位置-終了位置]"という形式になっている。
※3 「目」などの形態素が複数同時に表れているのは、それらがIPA辞書内で、同じ単語名でも違う品詞として複数登録されているため(多品詞語)

  • -

このような形のグラフは、形態素解析の用語では(?)ラティス構造と呼ばれるらしい。ただ個人的には、DAG(Directed acyclic graph)と云われた方がしっくりくる。
このグラフのBOSノードを始点として(一般的なグラフの)探索を開始し、EOSノードへの到達毎に探索パスを出力するようにすれば、入力テキストの可能な形態素分割結果が全て得られる。※ 上の例では、10816通り(多分)


今回は、このグラフを入力テキストから得るのが目的な訳だが、そのためには前回用意したIPA辞書の単語セットを使って、入力テキストの全ての部分文字列に対してマッチングをかければ良い。
これはcommon-prefix-searchを使えば簡単に実現でき、基本的なロジックは以下のように数行+αで書くことができる。

;; 単語セット(trie)を読み込む
> (defvar *da* (doar:load "data/key.idx"))

;; doar:common-prefix-searchのラッパー: 一致位置ではなく、一致した部分文字列(とID)を返す
(defun common-prefix-search (text &key (da *da*) (start 0))
  (loop FOR (end-pos . id) IN (doar:common-prefix-search text da :start start)
        COLLECT (list (subseq text start end-pos) id)))

;; メインの処理
;; textに一致する単語辞書内の全ての単語を出力する
(defun print-matched-word (text)
  (dotimes (i (length text))
    (format t "位置~Dに一致した単語: ~{~A~^, ~}~%"
            i (mapcar #'car (common-prefix-search text :start i)))))

;; 実行例
> (print-matched-word "目玉焼きを食べる")
;; BOSはここにくる
位置0に一致した単語: 目, 目玉, 目玉焼き
位置1に一致した単語: 玉
位置2に一致した単語: 焼, 焼き
位置3に一致した単語: き
位置4に一致した単語: を
位置5に一致した単語: 食, 食べ, 食べる
位置6に一致した単語: べ
位置7に一致した単語: る
;; EOSはここにくる

まだ(上の※3に書かれている)多品詞語*1の存在を考慮に入れていないため、上に載せた図のそれとは若干異なるが、グラフを作成するのに必要な情報はほとんど得られている。

実装

概要は上に書いた通りなのだが、実際には後続の処理のために、いろいろやらなければいけないことがある。
以降は、そのためのコードを載せていく。


まずは、使用パッケージや構造体、スペシャル変数定義:

;;;;;;;;;;;;;;;;;
;;; 使用パッケージ等
(load "doar")
(require :cl-ppcre)
(require :iterate)
(use-package :cl-ppcre)


;;;;;;;;;;;;;                
;;; 構造体
;; 単語(形態素)用の構造体
;; スロットは、MeCabの単語辞書の行の各項目に対応する
;; ex] やぼったい{surface},19{left-id},19{right-id},6956{cost},形容詞,自立,*,*,形容詞・アウオ段,基本形,やぼったい,ヤボッタイ,ヤボッタイ{info}
(defstruct word
  (surface  "" :type string) ; 表層形(単語名)
  (left-id   0 :type fixnum) ; 左連接状態番号(単語が左側にある時の品詞ID)
  (right-id  0 :type fixnum) ; 右連接状態番号(単語が右側にある時の品詞ID)  ※ IPA辞書の場合は、おそらく常にleft-id==right-id
  (cost      0 :type fixnum) ; 単語コスト    
  info)                      ; 単語の付加情報: 普通は、品詞や読みなど。ただし任意の情報が可。キー(単語)に対応する値で、解析には使われない

(defmethod print-object ((obj word) stream)
  (with-slots (surface info) obj
    (format stream "[~S:~A]" surface info)))

;; wordに位置情報や累積コストなどを付与した構造体
(defstruct node 
  word                                     ; word構造体
  (beg -1 :type fixnum)                    ; マッチ開始位置
  (end -1 :type fixnum)                    ; マッチ終了位置
  (cost most-positive-fixnum :type number) ; ノードのコスト
  prev)                                    ; 連接するノード

(defmethod print-object ((obj node) stream)
  (with-slots (beg end word prev) obj 
    (format stream "{~D-~D ~S ~S}" beg end word prev)))


;;;;;;;;;;;;;;;;
;;; スペシャル変数
;; 辞書関連
(defvar *da* (doar:load "data/key.idx"))
(defvar *wdic*)   ; 単語辞書用: (aref *wdic* 単語ID) => (list word構造体)
        
;; EOS,BOS,未知語の定義
(defvar *bos*     (make-word :surface "BOS" :info "*,*,*,*,*,BOS"))
(defvar *eos*     (make-word :surface "EOS" :info "*,*,*,*,*,EOS"))
(defvar *unknown* (make-word :surface "_"
                             :left-id  1285  ; "名詞,一般"の品詞IDを割り当てておく
                             :right-id 1285
                             :cost     20000 ; 適当に大きいコスト
                             :info "未知語,*,*,*,*"))


次は単語辞書関連の関数定義など:

;; 単語辞書読込み
(defun load-word-dic (csv-file &optional (*da* *da*))
  (let ((dic (make-array (doar:size *da*) :initial-element nil))
        (cnt 0))
    (iterate:iter (iterate:FOR line IN-FILE csv-file USING #'read-line)
        ;; 進捗表示            
        (when (zerop (mod (incf cnt) 1000))
          (format t "# ~D~%" cnt))
        
        ;; 単語定義行を','で分割
        (destructuring-bind (surface lid rid cost info) (split #\, line :limit 5)
          (let ((id (doar:search surface *da*)))
            ;; wordを追加
            (push (make-word :surface   surface
                             :left-id   (parse-integer lid)
                             :right-id  (parse-integer rid)
                             :cost      (parse-integer cost)
                             :info      info)
                  (aref dic id)))))
    dic))
;; 宣言しておいた変数に値をセット
(defparameter *wdic* (load-word-dic "data/word.csv"))


;; 単語名 or 単語ID から、対応するwordのリストを取得する
(defun get-words (word &optional (*da* *da*) (*wdic* *wdic*))
  (etypecase word
    (string (when #1=(doar:search word *da*)
              (svref *wdic* #1#)))
    (fixnum (svref *wdic* word))))

;;;;
;; 使用例
;; 単語名から取得
> (get-words "目")
--> (["目":名詞,接尾,助数詞,*,*,*,目,モク,モク] ["目":名詞,接尾,一般,*,*,*,目,メ,メ]
     ["目":名詞,非自立,一般,*,*,*,目,メ,メ] ["目":名詞,一般,*,*,*,*,目,メ,メ])

;; 単語IDから取得
> (get-words (doar:search "目" *da*))
--> (["目":名詞,接尾,助数詞,*,*,*,目,モク,モク] ["目":名詞,接尾,一般,*,*,*,目,メ,メ]
     ["目":名詞,非自立,一般,*,*,*,目,メ,メ] ["目":名詞,一般,*,*,*,*,目,メ,メ])


最後に、入力テキストからグラフを生成するための関数定義:

;; テキスト(の部分文字列)に一致する全ての辞書内の単語を抽出する
;; 'word'とあるが、実際にはwordに位置情報(等)を追加したnodeのリストが返される
(defun matched-word-list (text &optional (*da* *da*))
  (let ((list '()))
    (dotimes (beg-pos (length text))
      (dolist (pair (doar:common-prefix-search text *da* :start beg-pos))
        (destructuring-bind (end-pos . word-id) pair
          (dolist (word (get-words word-id))
            (push (make-node :word word
                             :beg beg-pos
                             :end end-pos)
                  list)))))
    (nreverse list)))

;; matched-word-listの結果に、BOS/EOS/未知語、を追加する
;; ※ 関数名は不適切
(defun lattice (text &optional (*da* *da*) &aux (size (length text)))
  `(,(make-node :word *bos* :beg -1 :end 0 :cost 0)
    ,@(sort 
       (nconc
        ;; 【未知語】
        ;; テキストの全ての文字は、未知語の可能性があるものとして処理する
        ;; 雑だけど簡単な方法
        (loop FOR i FROM 0 BELOW size
              COLLECT (make-node :word *unknown* :beg i :end (1+ i)))
        (matched-word-list text))
       (lambda (a b)
         (or (< (node-beg a) (node-beg b))    ; マッチ開始位置と終了位置でソート
             (< (node-end a) (node-end b)))))
    ,(make-node :word *eos* :beg size :end (1+ size))))

;;;;
;; 使用例
>  (format t "~{~A~%~}" (matched-word-list "形態素解析"))
{0-1 ["形":名詞,接尾,一般,*,*,*,形,ケイ,ケイ] NIL}
{0-1 ["形":名詞,接尾,一般,*,*,*,形,ガタ,ガタ] NIL}
{0-1 ["形":名詞,一般,*,*,*,*,形,ナリ,ナリ] NIL}
{0-1 ["形":名詞,一般,*,*,*,*,形,カタ,カタ] NIL}
{0-1 ["形":名詞,一般,*,*,*,*,形,カタチ,カタチ] NIL}
{0-2 ["形態":名詞,一般,*,*,*,*,形態,ケイタイ,ケイタイ] NIL}
{0-3 ["形態素":名詞,一般,*,*,*,*,形態素,ケイタイソ,ケイタイソ] NIL}
{1-2 ["態":名詞,一般,*,*,*,*,態,タイ,タイ] NIL}
{2-3 ["素":名詞,一般,*,*,*,*,素,モト,モト] NIL}
{2-3 ["素":名詞,形容動詞語幹,*,*,*,*,素,ソ,ソ] NIL}
{3-4 ["解":動詞,自立,*,*,五段・ラ行,体言接続特殊2,解る,ワカ,ワカ] NIL}
{3-4 ["解":名詞,サ変接続,*,*,*,*,解,カイ,カイ] NIL}
{3-5 ["解析":名詞,サ変接続,*,*,*,*,解析,カイセキ,カイセキ] NIL}

;; 上の結果に、BOS/EOS/未知語が加わっている
>  (format t "~{~A~%~}" (lattice "形態素解析"))
{-1-0 ["BOS":*,*,*,*,*,BOS] NIL}
{0-1 ["_":未知語,*,*,*,*] NIL}
{0-1 ["形":名詞,接尾,一般,*,*,*,形,ケイ,ケイ] NIL}
{0-1 ["形":名詞,接尾,一般,*,*,*,形,ガタ,ガタ] NIL}
{0-1 ["形":名詞,一般,*,*,*,*,形,ナリ,ナリ] NIL}
{0-1 ["形":名詞,一般,*,*,*,*,形,カタ,カタ] NIL}
{0-1 ["形":名詞,一般,*,*,*,*,形,カタチ,カタチ] NIL}
{0-2 ["形態":名詞,一般,*,*,*,*,形態,ケイタイ,ケイタイ] NIL}
{1-2 ["_":未知語,*,*,*,*] NIL}
{1-2 ["態":名詞,一般,*,*,*,*,態,タイ,タイ] NIL}
{0-3 ["形態素":名詞,一般,*,*,*,*,形態素,ケイタイソ,ケイタイソ] NIL}
{2-3 ["_":未知語,*,*,*,*] NIL}
{2-3 ["素":名詞,一般,*,*,*,*,素,モト,モト] NIL}
{2-3 ["素":名詞,形容動詞語幹,*,*,*,*,素,ソ,ソ] NIL}
{3-4 ["_":未知語,*,*,*,*] NIL}
{3-4 ["解":動詞,自立,*,*,五段・ラ行,体言接続特殊2,解る,ワカ,ワカ] NIL}
{3-4 ["解":名詞,サ変接続,*,*,*,*,解,カイ,カイ] NIL}
{3-5 ["解析":名詞,サ変接続,*,*,*,*,解析,カイセキ,カイセキ] NIL}
{4-5 ["_":未知語,*,*,*,*] NIL}
{5-6 ["EOS":*,*,*,*,*,EOS] NIL}

1の段階で必要な関数は以上で終了。


あと、おまけとして、最初の方に載せた図を作成する関数の定義も書いておく。
graphvizがインストールされている必要がある

(defun node-label (node)
  (with-slots (beg end word) node
    (format nil "~A#~36R[~D-~D]" 
            (word-surface word) 
            (mod (sb-kernel:get-lisp-obj-address word) #36R10) 
            beg end)))

(defun nodes-end-at (node-list end-pos)
  (remove end-pos node-list :key #'node-end :test #'/=))

(defun print-dot (text &key (*da* *da*) (out *standard-output*) remove-unknown)
  (format out "~&digraph lattice {~%")
  (format out "graph [rankdir=LR]~%")
  
  (let ((nodes (lattice text)))
    (when remove-unknown
      (setf nodes (remove *unknown* nodes :key #'node-word)))
    (dolist (next (cdr nodes))
      (dolist (prev (nodes-end-at nodes (node-beg next)))
        (format out "~S -> ~S~%" (node-label prev) (node-label next)))))
  (format out "~&}~%"))
    
(defun dot (text dot-file gif-file &key remove-unknown)
  (with-open-file (out dot-file :direction :output :if-exists :supersede)
    (print-dot text :out out :remove-unknown remove-unknown))
  (run-program "dot" (list "-s10" "-Tgif" "-o" gif-file dot-file) :search t))

;;;;
;; 使用例
> (dot "目玉焼きを食べる" "graph.dot" "graph.gif" :remove-unknown t)

*1:正確には多品詞語以外にも、単語も品詞も同じだが読みだけが違う単語、といったものも結構あるが、簡単のために多品詞語という語句で統一することにする