2007-12-29

Schemeで重要語抽出を書いた感想

重要語抽出をSchemeで書いてみて、一応できたのだけど、ソースが汚い。だれか添削してくれないものだろうか。
つい数時間前にsrfiのマニュアルを初めて見ていろいろとがっくり来た。(というぐらい低レベルな自分)

今リファクタリングを重ねながら、思い知らされるのはやはり自分の今のSchemeの低レベルぶりだ。

他の要因として、Pythonだと細かい気の利いた標準関数、メソッドなどがあらかじめ用意されているが、Schemeの標準は自由度を尊重(というか「各自自力で」推奨?)しているためPythonほどガチガチではないから、そういうのを自分で書かないといけないというのもあるんじゃなかろうか。

Pythonのdictのgetメソッドがデフォルト値を指定できたり、itertoolsのgroupbyとかは地味に便利だが、Schemeの場合はそういうのは自分で用意しないといけない。

以下、その汚いソース。アルゴリズムは毎度のことながらhttp://gensen.dl.itc.u-tokyo.ac.jp/から拝借。
mecabへの接続には、先日書いたやつを使用した。
let*を使っている部分からレベル2の匂いが。

;; coding: utf-8
(use mecab)
(use srfi-1)
(use srfi-13)

;;名詞の列を抽出する関数
(define (takenowns node)
(let impl ((node node) (buf '()) (ans '()))
(if (mecab-node-null? node)
(if (null? buf) ans (append ans (list buf)))
(if (string-prefix? "名詞" (mecab-node-feature node))
(impl (mecab-node-next node) (append buf (list (mecab-node-surface node))) ans)
(impl (mecab-node-next node) '() (if (null? buf) ans (append ans (list buf))))))))

;;文字列のリストの比較関数
(define (compare-string x y) (if (and (null? x) (null? y)) #t
(if (null? x) #t
(if (null? y) #f
(if (eq? (car x) (car y))
(comp (cdr x) (cdr y))
(string<? (car x) (car y)))))))

(define (groupby data eqfunc)
(let impl ((data data) (buf '()) (ans '()))
(if (null? data)
(if (null? buf) ans (append ans (list buf)))
(let ((head (car data)) (tail (cdr data)))
(if (null? buf)
(impl tail (list head) ans)
(if (eqfunc (car buf) head)
(impl tail (append buf (list head)) ans)
(impl tail (list head) (append ans (list buf)))))))))

(define (countgroup data)
(if (null? data)
'()
(if (null? (car data))
(countgroup (cdr data))
(cons (cons (car (car data)) (length (car data)))
(countgroup (cdr data))))))

;; bigram生成関数
(define (bigram data)
(if (< (length data) 2)
'()
(cons (list (car data) (cadr data)) (bigram (cdr data)))))

(define (count-bigram data keyf)
(map (lambda (x) (cons (car x) (length x)))
(groupby (sort (map keyf data) string<?) equal?)))

;;デフォルト値付きのassoc
(define (defassoc k ary d)
(let ((a (assoc k ary)))
(if (eq? #f a) d (cdr a))))

;;スコア計算式
(define (calc-score word all left right)
(* (defassoc (string-join word) all 1.0)
(expt
(let loop ((restword word) (weight 1.0))
(if (null? restword)
weight
(loop (cdr restword)
(* weight (+ 1 (defassoc (car restword) left 0))
(+ 1 (defassoc (car restword) right 0))))))
(/ 1 (* 2 (length word))))))

;;複合語抽出メイン関数
(define (calc-mword mecabobj body)
(let* ((words (takenowns
(mecab-sparse-tonode mecabobj body)))
(tandoku-hindo (countgroup (groupby (sort words compare-string) equal?)))
(uniq-bigram
(map car
(groupby (sort (concatenate (map bigram words)) compare-string) equal?)))
(left-hindo (count-bigram uniq-bigram cadr))
(right-hindo (count-bigram uniq-bigram car))
(tandoku-hindo-map (map (lambda (x) (cons (string-join (car x)) (cdr x))) tandoku-hindo)))
(sort
(map
(lambda (x) (cons (string-join (car x)) (calc-score (car x) tandoku-hindo-map left-hindo right-hindo)))
tandoku-hindo)
(lambda (a b) (> (cdr a) (cdr b))))))

(define m (mecab-new2 ""))

(map print (calc-mword m
"日本ハムが来秋のドラフト上位候補に、ホンダの長野(ちょうの)久義外野手(23)=日大出=を
リストアップしていることが27日、分かった。昨年11月の大学生・社会人ドラフトで4巡目指名しなが
ら入団拒否された“恋人”に、再度アタックする。 1度フラれても、あきらめきれない。日本ハムが再
び、長野の獲得に向けて動いている。「去年は(入団を)断られたけど、今年1年見て順調にきている。改
めて推薦したい選手の1人」と球団関係者。“恋人”の高評価は変わらない。 2年越しのラブコールだ。
日本ハムは、昨年のドラフトで巨人入りを志望していた長野(当時日大)を大学生・社会人ドラフト4巡目
で強行指名。だが、希望球団でないことを理由に入団を断られた。 その後、長野は社会人のホンダへ進
み、1年目から外野の定位置を獲得。3月の社会人東京大会で新人賞を受賞し、日本代表として出場した
11月のワールド杯(台湾)ではチーム最高打率(.457)をマーク。07年の社会人野球ベストナイン
にも選出された。来秋のドラフトでは上位指名確実の逸材だ。 入団拒否後も、日本ハムの担当スカウトが
再度の獲得へ向けて誠意をみせている。関係者を通じて、巨人オンリーだった長野の心変わりをキャッチし
た。指名を拒否されながら、再び指名するのは過去数例(別項)あるが、極めて異例だ。「来年も(長野
を)注目していきたい」と球団関係者。熱い思いが届く日まで、密着マークする。"))

(mecab-destroy m)


実行結果
ayu@~/work/Gauche-mecab% gosh sample.scm | nkf -e | head -n 20
(長野 . 6.0)
(指名 . 5.656854249492381)
(ドラフト . 4.898979485566356)
(日本ハム . 4.0)
(球団 関係 者 . 3.563594872561357)
(1 人 . 3.309750919646873)
(1 年 目 . 3.1072325059538586)
(獲得 . 3.0)
(入団 . 2.8284271247461903)
(0 7 年 . 2.6671682753399955)
(今年 1 年 . 2.5873402367724454)
(4 5 7 . 2.5697965868506505)
(4 巡 目 指名 . 2.413690382068065)
(社会 人 ドラフト . 2.2894284851066637)
(社会 人 ドラフト 4 巡 目 . 2.2894284851066637)
(2 年 越し . 2.220906154852325)
(社会 人 . 2.2133638394006434)
(上位 指名 確実 . 2.1398263878673256)
(2 7 日 . 2.1398263878673256)
(1 度 フラ . 2.075781631112427)