LISP中的广度优先搜索 [英] Breadth first search in LISP
问题描述
我使用列表表示树. 例如:
I have a representation of a tree using lists. For example:
(1 ((2 (3)) (3 (2)))) (2 ((1 (3)) (3 (1)))) (3 ((1 (2)) (2 (1)))))`
现在，我需要在维护层次结构树的同时逐级遍历它.例如:
Now I need to traverse it level by level while maintaining the hierarchy tree. For instance:
- 遍历根节点
(1) - 遍历深度1
(1 2) (1 3) (2 1) (3 1) (3 1) (3 2) - 遍历深度2
(1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)
- Traversing root node
(1) - Traversing depth 1
(1 2) (1 3) (2 1) (3 1) (3 1) (3 2) - Traversing depth 2
(1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)
我不知道如何在Lisp中做到这一点.任何帮助(甚至是伪代码)都应受到赞赏.我已经考虑过几种方法，但似乎没有一种是合法的.
I can't figure out how to do it in Lisp. Any help (even a pseudo code) is appreciated. I have thought of several approaches but none of them seems legit.
推荐答案
使用议程的优先搜索
进行广度优先搜索的经典方法是维护议程:接下来要查看的事情列表.然后，您只需将对象从议程的开头剥离，然后将其子对象添加到议程的结束.对于此类议程，一种非常简单的方法是节点列表:将其添加到列表的末尾，然后使用append.
Breadth-first search using an agenda
The classic way to do a breadth-first search is by maintaining an agenda: a list of things to look at next. Then you simply peel objects off the start of the agenda, and add their children to the end of the agenda. A very simple-minded approach to such an agenda is a list of nodes: to add to the end of the list you then use append.
我无法理解您的树形结构(请问需要数据结构或算法规范的问题时，给出该规范:浪费所有人的时间来尝试第二遍，猜猜这个)，所以我用列表做了自己的事情:一棵树是一个缺点，它的价值是汽车，而cdr是孩子的列表.这里是制作和访问这种树结构和示例树的函数.
I can't understand your tree structure (please, when asking questions which need specification of a data structure or an algorithm give that specification: it is a waste of everyone's time to try to second-guess this) so I have made my own in terms of lists: a tree is a cons whose car is its value and whose cdr is a list of children. Here are functions to make and access such a tree structure, and a sample tree.
(defun tree-node-value (n)
(car n))
(defun tree-node-children (n)
(cdr n))
(defun make-tree-node (value &optional (children '()))
(cons value children))
(defparameter *sample-tree*
(make-tree-node
1
(list
(make-tree-node 2 (list (make-tree-node 3)))
(make-tree-node 4 (list (make-tree-node 5) (make-tree-node 6)))
(make-tree-node 7 (list (make-tree-node 8 (list (make-tree-node 9))))))))
现在，我不必再担心树的显式结构.
Now I never have to worry about the explicit structure of trees again.
现在这是一个使用议程的函数，该议程将在树中搜索给定的节点值:
Now here is a function which uses an agenda which will search this tree for a given node value:
(defun search-tree/breadth-first (tree predicate)
;; search a tree, breadth first, until predicate matches on a node's
;; value. Return the node that matches.
(labels ((walk (agenda)
(if (null agenda)
;; we're done: nothing matched
(return-from search-tree/breadth-first nil)
(destructuring-bind (this . next) agenda
(if (funcall predicate (tree-node-value this))
;; found it, return the node
(return-from search-tree/breadth-first this)
;; missed, add our children to the agenda and
;; carry on
(walk (append next (tree-node-children this))))))))
(walk (list tree))))
为了进行比较，这里是深度优先搜索:
For comparison here is a depth first search:
(defun search-tree/depth-first (tree predicate)
;; search a tree, depth first, until predicate matches on a node's
;; value
(labels ((walk (node)
(if (funcall predicate (tree-node-value node))
(return-from search-tree/depth-first node)
(dolist (child (tree-node-children node) nil)
(walk child)))))
(walk tree)))
您现在可以通过具有一个打印其参数但始终失败的谓词来比较这些实现，从而导致遍历整个树:
You can now compare these implementations by having a predicate which prints its argument but always fails, thus causing a traversal of the whole tree:
> (search-tree/breadth-first *sample-tree*
(lambda (v)
(print v)
nil))
1
2
4
7
3
5
6
8
9
nil
> (search-tree/depth-first *sample-tree*
(lambda (v)
(print v)
nil))
1
2
3
4
5
6
7
8
9
nil
附录1:更好的议程实施方式
这种幼稚的议程实施方式存在的一个问题是，我们最终总是一直调用append.更加聪明的实现方式可以有效地将项目附加到末尾.这是这样的实现:
Appendix 1: a better agenda implementation
One problem with this naive agenda implementation is that we end up calling append all the time. A cleverer implementation allows items to be appended to the end efficiently. Here is such an implementation:
(defun make-empty-agenda ()
;; an agenda is a cons whose car is the list of items in the agenda
;; and whose cdr is the last cons in that list, or nil is the list
;; is empty. An empty agenda is therefore (nil . nil)
(cons nil nil))
(defun agenda-empty-p (agenda)
;; an agenda is empty if it has no entries in its list.
(null (car agenda)))
(defun agenda-next-item (agenda)
;; Return the next entry from the agenda, removing it
(when (agenda-empty-p agenda)
(error "empty agenda"))
(let ((item (pop (car agenda))))
(when (null (car agenda))
(setf (cdr agenda) nil))
item))
(defun agenda-add-item (agenda item)
;; add an item to the end of the agenda, returning it
(let ((item-holder (list item)))
(if (agenda-empty-p agenda)
(setf (car agenda) item-holder
(cdr agenda) item-holder)
(setf (cdr (cdr agenda)) item-holder
(cdr agenda) item-holder))
item))
请注意，无法复制提供的这些议程之一.
Note that there is no way of copying one of these agendas provided.
这是一个使用此聪明"议程的显式迭代功能:
Here is an explicitly iterative function which uses this 'clever' agenda:
(defun search-tree/breadth-first/iterative (tree predicate)
(loop with agenda = (make-empty-agenda)
initially (agenda-add-item agenda tree)
while (not (agenda-empty-p agenda))
for node = (agenda-next-item agenda)
when (funcall predicate (tree-node-value node))
do (return-from search-tree/breadth-first/iterative node)
else do (loop for c in (tree-node-children node)
do (agenda-add-item agenda c))
finally (return nil)))
最后，任何基于议程的搜索都可以轻松地修改为可重新启动:只需在匹配的位置返回当前议程，并允许传递议程.这是上述功能的一种变体，它支持重新启动搜索:
Finally, any agenda-based search can easily be modified to be restartable: it simply needs to return the current agenda at the point it matched, and allow passing in of an agenda. Here is a variant of the above function which supports restarting searches:
(defun search-tree/breadth-first/iterative (tree predicate
&optional (agenda
(make-empty-agenda)))
;; search TREE using PREDICATE. if AGENDA is given and is not empty
;; instead restart using it (TREE is ignored in this case). Return
;; the node found, or nil, and the remaining agenda
(loop initially (unless (not (agenda-empty-p agenda))
(agenda-add-item agenda tree))
while (not (agenda-empty-p agenda))
for node = (agenda-next-item agenda)
when (funcall predicate (tree-node-value node))
do (return-from search-tree/breadth-first/iterative
(values node agenda))
else do (loop for c in (tree-node-children node)
do (agenda-add-item agenda c))
finally (return (values nil agenda))))
附录2:带有议程的常规搜索
实际上有可能进一步推广基于议程的搜索树的方法.特别是:
Appendix 2: general search with an agenda
It is in fact possible to further generalise the agenda-based approach to searching trees. In particular:
- 如果议程是队列(FIFO)，那么您将获得广度优先搜索；
- 如果议程是一个堆栈(LIFO)，则您将进行深度优先搜索.
对于这两种情况，实际的搜索实现可以相同，这很简单.
The actual search implementation can be identical for these two cases, which is neat.
下面是一些代码演示了这一点.这就定义了用于树访问的通用功能(具有用于基于cons的树的方法)，因此无需担心，并进一步定义了带有两个具体类的议程的协议，这两个类具有适当的方法.然后，搜索功能完全不知道是进行深度优先搜索还是宽度优先搜索，并且无论哪种情况都可以重新启动.
Below is some code which demonstrates this. This defines generic functions for tree access (with methods for cons-based trees) so nothing needs to care about that, and further defines a protocol for agendas with two concrete classes, queue and stack which have appropriate methods. The search function is then completely agnostic about whether it does depth-first or breadth-first search, and is restartable in either case.
这是相当大量的代码:我将其留在这里，以防它对任何人有用.
This is a fairly substantial chunk of code: I'm leaving it here just in case it's useful to anyone.
;;;; Trees
;;;
(defgeneric tree-node-value (n)
(:documentation "The value of a tree node"))
(defgeneric tree-node-children (n)
(:documentation "The children of a tree"))
;;;; Consy trees
;;;
(defmethod tree-node-value ((n cons))
(car n))
(defmethod tree-node-children ((n cons))
(cdr n))
(defun make-cons-tree-node (value &optional (children '()))
;; consy trees: I could do some clever EQL method thing perhaps to
;; abstract this?
(cons value children))
(defun form->tree (form &key (node-maker #'make-cons-tree-node))
(labels ((walk-form (f)
(destructuring-bind (value . child-forms) f
(funcall node-maker
value
(mapcar #'walk-form child-forms)))))
(walk-form form)))
(defparameter *sample-tree*
(form->tree '(1 (2 (3))
(4 (5) (6))
(7 (8 (9))))))
;;;; Agendas
;;;
(defclass agenda ()
())
(defgeneric agenda-empty-p (agenda)
(:documentation "Return true if AGENDA is empty"))
(defgeneric agenda-next-item (agenda)
(:documentation "Return the next item from AGENDA.
If there is no next item, signal an error: there is a before method which does this.")
(:method :before ((agenda agenda))
(when (agenda-empty-p agenda)
(error "empty agenda"))))
(defmethod initialize-instance :after ((agenda agenda) &key
(item nil itemp)
(items (if itemp (list item) '()))
(ordered nil))
(agenda-add-items agenda items :ordered ordered))
(defgeneric agenda-add-item (agenda item)
(:documentation "Add ITEM to AGENDA, returning ITEM.
There is an around method which arranges for ITEM to be returned.")
(:method :around ((agenda agenda) item)
(call-next-method)
item))
(defgeneric agenda-add-items (agenda items &key ordered)
(:documentation "Add ITEMS to AGENDA.
If ORDERED is true do so in a way that AGENDA-NEXT-ITEM will pull them
off in the same order. Return AGENDA (there is an around method which
arranges for this). The default method just adds the items in the
order given.")
(:method :around ((agenda agenda) items &key ordered)
(declare (ignorable ordered))
(call-next-method)
agenda)
(:method ((agenda agenda) items &key ordered)
(declare (ignorable ordered))
(loop for item in items
do (agenda-add-item agenda item))))
;;;; Queues are FIFO agendas
;;;
(defclass queue (agenda)
((q :initform (cons nil nil)))
(:documentation "A queue"))
(defmethod agenda-empty-p ((queue queue))
(null (car (slot-value queue 'q))))
(defmethod agenda-next-item ((queue queue))
(let* ((q (slot-value queue 'q))
(item (pop (car q))))
(when (null (car q))
(setf (cdr q) nil))
item))
(defmethod agenda-add-item ((queue queue) item)
(let ((q (slot-value queue 'q))
(item-holder (list item)))
(if (null (car q))
(setf (car q) item-holder
(cdr q) item-holder)
(setf (cdr (cdr q)) item-holder
(cdr q) item-holder))))
;;;; Stacks are LIFO agendas
;;;
(defclass stack (agenda)
((s :initform '()))
(:documentation "A stack"))
(defmethod agenda-empty-p ((stack stack))
(null (slot-value stack 's)))
(defmethod agenda-next-item ((stack stack))
(pop (slot-value stack 's)))
(defmethod agenda-add-item ((stack stack) item)
(push item (slot-value stack 's)))
(defmethod agenda-add-items ((stack stack) items &key ordered)
(loop for item in (if ordered (reverse items) items)
do (agenda-add-item stack item)))
;;;; Searching with agendas
;;;
(defun tree-search (tree predicate &key (agenda-class 'stack))
;; search TREE using PREDICATE. AGENDA-CLASS (default STACK)
;; defines the type of search: a STACK will result in a depth-first
;; search while a QUEUE will result in a breadth-first search. This
;; is a wrapper around AGENDA-SEARCH.
(agenda-search (make-instance agenda-class :item tree) predicate))
(defun agenda-search (agenda predicate)
;; Search using an agenda. PREDICATE is compared against the value
;; of a tree node. On success return the node matched and the
;; agenda, on failure return NIL and NIL. If the returned agenda is
;; not empty it can be used to restart the search.
(loop while (not (agenda-empty-p agenda))
for node = (agenda-next-item agenda)
when (funcall predicate (tree-node-value node))
do (return-from agenda-search
(values node agenda))
else do (agenda-add-items agenda (tree-node-children node)
:ordered t)
finally (return (values nil nil))))
这篇关于LISP中的广度优先搜索的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
