第十四章 不确定性

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

14.1 对amb的描述

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

(amb 1 2)

的结果可能为1或2。

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

(amb)
-->ERROR!!! amb tree exhausted

(我们后面再讨论这个错误信息。)

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

(amb 1 (amb))

而且:

都返回1

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

比如:

(amb #f #t)

可以返回#f#t,但是在程序:

(if (amb #f #t)
    1
    (amb))

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

14.2 用Scheme实现amb

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

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

(define amb-fail '*)

(define initialize-amb-fail
  (lambda ()
    (set! amb-fail
      (lambda ()
        (error "amb tree exhausted")))))

(initialize-amb-fail)

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

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

(define-macro amb
  (lambda alts...
    `(let ((+prev-amb-fail amb-fail))
       (call/cc
        (lambda (+sk)

          ,@(map (lambda (alt)
                   `(call/cc
                     (lambda (+fk)
                       (set! amb-fail
                         (lambda ()
                           (set! amb-fail +prev-amb-fail)
                           (+fk 'fail)))
                       (+sk ,alt))))
                 alts...)

          (+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-failamb-fail做的第一件事是重新设置amb-fail为之前入口时的值。它接下来调用失败续延+fk,这个续延会尝试下个可能的选择(如果存在的话)。

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

14.3 在Scheme中使用amb

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

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

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

过程number-between是一种生成给定lohi(包括lohi在内)之间数字的抽象方法:

(define number-between
  (lambda (lo hi)
    (let loop ((i lo))
      (if (> i hi) (amb)
          (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)一定失败的特点可以用于程序的 断言 中。

(define assert
  (lambda (pred)
    (if (not pred) (amb))))

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

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

(define gen-prime
  (lambda (hi)
    (let ((i (number-between 2 hi)))
      (assert (prime? i))
      i)))

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

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

(amb)
=> 3

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

(amb)
=> 5

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

(bag-of
  (gen-prime 20))

这样会返回:

(2 3 5 7 11 13 17 19)

bag-of定义如下:

(define-macro bag-of
  (lambda (e)
    `(let ((+prev-amb-fail amb-fail)
           (+results '()))
       (if (call/cc
            (lambda (+k)
              (set! amb-fail (lambda () (+k #f)))
              (let ((+v ,e))
                (set! +results (cons +v +results))
                (+k #t))))
           (amb-fail))
       (set! amb-fail +prev-amb-fail)
       (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是否说谎。

(define solve-kalotan-puzzle
  (lambda ()
    (let ((parent1 (amb 'm 'f))
          (parent2 (amb 'm 'f))
          (kibi (amb 'm 'f))
          (kibi-self-desc (amb 'm 'f))
          (kibi-lied? (amb #t #f)))
      (assert
       (distinct? (list parent1 parent2)))
      (assert
       (if (eqv? kibi 'm)
           (not kibi-lied?)))
      (assert
       (if kibi-lied?
           (xor
            (and (eqv? kibi-self-desc 'm)
                 (eqv? kibi 'f))
            (and (eqv? kibi-self-desc 'f)
                 (eqv? kibi 'm)))))
      (assert
       (if (not kibi-lied?)
           (xor
            (and (eqv? kibi-self-desc 'm)
                 (eqv? kibi 'm))
            (and (eqv? kibi-self-desc 'f)
                 (eqv? kibi 'f)))))
      (assert
       (if (eqv? parent1 'm)
           (and
            (eqv? kibi-self-desc 'm)
            (xor
             (and (eqv? kibi 'f)
                  (eqv? kibi-lied? #f))
             (and (eqv? kibi 'm)
                  (eqv? kibi-lied? #t))))))
      (assert
       (if (eqv? parent1 'f)
           (and
            (eqv? kibi 'f)
            (eqv? kibi-lied? #t))))
      (list parent1 parent2 kibi))))

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

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

14.4.2 地图着色

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

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

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

(define choose-color
  (lambda ()
    (amb 'red 'yellow 'blue 'white)))

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

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

(define color-europe
  (lambda ()

    ;choose colors for each country
    (let ((p (choose-color)) ;Portugal
          (e (choose-color)) ;Spain
          (f (choose-color)) ;France
          (b (choose-color)) ;Belgium
          (h (choose-color)) ;Holland
          (g (choose-color)) ;Germany
          (l (choose-color)) ;Luxemb
          (i (choose-color)) ;Italy
          (s (choose-color)) ;Switz
          (a (choose-color)) ;Austria
          )

      ;construct the adjacency list for
      ;each country: the 1st element is
      ;the name of the country; the 2nd
      ;element is its color; the 3rd
      ;element is the list of its
      ;neighbors' colors
      (let ((portugal
             (list 'portugal p
                   (list e)))
            (spain
             (list 'spain e
                   (list f p)))
            (france
             (list 'france f
                   (list e i s b g l)))
            (belgium
             (list 'belgium b
                   (list f h l g)))
            (holland
             (list 'holland h
                   (list b g)))
            (germany
             (list 'germany g
                   (list f a s h b l)))
            (luxembourg
             (list 'luxembourg l
                   (list f b g)))
            (italy
             (list 'italy i
                   (list f a s)))
            (switzerland
             (list 'switzerland s
                   (list f i a g)))
            (austria
             (list 'austria a
                   (list i s g))))
        (let ((countries
               (list portugal spain
                     france belgium
                     holland germany
                     luxembourg
                     italy switzerland
                     austria)))

          ;the color of a country
          ;should not be the color of
          ;any of its neighbors
          (for-each
           (lambda (c)
             (assert
              (not (memq (cadr c)
                         (caddr c)))))
           countries)

          ;output the color
          ;assignment
          (for-each
           (lambda (c)
             (display (car c))
             (display " ")
             (display (cadr c))
             (newline))
           countries))))))

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


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