用Lisp解决简单的模式匹配(Pattern Match)问题

Lisp是人工智能中比较常用的语言之一，本文以一个经典的模式匹配(Pattern Match)问题为例，简要分析一下Lisp的语言结构。(楠哥计算机学习网www.liubonan.info)

Lisp的语言结构非常简单，有些牛人甚至称“学会七种操作即掌握了lisp的精髓”。Lisp有一篇开山之作《The roots of lisp》，现在已经译为了中文，参看此文，即可大体上掌握Lisp中最精华的内容。(楠哥计算机学习网www.liubonan.info)

一个AI中的经典问题——模式匹配(Pattern Match)是这样的，对于一个模式，可以找到与之相符合的内容，并将变量的部分形成匹配的序列进行返回。使用Lisp来描述就是用一些特定的符号如“=x”来匹配一些常量的值，如33（数字）、dog（字符串、符号）等。(楠哥计算机学习网www.liubonan.info)

使用Lisp解决这类问题的基本思路是将读入的内容看做一个list，依次取出list当中的各个元素，按照事先设定好的逻辑判断其是否为变量（即“=x"的形式），如果是，则寻找实力当中对应部分是否与之匹配，如匹配则将其加入到“匹配表”当中。当然，判断之前需要先判断一个变量是否已经匹配了其它的元素。(楠哥计算机学习网www.liubonan.info)

在下面的代码中，matcher方法不仅可以匹配=x的变量，还可以完成>x， <x，!x等形式，另外可以完成匹配条件的逻辑“并”操作（操作符为&）。可以通过调用（match （object =x =y）（object ‘3 ‘high））进行匹配，程序将返回（（x 3）（y high））的匹配表。该程序还可以将变量与list匹配，如=x可以匹配’（a b）。(楠哥计算机学习网www.liubonan.info)

程序的核心代码如下。代码的完全版可以在楠哥的个人简历站中course目录下载。(楠哥计算机学习网www.liubonan.info)

;This is main function.
(defun matcher(pattern fact)
 (if (and (atom pattern) (atom fact))
  (cond ((and (not (eq (atom-first-eq pattern) NIL)) (atom-eq-match pattern fact)) (atom-eq-match pattern fact))
           ((atom-first-not pattern) (atom-not-match pattern fact))
           ((atom-first-large pattern) (atom-large-match pattern fact))
           ((atom-first-small pattern) (atom-small-match pattern fact))
           ((eq pattern fact) T)
           (T NIL)
  )
  (if (or (atom pattern) (atom fact))
   (if (and (atom fact) (eq (car pattern) '&amp;))
    (match-and (cdr pattern) fact)
    (if (atom pattern)
     (if (atom-first-eq pattern)
      (list-match-eq pattern fact)
      (if (atom-first-not pattern)
       (list-match-not pattern fact)
       NIL
      )
     )
    )
   )
   (cond ((not (matcher (car pattern) (car fact))) NIL)
	 ((not (matcher (cdr pattern) (cdr fact))) NIL)
	 (T T)
   )
  )
 )
)
&lt;/pre&gt;

&lt;pre lang=&quot;lisp&quot; line=&quot;1&quot;&gt;
(setq bindings '()) ;This is a global variable. It is to save bindings' list.

(defun atom-first-cut (varatom) ; Get the first char of the atom.
 (setq temp (read-from-string (subseq (prin1-to-string varatom) 1)))
 temp
)

(defun test-binds (value pair) ; Compare the value and the first part of one item in the bindings list.
 (if (eq (atom-first-cut (car pair)) value)
 (car (cdr pair))
  NIL
 )
) 

(defun search-bindings (value queue) ; Search bindings list with &quot;value&quot; as the index.
 (if (null queue)
  NIL
  (if (eq (test-binds value (car queue)) NIL)
   (search-bindings value (cdr queue))
   (test-binds value (car queue))
  )
 )
)

;This is &quot;=&quot; code.
(defun atom-first-eq (varatom)
 (if (equal (subseq (prin1-to-string varatom) 0 1) &quot;=&quot;)
  T
  NIL
 )
)

(defun atom-eq-match (atom-pattern atom-fact)
 (if (not (search-bindings (atom-first-cut atom-pattern) bindings))
  (setq bindings (append bindings (list (list atom-pattern atom-fact))))
  (if (equal atom-fact (search-bindings (atom-first-cut atom-pattern) bindings))
   T
   NIL
  )
)
)