计算机程序的构造和解释(SICP) 第4章 习题解析 Part4

这次回顾第四章第四部分习题。

学习资料：

https://ocw.mit.edu/courses/electrical-engineering-and-computer-science/6-001-structure-and-interpretation-of-computer-programs-spring-2005/index.htm

https://github.com/DeathKing/Learning-SICP

https://mitpress.mit.edu/sites/default/files/sicp/index.html

https://www.bilibili.com/video/BV1Xx41117tr?from=search&seid=14983483066585274454

参考资料：

https://sicp.readthedocs.io/en/latest

http://community.schemewiki.org/?SICP-Solutions

http://community.schemewiki.org/?sicp

https://liujiacai.net/blog/2016/02/22/recursion-without-name/

https://mvanier.livejournal.com/2897.html

https://github.com/jiacai2050/sicp

https://liujiacai.net/

4.32(p286)

可以利用多出来的惰性构造一种数据结构，该数据结构只有在使用时才会被求值，例子如下：

; 流, 下式会直接报错
(cons-stream (/ 2 0) 3)

; 此处的cons不会报错
(cons (/ 2 0) 3)

4.33(p286)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.33

原因是读入引号表达式得到的表为list，所以要将其转换为cons构成的表，这部分需要增加如下函数：

; change
(define (text-of-quotation exp env)
    (let ((arr (cadr exp)))
         (if (pair? arr)
             (eval (list->cons arr) env)
             arr)))

; add
(define (list->cons exp)
        (if (null? exp)
            (list 'quote '())
            (list 'cons
                (list 'quote (car exp))
                (list->cons (cdr exp)))))

代码如下：

(load "4.33_helper.scm")

(define the-global-environment (setup-environment))
(driver-loop)

(define (cons x y)
  (lambda (m) (m x y)))

(define (car z)
  (z (lambda (p q) p)))

(define (cdr z)
  (z (lambda (p q) q)))


(define a (cons 1 2))
a

(car a)

(cons 1 2)

(car '(a b c))

测试结果如下：

;;; L-Eval input:
a
;;; L-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)

;;; L-Eval input:
(car a)
;;; L-Eval value:
1

;;; L-Eval input:
(cons 1 2)
;;; L-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)

