継続は力なり

#概要
schemeで、継続を使って順列を列挙するジェネレーターを書くために試行錯誤したメモ。

#導入
schemeで、1,…,nの順列を列挙したいと思った。但し、本当に全部の順列が欲しい訳ではなくて、辞書式順に順列を列挙して、適当な条件を満たす列が出たら、それ以降は要らない。

最初に、条件反射で次のようなコードを書いた。再帰=深さ優先探索。

(define (print-perm n)
  (define flag (make-vector n #t))
  (let loop ((i 0)
             (j 0)
             (perm ()))
    (cond ((= i n) (print perm)) ;; (a)
          ((< j n)
           (if (vector-ref flag j)
               (begin
                 (vector-set! flag j #f)
                 (loop (+ i 1) 0 (cons (+ j 1) perm))
                 (vector-set! flag j #t)))
           (loop i (+ j 1) perm)))))

実際には、(a)の所で、(print perm)としている代わりに、リストpermをどっか別の所に渡して、条件を満たすかどうかを調べたい。条件を満たしていたら処理を止めて、満たしていなければ続きの処理を実行したい。

何となく噂には聞いていたけど、こういう時には継続を使えば良いのではないかと思って調べてみた。目指すのは、以下のような動作である。

gosh> (define gen (permutation-generator 3))
gen
gosh> (gen)
(3 2 1)
gosh> (gen)
(2 3 1)
gosh> (gen)
(3 1 2)
gosh> (gen)
(1 3 2)
gosh> (gen)
(2 1 3)
gosh> (gen)
(1 2 3)
gosh> (gen)
end

つまり、(permutation-generator n)で、1,2,…,nの順列を列挙する為の手続きが作成され、以下その手続を呼ぶ毎に順列が辞書式順で返ってくる。

#本文
まず、permutation-generatorは、引数nを受け取って手続きを返すので、次のような所から出発する。

(define (permutation-generator n)
  (define (generator)
    )
  generator)

次に、上のプログラムの(a)の部分に来た時に外部に脱出する為の出口を確保する。

(define (permutation-generator n)
  (define return ())
  (define (generator)
    (call/cc
     (lambda (cc) ;; (b)
       (set! return cc))))
  generator)

ここがポイントで、generatorの処理の全体をcall/ccで囲む。こうすると、(b)のccに入る継続の実体は、generatorを呼び出した所に値を返して以降の手続きを実行する という処理になる。これを、クロージャーの中にreturn関数として登録しておけば、いつでもreturnを呼ぶ事で、generatorの呼び出し元に一気に戻る事ができる。

出口が出来たので、処理の実体をはめ込んで、途中脱出したい所で、さっきのreturnを呼ぶようにする。ここに2個目のポイントがあって、returnする前に、残りの処理を継続として保存しておく。その継続を呼べば、処理の続きが再開出来る。

• generatorは、呼び出される度に、 保存されている残りの処理 を呼び出すようにする。
• 最初に呼び出された時の 残りの処理 として、ループを初期値で呼び出す処理を入れておく。

(define (permutation-generator n)
  (define flag (make-vector n #t))
  (define return ())
  (define (loop i j perm)
    (cond ((= i n)
           (call/cc (lambda (cc)
                      (set! next-start cc) ;;残りの処理を継続として保存
                      (return perm)))) ;;途中脱出!
          ((< j n)
           (if (vector-ref flag j)
               (begin
                 (vector-set! flag j #f)
                 (loop (+ i 1) 0 (cons (+ 1 j) perm))
                 (vector-set! flag j #t)))
           (loop i (+ j 1) perm))))
  (define (next-start) (loop 0 0 ()))
  (define (generator)
    (call/cc
     (lambda (cc)
       (set! return cc)
       (next-start))))
  generator)

これまでで、順列の列挙は出来てるんだけど、終了処理が無いのでそれも挿入。処理の終端に来たら、残りの処理 として、終わった事を知らせるという継続を保存。これで完成。

(define (permutation-generator n)
  (define flag (make-vector n #t))
  (define return ())
  (define (loop i j perm)
    (cond ((= i n)
           (call/cc (lambda (cc)
                      (set! next-start cc)
                      (return perm))))
          ((< j n)
           (if (vector-ref flag j)
               (begin
                 (vector-set! flag j #f)
                 (loop (+ i 1) 0 (cons (+ 1 j) perm))
                 (vector-set! flag j #t)))
           (loop i (+ j 1) perm))
          ((= i 0)
           (call/cc (lambda (cc)
                      (set! next-start cc)))
           (return 'end))))
  (define (next-start) (loop 0 0 ()))
  (define (generator)
    (call/cc
     (lambda (cc)
       (set! return cc)
       (next-start))))
  generator)