amb - 主題のない日記

schemeプログラミングで継続を使った例として挙げられることがあるambだが、難しそうだったので手を出していなかった。しかし、突然今なら出来そうな気分になったので試しに書いてみた。

(define (problem proc)
  (let ((path #f))
    (define (amb . ls)
      (let/cc cc (push! path cc))
      (if (null? ls)
          (begin
            (pop! path)
            ((car path)))
          (pop! ls)))
    (lambda()
      (if path
          ((car path))
          (let/cc cc
            (set! path
              `(,(lambda()(cc 'fail))))
            (proc amb))))))

独習scheme3週間にあるようなグローバルな環境を使うのはちょっといまひとつだし、SICPにあるような駆動ループ(REPL)まで用意するのは大げさな気がするので私なりに若干仕様を変更している。
テストケースとしてSICPの問題4.42を取り上げる。問題文はこうだ。

５人の女子生徒が試験を受けた。彼女らの両親は結果に対し過度の関心を持っている、と彼女らは考えている。そこで彼女らは自宅へ試験についての手紙を書くのに、誰もが１つの正しい情報と１つのうその情報を書こうと約束した。以下は彼女らの手紙の関係する部分である。

Betty

「Kitty は試験が２番で私は３番でした。」

Ethel

「私がトップと聞いてうれしいでしょう。Joan が２ばんでした。」

Joan

「私は３番でした。可哀想な Ethel はビリでした。」

Kitty

「私は２番になりました。Mary は４番でしかありませんでした。」

Mary

「私は４番でした。トップの座は Betty がとりました。」

５人の女子生徒の本当の順番はどうなっているのか。

上の実装を用いて記述してみよう。

(define (assert amb pred)
  (if (not pred) (amb)))

(srfi-1)

(define (number-between amb a b)
  (apply amb (iota (- b a -1) a 1)))

(define (xor a b)
  (or (and a (not b)) (and (not a) b)))

(define (all-different? . ls)
  (let loop ((obj (car ls)) (ls (cdr ls)))
    (or (null? ls)
        (and (not (memv obj ls))
             (loop (car ls) (cdr ls))))))

(define girls-exam
  (problem
   (lambda(amb)
     (let ((kitty (number-between amb 1 5))
           (betty (number-between amb 1 5))
           (mary (number-between amb 1 5))
           (ethel (number-between amb 1 5))
           (joan (number-between amb 1 5)))
       (assert amb (xor (= kitty 2) (= betty 3)))
       (assert amb (xor (= kitty 2) (= mary 4)))
       (assert amb (xor (= mary 4) (= betty 1)))
       (assert amb (xor (= ethel 1) (= joan 2)))
       (assert amb (xor (= joan 3) (= ethel 5)))
       (assert amb (all-different? kitty betty ethel joan mary))
       (map list '(kitty betty ethel joan mary)
            (list kitty betty ethel joan mary))))))

(girls-exam) ;; -> ((kitty 1) (betty 3) (ethel 5) (joan 2) (mary 4))
(girls-exam) ;; -> fail 可能性が残っていないので失敗

以上の通り、期待通りの結果を得ることが出来た。
でも、ambをネストしたときの挙動が変だ。

(define test
  (problem
   (lambda(amb)
     (amb 1 (amb 2 3)))))

(test) ;; -> 1
(test) ;; -> 2
(test) ;; -> 1
(test) ;; -> 3
(test) ;; -> fail

もう少しよく考えてみよう。こんな短かいコードでも継続の流れを追おうとすると混乱してくる。
Document ID: 9ad64fca6731d972525d6b862be2bfa6