(Scheme) (Lisp)
  1. (Scheme と Lisp のドキュメント) ;; Scheme, Lisp リンク集
  2. (Scheme と Lisp のプログラミングテクニック) ;; 各種ドキュメントから拾ってきたテクニック集
  3. (Scheme 処理系のインストール) ;; 筆者がインストールした Scheme 処理系
  4. (levenshtein-distance.el) [New 2003/06/08] ;; Emacs Lisp で動く曖昧検索ライブラリ
  5. (spamfilter.el) ;; Emacs Lisp で動く SPAM フィルタリングライブラリ
  6. (Perl.scm) ;; Scheme で Perl っぽくスクリプトを書くためのライブラリ
  7. おまけ集 ;; 各種オンラインドキュメントをダウンロードする Perl スクリプト.

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

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

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

今のところ, 書けたのはこれだけ.
  1. (高階関数の使い方) ;; 高階関数を使ったプログラミング
  2. (継続の使い方) ;; 継続を使ったマクロ集
  3. (クロージャの使い方) ;; クロージャを使うときの典型的なパターン
  4. (再帰関数を末尾再帰関数に変換する) ;; 再帰関数を自動的に末尾再帰関数に変換するには?
  5. (関数の結果をキャッシュする) ;; 計算コストのかかる関数を高速化するには?
  6. (delayforce を実装する) ;; 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 は以下のようなループ構造 を使って書くこともできる.
  4. (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))))

赤字の部分は, 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))))

赤字の部分が今回追加した部分です. 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))))

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

> (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 → (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 の場合).
  5. (defmacro define-tailrec (func-def)
      (rec->tailrec func-def))
    
    ;; 使い方
    (define-tailrec
      (define (fact n)
        (if (<= n 1) 1
            (* n (fact (- n 1))))))
    
  6. 制限事項は以下のとおりですが, 比較的簡単に解消できると思います.
  7. 元ネタ: 最終バージョンの rec->tailrec の元ネタは, 昔読んだ論文 です. 論文の名前を忘れてしまったので, 知っている方がおられたら, ccbcc55@hotmail.com までご連絡いただけるとありがたいです.


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

非常に計算コストのかかる関数があり, かつその関数を同じ引数で複数回呼び出すよ うな場合, 次のように結果をキャッシュする 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 を key とし, 関数の結果を value とする連想リスト (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. 補足: キャッシュをクリアしたければ以下のようにキャッシュをクリアする クロージャを同時に返すようにする.
  6. (define (memoize proc)
      (let ((cache '()))
        (list (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 (cadr f))
    


(delayforce を実装する)

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. ちょっとしたデバッグメッセージを表示する時に ` を使うと楽に書ける.
  2. (display `((a ,a) (b ,b) (c ,c)))
    
  3. Scheme の named let (名前付き let) を Common Lisp で使うには
  4. (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 処理系のインストール)


(levenshtein-distance.el)

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

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

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

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


(spamfilter.el)

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

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

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

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

  1. 茶筌 - 遅い、検出精度は高い、コーパスの登録単語数・総容量は最小
  2. bigram - 速い、検出精度は普通(?)、コーパスの登録単語数・総容量は最大
  3. block - 速い、検出精度はやや低い(?)、コーパスの登録単語数・総容量は中程度
という結果が得られています。データ数が少ないため参考にならないかもしれません。
これらの手法による検出率の違い等を報告していただけるとありがたいです。


(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)