为了便于描述,本文中的图指的是下图所示的无向图。
搜索指:搜索从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)。
在本例中,广度优先搜索的结果优于深度优先搜索的结果。