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

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

15.1 目标 (The Aim)

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

  1.       (parent donald nancy)
  2.

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

  1.       (<- head body)
  2.

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

  1.       (<- (child ?x ?y) (parent ?y ?x))
  2.

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

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

  1.       (<- (father ?x ?y) (and (parent ?x ?y) (male ?x)))
  2.

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

  1.       (<- (daughter ?x ?y) (and (child ?x ?y) (female ?x)))
  2.

然后使用它来证明 (daughter x y) 可能导致程序使用第一个规则去证明 (child x y) 。 ](http://acl.readthedocs.org/en/latest/zhCN/ch15-cn.html#the-aim) 表达式的证明可以回溯任意数量的规则，只要它最终结束于给出的已知事实。这个过程有时候被称为反向链接 (backward-chaining)。之所以说 反向 (backward) 是因为这一类推论先考虑 head 部分，这是为了在继续证明 body 部分之前检查规则是否有效。链接 (chaining) 来源于规则之间的依赖关系，从我们想要证明的内容到我们的已知条件组成一个链接 (尽管事实上它更像一棵树)。 λ

15.2 匹配 (Matching)

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

  1.       (p ?x ?y c ?x)
  2. (p  a  b c  a)
  3.

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

  1.       (p ?x b ?y a)
  2. (p ?y b  c a)
  3.

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

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

  1.       (defun match (x y &optional binds)
  2.   (cond
  3.    ((eql x y) (values binds t))
  4.    ((assoc x binds) (match (binding x binds) y binds))
  5.    ((assoc y binds) (match x (binding y binds) binds))
  6.    ((var? x) (values (cons (cons x y) binds) t))
  7.    ((var? y) (values (cons (cons y x) binds) t))
  8.    (t
  9.     (when (and (consp x) (consp y))
  10.       (multiple-value-bind (b2 yes)
  11.                            (match (car x) (car y) binds)
  12.         (and yes (match (cdr x) (cdr y) b2)))))))
  14. (defun var? (x)
  15.   (and (symbolp x)
  16.        (eql (char (symbol-name x) 0) #\?)))
  18. (defun binding (x binds)
  19.   (let ((b (assoc x binds)))
  20.     (if b
  21.         (or (binding (cdr b) binds)
  22.             (cdr b)))))
  23.

图 15.1: 匹配函数。 

  1.       > (match '(p a b c a) '(p ?x ?y c ?x))
  2. ((?Y . B) (?X . A))
  3. T
  4. > (match '(p ?x b ?y a) '(p ?y b c a))
  5. ((?Y . C) (?X . ?Y))
  6. T
  7. > (match '(a b c) '(a a a))
  8. NIL
  9.

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

  1.       > (match '(p ?x) '(p ?x))
  2. NIL
  3. T
  4.

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

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

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

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

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

  1.       > (match '(?x a) '(?y ?y))
  2. ((?Y . A) (?X . ?Y))
  3. T
  4.

先匹配 ?x 和 ?y ，然后匹配 ?y 和 a ，我们间接确定 ?x 是 a 。 ](http://acl.readthedocs.org/en/latest/zhCN/ch15-cn.html#matching)

15.3 回答查询 (Answering Queries)

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

  1.       (parent donald nancy)
  2.

然后我们想让程序证明：

  1.       (parent ?x ?y)
  2.

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

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

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

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

  1.       (defvar *rules* (make-hash-table))
  3. (defmacro <- (con &optional ant)
  4.   `(length (push (cons (cdr ',con) ',ant)
  5.                  (gethash (car ',con) *rules*))))
  6.

图 15.2 定义规则

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

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

  1.       > (<- (parent donald nancy))
  2. 1
  3. > (<- (child ?x ?y) (parent ?y ?x))
  4. 1
  5.

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

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

  1.       (defun prove (expr &optional binds)
  2.   (case (car expr)
  3.     (and (prove-and (reverse (cdr expr)) binds))
  4.     (or  (prove-or (cdr expr) binds))
  5.     (not (prove-not (cadr expr) binds))
  6.     (t   (prove-simple (car expr) (cdr expr) binds))))
  8. (defun prove-simple (pred args binds)
  9.   (mapcan #'(lambda (r)
  10.               (multiple-value-bind (b2 yes)
  11.                                    (match args (car r)
  12.                                           binds)
  13.                 (when yes
  14.                   (if (cdr r)
  15.                       (prove (cdr r) b2)
  16.                       (list b2)))))
  17.           (mapcar #'change-vars
  18.                   (gethash pred *rules*))))
  20. (defun change-vars (r)
  21.   (sublis (mapcar #'(lambda (v) (cons v (gensym "?")))
  22.                   (vars-in r))
  23.           r))
  25. (defun vars-in (expr)
  26.   (if (atom expr)
  27.       (if (var? expr) (list expr))
  28.     (union (vars-in (car expr))
  29.            (vars-in (cdr expr)))))
  30.

图 15.3: 推论。

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

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

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

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

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

  1.       (<- (child ?x ?y) (parent ?y ?x))
  3. (<- (daughter ?y ?x) (and (child ?y ?x) (female ?y)))
  4.

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

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

  1.       > (match '(child ?y ?x)
  2.          '(child ?x ?y)
  3.          '((?y . a) (?x . b)))
  4. NIL
  5.

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

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

  1.       (defun prove-and (clauses binds)
  2.   (if (null clauses)
  3.       (list binds)
  4.       (mapcan #'(lambda (b)
  5.                   (prove (car clauses) b))
  6.               (prove-and (cdr clauses) binds))))
  8. (defun prove-or (clauses binds)
  9.   (mapcan #'(lambda (c) (prove c binds))
  10.           clauses))
  12. (defun prove-not (clause binds)
  13.   (unless (prove clause binds)
  14.     (list binds)))
  15.

图 15.4 逻辑操作符 (Logical operators)

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

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

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

  1.       (defmacro with-answer (query &body body)
  2.   (let ((binds (gensym)))
  3.     `(dolist (,binds (prove ',query))
  4.        (let ,(mapcar #'(lambda (v)
  5.                          `(,v (binding ',v ,binds)))
  6.                      (vars-in query))
  7.          ,@body))))
  8.

图 15.5 介面宏 (Interface macro)

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

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

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

  1.       (with-answer (p ?x ?y)
  2.   (f ?x ?y))
  4. ;;将被展开成下面的代码
  6. (dolist (#:g1 (prove '(p ?x ?y)))
  7.   (let ((?x (binding '?x #:g1))
  8.         (?y (binding '?y #:g1)))
  9.     (f ?x ?y)))
  10.

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

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

  1.       (<- (parent donald nancy))
  2. (<- (parent donald debbie))
  3. (<- (male donald))
  4. (<- (father ?x ?y) (and (parent ?x ?y) (male ?x)))
  5. (<- (= ?x ?y))
  6. (<- (sibling ?x ?y) (and (parent ?z ?x)
  7.                          (parent ?z ?y)
  8.                          (not (= ?x ?y))))
  10. ;;我们可以像下面这样做出推论
  12. > (with-answer (father ?x ?y)
  13.     (format t "~A is the father of ~A.~%" ?x ?y))
  14. DONALD is the father of DEBBIE.
  15. DONALD is the father of NANCY.
  16. NIL
  17. > (with-answer (sibling ?x ?y))
  18.     (format t "~A is the sibling of ~A.~%" ?x ?y))
  19. DEBBLE is the sibling of NANCY.
  20. NANCY is the  sibling of DEBBIE.
  21. NIL
  22.

图 15.7: 使用中的程序 ](http://acl.readthedocs.org/en/latest/zhCN/ch15-cn.html#answering-queries)

15.4 分析 (Analysis)

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

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

听上去好像比我们已经写的这个程序复杂很多，但其实可能只是长了两三倍。想要学习这种技术的读者可以看 On Lisp 或者Paradigms of Artificial Intelligence Programming ，这两本书有一些使用这种风格写的示例程序。 ](http://acl.readthedocs.org/en/latest/zhCN/ch15-cn.html#analysis)