用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， 程序的核心代码如下。代码的完全版可以在楠哥的个人简历站（www.liubonan.info/en/）中course目录下载。(楠哥计算机学习网www.liubonan.info)1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
;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) '&))
(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)
)
)
)
)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(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 "value" 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 "=" code.
(defun atom-first-eq (varatom)
(if (equal (subseq (prin1-to-string varatom) 0 1) "=")
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
)
)
)
楠哥简介
优秀资源推荐