;;; L-Eval input:
(car '(a b c))
;;; L-Eval value:
a

4.34(p286)

需要添加一些primitive过程，内容如下：

(define (display-cons object)
    (display "(cons ")
    (display (lazy-car object))
    (display " ")
    (display (lazy-cdr object))
    (display ")"))

(define (user-print object)
    ; add
    (cond ((tagged-list? object 'cons) 
           (display-cons object))
          ((compound-procedure? object) 
           (display (list 'compound-procedure
                    (procedure-parameters object)
                    (procedure-body object)
                    '<procedure-env>))
          (else (display object)))))

(define (lazy-cons x y)
  (list 'cons (lambda (m) (m x y))))

(define (lazy-car z)
  ((cadr z) (lambda (p q) p)))

(define (lazy-cdr z)
  ((cadr z) (lambda (p q) q)))

(define (setup-environment)
  (let ((initial-env
         (extend-environment (primitive-procedure-names)
                             (primitive-procedure-objects)
                             the-empty-environment)))
    (define-variable! 'true true initial-env)
    (define-variable! 'false false initial-env)
    ; add
    (define-variable! 'lazy-cons (list 'primitive lazy-cons) initial-env)
    (define-variable! 'lazy-car (list 'primitive lazy-car) initial-env)
    (define-variable! 'lazy-cdr (list 'primitive lazy-cdr) initial-env)
    initial-env))

测试代码：

(driver-loop)

; test
(define a (lazy-cons 1 2))

(define b (lazy-cons 3 a))

a
b

实验结果：

;;; L-Eval input:
a
;;; L-Eval value:
(cons 1 2)

;;; L-Eval input:
b
;;; L-Eval value:
(cons 3 (cons #[compound-procedure 13]))

4.35(p290)

代码如下：

(load "ch4-ambeval.scm")

(define the-global-environment (setup-environment))
(driver-loop)

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

(define (an-integer-between low high)
    (require (>= high low))
    (amb low (an-integer-between (+ low 1) high)))

(define (a-pythagorean-triple-between low high)
    (let ((i (an-integer-between low high)))
        (let ((j (an-integer-between i high)))
        (let ((k (an-integer-between j high)))
            (require (= (+ (* i i) (* j j)) (* k k)))
            (list i j k)))))

(a-pythagorean-triple-between 2 10)
try-again

try-again

实验结果：

(a-pythagorean-triple-between 2 10)
;;; Starting a new problem 
;;; Amb-Eval value:
(3 4 5)

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(6 8 10)

;;; Amb-Eval input:
try-again
End of input stream reached.

4.36(p290)

如果直接换成

an-integer-starting-from

那么最先循环的是$k$，会产生如下结果：

(1 1 1)
(1 1 2)
(1 1 3)

正确的方式如下：

(load "ch4-ambeval.scm")

(define the-global-environment (setup-environment))
(driver-loop)

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

(define (an-integer-between low high)
    (require (>= high low))
    (amb low (an-integer-between (+ low 1) high)))

(define (an-integer-starting-from n)
    (amb n (an-integer-starting-from (+ n 1))))

; (define (a-pythagorean-triple)
;     (let ((i (an-integer-starting-from 1)))
;         (let ((j (an-integer-starting-from i)))
;         (let ((k (an-integer-starting-from j)))
;             (display i)
;             (display " ")
;             (display j)
;             (display " ")
;             (display k)
;             (newline)
;             (require (= (+ (* i i) (* j j)) (* k k)))
;             (list i j k)))))
; ; 会先循环k, 得到(1 1 1), (1 1 2)
; (a-pythagorean-triple)

(define (a-pythagorean-triple-v1)
    (let ((k (an-integer-starting-from 1)))
        (let ((j (an-integer-between 1 k)))
        (let ((i (an-integer-between 1 j)))
            (require (= (+ (* i i) (* j j)) (* k k)))
            (list i j k)))))

(a-pythagorean-triple-v1)

try-again

try-again

try-again

实验结果：

;;; Amb-Eval value:
(3 4 5)

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(6 8 10)

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(5 12 13)

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(9 12 15)

4.37(p290)

效率更高，原因如下：

• 只要枚举i, j
• (>= hsq ksq)减少了搜索范围。

4.38(p291)

参考资料：

http://web.mit.edu/scheme_v9.2/doc/mit-scheme-ref/Machine-Time.html

原题翻译有误，应该是忽略Smith和Fletcher住在相邻层的约束，原始题目如下：

Exercise 4.38. Modify the multiple-dwelling procedure to omit the requirement that Smith and Fletcher do not live on adjacent floors. How many solutions are there to this modified puzzle?

代码：

(load "ch4-ambeval.scm")

(define the-global-environment (setup-environment))

(driver-loop)

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

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

(define (multiple-dwelling)
  (let ((baker (amb 1 2 3 4 5))
        (cooper (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller (amb 1 2 3 4 5))
        (smith (amb 1 2 3 4 5)))
    (require
     (distinct? (list baker cooper fletcher miller smith)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    ; (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

(multiple-dwelling)

try-again

try-again

try-again

try-again

try-again

try-again

实验结果：

;;; Starting a new problem 
;;; Amb-Eval value:
((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1))

;;; Amb-Eval input:
try-again
;;; There are no more values of
(multiple-dwelling)

一共有5个解。

4.39(p291)

顺序不会影响结果，但是会影响效率，相关代码如下：

(load "ch4-ambeval.scm")

(define the-global-environment (setup-environment))

(driver-loop)

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

; 计算时间
(define (get-time f n)
    (define (iter i)
        (cond ((>= n i) (f) (iter (+ i 1)))))
    (define start (real-time-clock))
    (iter 1)
    (define end (real-time-clock))
    (/ (- end start) n))

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

(define (multiple-dwelling-v1)
  (let ((baker (amb 1 2 3 4 5))
        (cooper (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller (amb 1 2 3 4 5))
        (smith (amb 1 2 3 4 5)))
    (require
     (distinct? (list baker cooper fletcher miller smith)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

(define (multiple-dwelling-v2)
  (let ((baker (amb 1 2 3 4 5))
        (cooper (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller (amb 1 2 3 4 5))
        (smith (amb 1 2 3 4 5)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
        (require
     (distinct? (list baker cooper fletcher miller smith)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

(get-time multiple-dwelling-v1 10.0)

(get-time multiple-dwelling-v2 10.0)

实验结果：

;;; Amb-Eval input:
; (multiple-dwelling-v1)
(get-time multiple-dwelling-v1 10.0)
;;; Starting a new problem 
;;; Amb-Eval value:
539.5

;;; Amb-Eval input:
(get-time multiple-dwelling-v2 10.0)
;;; Starting a new problem 
;;; Amb-Eval value:
695.6

4.40(p291)

代码：

(load "ch4-ambeval.scm")

(define the-global-environment (setup-environment))

(driver-loop)

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

(define (get-time f n)
    (define (iter i)
        (cond ((>= n i) (f) (iter (+ i 1)))))
    (define start (real-time-clock))
    (display n)
    (iter 1)
    (define end (real-time-clock))
    (/ (- end start) n))

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

(define (multiple-dwelling)
    (let ((fletcher (amb 1 2 3 4 5)))
        (require (not (= fletcher 5)))
        (require (not (= fletcher 1)))
        (let ((cooper (amb 1 2 3 4 5)))
            (require (not (= cooper 1)))
            (require (not (= (abs (- fletcher cooper)) 1)))
            (let ((miller (amb 1 2 3 4 5)))
                (require (> miller cooper))
                (let ((smith (amb 1 2 3 4 5)))
                    (require (not (= (abs (- smith fletcher)) 1)))
                        (let ((baker (amb 1 2 3 4 5)))
                            (require (not (= baker 5)))
                                (require
                                    (distinct? (list baker cooper fletcher miller smith)))
                                    (list (list 'baker baker)
                                        (list 'cooper cooper)
                                        (list 'fletcher fletcher)
                                        (list 'miller miller)
                                        (list 'smith smith))))))))

(get-time multiple-dwelling 10.0)

实验结果：

;;; Amb-Eval input:
(get-time multiple-dwelling 10.0)
;;; Starting a new problem 10.
;;; Amb-Eval value:
71.2

4.41(p291)

代码：

(define (judge-range x)
    (and (<= x 5) (>= x 1)))

(define (distinct? items)
     (cond ((null? items) true)
           ((null? (cdr items)) true)
           ((member (car items) (cdr items)) false)
           (else (distinct? (cdr items)))))

(define (judge b c f m s)
    (and 
        (distinct? (list b c f m s))
        (not (= b 5))
        (not (= c 1))
        (not (= f 5))
        (not (= f 1))
        (> m c)
        (not (= (abs (- f c)) 1))))

(define (multiple-dwelling)
    (define res '())
    ; i表示当前处理的元素
    (define (multiple-dwelling-iter b c f m s i)
        (if (and (judge-range b) (judge-range c) (judge-range f) (judge-range m) (judge-range s))
            (if (judge b c f m s)
                (set! res (append res 
                            (list (list (list 'baker b)
                                    (list 'cooper c)
                                    (list 'fletcher f)
                                    (list 'miller m)
                                    (list 'smith s)))))
                (cond ((= i 1) (multiple-dwelling-iter (+ b 1) c f m s i)
                               (multiple-dwelling-iter b c f m s (+ i 1)))
                      ((= i 2) (multiple-dwelling-iter b (+ c 1) f m s i)
                               (multiple-dwelling-iter b c f m s (+ i 1)))
                      ((= i 3) (multiple-dwelling-iter b c (+ f 1) m s i)
                               (multiple-dwelling-iter b c f m s (+ i 1)))
                      ((= i 4) (multiple-dwelling-iter b c f (+ m 1) s i)
                               (multiple-dwelling-iter b c f m s (+ i 1)))
                      (else (multiple-dwelling-iter b c f m (+ s 1) i))))))
    (multiple-dwelling-iter 1 1 1 1 1 1)
    res)

(multiple-dwelling)

实验结果：

1 ]=> (multiple-dwelling)
;Value 13: (((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1)) ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) ((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3)) ((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3)) ((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5)))

4.42(p292)

参考资料：

https://mitpress.mit.edu/sites/default/files/sicp/full-text/book/book-Z-H-28.html#%_sec_4.3.2

http://community.schemewiki.org/?sicp-ex-4.42

注意如果在primitive-procedures中添加如下内容会报错：

(list 'or or)
(list 'and and)

解决方法是使用if来代替or和and，特别的，这里利用if定义了xor，代码如下：

(load "ch4-ambeval.scm")

(define the-global-environment (setup-environment))

(driver-loop)

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

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

(define (xor a b)
    (if a
        (not b)
        b))

(define (get-rank)
  (let ((Betty (amb 1 2 3 4 5))
        (Ethel (amb 1 2 3 4 5))
        (Joan (amb 1 2 3 4 5))
        (Kitty (amb 1 2 3 4 5))
        (Mary (amb 1 2 3 4 5)))
    (require
     (distinct? (list Betty Ethel Joan Kitty Mary)))
    (require (xor (= Kitty 2) (= Betty 3)))
    (require (xor (= Ethel 1) (= Joan 2)))
    (require (xor (= Joan 3) (= Ethel 5)))
    (require (xor (= Kitty 2) (= Mary 4)))
    (require (xor (= Mary 4) (= Betty 1)))
    (list (list 'Betty Betty)
          (list 'Ethel Ethel)
          (list 'Joan Joan)
          (list 'Kitty Kitty)
          (list 'Mary Mary))))

(get-rank)

try-again

try-again

4.43(p292)

名称对应关系：

; daughter
Mary -> Ma
Gabrielle -> Ga
Lorna -> Lo
Rosalind -> Ro
Melissa -> Me

; father
Mr. Moore -> Mo
Sir Barnacle -> Ba
Mr. Hall -> Ha
Colonel Downing -> Co
Dr. Parker -> Pa

为了求解该问题，分别定义了daughter->father以及father->daughter，代码如下：

(load "ch4-ambeval.scm")

(define the-global-environment (setup-environment))

(driver-loop)

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

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

(define (and p1 p2)
    (if p1
        p2
        false))

(define (pair-eq? p1 p2)
    (and (eq? (car p1) (car p2))
         (eq? (cadr p1) (cadr p2))))

(define (contain? pair pairs)
    (cond ((null? pairs) false)
          ((pair-eq? (car pairs) pair) true)
          (else (contain? pair (cdr pairs)))))

(define (get-answer-v1)
        ; daughter -> father
  (let ((Ma (amb 'Mo))
        (Ga (amb 'Ha 'Co 'Pa))
        (Lo (amb 'Ha 'Co 'Pa))
        (Ro (amb 'Ha 'Co 'Pa))
        (Me (amb 'Ba))
        ; father -> daughter
        (Mo (amb 'Ma))
        (Ba (amb 'Me))
        (Ha (amb 'Ga 'Lo 'Ro))
        (Co (amb 'Ga 'Lo 'Ro))
        (Pa (amb 'Ga 'Lo 'Ro ))
        ; (father, daughter)
        (pairs (list (list 'Ba 'Ga)
                     (list 'Mo 'Lo)
                     (list 'Ha 'Ro)
                     (list 'Co 'Me))))
    (require
     (distinct? (list Ga Lo Ro)))
    (require
     (distinct? (list Ha Co Pa)))
    (require (contain? (list Ga Pa) pairs))
    ; (father, daughter)
    (list (list 'Mo Mo)
          (list 'Ba Ba)
          (list 'Ha Ha)
          (list 'Co Co)
          (list 'Pa Pa))))

(get-answer-v1)

try-again

try-again

(define (get-answer-v2)
        ; daughter -> father
  (let ((Ma (amb 'Mo 'Ha 'Co 'Pa))
        (Ga (amb 'Mo 'Ha 'Co 'Pa))
        (Lo (amb 'Mo 'Ha 'Co 'Pa))
        (Ro (amb 'Mo 'Ha 'Co 'Pa))
        (Me (amb 'Ba))
        ; father -> daughter
        (Mo (amb 'Ma 'Ga 'Lo 'Ro))
        (Ba (amb 'Me))
        (Ha (amb 'Ma 'Ga 'Lo 'Ro))
        (Co (amb 'Ma 'Ga 'Lo 'Ro))
        (Pa (amb 'Ma 'Ga 'Lo 'Ro ))
        ; (father, daughter)
        (pairs (list (list 'Ba 'Ga)
                     (list 'Mo 'Lo)
                     (list 'Ha 'Ro)
                     (list 'Co 'Me))))
    (require
     (distinct? (list Ma Ga Lo Ro)))
    (require
     (distinct? (list Mo Ha Co Pa)))
    (require (contain? (list Ga Pa) pairs))
    ; (father, daughter)
    (list (list 'Mo Mo)
          (list 'Ba Ba)
          (list 'Ha Ha)
          (list 'Co Co)
          (list 'Pa Pa))))

(get-answer-v2)

try-again

try-again

实验结果：

;;; Amb-Eval input:
(get-answer-v1)
;;; Starting a new problem 
;;; Amb-Eval value:
((mo ma) (ba me) (ha ga) (co lo) (pa ro))

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((mo ma) (ba me) (ha lo) (co ga) (pa ro))

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((mo ma) (ba me) (ha ga) (co lo) (pa ro))

;;; Amb-Eval input:
(get-answer-v2)
;;; Starting a new problem 
;;; Amb-Eval value:
((mo ma) (ba me) (ha ga) (co lo) (pa ro))

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((mo ma) (ba me) (ha lo) (co ga) (pa ro))

4.44(p292)

代码：

(load "ch4-ambeval.scm")

(define the-global-environment (setup-environment))

(driver-loop)

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

(define (and p1 p2)
    (if p1
        p2
        false))

(define (or p1 p2)
    (if p1
        true
        p2))

(define (arr-eq? a1 a2)
    (or (= (car a1) (car a2))
        (= (cdr a1) (cdr a2))))

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((arr-eq? (car items) (cadr items)) false)
        (else (distinct? (cdr items)))))

(define (pred items)
    ; 获得长度
    (define (get-len arr)
        (if (null? arr)
            0
            (+ 1 (get-len (cdr arr)))))
    ; 获得元素
    (define (get-item arr k)
        (if (= k 1)
            (car arr)
            (get-item (cdr arr) (- k 1))))

    (define n (get-len items))
    ; 判断两个元素是否满足条件
    (define (judge-pair p1 p2)
        (let ((a1 (car p1))
              (a2 (cdr p1))
              (b1 (car p2))
              (b2 (cdr p2)))
             (cond ((= a1 b1) false)
                   ((= a2 b2) false)
                   ((= (abs (- a1 b1)) (abs (- a2 b2))) false)
                   (else true))))
    ; 判断item是否满足条件
    (define (judge-iter item j)
        (cond ((> j n) true)
              ((judge-pair item (get-item items j)) (judge-iter item (+ j 1)))
              (else false)))
    ; 判断从第i个元素开始是否满足条件
    (define (judge-loop i)
        (cond ((> i n) true)
              ((judge-iter (get-item items i) (+ i 1)) (judge-loop (+ i 1)))
              (else false)))
    (judge-loop 1))

(define (8-queen-v1)
    (let ((a1 (cons 1 (amb 1 2 3 4 5 6 7 8))))
        (let ((a2 (cons 2 (amb 1 2 3 4 5 6 7 8))))
            (require (distinct? (list a1 a2)))
            (require (pred (list a1 a2)))
            (let ((a3 (cons 3 (amb 1 2 3 4 5 6 7 8))))
                (require (distinct? (list a1 a2 a3)))
                (require (pred (list a1 a2 a3)))
                (let ((a4 (cons 4 (amb 1 2 3 4 5 6 7 8))))
                    (require (distinct? (list a1 a2 a3 a4)))
                    (require (pred (list a1 a2 a3 a4)))
                    (let ((a5 (cons 5 (amb 1 2 3 4 5 6 7 8))))
                        (require (distinct? (list a1 a2 a3 a4 a5)))
                        (require (pred (list a1 a2 a3 a4 a5)))
                        (let ((a6 (cons 6 (amb 1 2 3 4 5 6 7 8))))
                            (require (distinct? (list a1 a2 a3 a4 a5 a6)))
                            (require (pred (list a1 a2 a3 a4 a5 a6)))
                            (let ((a7 (cons 7 (amb 1 2 3 4 5 6 7 8))))
                                (require (distinct? (list a1 a2 a3 a4 a5 a6 a7)))
                                (require (pred (list a1 a2 a3 a4 a5 a6 a7)))
                                (let ((a8 (cons 8 (amb 1 2 3 4 5 6 7 8))))
                                    (require (distinct? (list a1 a2 a3 a4 a5 a6 a7 a8)))
                                    (require (pred (list a1 a2 a3 a4 a5 a6 a7 a8)))
                                    (list a1 a2 a3 a4 a5 a6 a7 a8))))))))))

(8-queen-v1)

try-again

实验结果：

;;; Starting a new problem 
;;; Amb-Eval value:
((1 . 1) (2 . 5) (3 . 8) (4 . 6) (5 . 3) (6 . 7) (7 . 2) (8 . 4))

;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((1 . 1) (2 . 6) (3 . 8) (4 . 3) (5 . 7) (6 . 4) (7 . 2) (8 . 5))