第十四章 不确定性

麦卡锡的非确定运算符amb几乎和Lisp一样古老，尽管现在它已经从Lisp中消失了。amb接受一个或多个表达式，并在它们中进行一次“非确定”（或者叫“模糊”）选择，这个选择会让程序趋向于有意义。现在我们来探索一下Scheme内置的amb过程，该过程会对模糊的选项进行深度优先选择，并使用Scheme的控制操作符call/cc来回溯其他的选项。结果是一个优雅的回溯机制，该机制可用于在Scheme中对问题空间进行搜索而不需要另一种扩展了的语言。这种内嵌的恢复续延的机制可以用来实现Prolog风格的逻辑语言，但是更方便（sparer），因为这个操作符更像是Scheme的一个布尔运算符，使用时不需要特殊的上下文（context），而且也不依赖语言学的一些基础元素如逻辑变量和归纳法（unification）。

14.1 对amb的描述

最早的Scheme的教程SICP对amb进行了易于理解的描述，同时还给出了许多例子。说得直白一些，amb接受零个或更多表达式并“不确定”的返回其中“一个”的值。因此：

  1. (amb 1 2)

的结果可能为1或2。

不带参数调用amb则不会有返回值，而且应该会出错。因此：

  1. (amb)
  2. -->ERROR!!! amb tree exhausted

（我们后面再讨论这个错误信息。）

特别的，如果它的至少一个外层表达式收敛（converges）此时需要amb返回一个值，那么就不会出错，因此：

  1. (amb 1 (amb))

而且：

都返回1。

很明显，amb不能简单的等同于它的第一个子表达式，因为它必须返回一个“非错误”的值，如果有这种可能的话。然而，仅仅这样还不够：为使程序收敛的选择比单纯选择amb的子表达式要更加严格。amb应该返回让“整个”程序收敛的值。在这个意义上，amb是一个“神”一般的运算符。

