非确定性

介绍

非确定性是一种通过仅定义问题来解决问题的算法。非确定性程序自动选择符合条件的选项。这项技术很适合逻辑编程。

例如，以下代码返回一对数，其和是一个质数。其中一个数从'(4 6 7)选取，另一个从'(5 8 11)选取。

  1. (let ((i (amb 4 6 7))
  2.       (j (amb 5 8 11)))
  3.   (if (prime? (+ i j))
  4.       (list i j)
  5.       (amb)))
  6. ;Value 23: (6 5)

(amb 4 6 7) 从4，6和7中返回一个合适的数，(amb 5 8 11)从5，8和11中返回一个合适的数。如果没有选出合适的值，(amb)返回假。

实际上，amb做了深度优先搜索。(amb c1 c2 c3 ...)创建了搜索路径依次检查c1，c2，c3，…并回溯。因此，非确定性是一种帮程序隐藏搜索的抽象。一旦我们有了amb，我们可以很容易地编写程序而无需思考计算机做了什么。

非确定性的实现

使用在非确定性中的回溯被实现为连接到继续（continuation）的闭包链。这个链被一个全局参数fail表示，该参数是一个复写自己的函数。

函数实现

第一步，我使用函数（名为choose）实现非确定性，演示于[代码1]。我首先定义一个全局参数fail，它的初始值是一个将返回no-choice到顶层的函数（22-26行）。然后通过在函数choose中重新定义fail实现闭包链。回溯通过调用之前的fail实现。

函数choose有如下行为：

  1. 如果没有选项，调用(fail)。
  2. 如果有任何选项，
    1. 将fail储存为fail0，并调用当前继续（continuation）。
    2. 在继续（continuation）中重新定义fail。fail重新被赋值回存在fail0里的原值，并对余下的选项应用（apply）choose。
    3. 返回第一个选项到继续（continuation）外面。

