Serendip

Web Studio

問題4.53

(amb) があるために、if-fail の第1引数はバックトラックを繰り返して prime-sum-pair により全ての組み合わせを探索する。
また、permanent-set! で pairs にセットした値はバックトラックしても元の値に戻されないため、成功した組み合わせは pairs に追加されていく。
全ての組み合わせを探索し、選択を使い切った時、if-fail の第1引数の失敗継続が呼び出され、第2引数が実行される。
わかりやすくするために prime-sum-pair と if-fail 第1引数の (amb) の直前に print 文を追加して動作を確認する。

(define (require p)
  (if (not p) (amb)))

(define (an-element-of items)
  (require (not (null? items)))
  (amb (car items) (an-element-of (cdr items))))

(define (prime-sum-pair list1 list2)
  (let ((a (an-element-of list1))
        (b (an-element-of list2)))
       (print "(" a " " b ")")
       (require (prime? (+ a b)))
       (list a b)))

(define (square n)
  (* n n))

(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)))

(let ((pairs '()))
     (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
                   (permanent-set! pairs (cons p pairs))
                   (print "permanent-set! : " pairs)
                   (amb))
              pairs))

実行結果

;;; 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))
                   (print "permanent-set! : " pairs)
                   (amb))
              pairs))

;;; Starting a new problem (1 20)
(1 35)
(1 110)
(3 20)
permanent-set! : ((3 20))
(3 35)
(3 110)
permanent-set! : ((3 110) (3 20))
(5 20)
(5 35)
(5 110)
(8 20)
(8 35)
permanent-set! : ((8 35) (3 110) (3 20))
(8 110)

;;; Amb-Eval value:
((8 35) (3 110) (3 20))

permanent-set! の代わりに set! を使った場合の実行結果

;;; Amb-Eval input:
(let ((pairs '()))
     (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35))))
                   (set! pairs (cons p pairs))
                   (print "set! : " pairs)
                   (amb))
              pairs))

;;; Starting a new problem (1 20)
(1 35)
(3 20)
set! : ((3 20))
(3 35)
(5 20)
(5 35)
(8 20)
(8 35)
set! : ((8 35))

;;; Amb-Eval value:
()

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る