比如：

  1. (amb #f #t)

可以返回#f或#t，但是在程序：

  1. (if (amb #f #t)
  2.     1
  3.     (amb))

中，第一个amb表达式必须返回#t，如果返回#f，那就会执行else分支，这会导致整个程序挂掉。

14.2 用Scheme实现amb

在我们的amb实现中，我们令amb的子表达式从左向右。也就是说，我们先选择第一个子表达式，如果不论怎样它都失败，那再选择第二个，如此等等。在回溯到前一个amb之前，程序控制流中后面出现的amb也被搜索以查看所有的可能性。换句话说，我们对amb的选择树进行了一个深度优先搜索，当我们碰到失败的情况时，我们就回溯到最近的节点来尝试其他的选择。（这叫做按时间顺序的回溯。）

我们首先定义一个机制来处理基本的错误的续延：

  1. (define amb-fail '*)
  3. (define initialize-amb-fail
  4.   (lambda ()
  5.     (set! amb-fail
  6.       (lambda ()
  7.         (error "amb tree exhausted")))))
  9. (initialize-amb-fail)

当amb出错时，它调用绑定到amb-fail的续延。这个续延是在所有amb的选择树都被尝试过并且失败的情况下调用的。

我们把amb定义为一个宏，接受任意数量的参数。

  1. (define-macro amb
  2.   (lambda alts...
  3.     `(let ((+prev-amb-fail amb-fail))
  4.        (call/cc
  5.         (lambda (+sk)
  7.           ,@(map (lambda (alt)
  8.                    `(call/cc
  9.                      (lambda (+fk)
  10.                        (set! amb-fail
  11.                          (lambda ()
  12.                            (set! amb-fail +prev-amb-fail)
  13.                            (+fk 'fail)))
  14.                        (+sk ,alt))))
  15.                  alts...)
  17.           (+prev-amb-fail))))))

对amb的调用被首先存储到+prev-amb-fail中，amb-fail的值是此时的入口。这是因为amb-fail变量会被随着对可能选项的遍历被设置为不同的失败续延。

我们然后捕获amb的入口续延+sk，这样当求出一个“非失败”的值时，它可以马上退出amb。

每个序列中的选择alt都被尝试（Scheme中隐式的begin序列）。

首先，我们捕获当前续延+fk，把它包在一个过程中并把该过程赋给amb-fail。接着替换物被求值(+sk alt)。如果alt的求值没有失败，那么把它的返回值作为参数给续延+sk，这样马上就退出了amb的调用。如果alt失败了，就调用amb-fail。amb-fail做的第一件事是重新设置amb-fail为之前入口时的值。它接下来调用失败续延+fk，这个续延会尝试下个可能的选择（如果存在的话）。

如果所有选择都失败了，amb入口的amb-fail（我们之前把它存放在+prev-amb-fail中）会被调用。

14.3 在Scheme中使用amb

选择一个1到10之间的数字，我们可以这样写：

  1. (amb 1 2 3 4 5 6 7 8 9 10)

毫无疑问这个程序会返回1（根据我们之前实现的策略），但这个与它的上下文有关，它完全可能返回给定的任何数字。

过程number-between是一种生成给定lo到hi（包括lo和hi在内）之间数字的抽象方法：

  1. (define number-between
  2.   (lambda (lo hi)
  3.     (let loop ((i lo))
  4.       (if (> i hi) (amb)
  5.           (amb i (loop (+ i 1)))))))

因此(number-between 1 6)会首先生成1。如果失败了，继续循环，生成2。如果还是失败，我们就得到3，这样一直到6。6以后，loop以参数7被调用，这比6要大，调用(amb)。这会产生一个最终的错误（回忆之前我们所说的，单独的(amb)肯定会出现错误）这时，这个包含(number-between 1 6)的程序会按时间顺序依次回溯之前的amb调用，用另一种方式来满足这个调用。

(amb)一定失败的特点可以用于程序的 断言 中。

  1. (define assert
  2.   (lambda (pred)
  3.     (if (not pred) (amb))))

调用(assert pred)确保了pred为真，否则它会让当前的amb选择点失败。

下面的程序用assert来生成一个小于等于其参数hi的素数：

  1. (define gen-prime
  2.   (lambda (hi)
  3.     (let ((i (number-between 2 hi)))
  4.       (assert (prime? i))
  5.       i)))

这看起来也太简单了，只是当不论以任何数字（如20）调用这个过程，它永远会给出第一个解：2。

我们当然希望得到所有的解，而不是只有第一个。这种情况下，我们会希望得到所有比20小的素数。一种方法是在该过程输出了第一个解后，显式地调用失败续延。因此：

  1. (amb)
  2. => 3

这样又会产生另一个失败续延，我们还可以继续调用它来得到另一个解。

  1. (amb)
  2. => 5

这种方式的问题是程序首先在Scheme的命令提示符后面被调用，并且在Scheme的命令行上调用(amb)也可以得到成功的解。实际上，我们正在使用不同的程序（我们无法预计到底有多少！），并把信息从前一个传递到下一个。相反的，我们希望可以在任意上下文中调用某种形式然后返回这些解。为此我们定义了bag-of宏，该宏返回其参数的所有成功实例。（如果参数永远不能成功，就返回空列表）因此我们可以这样写：

  1. (bag-of
  2.   (gen-prime 20))

这样会返回：

  1. (2 3 5 7 11 13 17 19)

宏bag-of定义如下：

  1. (define-macro bag-of
  2.   (lambda (e)
  3.     `(let ((+prev-amb-fail amb-fail)
  4.            (+results '()))
  5.        (if (call/cc
  6.             (lambda (+k)
  7.               (set! amb-fail (lambda () (+k #f)))
  8.               (let ((+v ,e))
  9.                 (set! +results (cons +v +results))
  10.                 (+k #t))))
  11.            (amb-fail))
  12.        (set! amb-fail +prev-amb-fail)
  13.        (reverse! +results))))

bag-of首先保存它的入口到amb-fail。它重新定义了amb-fail为一个在if测试中创建的本地续延。在这个测试中，bag-of的参数e被求值，如果成功，它的结果被收集到一个叫+results的列表，并且以#t为参数调用本地续延。这会让if测试成功，导致e会在它的下一个回溯点被重新尝试。e的其他结果也通过这种方法获得并放进+results里。

最后，当e失败时，它会调用基本的amb-fail，即以#f为参数调用本地续延。这就把控制从if中转移出来。我们把amb-fail恢复到它上一个入口的值，并返回+results。（过程reverse!只是用来把结果以他们生成的顺序展现出来）

14.4 逻辑谜题

在解决逻辑谜题时，这种深度优先搜索与回溯相结合的方法的强大才能明显体现出来。这些问题用过程式的方式非常难以解决，但是可以用amb简洁、直截了当的解决，而且不会减少解决问题的魅力。

14.4.1 Kalotan谜题

Kalotan是一个奇特的部落。这个部落里所有男人都总是讲真话。所有的女人从来不会连续2句讲真话，也不会连续2句都讲假话。

一个哲学家（Worf）开始研究这些人。Worf不懂Kalotan的语言。一天他碰到一对Kalotan夫妻和他们的孩子Kibi。Worf问Kibi：“你是男孩吗？”Kibi用Kalotan语回答，Worf没听懂。

Wrof又问孩子的父母（他们都会说英语），其中一个人说：“Kibi说：‘我是个男孩。’”，另外一个人说：“Kibi是个女孩，Kibi撒谎了”。

请问这三个Kalotan人的性别。

解决的方法包括引进一堆变量，给它们赋上各种可能的值，把所有情况列举为一系列assert表达式。

变量：parent1,parent2,kibi分别是父母（按照说话的顺序）和Kibi的性别。kibi-self-desc是Kibi用Kalotan语说的自己的性别。kibi-lied?表示Kibi是否说谎。

  1. (define solve-kalotan-puzzle
  2.   (lambda ()
  3.     (let ((parent1 (amb 'm 'f))
  4.           (parent2 (amb 'm 'f))
  5.           (kibi (amb 'm 'f))
  6.           (kibi-self-desc (amb 'm 'f))
  7.           (kibi-lied? (amb #t #f)))
  8.       (assert
  9.        (distinct? (list parent1 parent2)))
  10.       (assert
  11.        (if (eqv? kibi 'm)
  12.            (not kibi-lied?)))
  13.       (assert
  14.        (if kibi-lied?
  15.            (xor
  16.             (and (eqv? kibi-self-desc 'm)
  17.                  (eqv? kibi 'f))
  18.             (and (eqv? kibi-self-desc 'f)
  19.                  (eqv? kibi 'm)))))
  20.       (assert
  21.        (if (not kibi-lied?)
  22.            (xor
  23.             (and (eqv? kibi-self-desc 'm)
  24.                  (eqv? kibi 'm))
  25.             (and (eqv? kibi-self-desc 'f)
  26.                  (eqv? kibi 'f)))))
  27.       (assert
  28.        (if (eqv? parent1 'm)
  29.            (and
  30.             (eqv? kibi-self-desc 'm)
  31.             (xor
  32.              (and (eqv? kibi 'f)
  33.                   (eqv? kibi-lied? #f))
  34.              (and (eqv? kibi 'm)
  35.                   (eqv? kibi-lied? #t))))))
  36.       (assert
  37.        (if (eqv? parent1 'f)
  38.            (and
  39.             (eqv? kibi 'f)
  40.             (eqv? kibi-lied? #t))))
  41.       (list parent1 parent2 kibi))))

对于辅助过程的一些说明：distinct?过程返回true，如果其参数列表里所有参数都是不同的，否则返回false。过程xor只有当它的两个参数一个真一个假时才返回true，否则返回false。

输入(solve-kalotan-puzzle)会解决这个谜题。

14.4.2 地图着色

人们很早以前就知道（但知道1976年才证明）至少用四种颜色就可以给地球的地图着色，也就是说给所有国家着色并保证相邻的国家的颜色是不同的。为了验证确实是这样的，我们编写下面的程序，并指出非确定性编程是如何为之提供便利的。

下面的这段程序解决了西欧的地图着色问题。这个问题和其用Prolog语言的解法在《the Art of Prolog》中给出。（如果你能比较我们与那本书里的解法应该很有益处）

过程choose-color非确定的返回四种颜色之一：

  1. (define choose-color
  2.   (lambda ()
  3.     (amb 'red 'yellow 'blue 'white)))

在我们的解法中，我们为每个国家建立了一个数据结构。该结构是一个三元素的列表：第一个元素表示国家名，第二个元素是颜色，第三个元素是它相邻国家的颜色。注意我们用国家的首字母作为颜色的变量，即比利时（Belgium）的列表是(list 'belgium b (list f h l g))，因为——按照这个问题列表——比利时的邻国是法国(France)，荷兰(Holland)，卢森堡(Luxembourg)，德国(Germany)。

一旦我们给每个国家创建了列表，我们 仅仅 需要陈述他们应该满足的条件，即每个国家不能与邻国有相同的颜色。换句话说，对每个国家的列表，第二个元素的值应该不在第三个元素（列表）中。

  1. (define color-europe
  2.   (lambda ()
  4.     ;choose colors for each country
  5.     (let ((p (choose-color)) ;Portugal
  6.           (e (choose-color)) ;Spain
  7.           (f (choose-color)) ;France
  8.           (b (choose-color)) ;Belgium
  9.           (h (choose-color)) ;Holland
  10.           (g (choose-color)) ;Germany
  11.           (l (choose-color)) ;Luxemb
  12.           (i (choose-color)) ;Italy
  13.           (s (choose-color)) ;Switz
  14.           (a (choose-color)) ;Austria
  15.           )
  17.       ;construct the adjacency list for
  18.       ;each country: the 1st element is
  19.       ;the name of the country; the 2nd
  20.       ;element is its color; the 3rd
  21.       ;element is the list of its
  22.       ;neighbors' colors
  23.       (let ((portugal
  24.              (list 'portugal p
  25.                    (list e)))
  26.             (spain
  27.              (list 'spain e
  28.                    (list f p)))
  29.             (france
  30.              (list 'france f
  31.                    (list e i s b g l)))
  32.             (belgium
  33.              (list 'belgium b
  34.                    (list f h l g)))
  35.             (holland
  36.              (list 'holland h
  37.                    (list b g)))
  38.             (germany
  39.              (list 'germany g
  40.                    (list f a s h b l)))
  41.             (luxembourg
  42.              (list 'luxembourg l
  43.                    (list f b g)))
  44.             (italy
  45.              (list 'italy i
  46.                    (list f a s)))
  47.             (switzerland
  48.              (list 'switzerland s
  49.                    (list f i a g)))
  50.             (austria
  51.              (list 'austria a
  52.                    (list i s g))))
  53.         (let ((countries
  54.                (list portugal spain
  55.                      france belgium
  56.                      holland germany
  57.                      luxembourg
  58.                      italy switzerland
  59.                      austria)))
  61.           ;the color of a country
  62.           ;should not be the color of
  63.           ;any of its neighbors
  64.           (for-each
  65.            (lambda (c)
  66.              (assert
  67.               (not (memq (cadr c)
  68.                          (caddr c)))))
  69.            countries)
  71.           ;output the color
  72.           ;assignment
  73.           (for-each
  74.            (lambda (c)
  75.              (display (car c))
  76.              (display " ")
  77.              (display (cadr c))
  78.              (newline))
  79.            countries))))))

输入(color-europe)来得到一个颜色-国家对应表。

  1. SICP把这个过程命名为require。我们使用assert标识符是为了避免与用来从其他文件中加载代码的require标识符混淆。