Alcor の Abbreviation Scoring - 日々ごちゃごちゃと考える

steps to phantasien: Alcor の Abbreviation Scoring を xyzzy lisp に直訳してみた。ac-mode とかの絞り込みに使えないかと思ったんだけど、そのままだと使いにくそう。将来やっぱ使おうと思ったときのためにメモ。ぐちゃぐちゃ書いてるけど、リンク先の記事に書いてある以上のことはほぼない（自分が理解するために書いた）。

スコア、というのは元の文字列 string の各文字（あるいは各単語）が pattern として与えられたかどうか、という点数を平均したもの（1文字あたりの点数）

与えられた => 1.0
飛ばされた => 0.0
省略された => 0.85
未入力っぽい => 0.9

でポイントになるのが「飛ばされた」のか「省略された」のか。これを判断するのに string はいくつかの単語からなる文であり、pattern として入力されたのはその文中にあるいずれかの単語の先頭部分である、と見なしてそれをヒントに単語の区切りを探してる。

基本的なアイデアは, 比較文字列 (abbreviation) を語のプレフィクスのリストだと解釈しなおすこと.
steps to phantasien: Alcor の Abbreviation Scoring

以下どーやって調べてどーやって点数にしてるのか。

pattern をてきとーに区切って string の一致する部分を探していく

pattern が string のどこかに（先頭に限らず）一致するか調べて、一致しなければ pattern を後ろから削っていく。一致するしないに関しては全部 case insensitive。
一致する部分が見つかったら、pattern, string それぞれ残りの部分について同じことをする。例えば "multiple-value-bind" に対して pattern が "MulValBind" だったら、"Mul" まで削ったところで "MULtiple-value-bind" にマッチして次は pattern="ValBind", string="tiple-value-bind" となる。これもまた pattern を削っていって "Val" になったところで "tiple-VALue-bind" にマッチする。これを繰り返していくことで、pattern の各部分が string のどこかにあるかを調べていく。

残りの部分を見ていって、どこにも一致しなくなったら nil を返す。
pattern の最後まで使ったら、その時点で残ってる string は未入力と見なして0.9点もらえる。

飛ばされた or 省略された部分は減点

"Mul" に続いて "Val" がマッチしたときに、string の "tiple-" がすっ飛ばされたので、この分減点する。1文字飛ばすと-1点。
ただし、ヒットした部分が単語の開始部分っぽかったら減点が小さくなる。
マッチした部分が空白の直後だった場合、この string は "white space separated" な文と見なして、飛ばされた部分のうち空白1つ=1単語につき1点、空白以外の文字1つにつき0.15点の減点。ex) 飛ばされた部分が "tiple " だったら空白1個=1点+その他5個=0.75点で合計1.75点、文字あたり0.2916点ほどの減点。（この場合 "multiple" は先の "Mul" でヒットしているので減点する必要はないような気がする。）
マッチした部分が大文字から始まっていた場合（ただし上記の空白直後のケースと重複はしない）、この string は "CamelCase" な文（？）と見なして、飛ばされた部分のうち大文字1点、大文字以外は0.15点の減点。ヒットした部分が "Val" で飛ばされた部分が "tiple-" だったら大文字なしのその他6文字で合計0.9、文字あたり0.15点の減点。

## 単語の区切りが "white space separated" と "CamelCase" しか実装されてないので、"multiple-value-bind" みたいな string だと単語の区切りを見つけられずフルに減点されてしまう。そのまま ac-mode に組み込んでもあんまりうれしくなさそう。といっても "-" とか "_" とかを区切り文字として扱うようにする（さらに言えば現在の syntax-table を参照するとか、むしろ単語の境界にマッチするってのがあったような）のはそんなに難しくもなさそう。

最終的に

{[マッチした位置 + マッチした pattern の長さ] - 減点 + [残り部分のスコア * 残り部分の長さ]} / string の長さ

という計算でスコアを出してる。マッチの最後までは一旦1文字あたり1点与えておいてから飛ばした部分は減点する。それに残りの部分のスコアも足す（残り部分のスコアは1文字あたりのスコアで返ってくるので長さを掛けてる。）最後に文字数で割ることで1文字あたりのスコアにする。

ac-mode のこと

ac-mode は確か match する/しないだけでやってたんで、なんか色々めんどいことになりそうな。iswitchb だと便利かも（ファイル名の付け方によるかも）。isearch はしんどそう。というか使い道が違うのでイマイチな気が。anything は使ってないのでわからない。
pattern が長くなると重くなりそうなんで、pattern が何文字以下なら使うとか制限が必要な予感。
common-lisp とか python とは相性良さそうだけど ruby とか（はっきりとは知らないのだけど）関数名/変数名が省略されてる言語だとイマイチな希ガス。
## ac-mode のコード昔読んだんだけどもうすっかり忘れてていじるとかすぐにはできない。たしか special 変数使いまくっててタイヘンだった気が。

code

単に元記事のコードを lisp に翻訳しただけなんで、動くには動くって程度。

;;;; utilities

(defun substring-index (string substring &optional (count 0))
  "自分で定義しなくてもどっかにありそうな気がする #1"
  (let ((len (length substring)))
    (cond ((zerop len) nil)
          ((> len (length string)) nil)
          ((string= (substring string 0 len) substring) count)
          (t (substring-index (substring string 1) substring (1+ count))))))

(defun count-match (regexp string)
  "自分で定義しなくても #2"
  (let ((count 0))
    (while (string-match regexp string)
      (incf count)
      (setq string (substring string (match-end 0))))
    count))

(defun range (start &optional stop (step 1))
  "自分で #3  python の range"
  (when (null stop)
    (setq stop start
          start 0))
  (when (zerop step)
    (error))
  (let ((list (list))
        (continue? (if (> step 0) #'< #'>)))
    (while (funcall continue? start stop)
      (push start list)
      (incf start step))
    (nreverse list)))

;;;; Alcor's Abbreviation Scoring

(defun abbreviation-score (string pattern)
  (cond ((string= pattern "") 0.9)
        ((< (length string) (length pattern)) 0.0)
        (t
         (let ((pattern~ (string-downcase pattern)))
           (reduce (lambda (result i)
                     (or result
                         (score-for string pattern~ (- (length pattern~) i))))
                   (range (length pattern~))
                   :initial-value nil)))))

(defun score-for (string pattern pivot)
  (let* ((pattern-head (substring pattern 0 pivot))
         (pattern-tail (substring pattern pivot))
         (found (substring-index (string-downcase string) pattern-head)))
    (when found
      (let* ((tail (substring string (+ found pivot)))
             (tail-score (abbreviation-score tail pattern-tail)))
        (when (and (numberp tail-score)
                   (> tail-score 0))
          (/ (+ (- (+ found pivot)
                   (penalty string found))
                (* tail-score (length tail)))
             (length string)))))))

(defun penalty (string found)
  (if (zerop found)
      0
    (let ((skipped (substring string 0 found)))
      (cond ((string-match "\\\s $" skipped)  ; xyzzy の regexp に \s はない
             (let ((nws (count-match "\\\s " skipped))) ; Number of White Space?
               (+ nws (* (- (length skipped) nws) 0.15))))
            ((string-match "^[A-Z]" (substring string found))
             (let ((nuc (count-match "[A-Z]" skipped)))  ; Number of Upper Case?
               (+ nuc (* (- (length skipped) nuc) 0.15))))
            (t
             (length skipped))))))

ひどい日本語読むよりコード読んだ方がわかりやすいかも。