# HG changeset patch # User Steve Losh # Date 1615771894 14400 # Node ID 7e80eda841705b78dbd813c61316fadc8ec42c26 # Parent 3443da60edaa57bfcc232c492a6bcfc17112a8f5 Add an explicit condition hierarchy Fixes https://github.com/sjl/cl-digraph/issues/5 diff -r 3443da60edaa -r 7e80eda84170 .hgignore --- 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 diff -r 3443da60edaa -r 7e80eda84170 cl-digraph.asd --- 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 () diff -r 3443da60edaa -r 7e80eda84170 cl-digraph.test.asd --- 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 diff -r 3443da60edaa -r 7e80eda84170 docs/02-usage.markdown --- 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) - ; => - # + ; => # 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: + +[![condition type hierarchy](../static/conditions.svg)](../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 ------- diff -r 3443da60edaa -r 7e80eda84170 docs/03-reference.markdown --- 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) diff -r 3443da60edaa -r 7e80eda84170 docs/05-changelog.markdown --- 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 ------ diff -r 3443da60edaa -r 7e80eda84170 docs/api.lisp --- 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)) + diff -r 3443da60edaa -r 7e80eda84170 package.lisp --- 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)) diff -r 3443da60edaa -r 7e80eda84170 src/directed-graph.lisp --- 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)) diff -r 3443da60edaa -r 7e80eda84170 test/tests.lisp --- 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)))