(Scheme) (Lisp)

(Table of Contetns)

  1. (おしらせ)
  2. ((Scheme) (Lisp) の Blog) [New 2004/01/22] ; Blog を使ってみました. Scheme, Lisp やスクリプト言語の最近の話題はこちら.
  3. (Scheme と Lisp のドキュメント) ; Scheme, Lisp リンク集.
  4. (Scheme と Lisp のプログラミングテクニック) ; 各種ドキュメントから拾ってきたテクニック集.
  5. (Scheme 処理系のインストール (Mac OS X 10.2.6)) ; 筆者がインストールした Scheme 処理系.
  6. (Scheme 処理系のインストール (cygwin-1.3.2)) ; 注意: 古い情報
  7. (Common Lisp ユーザのための Emacs Lisp メモ) ; 筆者が Emacs Lisp を修得するときにハマったところ.
  8. (ACLTutorial) [Update 2003/12/18] ; (Franz) 社の (Allegro Common Lisp (ACL)) の使い方.
  9. (approx-search.el) [Update 2004/02/15] ; Emacs Lisp で動く曖昧検索ライブラリ.
  10. (levenshtein-distance.el) ; Emacs Lisp で動く曖昧検索ライブラリ. このライブラリは以後メンテナンスされません. (approx-search.el) を使ってください.
  11. (spamfilter.el) [Update 2004/01/22] ; Emacs Lisp で動く SPAM フィルタリングライブラリ. (Wanderlust), (Mew), (Navi2ch) で使えます.
  12. (Perl.scm) ; Scheme で Perl っぽくスクリプトを書くためのライブラリ.
  13. (旧ページ) ; (Emacs Wiki) に移行する前のページ.
  14. (MacOSXInstallLog) ; Mac OS X のインストールログ.

(おしらせ)

(Franz) 社の (Common Lisp 無料セミナー) が行われます(毎月1回開催).

(目次へ戻る)


(Scheme と Lisp のドキュメント)

とりあえず, 各種定番? ドキュメント.

(目次へ戻る)


(Scheme と Lisp のプログラミングテクニック)

今のところ, 書けたのはこれだけ.

  1. (高階関数の使い方) ; 高階関数を使ったプログラミング
  2. (継続の使い方) ; 継続を使ったマクロ集
  3. (クロージャの使い方) ; クロージャを使うときの典型的なパターン
  4. (再帰関数を末尾再帰関数に変換する) ; 再帰関数を自動的に末尾再帰関数に変換するには?
  5. (関数の結果をキャッシュする) ; 計算コストのかかる関数を高速化するには?
  6. (delay と force を実装する) ; Common Lisp で遅延評価するには?
  7. (無限リスト) ; 遅延評価を使って無限リストを表現するには?
  8. (小ネタ)

(目次へ戻る)

(高階関数の使い方)

高階関数を使ったプログラミング例として, ツリー構造を扱う高階関数を作ってみます.

まず以下のようなツリー構造の場合,

