SICP 読み (232) 4.3.3 amb 評価器の実装
問題 4.50 は一旦置いとく事に。次の問題 4.51 も微妙。permanent-set! の実装について、単純に set-variable-value! しといて失敗な時に戻さなければ良いんじゃね? という安易な考えしか持っていません。多分ダウト。
逆に
(let ((x (an-element-of '(a b c)))
(y (an-element-of '(a b c))))
(permanent-set! count (+ count 1))
(require (not (eq? x y)))
(list x y count))な一連の手続きの permanent-set! が set! だった時の挙動がさくっとイメージできませんので時間をかけて整理してみる事に。
で、何がイメージできてないか、というと失敗した時に set! で設定したナニがどこまで巻き戻るのか、という事と言えば良いでしょうか。なんか日本語微妙。ただこの評価器の特徴として_最新の失敗継続を持ち回っている_という部分が微妙だったような気がします。set! が元に戻って amb はどうなるの? みたいな感じと言えば良いでしょうか。
で、以下の手続きを見るに、set! を元に戻した後に失敗な継続を呼び出している模様。
(define (analyze-assignment exp)
(let ((var (assignment-variable exp))
(vproc (analyze (assignment-value exp))))
(lambda (env succeed fail)
(vproc env
(lambda (val fail2) ; *1*
(let ((old-value
(lookup-variable-value var env)))
(set-variable-value! var val env)
(succeed 'ok
(lambda () ; *2*
(set-variable-value! var
old-value
env)
(fail2)))))
fail))))という事は
;;; Starting a new problem ;;; Amb-Eval value: (a b 2) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (a c 3)
なソレはどうなってくるのか、というナニを以下に列挙してみます。
- その一
- x には a、y には a がセット
- count は 1 になる
- require な条件は偽
- count が 0 に戻り、y には b がセット
- その二
- x には a、y には b がセット
- count は 1 になる
- require な条件は真
- (a b 1) が出力
で、この時に try-again した時にどうなるか、が微妙。失敗な継続が呼び出されるはずなので count は元に戻りますな。てー事は出力のみを列挙すれば
(a b 1) (a c 1) (b a 1) (b c 1) (c a 1) (c b 1)
みたいな感じになるんでしょうか。別途確認ってコトで、とりあえず permanent-set! なソレを検討できれば検討予定。
続
確認したらビンゴだった。ってコトは permanent-set! は失敗した時に元に戻さなければ OK ってコトで以下ッスか??
(define (analyze-p-assignment exp)
(let ((var (assignment-variable exp))
(vproc (analyze (assignment-value exp))))
(lambda (env succeed fail)
(vproc env
(lambda (val fail2) ; *1*
(let ((old-value
(lookup-variable-value var env)))
(set-variable-value! var val env)
(succeed 'ok fail2)))
fail))))で、評価器に盛り込んだら動作している模様。むむ。
;;; Amb-Eval input:
(let ((x (an-element-of '(a b c)))
(y (an-element-of '(a b c))))
(permanent-set! count (+ count 1))
(require (not (eq? x y)))
(list x y count))
;;; Starting a new problem
;;; Amb-Eval value:
(a b 2)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(a c 3)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(b a 4)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(b c 6)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(c a 7)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(c b 8)
;;; Amb-Eval input:
try-again
;;; There are no more values of
(let ((x (an-element-of '(a b c))) (y (an-element-of '(a b c)))) (permanent-set! count (+ count 1)) (require (not (eq? x y))) (list x y count))
;;; Amb-Eval input:なんか分からんがヤケに進むなぁ。
問題 4.52
こんなカンジで良いのだろうか。
(define (if-fail? exp) (tagged-list? exp 'if-fail))
(define (first-exp exp) (cadr exp))
(define (second-exp exp) (caddr exp))
(define (analyze-if-fail exp)
(let ((first (analyze (first-exp exp)))
(second (analyze (second-exp exp))))
(lambda (env succeed fail)
(first env
(lambda (first-v fail2)
(succeed first-v fail2))
(lambda ()
(second env
succeed
fail))))))動作確認。
;;; Amb-Eval input: (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))) (define (require p) (if (not p) (amb))) ;;; Starting a new problem ;;; Amb-Eval value: ok ;;; Amb-Eval input: ;;; Starting a new problem ;;; Amb-Eval value: ok ;;; Amb-Eval input: (if-fail (let ((x (an-element-of '(1 3 5)))) (require (even? x)) x) 'all-odd) ;;; Starting a new problem ;;; Amb-Eval value: all-odd ;;; Amb-Eval input: (if-fail (let ((x (an-element-of '(1 3 5 8)))) (require (even? x)) x) 'all-odd) ;;; Starting a new problem ;;; Amb-Eval value: 8 ;;; Amb-Eval input:
例示されてるナニな通りに一応動いてますな。ちなみに analyze に
((if-fail? exp) (analyze-if-fail exp))
なソレを入れるのを忘れてて動作せず。even? も知らね、と言われています。(駄目
失敗な継続をきちんと扱えているのかどうか微妙なカンジだったり。がしかし、4.3 節ラスト 2 問だ。
問題 4.53
体調不良によりどんどんヤッてしまう (何
prime? な手続きは p.28 によると以下。
(define (smallest-divisor n) (find-divisor n 2)) (define (find-divisor n test-divisor) (cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1))))) (define (divides? a b) (= (remainder b a) 0)) (define (prime? n) (= n (smallest-divisor n))) (define (square n) (* n n))
示されている以下の手続きが
(define (an-element-of items)
(require (not (null? items)))
(amb (car items) (an-element-of (cdr items))))
(define (require p)
(if (not p) (amb)))
(define (prime-sum-pair l1 l2)
(let ((a (an-element-of l1))
(b (an-element-of l2)))
(require (prime? (+ a b)))
(list a b)))
(let ((pairs '()))
(if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
(permanent-set! pairs (cons p pairs))
(amb))
pairs))何を戻すか、という事ですが、ぱっと見では if-fail の最初の式のいっちゃんケツにある amb で式が失敗して何も戻らないようにも見えるし、prime-sum-pair に渡した二つのリストの要素の和が素数であるペアをフィルタしているようにも見える。
ただ、式全体が失敗するのは両方のリストの要素が出つくした時じゃないかなぁ。戻るのは
((3 20) (3 110) (8 35))
と見た。
続々 (問題 4.53)
試験しようと思ったら、find-divisor の定義式を評価器が拒絶している。こんな感じ。
;;; Amb-Eval input:
(define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (+ test-divisor 1)))))
*** ERROR: pair required, but got ()
Stack Trace:
_______________________________________
0 exp
1 (sequence->exp (cond-actions first))
At line 197 of "./ch4-mceval.scm"
2 (cond->if exp)
At line 76 of "./ch4-ambeval.scm"
3 (map analyze exps)
At line 142 of "./ch4-ambeval.scm"
4 (analyze-sequence (lambda-body exp))
At line 106 of "./ch4-ambeval.scm"
5 (analyze (definition-value exp))
At line 151 of "./ch4-ambeval.scm"
6 (analyze exp)
At line 86 of "./ch4-ambeval.scm"困ったなぁ。って困ってたら 4.1.7 なソースを発見。差分は見つからない。ちなみに 4.1.7 なソースでは上記の定義は通っている。
なら、とゆーコトでソースをコピって評価してみたらやはり駄目。これは ch4-ambeval.scm 側の問題なのかなぁ。追いかけるの面倒なんでとりあえず以下で。(を
(define (find-divisor n test-divisor)
(if (> (square test-divisor) n)
n
(if (divides? test-divisor n)
test-divisor
(find-divisor n (+ test-divisor 1)))))で無理矢理動かしたら順番逆だった。そりゃそうか (とほほ
;;; Amb-Eval input:
(let ((pairs '()))
(if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
(permanent-set! pairs (cons p pairs))
(amb))
pairs))
;;; Starting a new problem
;;; Amb-Eval value:
((8 35) (3 110) (3 20))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(let ((pairs '())) (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110)))) (permanent-set! pairs (cons p pairs)) (amb)) pairs))
;;; Amb-Eval input:出た問題を解決するかどうかは不明ッス。(こら
# 試験は作れる環境なはずですが ...
