Поиск в ширину с использованием повестки дня
Классический способ выполнения поиска в ширину - поддержка повестки дня : список вещей, на которые следует обратить внимание.Затем вы просто снимаете объекты с начала повестки дня и добавляете их детей в конец повестки дня.Очень простой подход к такой повестке дня - это список узлов: чтобы добавить в конец списка, вы затем используете append.
Я не могу понять вашу древовидную структуру (пожалуйста, когда спрашиваетевопросы, которые требуют спецификации структуры данных или алгоритма , дают эту спецификацию : попытка угадать это - пустая трата времени каждого, поэтому я сделал свой собственный в терминах списков: деревоминусы, чья машина - это ценность, а чей - список детей.Вот функции для создания и доступа к такой древовидной структуре, а также пример дерева.
(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))))))))
Теперь мне больше не нужно беспокоиться о явной структуре деревьев.
Теперь вотфункция, которая использует повестку дня, которая будет искать в этом дереве заданное значение узла:
(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))))
Для сравнения приведен поиск в глубину:
(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)))
Теперь вы можете сравнить эти реализации с помощьюналичие предиката, который печатает свой аргумент, но всегда терпит неудачу, вызывая таким образом обход всего дерева:
> (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.Более умная реализация позволяет эффективно добавлять элементы в конец.Вот такая реализация:
(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))
Обратите внимание, что нет способа скопировать одну из этих предоставленных повесток дня.
Вот явно итеративная функция, которая использует эту «умную» повестку дня:
(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)))
Наконец, любой поиск по повестке дня можно легко изменить, чтобы он был перезапущен: ему просто нужно вернуть текущую повестку дня в том месте, к которому она была сопоставлена, и разрешить передачу повестки дня.Вот вариант вышеупомянутой функции, которая поддерживает возобновление поиска:
(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: общий поиск с повесткой дня
Фактически возможно дальнейшее обобщение основанного на повестке дня подхода кпоиск деревьев.В частности:
- если повестка дня является очередью (FIFO), то вы получаете поиск в ширину;
- , если повестка дня является стеком (LIFO), тогда вы получаете глубину сначалаsearch.
Реальная реализация поиска может быть идентичной для этих двух случаев, что является аккуратным.
Ниже приведен код, демонстрирующий это.Это определяет универсальные функции для доступа к дереву (с методами для основанных на доводах деревьев), так что об этом ничего не нужно заботиться, а также определяет протокол для повесток дня с двумя конкретными классами queue и stack, которые имеют соответствующие методы.Функция поиска тогда совершенно не зависит от того, выполняет ли она поиск в глубину или в ширину, и в любом случае она перезапускается.
Это довольно существенный кусок кода: я оставляю его здесь только вна всякий случай это кому-нибудь пригодится.
;;;; 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))))