(define tree '(1 (2 3) (4 (5 6) 7 ((8)) 9 10)))

標準のリスト処理関数は一番浅いノードにしか適用されません. 例えば reverse の場合,

> (reverse tree)
((4 (5 6) 7 ((8)) 9 10) (2 3) 1)

となってしまいます. これを全ての深さのノードに適用できるようにしてみます. まず以下のような汎用の高階関数を作ります.

(define (for-each-tree f g n tree)
  (cond ((null? tree) n)
        ((not (pair? tree)) (f tree))
        (else
         (g (for-each-tree f g n (car tree))
            (for-each-tree f g n (cdr tree))))))

ここで,

  1. f は 1 個の引数を取る関数でツリーの末端に適用されます.
  2. g は 2 個の引数を取る関数で, car 側の結果と cdr 側の結果を結合します.
  3. n はツリーが空リストの場合に返す値です.

この for-each-tree という高階関数を使って, ツリー構造に対してさまざまな処理を行う関数を作ってみます. でも, その前にユーティリティ関数を定義しておきます.

(define (identity obj)
  obj)

(define (r-cons x y)
  (append y (list x)))

(define (r-append x y)
  (append y x))

(define-syntax block
  (syntax-rules ()
    ((block tag body1 body2 ...)
     (call-with-current-continuation
      (lambda (tag)
        body1 body2 ...)))))

block(継続の使い方)で説明していますのでそちらを参照してください. それ以外は見たままです.

では, 新しい関数群を作成してみます.

(define (copy-tree tree)
  (for-each-tree identity cons '() tree))

(define (reverse-tree tree)
  (for-each-tree identity r-cons '() tree))

(define (map-tree f tree)
  (for-each-tree f cons '() tree))

(define (flatten-tree tree)
  (for-each-tree list append '() tree))

(define (sum-tree tree)
  (for-each-tree + + 0 tree))

(define (mul-tree tree)
  (for-each-tree * * 1 tree))

(define (length-tree tree)
  (for-each-tree (lambda (x) 1) + 0 tree))

(define (filter-tree f tree)
  (for-each-tree (lambda (x) (if (f x) (list x) '())) append '() tree))

(define (find-if-tree f tree)
  (block return
    (for-each-tree (lambda (x) (if (f x) (return x) #f))
                   (lambda (x y) #f)
                   #f
                   tree)))

(define (max-tree tree)
  (for-each-tree identity
                 (lambda (x y) (if (and x y) (max x y) (or x y)))
                 #f
                 tree))

このように, さまざまな処理を行う関数が for-each-tree を使って書くことができます. 実行結果は以下の通りです.

> (copy-tree tree)
(1 (2 3) (4 (5 6) 7 ((8)) 9 10))

> (reverse-tree tree)
((10 9 ((8)) 7 (6 5) 4) (3 2) 1)

> (map-tree - tree)
(-1 (-2 -3) (-4 (-5 -6) -7 ((-8)) -9 -10))

> (flatten-tree tree)
(1 2 3 4 5 6 7 8 9 10)

> (sum-tree tree)
55

> (mul-tree tree)
3628800

> (length-tree tree)
10

> (filter-tree odd? tree)
(1 3 5 7 9)

> (find-if-tree (lambda (x) (= x 5)) tree)
5

> (max-tree tree)
10

次に, これらの関数を末尾再帰にするため for-each-tree を改良してみます.

(define (for-each-tree f g n tree r)
  (cond ((null? tree) r)
        ((not (pair? tree)) (f tree))
        (else
         (for-each-tree f g n (cdr tree)
                        (g (for-each-tree f g n (car tree) n) r)))))

元の for-each-tree と比べて r という引数が追加されています. この r は結果を累積していくパラメータで accumulator と呼ばれます. accumulator の詳細については(OnLisp Section 2.8)を参照してください.

この新しい for-each-tree を使って上記の関数群を定義し直してみます. r-xxx 関数と xxx 関数が置き換わっているのところに注意してください.

(define (copy-tree tree)
  (for-each-tree identity r-cons '() tree '()))

(define (reverse-tree tree)
  (for-each-tree identity cons '() tree '()))

(define (map-tree f tree)
  (for-each-tree f r-cons '() tree '()))

(define (flatten-tree tree)
  (for-each-tree list r-append '() tree '()))

(define (sum-tree tree)
  (for-each-tree + + 0 tree 0))

(define (mul-tree tree)
  (for-each-tree * * 1 tree 1))

(define (length-tree tree)
  (for-each-tree (lambda (x) 1) + 0 tree 0))

(define (filter-tree f tree)
  (for-each-tree (lambda (x) (if (f x) (list x) '())) r-append '() tree '()))

(define (find-if-tree f tree)
  (block return
    (for-each-tree (lambda (x) (if (f x) (return x) #f))
                   (lambda (x y) #f)
                   #f
                   tree
                   #f)))

(define (max-tree tree)
  (for-each-tree identity
                 (lambda (x y) (if (and x y) (max x y) (or x y)))
                 #f
                 tree
                 #f))

実行結果は元の関数と同様です.

まとめ

  1. 関数型言語では, 汎用の高階関数と特定の特殊関数の合成としてモジュール化することにより, さまざまな処理を実現できる.
  2. 元ネタ: (なぜ関数プログラミングは重要か Section 2)
  3. 補足: 末尾再帰版の for-each-tree は以下のようなループ構造を使って書くこともできる.
(define (for-each-tree f g n tree r)
  (do ((tree tree (cdr tree))
       (r r (g (for-each-tree f g n (car tree) n) r)))
      ((not (pair? tree)) (if (null? tree) r (f tree)))))

(戻る)

(継続の使い方)

継続を使った簡単なマクロ集.

まず一番単純な Common Lisp の block に似たものを作ってみます.

(define-syntax block
  (syntax-rules ()
    ((block tag body1 body2 ...)
     (call-with-current-continuation
      (lambda (tag)
        body1 body2 ...)))))

Common Lisp と違うことは, ブロックからの脱出方法が (return-from tag value) ではなく, (tag value) と書くところです. block の使い方はこんな感じです.

> (define (print . objs)
    (for-each (lambda (o) (display o)) objs)
    (newline))

> (block return
    (print 'before)
    (return 'hello)
    (print 'after))
before
hello

> (block foo
    (print 'foo-1)
    (block bar
      (print 'bar-1)
      (foo 'hello)
      (bar 'bye)
      (print 'bar-2))
    (print 'foo-2))
foo-1
bar-1
hello

この block を使って Common Lisp の simple loop を作ってみます.

(define-syntax loop
  (syntax-rules ()
    ((loop tag body1 body2 ...)
     (block tag
       (let rec ()
         body1 body2 ...
         (rec))))))

使い方はこんな感じ.

> (let ((i 0))
    (loop return
      (print i)
      (if (= i 5) (return 'bye))
      (set! i (+ i 1))))
0
1
2
3
4
5
bye

次に C 言語ちっくな break と continue の使える while を作ってみます. break と continue を引数に渡さないといけないところがちょっとダサい気がしますが, とりあえず良しとしましょう. (注: 上で作成した block を利用しています)

(define-syntax while
  (syntax-rules ()
    ((while test break continue body1 body2 ...)
     (block break
       (let loop ()
         (cond (test
                (block continue
                  body1 body2 ...)
                (loop))))))))

使い方はこんな感じです. ネストした while からも一気に外側に抜けることができます.

> (let ((i 0))
    (while (< i 10) break continue
      (print i)
      (cond ((= i 1)
             (set! i 3)
             (continue)))
      (if (= i 5) (break 'bye))
      (set! i (+ i 1))))
0
1
3
4
5
bye

> (let ((i 0))
    (while (< i 5) break-i continue-i
      (let ((j 0))
        (while (< j 5) break-j continue-j
          (print `((i ,i) (j ,j)))
          (if (and (= i 1) (= j 1)) (break-i 'bye))
          (set! j (+ j 1))))
      (set! i (+ i 1))))
((i 0) (j 0))
((i 0) (j 1))
((i 0) (j 2))
((i 0) (j 3))
((i 0) (j 4))
((i 1) (j 0))
((i 1) (j 1))
bye

まとめ

  1. block 内で脱出するには (return-from tag value) ではなく, (tag value) を使う.
  2. ネストした block から一気に外側へ抜けることができる.

(戻る)

(クロージャの使い方)

クロージャを使うときの典型的なパターンを紹介します.

まず例として次のような関数を考えてみます.

(define gensym
  (lambda (n)
    (string->symbol (string-append "#:G" (number->string n)))))

> (gensym 1)
|#:G1|

> (gensym 2)
|#:G2|

この関数 gensym の目的は, ユニークなシンボルを生成することです. 変数 n を毎回引数に渡すのは使いづらいので, この変数 n を渡さなくて済むように, トップレベル変数(グローバル変数)を使って改造してみます.

(define *gensym-n* 0)

(define gensym
  (lambda ()
    (set! *gensym-n* (+ *gensym-n* 1))
    (string->symbol (string-append "#:G" (number->string *gensym-n*)))))

これで, ユニークなシンボルを得るという当初の目的を達成することができました. しかしクロージャにすると, グローバル変数を使わずに書くことができます.

(define gensym
  (let ((n 0))
    (lambda ()
      (set! n (+ n 1))
      (string->symbol (string-append "#:G" (number->string n))))))

上記の追加した変数 ngensym 関数外からはアクセスできません. つまり関数自体が n という状態を持っているかのように振舞います.

このパターンは,

(define 関数名
  (lambda (仮引数1 ...)
    ボディ))

という関数を,

(define 関数名
  (let ((変数1 初期値1) ...)
    (lambda (仮引数1 ...)
      ボディ)))

とすることにより, 上記の 変数1 ... を関数内にとじこめることができます.

letrec でも大丈夫です. 以下の例では fact の計算時にパスワード入力を求められます.

> (define protected-fact
    (letrec ((passwd 'foo)
             (fact (lambda (n)
                     (if (<= n 1) 1
                         (* n (fact (- n 1)))))))
      (lambda (n)
        (if (eq? passwd (read)) (fact n)
            'sorry))))

> (protected-fact 5)
bar ; 入力
sorry

> (protected-fact 5)
foo ; 入力
120

このパターンを使った例をもう一つ.

(define (make-point init-x init-y)
  (let ((x init-x) (y init-y))
    (lambda (method . param)
      (cond ((eq? method 'get-x) x)
            ((eq? method 'get-y) y)
            ((eq? method 'set-x) (set! x (car param)))
            ((eq? method 'set-y) (set! y (car param)))
            ((eq? method 'print) (display `((x ,x) (y ,y))) (newline))
            (else 'hum?)))))

> (define p (make-point 10 20))

> (p 'print)
((x 10) (y 20))

> (p 'get-x)
10

> (p 'set-x 100)

> (p 'print)
((x 100) (y 20))

> (define q (make-point 55 88))

> (q 'print)
((x 55) (y 88))

> (p 'print)
((x 100) (y 20))

> p
<closure 0xa09b900(method param)>

> q
<closure 0xa09b340(method param)>

クロージャを使ったオブジェクト指向みたいなことができます.

(戻る)

(再帰関数を末尾再帰関数に変換する)

通常の再帰関数を自動的に末尾再帰関数に変換する関数を作成します.

例として以下のような再帰関数 fact を末尾再帰関数に変換することを考えてみます.

(define (fact n)
  (if (<= n 1) 1
      (* n (fact (- n 1))))))

  ↓変換

(define (fact n acc)
  (if (<= n 1) acc
      (fact (- n 1) (* n acc))))

この変換は以下のようなステップに分けられます.

  1. アキュムレータ変数を仮引数に追加する.
    (define (fact n) ...) → (define (fact n acc) ...)
    
  2. 終了条件が真の場合にアキュムレータ変数を返すように置換する.
    (if (<= n 1) 1 ...) → (if (<= n 1) acc ...)
    
  3. 終端文脈内の自分自身を呼び出している部分を, アキュムレータ変数に置き換え, それを次回のアキュムレータとして自分自身を呼び出す形に変換する.
    (* n (fact (- n 1))) → (* n acc) → (fact (- n 1) (* n acc))
    

ステップ 3 がすこしややこしいですが, それほど難しいわけではありません. アキュムレータについては(OnLisp Section 2.8)を参照してください. 終端文脈については(R5RS 正しい終端再帰)を参照してください.

このような変換を行う関数 rec->tailrec を作成してみましょう. ひとまず, rec->tailrec が以下のような動作をすることを目標とします.

> (rec->tailrec '(define (fact n)
                   (if (<= n 1) 1
                       (* n (fact (- n 1))))))
(define (fact n acc)
  (if (<= n 1) acc
      (fact (- n 1) (* n acc))))

まずはじめにユーティリティ関数を定義しておきます.

(define (atom? obj)
  (not (pair? obj)))

(define (find-if p lst)
  (cond ((null? lst) #f)
        ((p (car lst)) (car lst))
        (else (find-if p (cdr lst)))))

(define (append-atom lst obj)
  (append lst (list obj)))

(define gensym
  (let ((n 0))
    (lambda ()
      (set! n (+ n 1))
      (string->symbol (string-append "G" (number->string n))))))

gensym はほとんどの処理系で用意されているので, そちらを使ったほうがよいでしょう. また, (クロージャの使い方)で説明していますのでそちらを参照してください. それ以外は見たままです.

では, rec->tailrec を作成します.

(define (rec->tailrec func-def)
  (let ((def (car func-def))
        (name (caadr func-def))
        (args (cdadr func-def))
        (body (cddr func-def))
        (acc (gensym)))
    `(,def (,name ,@args ,acc)
       ,@(rec->tailrec-body acc name body))))

rec->tailrec は引数で与えられた func-def を, 関数名(name), 仮引数(args), 関数本体(body) に分解し, アキュムレータ変数(acc)を仮引数に追加します. これは, 上述のステップ 1 に相当します. 関数本体は rec->tailrec-body で変換します.

ここで, アキュムレータ変数が gensym で生成されたユニークなシンボルであることに注意してください. こうしないと, もしも仮引数(args)中に偶然 acc というシンボルが入っていたときに, エラーとなってしまいます (仮引数群の中に同じ変数が 2 度以上現れてはならないため. (R5RS 手続き)を参照).

とりあえず, ダミーの rec->tailrec-body を定義して, rec->tailrec がどのような動作をするか試してみましょう.

> (define (rec->tailrec-body acc name body)
    body)

> (rec->tailrec '(define (fact n)
                   (if (<= n 1) 1
                       (* n (fact (- n 1))))))
(define (fact n G1)
  (if (<= n 1) 1
      (* n (fact (- n 1)))))

G1 というアキュムレータ変数が追加されています. これでステップ 1 は実現できました. 残りはステップ 2, 3 を実現する rec->tailrec-body を定義することです.

まずステップ 2 を考えてみましょう. 以下のように rec->tailrec-body を定義してみます.

(define (rec->tailrec-body acc name body)
  (define (if? expr) (and (pair? expr) (eq? 'if (car expr))))
  (cond ((atom? body) body)
        ((if? body)
         `(if ,(cadr body) ,acc
              ,(rec->tailrec-body acc name (cadddr body))))
        (else (map (lambda (expr) (rec->tailrec-body acc name expr)) body))))

((if? body) ...) の部分は, body(if ...) の場合に

(if test then else) → (if test acc else)

という変換を行います. 見つからなかった場合はリストの要素に対して再帰的に rec->tailrec-body を適用します.

試してみます.

> (rec->tailrec '(define (fact n)
                   (if (<= n 1) 1
                       (* n (fact (- n 1))))))
(define (fact n G2)
  (if (<= n 1) G2
      (* n (fact (- n 1)))))

元の関数で 1 を返す部分がアキュムレータ変数 G2 に置換されています. if 以外の対応をしていませんが, 一応ステップ 2 は実現できました.

次にステップ 3 ですが, 以下のように rec->tailrec-body を改良します.

(define (rec->tailrec-body acc name body)
  (define (if? expr) (and (pair? expr) (eq? 'if (car expr))))
  (define (self-call? expr) (and (pair? expr) (eq? name (car expr))))
  (cond ((atom? body) body)
        ((if? body)
         `(if ,(cadr body) ,acc
              ,(rec->tailrec-body acc name (cadddr body))))
        ((find-if self-call? body)
         (append-atom (find-if self-call? body)
                      (map (lambda (x) (if (self-call? x) acc x)) body)))
        (else (map (lambda (expr) (rec->tailrec-body acc name expr)) body))))

(define (self-call? expr) ...)((find-if self-call? body) ...) の部分が今回追加した部分です. body 中で自分自身を呼び出している式が見つかった場合に,

(... (name ...) ...) → (... acc ...) → (name ... (... acc ...))

という変換を行います.

試してみます.

> (rec->tailrec '(define (fact n)
                   (if (<= n 1) 1
                       (* n (fact (- n 1))))))
(define (fact n G3)
  (if (<= n 1) G3
      (fact (- n 1) (* n G3))))

ステップ 3 も実現できました. これで, fact を末尾再帰関数に変換するという当初の目的を達成できました.

この rec->tailrec には注意しなければならないことがあります. それは, 元の関数で (fact 5) は,

(* 5 (* 4 (* 3 (* 2 1))))

と計算されますが, 変換後の関数で (fact 5 1) は,

(* 2 (* 3 (* 4 (* 5 1))))

と計算されます. fact の場合は両者の結果は同じですので問題はありませんが, 以下の copy-list のような関数の場合には

> (define (copy-list lst)
    (if (null? lst) lst
        (cons (car lst) (copy-list (cdr lst)))))

> (copy-list '(1 2 3))
(1 2 3)

以下のように変換されます.

> (rec->tailrec '(define (copy-list lst)
                   (if (null? lst) lst
                       (cons (car lst) (copy-list (cdr lst))))))
(define (copy-list lst G4)
  (if (null? lst) G4
      (copy-list (cdr lst) (cons (car lst) G4))))

> (copy-list '(1 2 3) '())
(3 2 1)

そのため, 異なる結果を返す関数を生成してしまいます.

これをきちんと同じ結果を返すように rec->tailrec-body を改良します. 基本的な考え方は, クロージャを使って評価を遅延することにより元の関数と同じ計算順序にすることです.

(define (rec->tailrec-body acc name body)
  (define (if? expr) (and (pair? expr) (eq? 'if (car expr))))
  (define (self-call? expr) (and (pair? expr) (eq? name (car expr))))
  (cond ((atom? body) body)
        ((if? body)
         `(if ,(cadr body) (,acc ,(caddr body))
              ,(rec->tailrec-body acc name (cadddr body))))
        ((find-if self-call? body)
         (append-atom
          (find-if self-call? body)
          (let ((i (gensym)))
            `(lambda (,i)
               (,acc ,(map (lambda (x) (if (self-call? x) i x)) body))))))
        (else (map (lambda (expr) (rec->tailrec-body acc name expr)) body))))

(let ((i (gensym))) ...) の部分が今回修正した部分です. とりあえず, 実行してどのような変換を行うか見てみましょう.

> (rec->tailrec '(define (copy-list lst)
                   (if (null? lst) lst
                       (cons (car lst) (copy-list (cdr lst))))))
(define (copy-list lst G5)
  (if (null? lst) (G5 lst)
      (copy-list (cdr lst) (lambda (G6) (G5 (cons (car lst) G6))))))

> (copy-list '(1 2 3) (lambda (x) x))
(1 2 3)

(G5 lst)(lambda (G6) ...) の部分は, 前のバージョンと異なる部分です. 前のバージョンの変換結果と比べると, アキュムレータ変数の値が関数になっています. そのため, 終了条件が真の場合に返す値が,

G5 → (G5 lst)

のように関数呼び出しに変更されています. また, 計算結果を累積する部分が

(cons (car lst) G5) → (lambda (G6) (G5 (cons (car lst) G6)))

のようにクロージャによって評価が遅延されています. この遅延された計算は終了条件が真になった時点で, 関数呼び出し (G5 lst) によって一気に計算されます.

例として (copy-list '(1 2 3) (lambda (x) x)) の場合, 以下のようにクロージャが次々と生成された後, 最後に計算が行われます. その結果 (1 2 3) が得られます.

((lambda (G6)
   ((lambda (G6)
      ((lambda (G6)
         ((lambda (x) x)
          (cons 1 G6)))
       (cons 2 G6)))
    (cons 3 G6)))
 '())

ここで注意しておくべきことは, 元の再帰関数から末尾再帰関数に変換したことによりスタックの消費はなくなりましたが, 評価の遅延のためにクロージャを次々と生成するためヒープ消費量が増加してしまうことです.

まとめ

  1. rec->tailrec により再帰関数を末尾再帰関数に自動的に変換することができる.
  2. 最終バージョンの rec->tailrec は元の関数と同じ計算順序で計算を行うことができるが, 再帰呼び出し回数に比例してヒープ消費量が増大する.
  3. 元の関数と同じ計算順序で計算する必要のない場合(例えば fact), 一つ前のバージョンの rec->tailrec を使ったほうがよい.
  4. マクロにするには以下のようにする(defmacro の場合).
    (defmacro define-tailrec (func-def)
      (rec->tailrec func-def))
    ;; 使い方
    (define-tailrec
      (define (fact n)
        (if (<= n 1) 1
            (* n (fact (- n 1))))))
    
  5. 元ネタ: 最終バージョンの rec->tailrec の元ネタは, 昔読んだ論文です. 論文の名前を忘れてしまったので, 知っている方がおられたら, ccbcc55@hotmail.com までご連絡いただけるとありがたいです.
  6. 制限事項は以下のとおりですが, 比較的簡単に解消できると思います.

(戻る)

(関数の結果をキャッシュする)

非常に計算コストのかかる関数があり, かつその関数を同じ引数で複数回呼び出すような場合, 次のように結果をキャッシュする memoize という関数を作成して計算コストを削減することができます.

(define (memoize proc)
  (let ((cache '()))
    (lambda args
      (let ((hit (assoc args cache)))
        (if hit (cdr hit)
            (let ((result (apply proc args)))
              (set! cache (cons (cons args result) cache))
              result))))))

引数 args をキーとし, 関数の結果を値とする連想リスト(cache)をクロージャ内に保持し, キャッシュにヒットしなかった場合のみ関数 proc を実行します.

例として, 次のような関数 fact をキャッシュ可能な関数にしてみましょう. (注: この fact は以下の説明のためしょぼい実装にしています)

(define (fact n)
  (if (<= n 1) 1
      (* n (fact (- n 1)))))

この関数のキャッシュ可能な関数を生成するには, 以下のようにします.

(define memoized-fact (memoize fact))

では, 実際に期待した通りに動作しているかトレースして確かめてみます.

> (trace fact)
(fact)

> (memoized-fact 5)
[fact 5]
|  [fact 4]
|  |  [fact 3]
|  |  |  [fact 2]
|  |  |  |  [fact 1]
|  |  |  |  1
|  |  |  2
|  |  6
|  24
120
120

一度目の呼び出しでは当然キャッシュされていませんので関数 fact が呼び出されています. もう一度呼び出してみると,

> (memoized-fact 5)
120

今度はキャッシュにヒットしたので関数 fact は呼び出されませんでした. 期待通りに動作しているようです.

まとめ

  1. 任意の関数をキャッシュ可能にすることができる.
  2. assoc のコストより元の関数のコストが小さい場合には適用しないほうがよい.
  3. 副作用を伴う関数に適用するには注意が必要. 例えば I/O 関連の関数.
  4. 元ネタ: (OnLisp P. 65)
  5. 補足: キャッシュをクリアしたければ以下のようにキャッシュをクリアするクロージャを同時に返すようにする.
    (define (memoize proc)
      (let ((cache '()))
        (cons (lambda args
                (let ((hit (assoc args cache)))
                  (if hit (cdr hit)
                      (let ((result (apply proc args)))
                        (set! cache (cons (cons args result) cache))
                        result))))
              (lambda ()
                (set! cache '())))))
    (define f (memoize fact))
    (define memoized-fact (car f))
    (define clear-fact-cache (cdr f))
    

(戻る)

(delay と force を実装する)

Common Lisp には遅延評価のための関数(delay, force)が標準で用意されていませんが, クロージャを使って簡単に実装することができます.

(defun make-promise (f)
  (let ((ready-p nil)
        (result nil))
    #'(lambda ()
        (if ready-p result
          (let ((r (funcall f)))
            (if ready-p result
              (setq ready-p t
                    result r)))))))

(defun promise-p (f)
  (functionp f))

(defmacro delay (expr)
  `(make-promise #'(lambda () ,expr)))

(defun force (f)
  (if (promise-p f) (funcall f)
    f))

まとめ

  1. 元ネタ: (R5RS の force の項)
  2. 元ネタ: (SICP Section 3.5.1)
  3. (OnLisp P. 211) には構造体を使った実装が載っている.

(戻る)

(無限リスト)

遅延評価を利用して無限リストを表現してみます.

(define (make-inf-list generator inits)
  (cons (car inits) (delay (make-inf-list generator (generator inits)))))

(define inf-car car)

(define (inf-cdr lst)
  (force (cdr lst)))

(define (inf-truncate lst limit)
  (let loop ((i 0) (lst lst) (r '()))
    (if (= i limit) (reverse r)
        (loop (+ i 1) (inf-cdr lst) (cons (inf-car lst) r)))))

この make-inf-list を使って自然数のリストを表現してみます.

> (define natual-numbers (make-inf-list (lambda (x) (list (+ (car x) 1))) '(1)))

> (inf-car natual-numbers)
1

> (inf-car (inf-cdr natural-numbers))
2

> (inf-truncate natual-numbers 20)
(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)

make-inf-list を使ってフィボナッチ列を表現してみます.

> (define fibs (make-inf-list (lambda (x) (list (cadr x) (+ (car x) (cadr x)))) '(0 1)))

> (inf-truncate fibs 20)
(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)

まとめ

  1. 遅延評価を使うことによって無限リストを表現できる
  2. 元ネタ: (SICP Section 3.5.2)

(戻る)

(小ネタ)

  1. ちょっとしたデバッグメッセージを表示する時に ` を使うと楽に書ける.
    (display `((a ,a) (b ,b) (c ,c)))
    
  2. Scheme の named let (名前付き let) を Common Lisp で使うには
    (defmacro nlet (tag var-vals &body body)
      `(labels ((,tag ,(mapcar #'car var-vals) ,@body))
         (,tag ,@(mapcar #'cadr var-vals))))
    > (defun rev (lst)
        (nlet loop ((lst lst) (r nil))
          (if (null lst) r
            (loop (cdr lst) (cons (car lst) r)))))
    REV
    > (rev '(1 2 3 4 5))
    (5 4 3 2 1)
    

(目次へ戻る)


(Scheme 処理系のインストール (Mac OS X 10.2.6))

(環境)

(Mac OS X 10.2.6) + (Mac OS X Developer Tools December 2002) + (fink-0.5.2.cvs)

% uname -a
Darwin foo 6.6 Darwin Kernel Version 6.6: Thu May  1 21:48:54 PDT 2003;
root:xnu/xnu-344.34.obj~1/RELEASE_PPC  Power Macintosh powerpc

(目次へ戻る)

(Gauche-0.6.8)

URL

Install

% fink install dlcompat
% fink install libiconv
% curl -O http://easynews.dl.sourceforge.net/sourceforge/gauche/Gauche-0.6.8.tgz
% tar xfz Gauche-0.6.8.tgz 
% cd Gauche-0.6.8
% ./configure --with-local=/sw --with-rpath=/sw/lib --with-iconv=/sw \
    --enable-threads=pthreads
% make
% make test
% sudo make install
% cd doc
% sudo make install
% sudo vi /usr/local/info/dir

Config

/usr/local/info/dir に以下を追加
 The Algorithmic Language Scheme
 * Gauche Reference: (gauche-refe.info). An R5RS Scheme implementation.
 * Gauche Reference (ja): (gauche-refj.info).    An R5RS Scheme implementation.

~/.emacs に

(setq scheme-program-name "/usr/local/bin/gosh -i")
(autoload 'run-scheme "cmuscheme" "Run an inferior Scheme process. " t)

(Guile)

URL

Install

% fink install guile16

(DrScheme 204)

URL

Install

% curl -O http://download.plt-scheme.org/bundles/204/plt/PLT_Scheme.dmg

Finder で

(目次へ戻る)


(Scheme 処理系のインストール (cygwin-1.3.2))

注意: 以下の情報はかなり古いです. 最近筆者はメイン環境を Mac OS X に移行したので, 今後更新することはおそらくないと思います.

(環境)

Windows-2000 + (cygwin-1.3.2)

% uname -a
CYGWIN_NT-5.0 FOO 1.3.2(0.39/3/2) 2001-05-20 23:28 i686 unknown

(目次へ戻る)

(guile-1.5.4)

(Guile)

バイナリのインストール

guile-1.4 が(Project HeavyMoon ftp サイト)からダウンロードできるが, 色々と気に入らないこと(ドキュメントがほとんどない等)があるので, 最新版をコンパイルした.

  1. rpm をインストールしていない場合は, ここ (rpm-3.0.6.bin.tar.gz) から取ってきて / で展開する.
    % wget ftp://ftp.st.ryukoku.ac.jp/pub/ms-windows/HeavyMoon/rpm-3.0.6.bin.tar.gz
    % cp rpm-3.0.6.bin.tar.gz /
    % cd /
    % tar xfz rpm-3.0.6.bin.tar.gz
    
  2. バイナリをここ (guile-core-20020223-2.i686-cygwin.rpm) から取ってきて, 以下のようにする. ちなみに nosrc.rpm はここ(guile-core-20020223-2.nosrc.rpm).
    % wget http://www.geocities.co.jp/SiliconValley-PaloAlto/7043/guile-core-20020223-2.i686-cygwin.rpm
    % rpm -ivh --nodeps guile-core-20020223-2.i686-cygwin.rpm
    

ソースからコンパイル

  1. ソースコードをここ(Nightly snapshots of the Guile development sources)から取ってくる.
    % wget ftp://krusty.e-technik.uni-dortmund.de/pub/guile/snapshots/guile-core-20020223.tar.gz
    
  2. パッチをここ(guile-core-20020223-cygwin.patch.txt)から取ってきてあてる. (注意: ソースコートは日々更新されているのでパッチが正常にあたらない場合があるかもしれません. その場合は手で修正してください.)パッチの詳細については (Guile-user ML) を参照してください.
    % wget http://www.geocities.co.jp/SiliconValley-PaloAlto/7043/guile-core-20020223-cygwin.patch.txt
    % tar xfz guile-core-20020223.tar.gz
    % cd guile-core-20020223
    % patch -p1 < ../guile-core-20020223-cygwin.patch.txt
    
  3. コンパイルする.
    % ./configure --disable-shared
    % make
    % make install
    ;; なぜか guile-snarf がインストールされないので手動でコピー
    % install -m 755 libguile/guile-snarf /usr/local/bin
    
  4. 必要に応じて HTML ドキュメントを生成する.
    % cd doc/ref
    % texi2html guile.texi
    % cd ../goops
    % texi2html goops.texi
    % cd ../r5rs
    % texi2html r5rs.texi
    % cd ../tutorial
    % texi2html guile-tut.texi
    

(目次へ戻る)

(SCM-5d4)

(SCM)

  1. SLIB のインストール. 犬飼さんのページ (Installing SCM) を参考にする.
    % wget http://swissnet.ai.mit.edu/ftpdir/scm/slib2d2.zip
    % unzip slib2d2.zip -d /usr/local/lib
    ;; 環境変数の設定
    ;; [マイコンピュータ右クリック]-[プロパティ]-[詳細]-[環境変数]
    ;; または c:\autoexec.bat に
    set SCHEME_LIBRARY_PATH=C:\cygwin\usr\local\lib\slib\
    % vi ~/.bashrc
    -----------------------------------------------
    export SCHEME_LIBRARY_PATH=/usr/local/lib/slib/
    -----------------------------------------------
    % source ~/.bashrc
    
  2. SCM のインストール. 犬飼さんのページ (Installing SCM) を参考にする.
    % wget http://swissnet.ai.mit.edu/ftpdir/scm/scm5d4.zip
    % unzip scm5d4.zip
    % cd scm
    ;; bignum を大きめにする
    % perl -i.orig -pe 's/#  define NUMDIGS_MAX 1000/#  define NUMDIGS_MAX 20000/o' scmfig.h
    ;; コンパイル
    % make scmlit
    % ./build -p unix -F arrays array-for-each bignums cautious compiled-closure \
        dynamic-linking engineering-notation generalized-c-arguments inexact \
        macro posix record regex rev2-procedures tick-interrupts > makescm
    % perl -i.orig -nle 'chop; s/^cc/gcc/o; s/-O/-O2/o; print;' makescm
    % rm -f scm.exe ; sh ./makescm && test -f scm.exe && echo "done"
    done
    ;; テスト
    % ./scm r4rstest.scm
     :
    Passed all tests
     :
    > (test-cont) (test-sc4) (test-delay)
     :
    Passed all tests
     :
    > (exit)
    ;; SCM では定義されていないものを定義
    % vi ~/ScmInit.scm
    -----------------------------------------------
    (define call/cc call-with-current-continuation)
    -----------------------------------------------
    

(目次へ戻る)

(Gauche-0.6)

(Gauche - A Scheme Interpreter)

バイナリのインストール

  1. rpm をインストールしていない場合は, ここ (rpm-3.0.6.bin.tar.gz) から取ってきて / で展開する.
    % wget ftp://ftp.st.ryukoku.ac.jp/pub/ms-windows/HeavyMoon/rpm-3.0.6.bin.tar.gz
    % cp rpm-3.0.6.bin.tar.gz /
    % cd /
    % tar xfz rpm-3.0.6.bin.tar.gz
    
  2. バイナリをここ (Gauche-eucjp-0.6-1.i686-cygwin.rpm) から取ってきて, 以下のようにする. ちなみに nosrc.rpm はここ(Gauche-0.6-1.nosrc.rpm).
    % wget http://www.geocities.co.jp/SiliconValley-PaloAlto/7043/Gauche-eucjp-0.6-1.i686-cygwin.rpm
    % rpm -ivh --nodeps Gauche-eucjp-0.6-1.i686-cygwin.rpm
    

ソースからコンパイル(注: Gauche-0.5.7)

  1. (Gauche) のページを参考にインストールする. ソースコードをここ(Gauche-0.5.7.tgz)から取ってくる.
    % tar xfz Gauche-0.5.7.tgz
    % cd Gauche-0.5.7
    ;; --with-pthread をつけると configure に失敗する
    % ./configure --with-slib=/usr/local/lib/slib
    ;; ext/termios, ext/fcntl の make に失敗するがそれ以外は成功
    % make -k
    ;; ほとんど成功する
    % make -k test
    % make -k install
    

(目次へ戻る)

(Kawa-1.6.97)

(Kawa, the Java-based Scheme system)

  1. (Installing and using the binary distribution) のページを参考にする.
    ;; source から make は失敗するのでバイナリを使う
    % wget ftp://ftp.gnu.org/pub/gnu/kawa/kawa-1.6.97.tar.gz
    ;; ~/.emacs に
    -----------------------------------------------
    (setq scheme-program-name "C:/jdk1.3.1_01/bin/java.exe -cp D:/home/foo/kawa/kawa-1.6.97.jar kawa.repl")
    -----------------------------------------------
    

(目次へ戻る)

(guile-pg-0.07)

(Guile-pg Home Page)

  1. (guile-pg の README) を参考にする. パッチをここ (guile-pg-0.07.patch.txt) から取ってきてあてる.
    % wget http://guile-pg.sourceforge.net/guile-pg-0.07.tar.gz
    % wget http://www.geocities.co.jp/SiliconValley-PaloAlto/7043/guile-pg-0.07.patch.txt
    % tar xfz guile-pg-0.07.tar.gz
    % cd guile-pg-0.07
    ;; パッチをあてる
    % patch -p1 < ../guile-pg-0.07.patch.txt
    % ./configure --with-libpq-includes=/usr/include/postgresql --with-lib-pq-lib=/usr/lib
    % make -k
    # エラーがでるので以下を実行
    % gcc -g -O2 -Wall -Wmissing-prototypes -o guile-pg -L/usr/local/lib \
        -lguile -lcrypt -lregex -lpq -static guile-pg.o /usr/local/lib/libguile.a \
        /usr/local/lib/libltdl.a -lcrypt -lregex .libs/libpostgres.a -lpq -lpq \
        -lcrypt -lpq -lpq -lcrypt -lpq
    % make -k
    % make check
     :
    ==================
    All 2 tests passed
    ==================
     :
    % make install
    

(目次へ戻る)

(pseudo-2.12)

(Index of /ftpdir/pseudo)

  1. (pseudo-2.12 の README) を参考にする. ここでは Allegro Common Lisp (ACL) 用の設定方法を説明する.
  2. ソースを取ってきて展開.
    % mkdir pseudo-2.12
    % cd pseudo-2.12
    % wget http://www.swiss.ai.mit.edu/ftpdir/pseudo/pseudo-2.12.tar.gz
    % tar xfz pseudo-2.12.tar.gz
    
  3. clever.lisp の 35 行目をコメントアウトする.
     :
          #+:ccl "LISP"                     ;Coral
          ;; #+allegro "cl"
          "lisp"                            ;For Unix, Exploder, and anyone else
     :
    
  4. realp のところでコンパイルに失敗するので, core.lisp の 117 行目に #-allegro を追加.
     :
    ;This function is new in CLtL II / ANSI.
    #-allegro
    (defun realp (obj)
     :
    
  5. ACL を起動して, リスナ上で,
    CL-USER(1): :cd lisp/pseudo-2.12
    CL-USER(2): (load "loadit")
    CL-USER(3): (load-pseudoscheme "./")
    CL-USER(4): (ps:scheme)
    SCHEME(5): (display 'hello)
    

(目次へ戻る)

(Emacs の設定)

  1. scheme-program-name で起動したい処理系を指定して M-x run-scheme で起動する.
    ;; (setq scheme-program-name "D:/home/foo/scm/scm.exe")
    ;; (setq scheme-program-name "C:/jdk1.3.1_01/bin/java.exe -cp D:/home/foo/kawa/kawa-1.6.97.jar kawa.repl")
    (setq scheme-program-name "C:/cygwin/usr/local/bin/gosh.exe -i")
    ;; (setq scheme-program-name "C:/cygwin/bin/guile.exe")
    ;; (setq scheme-program-name "C:/cygwin/usr/local/bin/guile-pg.exe")
    (autoload 'run-scheme "cmuscheme" "Run an inferior Scheme process. " t)
    

(目次へ戻る)


(Common Lisp ユーザのための Emacs Lisp メモ)

筆者が Emacs Lisp を修得するときにハマったところ.

  1. (シンボルは case sensitive)
  2. (ダイナミックスコープ)
  3. (クロージャがない)
  4. (末尾再帰の最適化をしない)
  5. (labmda はただのコンス)
  6. (optional 引数のデフォルト値が設定できない)
  7. (実行時に cl パッケージに依存してはならない)
  8. (古い Emacs ではハッシュテーブルは組み込みではない)

(シンボルは case sensitive)

(elisp マニュアル 2.3.4) より「In Emacs Lisp, upper case and lower case letters are distinct.」
(eq 'a 'A) => nil

(戻る)

(ダイナミックスコープ)

(elisp マニュアル 11.9) より「Local bindings in Emacs Lisp have indefinite scope and dynamic extent. ... The combination of dynamic extent and indefinite scope is called dynamic scoping.」

Common Lisp だとこれはエラーになるが, Emacs Lisp では問題なし.

(defun foo ()
  x)

(defun bar ()
  (let ((x -1))
    (foo)))
Common Lisp だと,
(defvar x)
としておくか,
(defun bar ()
  (let ((x -1))
    (declare (special x))
    (foo)))
とすると Emacs Lisp と同じ動作になる.

(戻る)

(クロージャがない)

(elisp マニュアル 11.9.2) より「Emacs Lisp does not have closures.」
(setq f (let ((n 0))
          #'(lambda () (setq n (1+ n)))))

(funcall f) => error: (void-variable n)

f => (lambda nil (setq n (1+ n)))

(consp f) => t
ていうか lambda はただのコンス.

cl パッケージの lexical-let を使えばクロージャにできるようだ.

(require 'cl)

(setq g (lexical-let ((n 0))
          #'(lambda () (setq n (1+ n)))))

(funcall g) => 1
(funcall g) => 2

g => (lambda (&rest --cl-rest--)
       (apply (lambda (G5215)
                (set G5215 (1+ (symbol-value G5215))))
              (quote --n--) --cl-rest--))

(戻る)

(末尾再帰の最適化をしない)

Emacs Lisp は末尾再帰をループに変換しないので, 以下のようなコードはスタックオーバーフローする可能性がある.
(defun fact-aux (n r)
  (if (<= n 1) r
    (fact-aux (1- n) (* n r))))

(defun fact (n)
  (fact-aux n 1))

(fact 5) => 120
しかし, かなり強引だが以下のようにすればほとんど末尾再帰のように書くことができる.
(defun fact-aux (n r)
  (if (<= n 1) r
    `(fact-aux ,(1- n) ,(* n r))))

(defun fact (n)
  (do ((next (fact-aux n 1) (funcall (car next) (cadr next) (caddr next))))
      ((not (consp next)) next)))

(fact 5) => 120
Scheme 等の再帰で書かれたコードを移植するときに便利.

もうひとつ別の例.

(defun even-p (n)
  (if (zerop n) t
    (odd-p (1- n))))

(defun odd-p (n)
  (if (zerop n) nil
    (even-p (1- n))))

(even-p 10) => t
(odd-p 10) => nil
相互末尾再帰でも同じように書ける.
(defun even-p-aux (n)
  (if (zerop n) t
    `(odd-p-aux ,(1- n))))

(defun odd-p-aux (n)
  (if (zerop n) nil
    `(even-p-aux ,(1- n))))

(defun even-p (n)
  (do ((next (even-p-aux n) (funcall (car next) (cadr next))))
      ((not (consp next)) next)))

(defun odd-p (n)
  (do ((next (odd-p-aux n) (funcall (car next) (cadr next))))
      ((not (consp next)) next)))

(even-p 10) => t
(odd-p 10) => nil
(japanese-tokenizer.el) の bigram の実装を参照.

(labmda はただのコンス)

前述のように lambda はただのコンスで, さらにダイナミックスコープなので, 以下のような一見何の問題もなさそうなコードが無限ループになる.
(defun foo (func)
  (print `(foo-func => ,func))
  (funcall func))

(defun bar (func)
  (print `(bar-func => ,func))
  (foo #'(lambda () (print "bar") (funcall func))))

(defun test ()
  (bar #'(lambda () (print "test"))))

(test)
-| (bar-func => (lambda nil (print "test")))
-| (foo-func => (lambda nil (print "bar") (funcall func)))
-| "bar"
-| "bar"
-| "bar"
 :
=> error: (error "Lisp nesting exceeds max-lisp-eval-depth")
となって無限ループしてしまう. 高階関数の仮引数の名前に func なんていう安易な名前をつけてはいけないようだ.

これを回避するには, 単純に仮引数の名前にプレフィックスを付けて名前が被らないようにすればよい(ただし完全にこの問題を回避することはできない).

(defun foo (foo-func)
  (print `(foo-func => ,foo-func))
  (funcall foo-func))

(defun bar (bar-func)
  (print `(bar-func => ,bar-func))
  (foo #'(lambda () (print "bar") (funcall bar-func))))

(defun test ()
  (bar #'(lambda () (print "test"))))

(test)
-| (bar-func => (lambda nil (print "test")))
-| (foo-func => (lambda nil (print "bar") (funcall bar-func)))
-| "bar"
-| "test"
=> "test"
以下のようにして func を評価させる手もあるが, プレフィックスをつけるほうが楽.
(defun foo (func)
  (print `(foo-func => ,func))
  (funcall func))

(defun bar (func)
  (print `(bar-func => ,func))
  (foo `(lambda () (print "bar") (funcall ,func)))) ; ココ

(defun test ()
  (bar #'(lambda () (print "test"))))

(test)
-| (bar-func => (lambda nil (print "test")))
-| (foo-func => (lambda nil (print "bar") (funcall (lambda nil (print "test")))))
-| "bar"
-| "test"
=> "test"
参考: (2ch Emacs Lisp スレッド).

(戻る)

(optional 引数のデフォルト値が設定できない)

(elisp マニュアル 12.2.3) より「Common Lisp allows the function to specify what default value to use when an optional argument is omitted; Emacs Lisp always uses nil.」

Emacs Lisp では以下のように書けない.

(defun foo (a &optional (b 0))
  ...)
仕方ないので以下のように書く.
(defun foo (a &optional b)
  (let ((b (or b 0)))
    ...)
当然 supplied-p もないので (foo 1)(foo 1 nil) が区別できない. ちなみに &body もない.

こういうマクロを作ってみた.

(defmacro optional-bind (var-vals &rest body)
  `(let (,@(mapcar #'(lambda (var-val)
                       `(,(car var-val) (or ,(car var-val) ,(cadr var-val))))
            var-vals))
     ,@body))
このマクロを使えばこう書ける.
(defun foo (a &optional b)
  (optional-bind ((b 0))
    ...))

(戻る)

(実行時に cl パッケージに依存してはならない)

(elisp マニュアル D.1) より「Please don't require the cl package of Common Lisp extensions at run time. ... If your package loads cl at run time, that could cause name clashes for users who don't use that package.」

コンパイル時に cl パッケージを使う分には問題ないので,

(eval-when-compile
  (require 'cl))
としておけば, setfdolist 等のマクロが使える.

(戻る)

(古い Emacs ではハッシュテーブルは組み込みではない)

Emacs 20 などの古い Emacs ではハッシュテーブルは cl パッケージで提供されているので, 実行時に cl パッケージに依存してしまう.

こんな感じでハッシュテーブルが組み込みかどうかを判別できる.

(if (and (fboundp 'make-hash-table) (subrp (symbol-function 'make-hash-table)))
    (eval-when-compile (require 'cl)) ; 組み込み
  (require 'cl)) ; cl パッケージ
(シンボル表を利用したハッシュ) を利用するという手もある.

(戻る)

(目次へ戻る)


(approx-search.el)

[Update 2004/02/15] (approx-search-0.2.tar.gz) ; 曖昧度を設定できるようにしました. (Meadow) に対応しました.

曖昧検索, approximate pattern matching を可能にする Emacs Lisp ライブラリ.

他人の書いたプログラムや, 遠い昔に自分で書いたプログラムをメンテしている時, 難しい単語やスペルミスした単語がうまく検索できなくて困ったことありませんか? そういう時に曖昧検索できると便利だと思ってこのライブラリを書きました.

以前 (Levenshtein distance) というアルゴリズムを使って曖昧検索を実装したのですが, あまりにも遅すぎるため, いまいち使えませんでした. 今回は正規表現ベースのアルゴリズムを使って高速に曖昧検索できるようにしました.

基本的なアイデアは, 入力された文字列から曖昧検索のための正規表現を生成するというもので, (Migemo) を参考にしました. (Migemo) の場合はローマ字入力から日本語の正規表現を生成しますが, このライブラリでは入力から曖昧検索の正規表現を生成します. 具体的にはこんな感じです.

(approx-generate-regexp "abcd")
=> "\\(bcd\\|acd\\|abd\\|abc\\|a.cd\\|ab.d\\|ab.cd\\)"

この生成された正規表現を re-search-forward に渡して曖昧検索を実現しています. 入力された文字数を N 個とすると, だいたい 3N 個程度のパターンを生成して, その OR パターンで正規表現検索します.

曖昧度, ambiguousness を指定できるようにしました. 曖昧度を大きくすると再帰的にパターンを生成して, より曖昧な検索が可能となります.デフォルトの曖昧度は 1 です. M-x approx-set-ambiguousness で曖昧度を設定できます.

インクリメンタルサーチ, isearch にも対応しています. (Meadow) でも動作するように修正しました (*).

(Migemo) を使った曖昧検索はできません. (Migemo) に対応することもできますが, 作者がこのライブラリを使う場面は主にプログラムを編集する時(つまり (Migemo) を off にしている時)なので, 今のところ (Migemo) で利用できるようにする必要はあまり感じていません.

(目次へ戻る)


(levenshtein-distance.el)

このライブラリは以後メンテナンスされません. (approx-search.el) を使ってください.

(Levenshtein distance) (edit distance, 編集距離) を使った曖昧検索を可能にする Emacs Lisp ライブラリ.

通常の search-forward は引数で与えた文字列に完全にマッチする文字列を検索する. しかし, 数文字くらい違っていてもかまわないから検索してほしい場面がある.

例えば SPAM メールのフィルタで "未承諾広告" と設定している場合, 簡単なマッチングでは "末承諾広告" を逃してしまう. この場合, search-forward-regexp を使って正規表現で ".承諾広告" などとすれば事足りるのだが, 例えば "未承諾廣告" は逃してしまう. まあ, ひたすら正規表現を凝ったものにすればよいのだが, 面倒だし, きりがない.

こういう場合に, 文字列を曖昧に検索できると便利である. このライブラリの ld-search-forward を使って "未承諾広告" を検索すると, "末承諾広告""未承諾廣告" もマッチさせることができる.

(目次へ戻る)


(spamfilter.el)

[Update 2003/01/22] (spamfilter-1.1.tar.gz) ; コーパスから単語を削除する API を追加しました.

(概要)

近頃, 流行っている Paul Graham さんの (A Plan for Spam) および (Better Bayesian Filtering) を Emacs Lisp で実装した SPAM フィルタリングライブラリです. Emacs 上のメーラ内で使うことを想定しています. 筆者は (Wanderlust) 上で使っています.

日本語に対応したベイジアンフィルタは色々ありますが((scbayes), (bsfilter), (bogofilter + kakasi) 等), それらと比べて以下の特徴があります.

日本語の場合, token への分解は英語のように単純ではない (*) ため, 以下の 3 種類の手法を選択できるようにしました.

  1. (茶筌) ; ChaSen, 日本語形態素解析システム
  2. bigram ; 日本語部分を 2 文字づつ切り出す (scbayes で使われている手法)
  3. block(?) ; 漢字, 平仮名, 片仮名ごとに切り出す (Mozilla で使われている手法)

筆者の環境で同じデータ(spam 約 250 通, nonspam 約 1000 通)をもとに簡単にテストした限りでは,

  1. (茶筌) ; 遅い, コーパスが小さくても検出精度は高い, コーパスの登録単語数・総容量は最小
  2. bigram ; 速い, コーパスがある程度大きくなれば検出精度はよい, コーパスの登録単語数・総容量は最大
  3. block ; 速い, 検出精度はやや低い, コーパスの登録単語数・総容量は中程度

上記 3 種類のどの手法でも

という結果が得られています. 筆者のおすすめは bigram です.

(特徴)

(ダウンロード)

(検出精度を向上させるための Tips)

筆者が半年近くベイジアンフィルタを使ってきた中での Tips です(現在 nonspam 2000 通, spam 1000 通).

友人, 仕事関係, ML, メールマガジンの類いのほとんどはルールによるフィルタ((Wanderlust) の場合は wl-refile-rule-alist)を使って判別できます. また, 例のサブジェクトが「未承諾広告」のメールも, ルールでつかまえられます. したがって, これらのメールはベイジアンフィルタで処理しなくても判別できるので コーパスには登録しないほうが検出精度が向上するようです.

設定例はこんな感じ. spamf-wl-ignore-register-folder-names で除外するフォルダを指定します.

(setq wl-refile-rule-alist
      '(("From"
         ("@mailmagazine\\.co\\.jp" . "+mailmagazine")
         ("otomodati@bar\\.ne\\.jp" . "+friend")
         ("okyaku@foo\\.co\\.jp" . "+work"))
        (("To" "Cc")
         ("ml@baz\\.org" . "+ml"))
        ("Subject"
         ("未承諾広告" . "+trash"))))

(setq spamf-wl-ignore-register-folder-names
      '("+trash" "+mailmagazine" "+friend" "+work" "+ml"))
筆者の場合はルールだけでほぼ 90% のメールは振り分けできています. 残りの 10% がベイジアンフィルタに委ねられます.

ただし, これらのルールで判別したメールに SPAM が混じりはじめたら(例えば ML に SPAM が送られてきたりしたら)ルールを変更してベイジアンフィルタで処理しなければなりません.

上記は筆者の環境での話ですのであなたの環境ではうまくいかないかもしれません.

他にも検出精度を向上させるための Tips があれば ccbcc55@hotmail.com に教えてください.

(日本語対応ベイジアンフィルタ)

知っている範囲で. これ以外にもあれば, ccbcc55@hotmail.com に教えてください.

(目次へ戻る)


(Perl.scm)

こんな感じの Perl スクリプトを,

while (<>) {
  chop;
  print $.;
  print ": ";
  s/define/DEFINE/;
  if (/let/) { print "LET "; }
  print;
  print "\n";
}

Scheme でこんな感じに書くためのライブラリ.

(while (<>)
  (chop!)
  (print *.*)
  (print ": ")
  (s! "define" "DEFINE")
  (if (m "let") (print "LET "))
  (print)
  (newline))

ちなみにちゃんと Scheme っぽく書くこともできます.

(while (<> line '("perl.scm" "pregexp/pregexp.scm"))
  (set! line (chop line))
  (print *.*)
  (print ": ")
  (set! line (s "define" "DEFINE" #f line))
  (if (m "let" line) (print "LET "))
  (let loop ((line (split "\\s+" line)))
    (cond ((null? line) #t)
          (else (print "[") (print (car line)) (print "]")
                (loop (cdr line)))))
  (newline))

(目次へ戻る)


since 2002/02/10

Susumu Ota (ccbcc55@hotmail.com)