--- a/.hgignore Mon Dec 14 20:15:02 2020 -0500
+++ b/.hgignore Sun Mar 14 21:31:34 2021 -0400
@@ -2,4 +2,5 @@
scratch.lisp
*.png
+*.svg
docs/build
--- a/cl-digraph.asd Mon Dec 14 20:15:02 2020 -0500
+++ b/cl-digraph.asd Sun Mar 14 21:31:34 2021 -0400
@@ -4,7 +4,7 @@
:homepage "http://docs.stevelosh.com/cl-digraph/"
:license "MIT/X11"
- :version "1.3.2"
+ :version "1.4.0"
:depends-on ()
--- a/cl-digraph.test.asd Mon Dec 14 20:15:02 2020 -0500
+++ b/cl-digraph.test.asd Sun Mar 14 21:31:34 2021 -0400
@@ -5,6 +5,7 @@
:license "MIT"
:depends-on (:cl-digraph
+ :alexandria
:1am)
:serial t
--- a/docs/02-usage.markdown Mon Dec 14 20:15:02 2020 -0500
+++ b/docs/02-usage.markdown Sun Mar 14 21:31:34 2021 -0400
@@ -22,8 +22,7 @@
:::lisp
(digraph:make-digraph)
- ; =>
- #<DIGRAPH:DIGRAPH () {1002CFD343}>
+ ; => #<DIGRAPH:DIGRAPH () {1002CFD343}>
Working with Vertices
---------------------
@@ -172,7 +171,16 @@
; => ((a . b))
(digraph:insert-edge *d* 'cats 'dogs)
- ; => Error!
+ ; =>
+ ; Cannot add edge with predecessor CATS because it is not in the graph
+ ; [Condition of type DIGRAPH::MISSING-PREDECESSOR]
+ ;
+ ; Restarts:
+ ; R 0. CONTINUE - Retry assertion with new value for DIGRAPH::PREDECESSOR.
+ ; R 1. ABORT - Exit debugger, returning to top level.
+
+See the [Conditions](#conditions) section for more information about the error
+hierarchy.
Edges can be removed with `remove-edge`. Removing an edge that's not in the
graph is silently ignored:
@@ -342,13 +350,70 @@
(digraph:topological-sort *d*)
; => one of
- (C B A D)
- (B C A D)
+ ; (C B A D)
+ ; (B C A D)
+
+A `digraph:topological-sort-cycle` will be signaled if the digraph
+contains a cycle:
+
+ :::lisp
+ (defparameter *d*
+ (digraph:make-digraph :initial-vertices '(a b c d)))
-An error will be signaled if the digraph contains a cycle.
+ (digraph:insert-edge *d* 'a 'b) ; a depends on b
+ (digraph:insert-edge *d* 'b 'c) ; b depends on c
+ (digraph:insert-edge *d* 'c 'a) ; c depends on a
+
+ (digraph:topological-sort *d*)
+ ; =>
+ ; Cycle detected during topological sort involving vertex A
+ ; [Condition of type DIGRAPH:TOPOLOGICAL-SORT-CYCLE]
+ ;
+ ; Restarts:
+ ; R 0. ABORT - Exit debugger, returning to top level.
+
+See the [Conditions](#conditions) section for more information about the error
+hierarchy.
[topologically sorted]: https://en.wikipedia.org/wiki/Topological_sorting
+Conditions
+----------
+
+The following condition types are defined by cl-digraph:
+
+[](../static/conditions.svg)
+
+Dotted outlines denote abstract types that are never actually instantiated, but
+can be useful for handling whole classes of errors.
+
+* `digraph-error`: abstract type for digraph-related errors.
+* `missing-vertex`: abstract type for errors signaled when trying to insert an edge involving a vertex that is not in the graph.
+* `missing-predecessor`: error signaled when trying to insert an edge whose predecessor is not in the graph.
+* `missing-successor`: error signaled when trying to insert an edge whose successor is not in the graph.
+* `topological-sort-cycle`: error signaled when trying to topologically sort a graph involving a cycle.
+
+For `missing-vertex` errors of both kinds you can use the `vertex-involved`
+reader to retrieve the offending vertex from the condition object.
+
+For `topological-sort-cycle` errors you can use the `vertex-involved` reader to
+retrieve one of the vertices involved in a cycle from the condition object.
+*Which* vertex of the cycle is returned is arbitrary:
+
+ :::lisp
+ (defparameter *d*
+ (digraph:make-digraph :initial-vertices '(a b c d)))
+
+ (digraph:insert-edge *d* 'a 'b) ; a depends on b
+ (digraph:insert-edge *d* 'b 'c) ; b depends on c
+ (digraph:insert-edge *d* 'c 'a) ; c depends on a
+
+ (handler-case (digraph:topological-sort *d*)
+ (digraph:topological-sort-cycle-error (c)
+ (list :cyclic (digraph:vertex-involved c))))
+ ; =>
+ ; (:CYCLIC A)
+
Drawing
-------
--- a/docs/03-reference.markdown Mon Dec 14 20:15:02 2020 -0500
+++ b/docs/03-reference.markdown Sun Mar 14 21:31:34 2021 -0400
@@ -78,6 +78,10 @@
A directed graph. Use `make-digraph` to create one.
+### `DIGRAPH-ERROR` (class)
+
+Base condition for digraph-related errors.
+
### `EDGES` (function)
(EDGES DIGRAPH)
@@ -100,11 +104,14 @@
Insert an edge from `predecessor` to `successor` if not already present.
- The `predecessor` and `successor` vertices must exist in the graph already.
-
Returns `t` if the edge was already in the graph, or `nil` if it was
inserted.
+ The `predecessor` and `successor` vertices must already exist in the graph.
+ If `predecessor` is not in the graph a `missing-predecessor` error will be
+ signaled. Otherwise, if `successor` is not in the graph, a `missing-successor`
+ error will be signaled.
+
### `INSERT-VERTEX` (function)
@@ -262,6 +269,22 @@
+### `MISSING-PREDECESSOR` (class)
+
+An error signaled when trying to insert an edge whose predecessor is not in the graph.
+
+ `vertex-involved` can be used to retrieve the offending predecessor.
+
+### `MISSING-SUCCESSOR` (class)
+
+An error signaled when trying to insert an edge whose successor is not in the graph.
+
+ `vertex-involved` can be used to retrieve the offending successor.
+
+### `MISSING-VERTEX` (class)
+
+Base condition for errors signaled when inserting an edge with a vertex missing.
+
### `NEIGHBORS` (function)
(NEIGHBORS DIGRAPH VERTEX)
@@ -348,10 +371,24 @@
The order in which the vertices are processed is unspecified.
- An error will be signaled if the graph contains a cycle.
+ A `topological-sort-cycle` error will be signaled if the graph contains
+ a cycle.
+### `TOPOLOGICAL-SORT-CYCLE` (class)
+
+An error signaled when topologically sorting a graph that contains a cycle.
+
+ `vertex-involved` can be used to retrieve one of the vertices involved in a
+ cycle. Which vertex in the cycle is chosen is arbitrary.
+
+### `VERTEX-INVOLVED` (generic function)
+
+ (VERTEX-INVOLVED CONDITION)
+
+Retrieve the vertex involved in the condition.
+
### `VERTICES` (function)
(VERTICES DIGRAPH)
--- a/docs/05-changelog.markdown Mon Dec 14 20:15:02 2020 -0500
+++ b/docs/05-changelog.markdown Sun Mar 14 21:31:34 2021 -0400
@@ -5,6 +5,11 @@
[TOC]
+v1.4.0
+------
+
+Added an explicit [condition hierarchy](../usage#conditions).
+
v1.3.2
------
--- a/docs/api.lisp Mon Dec 14 20:15:02 2020 -0500
+++ b/docs/api.lisp Sun Mar 14 21:31:34 2021 -0400
@@ -28,3 +28,14 @@
"
:title "cl-dot Support")
+(d-api:draw-class-hierarchy
+ "docs/static/conditions.svg"
+ '(digraph::digraph-error
+ digraph::missing-vertex
+ digraph::missing-predecessor
+ digraph::missing-successor
+ digraph::topological-sort-cycle)
+ :abstract-classes
+ '(digraph::digraph-error
+ digraph::missing-vertex))
+
--- a/package.lisp Mon Dec 14 20:15:02 2020 -0500
+++ b/package.lisp Sun Mar 14 21:31:34 2021 -0400
@@ -51,4 +51,11 @@
:reachablep
- :copy-digraph))
+ :copy-digraph
+
+ :digraph-error
+ :missing-vertex
+ :missing-predecessor
+ :missing-successor
+ :topological-sort-cycle
+ :vertex-involved))
--- a/src/directed-graph.lisp Mon Dec 14 20:15:02 2020 -0500
+++ b/src/directed-graph.lisp Sun Mar 14 21:31:34 2021 -0400
@@ -11,6 +11,52 @@
(list :hash-function hash-function))))
+;;;; Errors -------------------------------------------------------------------
+(defgeneric vertex-involved (condition)
+ (:documentation "Retrieve the vertex involved in the condition."))
+
+(define-condition digraph-error (error) ()
+ (:documentation "Base condition for digraph-related errors."))
+
+(define-condition topological-sort-cycle (digraph-error)
+ ((vertex-involved% :initarg :vertex-involved :reader vertex-involved))
+ (:report
+ (lambda (c stream)
+ (format stream "Cycle detected during topological sort involving vertex ~S."
+ (vertex-involved c))))
+ (:documentation
+ "An error signaled when topologically sorting a graph that contains a cycle.
+
+ `vertex-involved` can be used to retrieve one of the vertices involved in a
+ cycle. Which vertex in the cycle is chosen is arbitrary."))
+
+(define-condition missing-vertex (digraph-error)
+ ((vertex-involved% :initarg :vertex-involved :reader vertex-involved))
+ (:documentation "Base condition for errors signaled when inserting an edge with a vertex missing."))
+
+(define-condition missing-predecessor (missing-vertex) ()
+ (:report
+ (lambda (c stream)
+ (format stream
+ "Cannot add edge with predecessor ~S because it is not in the graph."
+ (vertex-involved c))))
+ (:documentation
+ "An error signaled when trying to insert an edge whose predecessor is not in the graph.
+
+ `vertex-involved` can be used to retrieve the offending predecessor."))
+
+(define-condition missing-successor (missing-vertex) ()
+ (:report
+ (lambda (c stream)
+ (format stream
+ "Cannot add edge with successor ~S because it is not in the graph."
+ (vertex-involved c))))
+ (:documentation
+ "An error signaled when trying to insert an edge whose successor is not in the graph.
+
+ `vertex-involved` can be used to retrieve the offending successor."))
+
+
;;;; Data ---------------------------------------------------------------------
(defclass digraph ()
((nodes :initarg :nodes :reader digraph-nodes)
@@ -56,15 +102,14 @@
(defmacro do-vertices ((symbol digraph) &body body)
`(loop :for ,symbol :being :the hash-keys :of (digraph-nodes ,digraph)
- :do (progn ,@body)))
+ :do (progn ,@body)))
(defmacro do-edges ((predecessor-symbol successor-symbol digraph) &body body)
(with-gensyms (succs)
`(loop
- :for ,predecessor-symbol :being :the hash-keys :of (digraph-nodes ,digraph)
- :using (hash-value (nil . ,succs))
- :do (loop :for ,successor-symbol :in ,succs ; i miss u, iterate
- :do (progn ,@body)))))
+ :for ,predecessor-symbol :being :the hash-keys :of (digraph-nodes ,digraph)
+ :using (hash-value (nil . ,succs))
+ :do (loop :for ,successor-symbol :in ,succs :do (progn ,@body)))))
;;;; Basic API ----------------------------------------------------------------
@@ -124,18 +169,19 @@
(defun insert-edge (digraph predecessor successor)
"Insert an edge from `predecessor` to `successor` if not already present.
- The `predecessor` and `successor` vertices must exist in the graph already.
-
Returns `t` if the edge was already in the graph, or `nil` if it was
inserted.
+ The `predecessor` and `successor` vertices must already exist in the graph.
+ If `predecessor` is not in the graph a `missing-predecessor` error will be
+ signaled. Otherwise, if `successor` is not in the graph, a `missing-successor`
+ error will be signaled.
+
"
- (assert (contains-vertex-p digraph predecessor) (predecessor)
- "Cannot add edge with predecessor ~S because it is not in the graph"
- predecessor)
- (assert (contains-vertex-p digraph successor) (successor)
- "Cannot add edge with successor ~S because it is not in the graph"
- successor)
+ (unless (contains-vertex-p digraph predecessor)
+ (error 'missing-predecessor :vertex-involved predecessor))
+ (unless (contains-vertex-p digraph successor)
+ (error 'missing-successor :vertex-involved successor))
(prog1
(contains-edge-p digraph predecessor successor)
(pushnew predecessor (pred digraph successor) :test (digraph-test digraph))
@@ -286,6 +332,12 @@
result))
+(defun find-vertex-if (function digraph)
+ (do-vertices (v digraph)
+ (when (funcall function v)
+ (return-from find-vertex-if v))))
+
+
;;;; Copying ------------------------------------------------------------------
(defun copy-digraph (digraph)
"Create a fresh copy of `digraph`.
@@ -413,9 +465,7 @@
(labels
((visit (vertex)
(ecase (gethash vertex status :new)
- (:active
- (error "Cycle detected during topological map involving vertex ~S"
- vertex))
+ (:active (error 'topological-sort-cycle :vertex-involved vertex))
(:new (recur vertex))
(:done nil)))
(recur (vertex)
@@ -423,8 +473,8 @@
(mapc #'visit (succ digraph vertex))
(setf (gethash vertex status) :done)
(funcall function vertex)))
- (mapc #'visit (roots digraph))))
- nil)
+ (mapc #'visit (roots digraph)))
+ status))
(defun topological-sort (digraph)
"Return a fresh list of the vertices of `digraph` in topological order.
@@ -435,15 +485,19 @@
The order in which the vertices are processed is unspecified.
- An error will be signaled if the graph contains a cycle.
+ A `topological-sort-cycle` error will be signaled if the graph contains
+ a cycle.
"
- (let ((result nil)
- (i 0))
- (topological-sort% (lambda (v) (incf i) (push v result)) digraph)
- (if (= i (count-vertices digraph)) ; make sure there are no rootless cycles
+ (let* ((result nil)
+ (seen (topological-sort% (lambda (v) (push v result)) digraph)))
+ ;; Make sure there are no rootless cycles.
+ (if (= (hash-table-count seen) (count-vertices digraph))
(nreverse result)
- (error "Cycle detected during topological sort."))))
+ (error 'topological-sort-cycle
+ :vertex-involved (find-vertex-if
+ (lambda (v) (not (gethash v seen)))
+ digraph)))))
(defun reachablep (digraph start target &key (strategy :breadth-first))
--- a/test/tests.lisp Mon Dec 14 20:15:02 2020 -0500
+++ b/test/tests.lisp Sun Mar 14 21:31:34 2021 -0400
@@ -3,7 +3,7 @@
;;;; Utils --------------------------------------------------------------------
(defmacro define-test (name &body body)
- `(test ,(symb 'test- name)
+ `(test ,(symb 'test/ name)
(let ((*package* ,*package*))
,@body)))
@@ -95,6 +95,14 @@
(edges g)))))
+(define-test missing-vertices
+ (let ((g (make-digraph :initial-vertices '(a b))))
+ (insert-edge g 'a 'b)
+ (signals missing-vertex (insert-edge g 'x 'y))
+ (signals missing-predecessor (insert-edge g 'x 'a))
+ (signals missing-successor (insert-edge g 'a 'x))))
+
+
(define-test remove-vertex
(let ((g (make-digraph :initial-vertices '(a b c))))
(insert-edge g 'a 'b)
@@ -254,20 +262,48 @@
(is (member (arbitrary-vertex g) '(new)))))
+(defmacro has-topo-error (graph involving)
+ (alexandria:once-only (graph involving)
+ `(handler-case (topological-sort ,graph)
+ (topological-sort-cycle (c)
+ (is (member (vertex-involved c) ,involving))))))
+
(define-test topological-sort-cycle-detection
+ ;; a b c d
(let ((g (make-digraph :initial-vertices '(a b c d))))
(is (= 4 (length (topological-sort g))))
+
+ ;; a--->b c d
(insert-edge g 'a 'b)
(is (= 4 (length (topological-sort g))))
+
+ ;; a--->b--->c d
(insert-edge g 'b 'c)
(is (= 4 (length (topological-sort g))))
+
+ ;; a--->b--->c d
+ ;; ^ |
+ ;; |_________|
(insert-edge g 'c 'a)
- (signals error (topological-sort g))
+ (has-topo-error g '(a b c))
(remove-edge g 'c 'a)
+
+ ;; a--->b--->c d--+
+ ;; ^ |
+ ;; | |
+ ;; +--+
(insert-edge g 'd 'd)
- (signals error (topological-sort g))
+ (has-topo-error g '(d))
(remove-edge g 'd 'd)
+
+ ;; a--->b--->c--->d
(insert-edge g 'c 'd)
(is (= 4 (length (topological-sort g))))
+
+ ;; a--->b--->c--->d--+
+ ;; ^ |
+ ;; | |
+ ;; +------------+
(insert-edge g 'd 'b)
- (signals error (topological-sort g))))
+ (has-topo-error g '(b c d))
+ (remove-edge g 'd 'b)))