naoya_t:コンビネータパーサで遊んでみる
先日ふつケルを読み終えて、こういうのSchemeで作れないかな、とか思ったり思わなかったりしていたところに、
Ruiさんが Gauche 用のコンビネータパーサを作ってくれた
ので早速使ってみることにした。
MeCab の出力をパースしてみよう
MeCab は
ゴーシュは町の活動写真館でセロを弾く係りでした。
のような日本語文を
ゴーシュ 名詞,一般,*,*,*,*,* は 助詞,係助詞,*,*,*,*,は,ハ,ワ 町 名詞,一般,*,*,*,*,町,マチ,マチ の 助詞,連体化,*,*,*,*,の,ノ,ノ 活動 名詞,サ変接続,*,*,*,*,活動,カツドウ,カツドー 写真 名詞,一般,*,*,*,*,写真,シャシン,シャシン 館 名詞,接尾,一般,*,*,*,館,カン,カン で 助詞,格助詞,一般,*,*,*,で,デ,デ セロ 名詞,一般,*,*,*,*,セロ,セロ,セロ を 助詞,格助詞,一般,*,*,*,を,ヲ,ヲ 弾く 動詞,自立,*,*,五段・カ行イ音便,基本形,弾く,ヒク,ヒク 係り 名詞,一般,*,*,*,*,係り,カカリ,カカリ でし 助動詞,*,*,*,特殊・デス,連用形,です,デシ,デシ た 助動詞,*,*,*,特殊・タ,基本形,た,タ,タ 。 記号,句点,*,*,*,*,。,。,。 EOS
のように形態素に分解してくれる。
まずはこの出力テキストのパースから:
(use peg) (define mecab-parser (let* ((%surface ($do (chars ($many ($none-of #[\t]) 1)) ($return (string->symbol (list->string chars))))) (%field ($do (chars ($many ($none-of #[,\n]) 1)) ($return (string->symbol (list->string chars))))) (%line ($do (surface %surface) tab (feature ($sep-by %field ($char #\,))) newline ($return (cons surface feature)))) (%eos ($seq ($string "EOS") newline))) ($do (lines ($many %line)) %eos ($return lines)))) (define morphemes (parse-string mecab-parser "ゴーシュ 名詞,一般,*,*,*,*,* は 助詞,係助詞,*,*,*,*,は,ハ,ワ 町 名詞,一般,*,*,*,*,町,マチ,マチ の 助詞,連体化,*,*,*,*,の,ノ,ノ 活動 名詞,サ変接続,*,*,*,*,活動,カツドウ,カツドー 写真 名詞,一般,*,*,*,*,写真,シャシン,シャシン 館 名詞,接尾,一般,*,*,*,館,カン,カン で 助詞,格助詞,一般,*,*,*,で,デ,デ セロ 名詞,一般,*,*,*,*,セロ,セロ,セロ を 助詞,格助詞,一般,*,*,*,を,ヲ,ヲ 弾く 動詞,自立,*,*,五段・カ行イ音便,基本形,弾く,ヒク,ヒク 係り 名詞,一般,*,*,*,*,係り,カカリ,カカリ でし 助動詞,*,*,*,特殊・デス,連用形,です,デシ,デシ た 助動詞,*,*,*,特殊・タ,基本形,た,タ,タ 。 記号,句点,*,*,*,*,。,。,。 EOS ")
結果 (morphemes) はこんな感じ:
((ゴーシュ 名詞 一般 * * * * *) (は 助詞 係助詞 * * * * は ハ ワ) (町 名詞 一般 * * * * 町 マチ マチ) (の 助詞 連体化 * * * * の ノ ノ) (活動 名詞 サ変接続 * * * * 活動 カツドウ カツドー) (写真 名詞 一般 * * * * 写真 シャシン シャシン) (館 名詞 接尾 一般 * * * 館 カン カン) (で 助詞 格助詞 一般 * * * で デ デ) (セロ 名詞 一般 * * * * セロ セロ セロ) (を 助詞 格助詞 一般 * * * を ヲ ヲ) (弾く 動詞 自立 * * 五段・カ行イ音便 基本形 弾く ヒク ヒク) (係り 名詞 一般 * * * * 係り カカリ カカリ) (でし 助動詞 * * * 特殊・デス 連用形 です デシ デシ) (た 助動詞 * * * 特殊・タ 基本形 た タ タ) (。 記号 句点 * * * * 。 。 。))
パースする対象は文字列でなくてもいい
こうして得たリストをさらにパースしてみたい。
まずは文節単位に区切ってみよう。
たとえばこんな記述でパースしたいのだが:
(define %名詞 ($品詞 '名詞)) (define %記号 ($品詞 '記号)) (define %形容詞 ($品詞 '形容詞)) (define %連体詞 ($品詞 '連体詞)) (define %助動詞 ($品詞 '助動詞)) (define %助詞 ($品詞 '助詞)) (define %副詞 ($品詞 '副詞)) (define %動詞 ($品詞 '動詞)) (define %接続詞 ($品詞 '接続詞)) (define %接頭詞 ($品詞 '接頭詞)) (define %句点 ($表層形 '。)) (define %読点 ($表層形 '、)) (define %sentence (let* ((%v ($do (v ($many %動詞 1 2)) (aux ($many %助動詞 0 2)) (p ($many %助詞 0 2)) ($return (list 'v v aux p)))) (%n ($do (n ($many %名詞 1)) (p ($many ($or %助動詞 %助詞) 0 2)) ($return (list 'n n p)))) (%adj ($do (mod ($or %連体詞 %形容詞)) ($return (list 'adj mod)))) (%adv ($do (mod %副詞) ($return (list 'adv mod)))) (%seg ($or %n %v %adj %adv))) ($do (segs ($many %seg 1)) ($optional %句点) ($return (list 'sentence segs)))))
ここで
(define ($表層形 x) ($do (m ($satisfy (lambda (m) (eq? (m-surface m) x)) x)) ($return m))) (define ($品詞 x) ($do (m ($satisfy (lambda (m) (eq? (m-hinshi m) x)) x)) ($return m))) (define (m-surface m) (car m)) (define (m-hinshi m) (cadr m))
1段目のパースで得たリストを、コンビネータパーサが扱えるストリームに変換
(define (make-morpheme-stream morphemes) (let loop ((l morphemes) (pos 0)) (lambda () (if (null? l) (let loop () (values #f pos loop)) (values (car l) pos (loop (cdr l) (+ pos 1)))))))
parse-string を一部改造して parse-morphemes を定義
(define (parse-morphemes parse morphemes) (define (error->string err) (case (failure-type err) ((message) (failure-message err)) ((expect) (failure-message err)) ((unexpect) (format #f "unexpected: ~a" (failure-message err))))) (let1 r (parse (make-morpheme-stream morphemes)) (if (parse-success? r) (semantic-value-finalize! (result-value r)) (raise (make-condition <parse-error> 'position (failure-position r) 'message (error->string r))))))
あとは
(define (parse-sentence s) (parse-morphemes %sentence s))
でパースが可能。
結果を見てみよう:
(define (print-sentence s) (define (print-seg seg) (let ((type (car seg))) (case type ((n) (let ((n (cadr seg)) (p (caddr seg))) (format "[~a] ~a ~a" type (string-join (map m-surface-str n) "+") (string-join (map m-surface-str p) ".")))) ((v) (let ((v (cadr seg)) (aux (caddr seg)) (p (caddr seg))) (format "[~a] ~a ~a ~a" type (string-join (map m-surface-str v) "+") (string-join (map m-surface-str aux) ".") (string-join (map m-surface-str p) ".")))) ((adj adv) (let ((a (cadr seg))) (format "[a] ~a" (m-surface-str a)))) (else (format "? ~a" seg))))) (map print (map print-seg (cadr s)))) (print-sentence (parse-sentence result)) [n] ゴーシュ は [n] 町 の [n] 活動+写真+館 で [n] セロ を [v] 弾く [n] 係り でし.た
《たぶん続く》