Common LISP实现简单的深度优先搜索

        这里的搜索，指的是简单的有向无环图中的搜索。首先手工建立图中各结点之间的关系，然后使用程序判断是否存在从起始结点到终止结点的路径。

 

 

这里的搜索问题简化为在上述的有向无环图中寻找一条从S到F的路径。

在图中，如果有从结点P到结点C的有向弧，则P称为C的父节点，C称为P的子结点。

可以将上图使用原子和特性表来表示。

为了简化Common Lisp中对符号特性的设置，定义属性设置函数putProp。代码如下：

;将物体obj的名为name的属性的值设置为value

(defun putProp (obj name value )

 (setf (get obj name) value)

)

;测试函数putProp的代码

(putprop 'James 'son '(robert albert) )

(get 'James 'son)

利用putProp设置图中各个结点之间的直接父子关系（手工建立关系图，确实是个枯燥累人的工作）。代码如下：

(putProp 'S 'children '(L O))  ;设置S结点的子结点为L和O

(putProp 'L 'children '(M F))  ;设置L结点的子结点为M和F

(putProp 'M 'children '(N))   ;设置M结点的子结点为N

(putProp 'N 'children '(F))   ;设置N结点的子结点为F

(putProp 'O 'children '(P Q))  ;设置O结点的子结点为P和Q

(putProp 'P 'children '(F))   ;设置P结点的子结点为F

(putProp 'Q 'children '(F))   ;设置Q结点的子结点为F

深度优先搜索

;定义expand， 展开结点node，将结点的子结点作为返回值

(defun expand (node)

(get node 'children)

)

;深度优先搜索，从S到F是否存在路径

(defun depth (start finish)

(prog (queue expansion)

(setq queue (list start)) ;初始化

(print queue) ;测试代码. 显示队列内容

tryagain ;循环开始

(cond ;分情况处理

((null queue) (return nil)) ;队列为空, 表示不存在路径，返回nil

((equal finish (car queue)) (return T)) ;找到, 返回T

)

(setq expansion (expand (car queue))) ;扩展队列第一个元素

(setq queue (cdr queue)) ;删除队列中的第一个元素

(setq queue (append expansion queue))   ;扩展队列. 新结点在前，实现深度优先搜索

(print queue) ;测试代码. 显示队列内容

(go tryagain)

)

)

函数的运行及结果：

(depth 's 'f)  ;lisp不区分符号的大小写

运行结果为输出T。

如下图所示：