plutonas

(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*))