2007-12-29

末尾再帰重要

非常に貴重な突っ込みをいただきました。

odz buffer -- [Python][Scheme]tail call

教訓
* 時々は末尾再帰を意識して書こう。(特にこういう頻繁に呼び出す関数では。)
* lengthは遅い。(リストをつらつらたどって毎回計算するのかな?)
* Gaucheは関数の再帰呼び出しでスタックを使い尽くすとヒープに移す。ただしそうなるとちょっと遅くはなるかも。
* Pythonはやはり配列の添字番号をうまく使い、ジェネレーターを活かすと吉。
* Pythonのrange関数は、schemeではsrfi-1のiota

ほんとうにたすかります。ありがとうございます。
でも、このツッコミで示された最速の関数bigram3を読み解けないという悲しい状況。がんばって読もうと思います。

追記-------
bigram3理解できました。
同様の方針でこれまで自分が書いていた他の関数も末尾再帰になるようにしてみたりした。

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)

[日記]Schemeのレベル

私家版、Schemeプログラマのレベル10

SICPのambで挫折している自分はレベル4に踏み込んだばかりのレベルだ。
レベル4の「クロージャーうんぬん」はPythonを使っていて自然に身に付いたおかげで、今とても助かっているんだなあと再認識。

きっとambを使いこなせるようになれば、今会社で書いている複雑なPythonのプログラムもずいぶんすっきり書けるんだろうなあ。

[メモ]再帰を使うとn-gramはすっきり書ける

例として、bigramを生成する関数。

再帰を使わないバージョン(Python)

def bigram(data):
if len(data) < 2:
return
prev = data[0]
for x in data[1:]:
yield [prev, x]
prev = x

再帰を使ったバージョン(Scheme)
(define (bigram data)
(if (< (length data) 2)
'()
(cons (list (car data) (cadr data)) (bigram (cdr data)))))


Pythonだと再帰の深さの制限があるので、このような書き方はできませんが。
補: 念のためやってみた。
def bigram2(data):
if len(data) < 2:
return []
return [[data[0], data[1]],] + bigram2(data[1:])

↑Pythonでこう書ければいいんだけど、すぐに"maximum recursion depth exceeded"になるよ。

補: 実際にschemeでエラーにならないことも確認。
(define (bigram data)
(if (< (length data) 2)
'()
(cons (list (car data) (cadr data)) (bigram (cdr data)))))

(define (range x)
(let loop ((ini 0))
(if (= ini x)
'()
(cons ini (loop (+ ini 1))))))

(print (bigram (range 10000)))


Pythonのrange関数相当のものがschemeにも標準であるはずだと思うんだけどなあ。

2007-12-28

[メモ]MySQLでテーブル一覧でビューかどうか調べる方法。


select TABLE_NAME, TABLE_TYPE from INFORMATION_SCHEMA.TABLES
where TABLE_SCHEMA="データベース名";

2007-12-14

Gaucheの練習: 連続する名詞の抽出

連続する名詞の抽出を書いてみた。Gauche(というかScheme)素人なのでとても時間がかかる。


;; coding: utf-8

(use mecab)

(define (takenowns node buf ans)
(if (mecab-node-null? node)
(if (null? buf) ans (append ans (list buf)))
(if (equal? "名詞" (substring (mecab-node-feature node) 0 2))
(takenowns (mecab-node-next node) (append buf (list (mecab-node-surface node))) ans)
(takenowns (mecab-node-next node) '() (if (null? buf) ans (append ans (list buf))))))
)

(define m (mecab-new2 ""))

(map print
(takenowns
(mecab-sparse-tonode m "並み居る共和党候補たちのはるか後方で何カ月も低迷していた
ハッカビー氏は、アイオワ州の支持率でついに、ミット・ロムニー氏についで2位となった")
'() '()))

(mecab-destroy m)

実行結果

ayu@~/work/Gauche-mecab% gosh sample.scm | nkf -e
(共和党 候補 たち)
(はるか 後方)
(何 カ月)
(低迷)
(ハッカビー 氏)
(アイオワ 州)
(支持 率)
(ミット・ロムニー 氏)
(ついで 2 位)


自分で書いておいてなんだが、非常に読みづらいコードだと思う。
もっときれいに書けるようになるにはあと何年かかるだろうか。
Pythonできれいにかけるようになるのにも数年かかったからなあ。

以下を調べておく事------
[done] Pythonのリストのように後ろに追加していけるリストはないのだろうか。
Python文字列のstartswithメソッド相当を作る。

2007-12-13

Schemeのmecabバインディング

関数型言語を勉強して来たが、実用を考えるとマルチバイト文字を扱えることが必須になる。
その時点で早くもHaskellは立場が弱くなるのだが、その点Gaucheはすばらしいということに改めて気づいた。(Schemeでは破壊的代入ができますが、そういう細かいことは自分のような初心者にはまあ、いいでしょう。)

そこで、自分の分野でガリガリ使ってGaucheの勉強をするために、Gaucheからmecabを使ってみようと思った。

この点での先人のすばらしい記事を発見。
その記事「Gauche:MeCab」に、自分としてはparseToNode相当の機能がほしかったので、Gaucheのバインディングの細かい事を勉強せずに推測で機能追加してみた。

Gauche-mecab.tar.gz

いちおう下のようなプログラムで動くようになる。

(ただし、mecabの文字コードとGaucheの内部encodingをそろえておく必要あり。)


;; coding: utf-8

(use mecab)

(define (allnodes node)
(if (mecab-node-null? node)
'()
(cons node (allnodes (mecab-node-next node))))
)

(define m (mecab-new2 ""))

(let ((node (mecab-sparse-tonode m "太郎は極悪です。")))
(map
(lambda (x)
(print (mecab-node-surface x))
(print (mecab-node-feature x)))
(allnodes node))
)

(mecab-destroy m)

実行結果

ayu@~/work/Gauche-mecab% gosh sample.scm | nkf -e

BOS/EOS,*,*,*,*,*,*,*,*
太郎
名詞,固有名詞,人名,名,*,*,太郎,タロウ,タロー

助詞,係助詞,*,*,*,*,は,ハ,ワ
極悪
名詞,形容動詞語幹,*,*,*,*,極悪,ゴクアク,ゴクアク
です
助動詞,*,*,*,特殊・デス,基本形,です,デス,デス

記号,句点,*,*,*,*,。,。,。

BOS/EOS,*,*,*,*,*,*,*,*