Detect *all* cycles during topological sort
Previously the cycle detection was limited to detecting when we hit
a currently-being-visited node during a traversal. So something like this would
be correctly found:
A --> B --> C
^ |
| |
+-----+
We start at the root (A), go to B, then to C, then to B, and detect that we're
still working on B and signal the error.
But this doesn't find all cycles, because we *start* at the root nodes, and if
a cycle doesn't have any outcropping branches we'll never reach it at all. For
example:
A --> B
^ |
| |
+-----+
This graph has no roots, so we incorrectly ignore the cycle.
This patch fixes the problem by keeping a count of visited nodes and and making
sure it matches the digraph's size at the end.
Fixes https://github.com/sjl/cl-digraph/issues/4
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Mon, 14 Dec 2020 20:13:51 -0500 |
| parents |
412a127b7419 |
| children |
63712529f020 f11da0d6a058 |
(in-package :digraph.dot)
(defun find-dot-roots (digraph)
(let ((nodes (vertices digraph))
(roots nil)
(test (digraph::digraph-test digraph)))
(labels ((descendents (vertex)
(map-depth-first #'identity digraph vertex))
(prune (vertex)
(setf nodes (set-difference nodes (descendents vertex)
:test test)))
(mark-root-and-prune (vertex)
(push vertex roots)
(prune vertex)))
(mapc #'mark-root-and-prune (digraph::roots digraph))
(loop :while nodes :do (mark-root-and-prune (pop nodes))))
roots))
(defparameter *current-digraph* nil)
(defmethod cl-dot:graph-object-node ((graph (eql 'digraph)) (vertex t))
(make-instance 'cl-dot:node
:attributes `(:label ,(format nil "~A" vertex) :shape :circle)))
(defmethod cl-dot:graph-object-points-to ((graph (eql 'digraph)) (vertex t))
(successors *current-digraph* vertex))
(defun draw (digraph &key (filename "digraph.png") (format :png))
"Draw `digraph` with cl-dot."
(let ((*current-digraph* digraph))
(cl-dot:dot-graph
(cl-dot:generate-graph-from-roots 'digraph (find-dot-roots digraph))
filename
:format format))
digraph)