第十五章：示例：推论

接下来三章提供了大量的 Lisp 程序例子。选择这些例子来说明那些较长的程序所采取的形式，和 Lisp 所擅长解决的问题类型。

在这一章中我们将要写一个基于一组 if-then 规则的推论程序。这是一个经典的例子 —— 不仅在于其经常出现在教科书上，还因为它反映了 Lisp 作为一个“符号计算”语言的本意。这个例子散发着很多早期 Lisp 程序的气息。

15.1 目标 (The Aim)

在这个程序中，我们将用一种熟悉的形式来表示信息：包含单个判断式，以及跟在之后的零个或多个参数所组成的列表。要表示 Donald 是 Nancy 的家长，我们可以这样写：

(parent donald nancy)

事实上，我们的程序是要表示一些从已有的事实作出推断的规则。我们可以这样来表示规则：

(<- head body)

其中， head 是 那么...部分 (then-part)， body 是 如果...部分 (if-part)。在 head 和 body 中我们使用以问号为前缀的符号来表示变量。所以下面这个规则：

(<- (child ?x ?y) (parent ?y ?x))

表示：如果 y 是 x 的家长，那么 x 是 y 的孩子；更恰当地说，我们可以通过证明 (parent y x) 来证明 (child x y) 的所表示的事实。

可以把规则中的 body 部分(if-part) 写成一个复杂的表达式，其中包含 and , or 和 not 等逻辑操作。所以当我们想要表达 “如果 x 是 y 的家长，并且 x 是男性，那么 x 是 y 的父亲” 这样的规则，我们可以写：

(<- (father ?x ?y) (and (parent ?x ?y) (male ?x)))

一些规则可能依赖另一些规则所产生的事实。比如，我们写的第一个规则是为了证明 (child x y) 的事实。如果我们定义如下规则：

(<- (daughter ?x ?y) (and (child ?x ?y) (female ?x)))

然后使用它来证明 (daughter x y) 可能导致程序使用第一个规则去证明 (child x y) 。

表达式的证明可以回溯任意数量的规则，只要它最终结束于给出的已知事实。这个过程有时候被称为反向链接 (backward-chaining)。之所以说 反向 (backward) 是因为这一类推论先考虑 head 部分，这是为了在继续证明 body 部分之前检查规则是否有效。链接 (chaining) 来源于规则之间的依赖关系，从我们想要证明的内容到我们的已知条件组成一个链接 (尽管事实上它更像一棵树)。 λ

15.2 匹配 (Matching)

我们需要有一个函数来做模式匹配以完成我们的反向链接 (back-chaining) 程序，这个函数能够比较两个包含变量的列表，它会检查在给变量赋值后是否可以使两个列表相等。举例，如果 ?x 和 ?y 是变量，那么下面两个列表：

(p ?x ?y c ?x)
(p  a  b c  a)

当 ?x = a 且 ?y = b 时匹配，而下面两个列表：

(p ?x b ?y a)
(p ?y b  c a)

当 ?x = ?y = c 时匹配。

我们有一个 match 函数，它接受两棵树，如果这两棵树能匹配，则返回一个关联列表（assoc-list）来显示他们是如何匹配的：

(defun match (x y &optional binds)
  (cond
   ((eql x y) (values binds t))
   ((assoc x binds) (match (binding x binds) y binds))
   ((assoc y binds) (match x (binding y binds) binds))
   ((var? x) (values (cons (cons x y) binds) t))
   ((var? y) (values (cons (cons y x) binds) t))
   (t
    (when (and (consp x) (consp y))
      (multiple-value-bind (b2 yes)
                           (match (car x) (car y) binds)
        (and yes (match (cdr x) (cdr y) b2)))))))

