SICP 読み (233) 4.3.3 amb 評価器の実装
自宅マシンにて動作確認。4.51 と 4.52 なソレを盛り込んで動作確認。やはり
(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)))))
を評価器に吸わせるとオチる。
で、試験を作ってどんどん掘り下げていくと
#!/usr/bin/env gosh (use test.unit) (require "ch4-ambeval") (define-test-suite "amb" ("cond" ("cond->if" (let ((l '(cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1)))))) (assert-equal '(((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1)))) (cond-clauses l)) (assert-true (not (cond-else-clause? (car (cond-clauses l))))) (assert-equal '(> (square test-divisor) n) (cond-predicate (car (cond-clauses l)))) (assert-equal '(((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1)))) (cdr (cond-clauses l))) (assert-equal '(n) (cond-actions (car (cond-clauses l)))) (assert-true (last-exp? '(n))) (assert-equal 'n (car '(n))) (assert-equal 'n (first-exp '(n))) ) ) ) )
の最後の試験にパスしない。と、ゆー事は first-exp が、という事でソースを見ると if-fail な盛り込みで
(define (if-fail? exp) (tagged-list? exp 'if-fail)) (define (first-exp exp) (cadr exp)) (define (second-exp exp) (caddr exp))
って (絶句
やれやれ。てーコトで if-fail なソレを以下のように修正。
(define (if-fail? exp) (tagged-list? exp 'if-fail)) (define (if-fail-first-exp exp) (cadr exp)) (define (if-fail-second-exp exp) (caddr exp)) (define (analyze-if-fail exp) (let ((first (analyze (if-fail-first-exp exp))) (second (analyze (if-fail-second-exp exp)))) (lambda (env succeed fail) (first env (lambda (first-v fail2) (succeed first-v fail2)) (lambda () (second env succeed fail))))))
しかも直前エントリな prime-sum-pair が微妙。正しくは
(define (prime-sum-pair l1 l2) (let ((a (an-element-of l1)) (b (an-element-of l2))) (require (prime? (+ a b))) (list a b)))
ですな。面倒臭いので一連のナニを上記含め以下に。
(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))
で、それでも動かなくって、色々試していたんですが、ramb なソレが虫。
(use math.mt-random) (define m (make <mersenne-twister> :seed (sys-time))) (define (list-ref items n) (if (= n 0) (car items) (list-ref (cdr items) (- n 1)))) (define (remainder items n) (if (= n 0) (cdr items) (cons (car items) (remainder (cdr items) (- n 1))))) (define (analyze-ramb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) (let ((n (mt-random-integer m (length choices)))) ((list-ref choices n) env succeed (lambda () (try-next (remainder choices n))))))) (try-next cprocs))))
上記を削除し、無事動作。なんかソースの管理が無茶苦茶ッス。(とほほほ