为了便于描述，本文中的图指的是下图所示的无向图。

搜索指：搜索从S到F的一条路径。若存在，则以表的形式返回路径；若不存在，则返回nil。

定义属性设置函数putProp

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

(defun putProp (obj name value )

(setf (get obj name) value)

)

;测试函数putProp的代码

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

(get 'James 'son)

图的表示

使用原子和特性表来表示上图中各结点之间的邻接关系。代码如下：

(putProp 'S 'neighbors '(L O)) ;设置S结点的邻接点为L和O

(putProp 'L 'neighbors '(S M F)) ;设置L结点的邻接点为S, M和F

(putProp 'M 'neighbors '(L N)) ;设置M结点的邻接点为L, N

(putProp 'N 'neighbors '(M F)) ;设置N结点的邻接点为M, F

(putProp 'O 'neighbors '(S P Q)) ;设置O结点的邻接点为S, P和Q

(putProp 'P 'neighbors '(O F)) ;设置P结点的邻接点为O, F

(putProp 'Q 'neighbors '(O F)) ;设置Q结点的邻接点为O, F

(putProp 'F 'neighbors '(N L P Q)) ;设置F结点的邻接点为N, L, P, Q

定义路径扩展函数expand

路径扩展函数，将路径X的第一个元素（即图中的某个结点）的邻接点集合E加入到X中（若E已经在X中，则不加入；这样是为了消除闭合路径）。代码如下：

;expand扩展路径X

(defun expand (X)

(mapcan

(lambda (E) ;匿名函数定义

(cond

((member E X) nil) ;若E在X存在, 则返回nil

(T (list (cons E X))) ;否则, 将E添加到表X的第一个位置

)

)

(get (car X) 'neighbors) ;匿名函数的参数, 即路径X的第一个元素的邻接点集合

)

)

上述的cond子句中，如果路径是闭合路径，则返回nil，append抛弃nil项；将非nil项收集到一张表中，作为expand的返回值。

深度优先搜索函数depth_first

函数代码如下

;深度优先搜索函数depth_first，找到从S到F的路径

(defun depth_first (start finish)

(prog (queue expansion)

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

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

tryagain ;循环开始

(cond ;分情况处理

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

((equal finish (caar queue))

(return (reverse (car queue))) ;返回找到的路径

) ;找到, 返回T

)

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

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

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

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

(go tryagain)

)

)

函数的运行及结果：

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

运行结果为输出(S L M N F)。

广度优先搜索函数width_first

广度优先与深度优先的代码基本一致，只有代码“(setq queue (append queue expansion))”不同，广度优先将expansion放在队尾，深度优先将expansion放在队首。函数代码如下：

;广度优先搜索函数width_first，找到从S到F的路径

(defun width_first (start finish)

(prog (queue expansion)

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

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

tryagain ;循环开始

(cond ;分情况处理

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

((equal finish (caar queue))

(return (reverse (car queue))) ;返回找到的路径

) ;找到, 返回T

)

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

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

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

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

(go tryagain)

)

)

函数的运行及结果：

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

运行结果为输出(S L F)。