SICP 読書ノート#59 - 4.3 非決定性計算 - call/ccによるambオペレータの実装 (pp.245)
前回で継続やcall/ccの振る舞いはつかめたので、今回はambオペレータをcall/ccで実装します。
ソースコードは以下に置いています。
amb評価器を動作させる
まずは動かしてみないとambが何者かすらわからないので動かしてみる。
1. SICP本家からサンプルコードをダウンロード
% curl -O https://mitpress.mit.edu/sicp/code/ch4-ambeval.scm % curl -O https://mitpress.mit.edu/sicp/code/ch4-mceval.scm
2. Racket処理系で解釈できるようにいくつか修正
§4.2の遅延評価器の時とほぼ同じことをやればよい。
ch4-ambeval.scm
- ファイルの先頭に
#lang racket
のシェバンを追加 ch4-mceval.scm
のロード処理をload
からinclude
に変更
(require racket/include) (include "ch4-mceval.scm")
- ファイルの終端に以下を追加
(define the-global-environment (setup-environment)) (driver-loop)
ch4-mceval.scm
- ファイルの先頭に
(require r5rs)
を追加 - Racket処理系や
ch4-ambeval.scm
と重複している定義をコメントアウトeval
apply
primitive-procedures
input-prompt
output-prompt
driver-loop
3. amb評価器を起動
ch4-ambeval.scm
をロードすると遅延評価器のREPLが起きて入力プロンプトが表示される。
racket@> ,enter "ch4-ambeval.scm" 'METACIRCULAR-EVALUATOR-LOADED 'AMB-EVALUATOR-LOADED ;;; Amb-Eval input:
amb評価器の仕様
amb評価器のインターフェース
amb評価器のREPL(driver-loop)で、(amb 1 2 3)
とした場合、1,2,3の選択肢の集合が評価器にセットされ、どれかひとつが返される。すでに選択肢がセットされていた場合、これまでのものは捨てられ、与えられた選択肢がセットされる。
;;; Amb-Eval input: (amb 1 2 3) ;;; Starting a new problem ;;; Amb-Eval value: 1
さらに'try-again
とすると、残りの選択肢からひとつ返される
;;; Amb-Eval input: try-again ;;; Amb-Eval value: 2
さらに'try-again
を続けていき、選択肢がなくなった場合、There are no more values of ...
とprintされる
;;; Amb-Eval input: try-again ;;; There are no more values of (amb 1 2 3)
また、REPLではなくコード上で(amb <choices> ...)
を呼ぶ場合、
<choices>
がある場合、新たな選択肢の集合が追加される<choices>
がない場合、残りの選択肢からひとつ返される ('try-again
と同じ)
となる。
選択肢のうちどれが選択されるか本質的にはわからない。このような処理を非決定性計算(または非決定性オートマトン)と呼ぶらしい。
ambの選択肢の探索
例えば、以下のようなコードをamb評価器のREPLに与えると、
;;; Amb-Eval input: (let ((x (amb 1 2 3)) (y (amb 'a 'b))) (list x y)) ;;; Starting a new problem ;;; Amb-Eval value: (1 a) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (1 b) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (2 a) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (2 b) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (3 a) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (3 b) ;;; Amb-Eval input: try-again ;;; There are no more values of (let ((x (amb 1 2 3)) (y (amb (quote a) (quote b)))) (list x y)) ;;; Amb-Eval input: try-again ;;; There is no current problem
集合 '(1 2 3)
と '(a b)
の内積を逐次返すコードとなる。
これをみても分かるように'try-again
とすると、以前の選択点に戻って別の選択肢を返していることがわかる。このように以前の選択点へ戻る処理を「バックトラック」と呼ぶ。
call/ccによるambオペレータの実装
ここからが本題。
SICPテキストのamb評価器を使うと、Racketの豊富な組み込みライブラリの恩恵が受けられないので、この先この評価器を使って問題を解いていくのは辛そう。
そこでambオペレータをcall/ccを使って実装する。まぁ、On Lispのコードを少し改変しただけですが。。
まず、与えられた選択肢からひとつを選び、残りの選択肢をキュー(コード上の*alternatives*
)にpushする手続きchoose
を実装する。
(define *alternatives* '()) (define (choose choices) (if (null? choices) (try-again) (call/cc (lambda (cc) (set! *alternatives* (cons (lambda () (cc (choose (cdr choices)))) *alternatives*)) (car choices)))))
残りの選択肢をキューにpushする際に(lambda () (cc (choose (cdr choices))))
とccを付けるのがポイント。ccを呼ぶことで、残りの選択肢から選ぶ度に(amb <choices> ...)
を実行したコンテキストへジャンプすることができる。
次に、残りの選択肢*alternatives*
から選び直す手続きtry-again
を実装する。これは*alternatives*
から手続きをpopし実行するだけなので、わかりやすい。
この時のnext
は上記の(lambda () (cc (choose (cdr choices))))
に相当。つまりnext
を作用させることでバックトラックを引き起こす。
(define try-again false) (call/cc (lambda (cc) (set! try-again (lambda () (if (null? *alternatives*) (cc '(there are no more values)) (let ((next (car *alternatives*))) (set! *alternatives* (cdr *alternatives*)) (next)))))))
あとは、choose
のラッパーとしてamb
を定義。
(define (amb . choices) (choose choices))
上記をamb.scmというファイルで保存し、Racket REPLで動かしてみる。
racket@> (require "amb.scm") racket@> (let ((x (amb 1 2 3)) (y (amb 'a 'b))) (list x y)) '(1 a) racket@> (try-again) '(1 b) racket@> (try-again) '(2 a) racket@> (try-again) '(2 b) racket@> (try-again) '(3 a) racket@> (try-again) '(3 b) racket@> (try-again) '(there are no more values)
できた!
このときの動作は以下のようになる。
(let ...)
で(choose '(2 3))
が*alternatives*
にpushされ、x
に1
が束縛される(choose '(b))
が*alternatives*
にpushされ、y
に'a
が束縛される'(1 a)
が返る
(try-again)
で(choose '(b))
がバックトラックされx
には1
が束縛されたまま(choose '())
が*alternatives*
にpushされ、y
に'b
が束縛される'(1 b)
が返る
(try-again)
で(choose '())
がバックトラックされると、(try-again)
が実行される(choose '(2 3))
がバックトラックされ(choose '(3))
が*alternatives*
にpushされ、x
に2
が束縛される(choose '(b))
が*alternatives*
にpushされ、y
に'a
が束縛される'(2 a)
が返る
後の(try-again)
もこれの繰り返しです。
ambオペレータの基本手続き
まずはrequire
だが、Racket組み込みのrequire
を奪われるとさすがに辛いので、req
という名前で定義する。また、Racketはif構文でaltenative節がないのを許さないので、適当にfalse
を返すようにしておく。
(define (req p) (if (not p) (amb) false))
次にan-element-of
。SICPの通りの実装では、
(define (an-element-of items) (req (not (null? items))) (amb (car items) (an-element-of (cdr items))))
実行時にamb手続きの引数が先に評価されてしまうので、an-element-of
の評価の無限ループに嵌まり返ってこなくなる。
そこで引数を遅延オブジェクト化する。
(define (an-element-of items) (req (not (null? items))) (amb (car items) (delay (an-element-of (cdr items)))))
反対にambオペレータの実装となるchoose
ではforceさせる。
(define (choose choices) (if (null? choices) (try-again) (call/cc (lambda (cc) (define try-next (lambda () (cc (choose (cdr choices))))) (set! *alternatives* (cons try-next *alternatives*)) (force (car choices)))))) ;; ここでforce
これでan-element-of
が動くようになった。
racket@> (an-element-of '(1 3 5)) 1 racket@> (try-again) 3 racket@> (try-again) 5 racket@> (try-again) '(there are no more values)
これでprime-sum-pair
も問題なく動く。
racket@> (require math/number-theory) ;; prime?のためにロード racket@> (define (prime-sum-pair list1 list2) (let ((a (an-element-of list1)) (b (an-element-of list2))) (req (prime? (+ a b))) (list a b))) racket@> (prime-sum-pair '(1 3 5 8) '(20 35 110)) '(3 20) racket@> (try-again) '(3 110) racket@> (try-again) '(8 35) racket@> (try-again) '(there are no more values)
ただし、上記のan-element-of
は(try-agian)
の度に(choose '())
が*alternatives*
にpushされるし、毎回delay/forceが絡むので効率はいまいち。
このambオペレータは特殊形式ではなく手続きなので、単純にapplyで実装する方がよいかもしれない。
(define (an-element-of items) (apply amb items))
次は§4.3の練習問題を解いていきます。