PROSAGA码农传奇-lisp-在LISP中进行广度优先搜索

<div class =“post-text”itemprop =“text”>
  <H2>
    使用议程进行广度优先搜索
  </H2>
  <P>
    进行广度优先搜索的经典方法是维持一个
    <EM>
      议程
    </EM>
    ：接下来要看的东西列表。然后你只需从议程开始处剥离对象，并将他们的孩子添加到
    <EM>
      结束
    </EM>
     议程。这种议程的一种非常简单的方法是节点列表：添加到列表的末尾然后使用
     <code>
      append
    </code>
    。
  </p>
  <P>
    我无法理解你的树结构（请在提出需要指定数据结构或算法的问题时
    <EM>
      给出那个规范
    </EM>
    ：浪费每个人的时间来尝试再次猜测这个）所以我在列表方面做了我自己的事：树是一个缺点，其汽车是它的价值，其cdr是一个孩子的列表。以下是制作和访问此类树结构的函数，以及示例树。
  </p>
   <pre>
    <code>
      (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))))))))

</code>
  </pre>
  <P>
    现在我再也不用担心树的显式结构了。
  </p>
  <P>
    现在这里有一个函数，它使用一个议程来搜索这个树的给定节点值：
  </p>
   <pre>
    <code>
      (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))))

</code>
  </pre>
  <P>
    为了比较，这里是深度优先搜索：
  </p>
   <pre>
    <code>
      (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)))

</code>
  </pre>
  <P>
    您现在可以通过使用谓词打印其参数但始终失败来比较这些实现，从而导致遍历整个树：
  </p>
   <pre>
    <code>
      > (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

</code>
  </pre>
  <HR />
  <H2>
    附录1：更好的议程实施
  </H2>
  <P>
    这个天真的议程实施的一个问题是我们最终打电话
     <code>
      append
    </code>
     每时每刻。更聪明的实现允许项目有效地附加到末尾。这是一个实现：
  </p>
   <pre>
    <code>
      (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))

</code>
  </pre>
  <P>
    请注意，无法复制其中一个提供的议程。
  </p>
  <P>
    这是一个明确的迭代函数，它使用了这个“聪明”的议程：
  </p>
   <pre>
    <code>
      (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)))

</code>
  </pre>
  <P>
    最后，任何基于议程的搜索都可以轻松修改为可重新启动：它只需要在匹配时返回当前议程，并允许传递议程。以下是上述函数的变体，它支持重新启动搜索：
  </p>
   <pre>
    <code>
      (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))))

</code>
  </pre>
  <H2>
    附录2：带议程的一般搜索
  </H2>
  <P>
    事实上，有可能进一步推广基于议程的搜索树木的方法。特别是：
  </p>
  <UL>
    <LI>
      如果议程是一个队列（FIFO），那么你得到广度优先搜索;
    </LI>
    <LI>
      如果议程是一个堆栈（LIFO），那么你将获得深度优先搜索。
    </LI>
  </UL>
  <P>
    对于这两种情况，实际的搜索实现可以是相同的，这是完整的。
  </p>
  <P>
    下面是一些演示这一点的代码。这定义了树访问的通用函数（使用基于cons的树的方法），因此没有必要关心它，并进一步定义了具有两个具体类的议程协议，
     <code>
      queue
    </code>
     和
     <code>
      stack
    </code>
     有适当的方法。然后，搜索功能完全不知道它是进行深度优先搜索还是广度优先搜索，并且在任何一种情况下都可以重新启动。
  </p>
  <P>
    这是一个相当大的代码块：我将它留在这里以防万一它对任何人都有用。
  </p>
   <pre>
    <code>
      ;;;; 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))))

</code>
  </pre>
</DIV>