(defun var? (x)
  (and (symbolp x)
       (eql (char (symbol-name x) 0) #\?)))

(defun binding (x binds)
  (let ((b (assoc x binds)))
    (if b
        (or (binding (cdr b) binds)
            (cdr b)))))

图 15.1: 匹配函数。

> (match '(p a b c a) '(p ?x ?y c ?x))
((?Y . B) (?X . A))
T
> (match '(p ?x b ?y a) '(p ?y b c a))
((?Y . C) (?X . ?Y))
T
> (match '(a b c) '(a a a))
NIL

当 match 函数逐个元素地比较它的参数时候，它把 binds 参数中的值分配给变量，这被称为绑定 (bindings)。如果成功匹配，match 函数返回生成的绑定；否则，返回 nil 。当然并不是所有成功的匹配都会产生绑定，我们的 match 函数就像 gethash 函数那样返回第二个值来表明匹配成功：

> (match '(p ?x) '(p ?x))
NIL
T

如果 match 函数像上面那样返回 nil 和 t ，表明这是一个没有产生绑定的成功匹配。下面用中文来描述 match 算法是如何工作的：

1. 如果 x 和 y 在 eql 上相等那么它们匹配；否则，
2. 如果 x 是一个已绑定的变量，并且绑定匹配 y ，那么它们匹配；否则，
3. 如果 y 是一个已绑定的变量，并且绑定匹配 x ，那么它们匹配；否则，
4. 如果 x 是一个未绑定的变量，那么它们匹配，并且为 x 建立一个绑定；否则，
5. 如果 y 是一个未绑定的变量，那么它们匹配，并且为 y 建立一个绑定；否则，
6. 如果 x 和 y 都是 cons ，并且它们的 car 匹配，由此产生的绑定又让 cdr 匹配，那么它们匹配。

下面是一个例子，按顺序来说明以上六种情况：

> (match '(p ?v  b ?x  d (?z ?z))
         '(p  a ?w  c ?y ( e  e))
         '((?v . a) (?w . b)))
((?Z . E) (?Y . D) (?X . C) (?V . A) (?W . B))
T

match 函数通过调用 binding 函数在一个绑定列表中寻找变量（如果有的话）所关联的值。这个函数必须是递归的，因为有这样的情况 “匹配建立一个绑定列表，而列表中变量只是间接关联到它的值： ?x 可能被绑定到一个包含 (?x . ?y) 和 (?y . a) 的列表”：

> (match '(?x a) '(?y ?y))
((?Y . A) (?X . ?Y))
T

先匹配 ?x 和 ?y ，然后匹配 ?y 和 a ，我们间接确定 ?x 是 a 。

15.3 回答查询 (Answering Queries)

在介绍了绑定的概念之后，我们可以更准确的说一下我们的程序将要做什么：它得到一个可能包含变量的表达式，根据我们给定的事实和规则返回使它正确的所有绑定。比如，我们只有下面这个事实：

(parent donald nancy)

然后我们想让程序证明：

(parent ?x ?y)

它会返回像下面这样的表达：

(((?x . donald) (?y . nancy)))

它告诉我们只有一个可以让这个表达式为真的方法： ?x 是 donald 并且 ?y 是 nancy 。

在通往目标的路上，我们已经有了一个的重要部分：一个匹配函数。 下面是用来定义规则的一段代码：

(defvar *rules* (make-hash-table))

(defmacro <- (con &optional ant)
  `(length (push (cons (cdr ',con) ',ant)
                 (gethash (car ',con) *rules*))))

图 15.2 定义规则

规则将被包含于一个叫做 *rules* 的哈希表，通过头部 (head) 的判断式构建这个哈系表。这样做加强了我们无法使用判断式中的变量的限制。虽然我们可以通过把所有这样的规则放在分离的列表中来消除限制，但是如果这样做，当我们需要证明某件事的时侯不得不和每一个列表进行匹配。

我们将要使用同一个宏 <- 去定义事实 (facts)和规则 (rules)。一个事实将被表示成一个没有 body 部分的规则。这和我们对规则的定义保持一致。一个规则告诉我们你可以通过证明 body 部分来证明 head 部分，所以没有 body 部分的规则意味着你不需要通过证明任何东西来证明 head 部分。这里有两个对应的例子：

> (<- (parent donald nancy))
1
> (<- (child ?x ?y) (parent ?y ?x))
1

调用 <- 返回的是给定判断式下存储的规则数量；用 length 函数来包装 push 能使我们免于看到顶层中的一大堆返回值。

下面是我们的推论程序所需的大多数代码：

(defun prove (expr &optional binds)
  (case (car expr)
    (and (prove-and (reverse (cdr expr)) binds))
    (or  (prove-or (cdr expr) binds))
    (not (prove-not (cadr expr) binds))
    (t   (prove-simple (car expr) (cdr expr) binds))))

(defun prove-simple (pred args binds)
  (mapcan #'(lambda (r)
              (multiple-value-bind (b2 yes)
                                   (match args (car r)
                                          binds)
                (when yes
                  (if (cdr r)
                      (prove (cdr r) b2)
                      (list b2)))))
          (mapcar #'change-vars
                  (gethash pred *rules*))))

(defun change-vars (r)
  (sublis (mapcar #'(lambda (v) (cons v (gensym "?")))
                  (vars-in r))
          r))

(defun vars-in (expr)
  (if (atom expr)
      (if (var? expr) (list expr))
    (union (vars-in (car expr))
           (vars-in (cdr expr)))))

图 15.3: 推论。

上面代码中的 prove 函数是推论进行的枢纽。它接受一个表达式和一个可选的绑定列表作为参数。如果表达式不包含逻辑操作，它调用 prove-simple 函数，前面所说的链接 (chaining)正是在这个函数里产生的。这个函数查看所有拥有正确判断式的规则，并尝试对每一个规则的 head 部分和它想要证明的事实做匹配。对于每一个匹配的 head ，使用匹配所产生的新的绑定在 body 上调用 prove。对 prove 的调用所产生的绑定列表被 mapcan 收集并返回：

> (prove-simple 'parent '(donald nancy) nil)
(NIL)
> (prove-simple 'child '(?x ?y) nil)
(((#:?6 . NANCY) (#:?5 . DONALD) (?Y . #:?5) (?X . #:?6)))

以上两个返回值指出有一种方法可以证明我们的问题。（一个失败的证明将返回 nil。）第一个例子产生了一组空的绑定，第二个例子产生了这样的绑定： ?x 和 ?y 被（间接）绑定到 nancy 和 donald 。

顺便说一句，这是一个很好的例子来实践 2.13 节提出的观点。因为我们用函数式的风格来写这个程序，所以可以交互式地测试每一个函数。

第二个例子返回的值里那些 gensyms 是怎么回事？如果我们打算使用含有变量的规则，我们需要避免两个规则恰好包含相同的变量。如果我们定义如下两条规则：

(<- (child ?x ?y) (parent ?y ?x))

(<- (daughter ?y ?x) (and (child ?y ?x) (female ?y)))

第一条规则要表达的意思是：对于任何的 x 和 y ， 如果 y 是 x 的家长，则 x 是 y 的孩子。第二条则是：对于任何的 x 和 y ， 如果 y 是 x 的孩子并且 y 是女性，则 y 是 x 的女儿。在每一条规则内部，变量之间的关系是显著的，但是两条规则使用了相同的变量并非我们刻意为之。

如果我们使用上面所写的规则，它们将不会按预期的方式工作。如果我们尝试证明“ a 是 b 的女儿”，匹配到第二条规则的 head 部分时会将 a 绑定到 ?y ，将 b 绑定到 ?x。我们无法用这样的绑定匹配第一条规则的 head 部分：

> (match '(child ?y ?x)
         '(child ?x ?y)
         '((?y . a) (?x . b)))
NIL

为了保证一条规则中的变量只表示规则中各参数之间的关系，我们用 gensyms 来代替规则中的所有变量。这就是 change-vars 函数的目的。一个 gensym 不可能在另一个规则中作为变量出现。但是因为规则可以是递归的，我们必须防止出现一个规则和自身冲突的可能性，所以在定义和使用一个规则时都要调用 chabge-vars 函数。

现在只剩下定义用以证明复杂表达式的函数了。下面就是需要的函数：

(defun prove-and (clauses binds)
  (if (null clauses)
      (list binds)
      (mapcan #'(lambda (b)
                  (prove (car clauses) b))
              (prove-and (cdr clauses) binds))))

(defun prove-or (clauses binds)
  (mapcan #'(lambda (c) (prove c binds))
          clauses))

(defun prove-not (clause binds)
  (unless (prove clause binds)
    (list binds)))

图 15.4 逻辑操作符 (Logical operators)

操作一个 or 或者 not 表达式是非常简单的。操作 or 时，我们提取在 or 之间的每一个表达式返回的绑定。操作 not 时，当且仅当在 not 里的表达式产生 none 时，返回当前的绑定。

prove-and 函数稍微复杂一点。它像一个过滤器，它用之后的表达式所建立的每一个绑定来证明第一个表达式。这将导致 and 里的表达式以相反的顺序被求值。除非调用 prove 中的 prove-and 函数则会先逆转它们。

现在我们有了一个可以工作的程序，但它不是很友好。必须要解析 prove-and 返回的绑定列表是令人厌烦的，它们会变得更长随着规则变得更加复杂。下面有一个宏来帮助我们更愉快地使用这个程序：

(defmacro with-answer (query &body body)
  (let ((binds (gensym)))
    `(dolist (,binds (prove ',query))
       (let ,(mapcar #'(lambda (v)
                         `(,v (binding ',v ,binds)))
                     (vars-in query))
         ,@body))))

图 15.5 介面宏 (Interface macro)

它接受一个 query （不被求值）和若干表达式构成的 body 作为参数，把 query 所生成的每一组绑定的值赋给 query 中对应的模式变量，并计算 body 。

> (with-answer (parent ?x ?y)
    (format t "~A is the parent of ~A.~%" ?x ?y))
DONALD is the parent of NANCY.
NIL

这个宏帮我们做了解析绑定的工作，同时为我们在程序中使用 prove 提供了一个便捷的方法。下面是这个宏展开的情况：

(with-answer (p ?x ?y)
  (f ?x ?y))

;;将被展开成下面的代码

(dolist (#:g1 (prove '(p ?x ?y)))
  (let ((?x (binding '?x #:g1))
        (?y (binding '?y #:g1)))
    (f ?x ?y)))

图 15.6: with-answer 调用的展开式

下面是使用它的一个例子：

(<- (parent donald nancy))
(<- (parent donald debbie))
(<- (male donald))
(<- (father ?x ?y) (and (parent ?x ?y) (male ?x)))
(<- (= ?x ?y))
(<- (sibling ?x ?y) (and (parent ?z ?x)
                         (parent ?z ?y)
                         (not (= ?x ?y))))

;;我们可以像下面这样做出推论

> (with-answer (father ?x ?y)
    (format t "~A is the father of ~A.~%" ?x ?y))
DONALD is the father of DEBBIE.
DONALD is the father of NANCY.
NIL
> (with-answer (sibling ?x ?y))
    (format t "~A is the sibling of ~A.~%" ?x ?y))
DEBBLE is the sibling of NANCY.
NANCY is the  sibling of DEBBIE.
NIL

图 15.7: 使用中的程序

15.4 分析 (Analysis)

看上去，我们在这一章中写的代码，是用简单自然的方式去实现这样一个程序。事实上，它的效率非常差。我们在这里是其实是做了一个解释器。我们能够把这个程序做得像一个编译器。

这里做一个简单的描述。基本的思想是把整个程序打包到两个宏 <- 和 with-answer ，把已有程序中在运行期做的多数工作搬到宏展开期（在 10.7 节的 avg 可以看到这种构思的雏形) 用函数取代列表来表示规则，我们不在运行时用 prove 和 prove-and 这样的函数来解释表达式，而是用相应的函数把表达式转化成代码。当一个规则被定义的时候就有表达式可用。为什么要等到使用的时候才去分析它呢？这同样适用于和 <- 调用了相同的函数来进行宏展开的 with-answer 。

听上去好像比我们已经写的这个程序复杂很多，但其实可能只是长了两三倍。想要学习这种技术的读者可以看 On Lisp 或者Paradigms of Artificial Intelligence Programming ，这两本书有一些使用这种风格写的示例程序。