[代码1]

  1. ;;; abbreviation for call-with-current-continuation
  2. (define call/cc call-with-current-continuation)
  4. ;;; This function is re-assigned in `choose` and `fail` itself.
  5. (define fail #f)
  7. ;;; function for nondeterminism
  8. (define (choose . ls)
  9.   (if (null? ls) 
  10.     (fail)
  11.     (let ((fail0 fail))
  12.       (call/cc
  13.         (lambda (cc)
  14.           (set! fail (lambda ()
  15.                        (set! fail fail0)
  16.                        (cc (apply choose (cdr ls)))))
  17.           (cc (car ls)))))))
  19. ;;; write following at the end of file
  20. ;;; initial value for fail
  21. (call/cc 
  22.   (lambda (cc)
  23.     (set! fail (lambda ()
  24.                  (cc 'no-choice)))))

让我们看看choose是否可以找到毕达哥拉斯三元组。函数pythag用于寻找三元组。如果找到了，它返回一个表。如果没有找到，调用无参数的choose，以回溯。

[例1]

  1. (define (sq x)
  2.   (* x x))
  3. ;Value: sq
  5. ;;; Pythagorean triples
  6. (define (pythag a b c)
  7.   (if (= (+ (sq a) (sq b)) (sq c))
  8.       (list a b c)
  9.       (choose)))
  10. ;Value: pythag
  12. (pythag (choose 1 2 3) (choose 3 4 5) (choose  4 5 6))
  13. ;Value 16: (3 4 5)

宏实现

为了对S-表达式使用非确定性操作，必须把操作定义为宏。例如，[例2]中所示函数an-integer-starting-from应该返回一个大于或等于n的整数，但是如果choose被以函数形式定义，它将不能正常工作，因为参数会立即求值。

[例2]

  1. (define (an-integer-starting-from n)
  2.   (choose n (an-integer-starting-from (1+ n))))
  3. ;Value: an-integer-starting-from
  5. (an-integer-starting-from 1)
  6. ;Aborting!: maximum recursion depth exceeded

为了解决这一点，我们定义了一个和[代码1]中定义一致但使用非确定性宏amb实现的choose。这个宏amb有和choose一样的递归调用自己的结构。

[代码1]中的1-5行和20-26行在下面的代码中得以重用。

[代码2]使用MIT-Scheme编译时，编译器给出如下警告：

  1. ;Warning: Possible inapplicable operator ()

但是代码可以正常工作。这些代码在Petite Chez Scheme下也可以运行。即使我没有试过其他Scheme实现，我认为amb的定义可以工作，只要它们遵守R5RS。你可以在这里下载一个为MIT-Scheme做的专门实现。MIT-Scheme编译器不会对这个专门实现提出警告。

[代码2]

  1. ;;; nondeterminism macro operator
  2. (define-syntax amb
  3.   (syntax-rules ()
  4.     ((_) (fail))
  5.     ((_ a) a)
  6.     ((_ a b ...)
  7.      (let ((fail0 fail))
  8.        (call/cc
  9.     (lambda (cc)
  10.       (set! fail
  11.         (lambda ()
  12.           (set! fail fail0)
  13.           (cc (amb b ...))))
  14.       (cc a)))))))

宏定义，amb，在参数为S-表达式时也和其他值一样正常工作。

[例3]

  1. (define (an-integer-starting-from n)
  2.   (amb n (an-integer-starting-from (1+ n))))
  3. ;Value: an-integer-starting-from
  5. (an-integer-starting-from 1)
  6. ;Value: 1
  8. (amb)
  9. ;Value: 2
  11. (amb)
  12. ;Value: 3

在Teach Yourself Scheme in Fixnum Days 和Dave Hername Code中的amb实现使用',@(map ...)'展开参数。即使它们是直截了当的定义，但由于使用了两次call/cc，它们某种程度上仍很复杂。[代码2]所示的递归定义更简单，即使展开的S-表达式会很复杂。

应用于逻辑编程，使程序更简洁

[代码3]演示了非确定性应用逻辑编程，使得程序更简洁

[代码3]

  1. 01:     ;;; returning all possibilities
  2. 02:     (define-syntax set-of
  3. 03:       (syntax-rules () 
  4. 04:         ((_ s) 
  5. 05:           (let ((acc '())) 
  6. 06:             (amb (let ((v s)) 
  7. 07:                    (set! acc (cons v acc)) 
  8. 08:                    (fail)) 
  9. 09:                  (reverse! acc))))))
  10. 10:     
  11. 11:     ;;; if not pred backtrack
  12. 12:     (define (assert pred)
  13. 13:       (or pred (amb)))
  14. 14:     
  15. 15:     ;;; returns arbitrary number larger or equal to n
  16. 16:     (define (an-integer-starting-from n)
  17. 17:       (amb n (an-integer-starting-from (1+ n))))
  18. 18:     
  19. 19:     ;;; returns arbitrary number between a and b
  20. 20:     (define (number-between a b)
  21. 21:       (let loop ((i a))
  22. 22:         (if (> i b)
  23. 23:             (amb)
  24. 24:           (amb i (loop (1+ i))))))

(set-of s)

返回满足s的所有可能性。宏的行为如下：

  1. （第5行）一个表（acc）被定义，它有所欲哦满足s的结果。
  2. （第6行）s的结果被赋给v，并加入到acc。如果结果没有带上v而直接被加入（如 (set! acc (cons s acc))），则会因为s使用了继续（continuation）而只在acc中存储了最后一个值。s改了了fail的值。
  3. （第7，8行）在这之后，调用fail回溯。因为使用了继续（continuation），函数fail行为就像在第6行被调用。
  4. （第9行）当所有可能的选项被找到时，调用(reverse! acc)并返回所有的可能选项。

定义假设amb从最左边参数开始搜索。

(assert pred)

如果谓词为假,就回溯。

(an-integer-starting-from n)

非确定性地返回从n开始的整数。

(number-between a b)

非确定性地返回a和b之间的整数

[例4]演示了如何使用set-of。得到了所有小于20的质数。

[例4]

  1. (define (prime? n)
  2.   (let ((m (sqrt n)))
  3.     (let loop ((i 2))
  4.       (or (< m i)
  5.           (and (not (zero? (modulo n i)))
  6.                (loop (+ i (if (= i 2) 1 2))))))))
  8. (define (gen-prime n)
  9.   (let ((i (number-between  2 n)))
  10.     (assert (prime? i))
  11.     i))
  13. (set-of (gen-prime 20))
  14. ;Value 12: (2 3 5 7 11 13 17 19)

逻辑编程的例子

让我们来解决SICP中的习题4.42作为例子。问题如下：

五位女同学参加一场考试。她们的家长对考试结果过分关心。为此她们约定，在给家里写信谈到考试时，每个姑娘都要写一句真话和一句假话。下面是从她们的信中摘出的句子：

贝蒂：“凯迪考第二，我只考了第三。”
艾赛尔：“你们应该高兴地听到我考了第一，琼第二。”
琼：“我考第三，可怜的艾赛尔考得最差。”
凯蒂：“我第二，玛丽只考了第四。”
玛丽：“我是第四，贝蒂的成绩最高。”

这五位姑娘的实际排名是什么？

[代码4]给出了这个问题的解法。

[代码4]

  1. 01:     (define (xor a b)
  2. 02:       (if a (not b) b))
  3. 03:     
  4. 04:     (define (all-different? . ls)
  5. 05:       (let loop ((obj (car ls)) (ls (cdr ls)))
  6. 06:         (or (null? ls)
  7. 07:             (and (not (memv obj ls))
  8. 08:                  (loop (car ls) (cdr ls))))))
  9. 09:     
  10. 10:     ;;; SICP Exercise 4.42
  11. 11:     (define (girls-exam)
  12. 12:       (let ((kitty (number-between 1 5))
  13. 13:             (betty (number-between 1 5)))
  14. 14:         (assert (xor (= kitty 2) (= betty 3)))
  15. 15:         (let ((mary (number-between 1 5)))
  16. 16:           (assert (xor (= kitty 2) (= mary 4)))
  17. 17:           (assert (xor (= mary 4) (= betty 1)))
  18. 18:           (let ((ethel (number-between 1 5))
  19. 19:                 (joan (number-between 1 5)))
  20. 20:             (assert (xor (= ethel 1) (= joan 2)))
  21. 21:             (assert (xor (= joan 3) (= ethel 5)))
  22. 22:             (assert (all-different? kitty betty ethel joan mary))
  23. 23:             (map list '(kitty betty ethel joan mary) (list kitty betty ethel joan mary))))))
  24. 24:     
  25. 25:     ;;; Bad answer for ex 4.42
  26. 26:     (define (girls-exam-x)
  27. 27:       (let ((kitty (number-between 1 5))
  28. 28:             (betty (number-between 1 5))
  29. 29:             (mary (number-between 1 5))
  30. 30:             (ethel (number-between 1 5))
  31. 31:             (joan (number-between 1 5)))
  32. 32:         (assert (xor (= kitty 2) (= betty 3)))
  33. 33:         (assert (xor (= kitty 2) (= mary 4)))
  34. 34:         (assert (xor (= mary 4) (= betty 1)))
  35. 35:         (assert (xor (= ethel 1) (= joan 2)))
  36. 36:         (assert (xor (= joan 3) (= ethel 5)))
  37. 37:         (assert (all-different? kitty betty ethel joan mary))
  38. 38:         (map list '(kitty betty ethel joan mary) (list kitty betty ethel joan mary))))

(xor a b)以下条件满足，返回#t:

  • a是#t，b是#f，或者
  • a是#f，b是#t。

(all-different? , ls)

当ls的所有元素都不相同时，返回#t。

(girls-exam)

是解决谜题的主要函数。它返回名字和排名的表。每次参数赋值后都调用了assert是为了有效地减少死分支的运行时间。(girls-exam-x)则是一个坏例子。它在为所有参数赋值之后调用assert。这种情况下，无谓地搜索了大量的死分支。[例5]显示(girl-exam-x)的运行时间是(girl-exam)的10倍。

[例5]

  1. (define-syntax cpu-time/sec
  2.   (syntax-rules ()
  3.     ((_ s)
  4.      (with-timings
  5.      (lambda () s)
  6.        (lambda (run-time gc-time real-time)
  7.      (write (internal-time/ticks->seconds run-time))
  8.      (write-char #\space)
  9.      (write (internal-time/ticks->seconds gc-time))
  10.      (write-char #\space)
  11.      (write (internal-time/ticks->seconds real-time))
  12.      (newline))))))
  13. ;Value: cpu-time/sec
  15. (cpu-time/sec (girls-exam))
  16. .03 0. .03
  17. ;Value 14: ((kitty 1) (betty 3) (ethel 5) (joan 2) (mary 4))
  19. (cpu-time/sec (girls-exam-x))
  20. .341 .29 .631
  21. ;Value 15: ((kitty 1) (betty 3) (ethel 5) (joan 2) (mary 4))

小结

当你使用了非确定性和用于逻辑编程分析技术时，你就可以写出看起来具有先见之明的程序。注意如果搜索路径里有循环我们就不能使用本章的代码。关于这一点，查看SICP 4.3以获取更多信息。

写这一章时，我参考了Teach Yourself Scheme in Fixnum Days。

你可以在这儿下载本章代码。