自分がPythonを使えるようになって思い上がっているのをいさめるために始めたSchemeの練習を今年も続けて行こうと思います。
帰省から帰ってきたら自分が年末に書いたコードすら読めなくなっててびびりましたが。
先日ここに書いた（汚い）ソースに、Gaucheの作者様から直々に添削を頂きました！ありがとうございます！本当にありがとうございます。感激しております！
そこでまずは、以下の二点を勉強しつつ修正してみた。
* デフォルト値つきのassoc -> util.listのassoc-ref
* Pythonで言うgroupby -> gauche.collectionのgroup-collection
さらにそのコメントにはパフォーマンスを考慮した工夫や、末尾再帰を簡易に書くヒントまでも頂いておりますが、そこは一晩寝てから続きをします。
ありがとうございます！
（上記二点による修正で、コードの行数が100行 -> 78行に激減！）
;; coding: utf-8
(use mecab)
(use srfi-1)
(use srfi-13)
(use gauche.collection)
(use util.list)
;;名詞の列を抽出する関数
(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 (countgroup data)
(define (iter data buf)
(if (null? data)
buf
(if (null? (car data))
(iter (cdr data) buf)
(iter (cdr data) (cons (cons (car (car data)) (length (car data))) buf)))))
(reverse (iter data '())))
(define (has l n)
(cond ((zero? n) #t)
((pair? l) (has (cdr l) (- n 1)))
(#t #f)))
;; bigram生成関数
(define (bigram data)
(define (iter data buf)
(if (has data 2)
(iter (cdr data) (cons (list (car data) (cadr data)) buf))
buf))
(iter data '()))
(define (count-bigram data keyf)
(map (lambda (x) (cons (car x) (length x)))
(group-collection (map keyf data) :test equal?)))
;;スコア計算式
(define (calc-score word all left right)
(* (assoc-ref all (string-join word) 1.0)
(expt
(let loop ((restword word) (weight 1.0))
(if (null? restword)
weight
(loop (cdr restword)
(* weight (+ 1 (assoc-ref left (car restword) 0))
(+ 1 (assoc-ref right (car restword) 0))))))
(/ 1 (* 2 (length word))))))
;;複合語抽出メイン関数
(define (calc-mword mecabobj body)
(let* ((words (takenowns
(mecab-sparse-tonode mecabobj body)))
(tandoku-hindo (countgroup (group-collection words :test equal?)))
(uniq-bigram
(map car
(group-collection (concatenate (map bigram words)) :test 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 ""))
(time (map print (calc-mword m
"日本ハムが来秋のドラフト上位候補に、ホンダの長野（ちょうの）久義外野手（２３）＝日大出＝
をリストアップしていることが２７日、分かった。昨年１１月の大学生・社会人ドラフトで４巡目指名しな
がら入団拒否された“恋人”に、再度アタックする。 １度フラれても、あきらめきれない。日本ハムが再
び、長野の獲得に向けて動いている。「去年は（入団を）断られたけど、今年１年見て順調にきている。改
めて推薦したい選手の１人」と球団関係者。“恋人”の高評価は変わらない。 ２年越しのラブコールだ。
日本ハムは、昨年のドラフトで巨人入りを志望していた長野（当時日大）を大学生・社会人ドラフト４巡目
で強行指名。だが、希望球団でないことを理由に入団を断られた。 その後、長野は社会人のホンダへ進
み、１年目から外野の定位置を獲得。３月の社会人東京大会で新人賞を受賞し、日本代表として出場した
１１月のワールド杯（台湾）ではチーム最高打率（．４５７）をマーク。０７年の社会人野球ベストナイン
にも選出された。来秋のドラフトでは上位指名確実の逸材だ。 入団拒否後も、日本ハムの担当スカウトが
再度の獲得へ向けて誠意をみせている。関係者を通じて、巨人オンリーだった長野の心変わりをキャッチし
た。指名を拒否されながら、再び指名するのは過去数例（別項）あるが、極めて異例だ。「来年も（長野
を）注目していきたい」と球団関係者。熱い思いが届く日まで、密着マークする。")))
(mecab-destroy m)
