(defmethod dfs ((graph basic-graph) (root basic-vertex) fn &key (out-edge-sorter #'edge-lessp-by-direction)) (setf *depth-first-search-timer* -1) (iterate-vertexes graph (lambda (v) (setf (color v) :white (previous-node v) nil (discovery-time v) -1 (finish-time v) -1))) (iterate-edges graph (lambda (e) (setf (color e) nil))) (loop with vl = (remove root (vertexes graph) :test #'eql) for v in (push root vl) do (when (eql (color v) :white) (dfs-visit graph v fn out-edge-sorter))) (values (sort (copy-list (vertexes graph)) #'< :key #'finish-time) graph)) ;;; --------------------------------------------------------------------------- (defmethod dfs-visit ((graph graph-container) (u basic-vertex) fn sorter) (incf *depth-first-search-timer*) (setf (color u) :gray (discovery-time u) *depth-first-search-timer*) (loop for edge in (sort (collect-elements (edges u) :filter (lambda (e) (out-edge-for-vertex-p e u))) sorter) do (bind ((v (other-vertex edge u))) (unless (color edge) (setf (color edge) (color v))) (when (eql (color v) :white) (setf (previous-node v) u) (funcall fn v) (dfs-visit graph v fn sorter)))) (incf *depth-first-search-timer*) (setf (color u) :black (finish-time u) *depth-first-search-timer*))