[Back]

4.3 Scheme的变形——非确定性计算

4.35

(define (an-interger-between low high)
    (require (<= low high))
    (amb low (an-interger-between (+ low 1) high)))

4.36

因为三角形边的限制,我们将high定为(i+j),然后不断地放大low就能确实的找出所有的毕达哥拉斯三元组。

4.37

这个过程省去了一个寻找k的分支,但是随之带来的是一次开方运算的消耗。

取决于数据大小

4.38

这个谜题有5个解

4.39

不会影响答案,但是会影响找到答案的时间。

distinct放在最后一个约束应该会更快,因为其他的运算都是数学运算,而distinct是个查找运算。

4.40

(define (logical-solving)
    (let ((fletcher (amb 2 3 4))
          (cooper (amb 2 3 4 5))
          (baker (amb 1 2 3 4))
          (miller (amb 1 2 3 4 5)))
        (require (> miller cooper))
        (require (not (= (abs (- fletcher cooper)) 1)))
        (let ((smith (amb 1 2 3 4 5)))
            (require (not (= (abs (- fletcher smith)) 1)))
            (list (list `baker baker)
                  (list `cooper cooper)
                  (list `fletcher fletcher)
                  (list `miller miller)
                  (list `smith smith)))))

4.41

(define (get-combination list)
    (if (null? list)
        `()
        (flatmap (lambda (x) (map (lambda (y) (cons x y)) (get-combination (cdr list))))
            (car list))))
 (define (restrictions l) 
   (apply 
     (lambda (baker cooper fletcher miller smith) 
       (and (> miller cooper) 
         (not (= (abs (- smith fletcher)) 1)) 
         (not (= (abs (- fletcher cooper)) 1)) 
         (distinct? (list baker cooper fletcher miller smith)))) 
     l))
(define (mutiple-dwelling) 
   (let ((baker '(1 2 3 4)) 
         (cooper '(2 3 4 5)) 
         (fletcher '(2 3 4)) 
         (miller '(3 4 5)) 
         (smith '(1 2 3 4 5))) 
     (filter restrictions (get-combination (list baker cooper fletcher miller smith))))) 

4.42

(define (xor a b)
    (or (and (not a) b) (and a (not b))))
(define (solve)
    (let ((betty (amb 1 2 3 4 5))
          (esier (amb 1 2 3 4 5))
          (jone  (amb 1 2 3 4 5))
          (ketty (amb 1 2 3 4 5))
          (mary  (amb 1 2 3 4 5)))
        (require (xor (= ketty 2) (= betty 3)))
        (require (xor (= esier 1) (= jone  2)))
        (require (xor (= jone  3) (= esier 5)))
        (require (xor (= ketty 2) (= mary  4)))
        (require (xor (= mary  4) (= betty 1)))
        (require (distinct? (list betty esier jone ketty mary)))
        (list (cons `betty betty)
              (cons `esier esier)
              (cons `jone  jone )
              (cons `ketty ketty)
              (cons `mary  mary ))))

4.43

 (define (father-daughter) 
   (let ((Moore 'Mary) 
         (Barnacle 'Melissa) 
         (Hall (amb 'Gabrielle 'Lorna)) 
         (Downing (amb 'Gabrielle 'Lorna 'Rosalind)) 
         (Parker (amb 'Lorna 'Rosalind))) 
     (require (cond ((eq? Hall 'Gabrielle) (eq? 'Rosalind Parker)) 
                    ((eq? Downing 'Gabrielle) (eq? 'Melissa Parker)) 
                    (else false))) 
     (require (distinct? (list Hall Downing Parker))) 
     (list (list 'Barnacle Barnacle) 
           (list 'Moore Moore) 
           (list 'Hall Hall) 
           (list 'Downing Downing) 
           (list 'Parker Parker)))) 

4.44

(define (queens board-size)
 (define (new-queen a b) 
     (require (<= a b)) 
     (amb a (new-queen (+ a 1) b))) 
  (define (iter positions)
    (require (distinct? (map cdr positions)))
    (require (distinct? (map (lambda (q) (- (car q) (cdr q))) positions)))
    (require (distinct? (map (lambda (q) (+ (car q) (cdr q))) positions)))
    (if (= board-size (length positions))
        (reverse (map cdr positions))
        (iter (cons (new-queen 1 board-size) positions))))
  (iter '()))

4.45

五种情况很容易想见.

4.46

从右往左的求值顺序会使得amb只求值不返回选择

4.47

因为scheme是急切求值的,这个程序会陷入死循环

4.48

 (define (parse-simple-noun-phrase)       
       (amb (list 'simple-noun-phrase 
                  (parse-word articles) 
                  (parse-word nouns)) 
                 (list 'simple-noun-phrase 
                  (parse-word articles) 
                  (parse-word adjectives) 
                  (parse-word nouns)))) 

4.49

(define (parse-word word-list)
    (require (not (null? *unparsed*)))
    (let ((found-word (amb (cadr word-list) (cddr word-list))))
        (set! *unparsed* (cdr *unparsed*))
        (list (car word-list) found-word)))

4.50

(define (analyze-ramb exp)
    (let ((cprocs (map analyze (amb-choices exp))))
        (lambda (env succeed fail)
            (define (try-next choices)
                (if (null? choices)
                    (fail)
                    (let ((randref (rand (length choices))))
                        ((list-ref (- randref 1))
                         env
                         succeed
                         (lambda () (try-next (del-list choices randref)))))))
            (try-next cprocs))))

4.51

只需再赋值的fail继续前删除回溯语句

使用set的话,cnt会一直是2

4.52

(define (analyze-if-fail exp)
    (let ((cprocs (analyze (cadr  exp)))
          (aprocs (analyze (caddr exp))))
        (lambda (env succeed fail)
            (cprocs
                env
                (lambda (evalue fail2)
                    (evalue proc succeed fail2))
                (aprocs proc succeed fail)))))

4.53

会获取到所有的素数对

这意味着,即使是非确定性求值,在经过简单的修改以后也能够有输出所有可能性的能力。

4.54

(false? pred-value)
fail