--- a/package.lisp Sun Nov 06 16:16:09 2016 +0000
+++ b/package.lisp Sun Nov 06 21:22:16 2016 +0000
@@ -23,7 +23,9 @@
:degree
:degree-in
:degree-out
- :size
+
+ :count-vertices
+ :count-edges
:do-vertices
:do-edges
--- a/src/directed-graph.lisp Sun Nov 06 16:16:09 2016 +0000
+++ b/src/directed-graph.lisp Sun Nov 06 21:22:16 2016 +0000
@@ -24,6 +24,17 @@
(defun make-digraph (&key initial-vertices
(test #'eql)
(hash-function nil))
+ "Create and return a new digraph.
+
+ `initial-vertices` can be a sequence of vertices to add to the graph.
+
+ `test` should be one of the hash table equality predicates.
+
+ If your Lisp implementation supports the `:hash-function` argument for
+ creating hash tables with custom predicates, you can specify one with
+ `hash-function`.
+
+ "
(let ((digraph (make-instance 'digraph
:nodes (make-hash-table-portably
:test test
@@ -31,7 +42,7 @@
:hash-function hash-function)
:test test
:hash-function hash-function)))
- (mapc (curry #'insert-vertex digraph) initial-vertices)
+ (map nil (curry #'insert-vertex digraph) initial-vertices)
digraph))
(defmethod print-object ((d digraph) stream)
@@ -46,85 +57,6 @@
`(cdr (gethash ,object (digraph-nodes ,digraph))))
-;;;; Basic API ----------------------------------------------------------------
-(defun vertices (digraph)
- (hash-table-keys (digraph-nodes digraph)))
-
-(defun edges (digraph)
- (map-edges #'cons digraph))
-
-
-(defun predecessors (digraph object)
- (copy-list (pred digraph object)))
-
-(defun successors (digraph object)
- (copy-list (succ digraph object)))
-
-(defun neighbors (digraph object)
- (union (predecessors digraph object)
- (successors digraph object)
- :test (digraph-test digraph)))
-
-
-(defun contains-vertex-p (digraph object)
- (nth-value 1 (gethash object (digraph-nodes digraph))))
-
-(defun contains-edge-p (digraph predecessor successor)
- (ensure-boolean (member successor (succ digraph predecessor)
- :test (digraph-test digraph))))
-
-
-(defun insert-vertex (digraph object)
- (nth-value 1 (ensure-gethash object (digraph-nodes digraph)
- (cons nil nil))))
-
-(defun insert-edge (digraph predecessor successor)
- (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)
- (pushnew predecessor (pred digraph successor) :test (digraph-test digraph))
- (pushnew successor (succ digraph predecessor) :test (digraph-test digraph))
- (values))
-
-(defun insert-chain (digraph predecessor successor &rest later-successors)
- (insert-edge digraph predecessor successor)
- (when later-successors
- (apply #'insert-chain digraph successor later-successors)))
-
-
-(defun remove-edge (digraph predecessor successor)
- (removef (succ digraph predecessor) successor :test (digraph-test digraph))
- (removef (pred digraph successor) predecessor :test (digraph-test digraph))
- (values))
-
-(defun remove-vertex (digraph object)
- (let ((ps (pred digraph object))
- (ss (succ digraph object))
- (test (digraph-test digraph)))
- (loop :for p :in ps :do (removef (succ digraph p) object :test test))
- (loop :for s :in ss :do (removef (pred digraph s) object :test test)))
- (remhash object (digraph-nodes digraph))
- (values))
-
-
-(defun degree (digraph object)
- (length (neighbors digraph object)))
-
-(defun degree-in (digraph object)
- (length (pred digraph object)))
-
-(defun degree-out (digraph object)
- (length (succ digraph object)))
-
-
-(defun size (digraph)
- (hash-table-count (digraph-nodes digraph)))
-
-
-;;;; Iteration ----------------------------------------------------------------
(defmacro do-vertices ((symbol digraph) &body body)
`(loop :for ,symbol :being :the hash-keys :of (digraph-nodes ,digraph)
:do (progn ,@body)))
@@ -138,25 +70,202 @@
:do (progn ,@body)))))
+;;;; Basic API ----------------------------------------------------------------
+(defun vertices (digraph)
+ "Return a fresh list of the vertices of `digraph`."
+ (hash-table-keys (digraph-nodes digraph)))
+
+(defun edges (digraph)
+ "Return a fresh list of the edges of `digraph`.
+
+ Each edge will be a cons of the form `(predecessor . successor)`.
+
+ "
+ (map-edges #'cons digraph))
+
+
+(defun predecessors (digraph vertex)
+ "Return a fresh list of the predecessors of `vertex`."
+ (copy-list (pred digraph vertex)))
+
+(defun successors (digraph vertex)
+ "Return a fresh list of the successors of `vertex`."
+ (copy-list (succ digraph vertex)))
+
+(defun neighbors (digraph vertex)
+ "Return a fresh list of the neighbors of `vertex`."
+ (union (predecessors digraph vertex)
+ (successors digraph vertex)
+ :test (digraph-test digraph)))
+
+
+(defun contains-vertex-p (digraph vertex)
+ "Return whether the graph contains `vertex`."
+ (nth-value 1 (gethash vertex (digraph-nodes digraph))))
+
+(defun contains-edge-p (digraph predecessor successor)
+ "Return whether the graph contains and edge from `predecessor` to `successor`."
+ (ensure-boolean (member successor (succ digraph predecessor)
+ :test (digraph-test digraph))))
+
+
+(defun insert-vertex (digraph vertex)
+ "Insert `vertex` into the graph if it is not already a member.
+
+ Returns `t` if the vertex was already in the graph, or `nil` if it was
+ inserted.
+
+ "
+ (nth-value 1 (ensure-gethash vertex (digraph-nodes digraph)
+ (cons nil nil))))
+
+(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.
+
+ "
+ (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)
+ (prog1
+ (contains-edge-p digraph predecessor successor)
+ (pushnew predecessor (pred digraph successor) :test (digraph-test digraph))
+ (pushnew successor (succ digraph predecessor) :test (digraph-test digraph))))
+
+(defun insert-chain (digraph predecessor successor &rest later-successors)
+ "Insert edges between a series of vertices.
+
+ Give a series of vertices `V0 V1 ... Vn`, edges between each will be inserted
+ if not already present:
+
+ V0 -> V1 -> ... -> Vn
+
+ All vertices must exist in the graph already.
+
+ Returns `nil`.
+
+ "
+ (insert-edge digraph predecessor successor)
+ (when later-successors
+ (apply #'insert-chain digraph successor later-successors)))
+
+
+(defun remove-edge (digraph predecessor successor)
+ "Remove an edge from `predecessor` to `successor` if present.
+
+ Returns `t` if there was such an edge, or `nil` if not.
+
+ "
+ (if (contains-edge-p digraph predecessor successor)
+ (progn
+ (removef (succ digraph predecessor) successor :test (digraph-test digraph))
+ (removef (pred digraph successor) predecessor :test (digraph-test digraph))
+ t)
+ nil))
+
+(defun remove-vertex (digraph vertex)
+ "Remove `vertex` from the graph if present.
+
+ If there are any edges to/from `vertex` they will be automatically removed.
+
+ Returns `t` if there was such a vertex, or `nil` if not.
+
+ "
+ (if (contains-vertex-p digraph vertex)
+ (let ((ps (pred digraph vertex))
+ (ss (succ digraph vertex))
+ (test (digraph-test digraph)))
+ (loop :for p :in ps :do (removef (succ digraph p) vertex :test test))
+ (loop :for s :in ss :do (removef (pred digraph s) vertex :test test))
+ (remhash vertex (digraph-nodes digraph))
+ t)
+ nil))
+
+
+(defun degree (digraph vertex)
+ "Return the number of neighbors of `vertex`."
+ (length (neighbors digraph vertex)))
+
+(defun degree-in (digraph vertex)
+ "Return the number of predecessors of `vertex`."
+ (length (pred digraph vertex)))
+
+(defun degree-out (digraph vertex)
+ "Return the number of successors of `vertex`."
+ (length (succ digraph vertex)))
+
+
+(defun count-vertices (digraph)
+ "Return the number of vertices in `digraph`."
+ (hash-table-count (digraph-nodes digraph)))
+
+(defun count-edges (digraph)
+ "Return the number of edges in `digraph`."
+ (let ((result 0))
+ (do-edges (nil nil digraph) (incf result))
+ result))
+
+
+;;;; Iteration ----------------------------------------------------------------
(defun mapc-vertices (function digraph)
+ "Call `function` on each vertex in `digraph`.
+
+ The order in which the vertices are processed is unspecified.
+
+ Returns `nil`.
+
+ "
(do-vertices (v digraph) (funcall function v)))
(defun mapc-edges (function digraph)
+ "Call `function` on each edge in `digraph`.
+
+ For each edge, `function` will be called once with two arguments:
+
+ (function predecessor successor)
+
+ The order in which the edges are processed is unspecified.
+
+ Returns `nil`.
+
+ "
(do-edges (p s digraph) (funcall function p s)))
(defun map-vertices (function digraph)
+ "Return a fresh list with the results of calling `function` on each vertex.
+
+ The order of the resulting list is unspecified.
+
+ "
(let ((result nil))
(do-vertices (v digraph) (push (funcall function v) result))
result))
(defun map-edges (function digraph)
+ "Return a fresh list with the results of calling `function` on each edge.
+
+ For each edge, `function` will be called once with two arguments:
+
+ (function predecessor successor)
+
+ The order of the resulting list is unspecified.
+
+ "
(let ((result nil))
(do-edges (p s digraph) (push (funcall function p s) result))
result))
(defun dump (digraph)
+ "Don't use this."
(format t "Digraph :TEST ~A~%:CONTENTS " (digraph-test digraph))
(finish-output)
(ql:quickload :losh :silent t)
@@ -167,8 +276,14 @@
;;;; Copying ------------------------------------------------------------------
(defun copy-digraph (digraph)
+ "Create a fresh copy of `digraph`.
+
+ The vertex objects themselves are not copied, but everything else is.
+
+ "
;; todo make this faster, but at least this works
(let ((copy (make-digraph :test (digraph-test digraph)
+ :hash-function (digraph-hash-function digraph)
:initial-vertices (vertices digraph))))
(do-edges (p s digraph) (insert-edge digraph p s))
copy))
@@ -178,6 +293,15 @@
;;; Adapted from http://algorithms.wtf/
(defun mapc-depth-first (function digraph start-vertex)
+ "Apply `function` to the vertices of a depth-first traversal of `digraph`.
+
+ Returns `nil`.
+
+ Vertices are processed in depth-first order, beginning at `start-vertex`.
+
+ Cycles in the graph will not be traversed into.
+
+ "
(let ((seen nil))
(labels ((recur (vertex)
(when (not (member vertex seen :test (digraph-test digraph)))
@@ -189,6 +313,15 @@
nil)
(defun mapc-breadth-first (function digraph start-vertex)
+ "Apply `function` to the vertices of a breadth-first traversal of `digraph`.
+
+ Returns `nil`.
+
+ Vertices are processed in breadth-first order, beginning at `start-vertex`.
+
+ Cycles in the graph will not be traversed into.
+
+ "
(let ((seen nil)
(remaining nil))
(labels ((recur (vertex)
@@ -205,12 +338,32 @@
(defun map-depth-first (function digraph start-vertex)
+ "Apply `function` to the vertices of a breadth-first traversal of `digraph`.
+
+ Returns a fresh list with the results.
+
+ Vertices are processed in depth-first order, beginning at `start-vertex`, and
+ the resulting list has this order as well.
+
+ Cycles in the graph will not be traversed into.
+
+ "
(let ((result nil))
(mapc-depth-first (lambda (v) (push (funcall function v) result))
digraph start-vertex)
(nreverse result)))
(defun map-breadth-first (function digraph start-vertex)
+ "Apply `function` to the vertices of a breadth-first traversal of `digraph`.
+
+ Returns a fresh list with the results.
+
+ Vertices are processed in breadth-first order, beginning at `start-vertex`,
+ and the resulting list has this order as well.
+
+ Cycles in the graph will not be traversed into.
+
+ "
(let ((result nil))
(mapc-breadth-first (lambda (v) (push (funcall function v) result))
digraph start-vertex)
@@ -226,7 +379,7 @@
(vertices digraph)))
-(defun mapc-topological (function digraph)
+(defun topological-sort% (function digraph)
(let ((status (make-hash-table-portably
:test (digraph-test digraph)
:hash-function (digraph-hash-function digraph))))
@@ -246,9 +399,22 @@
(mapc #'visit (roots digraph))))
nil)
-(defun map-topological (function digraph)
+(defun topological-sort (function digraph)
+ "Apply `function` to the vertices of `digraph` in topological order.
+
+ Returns a fresh list with the results.
+
+ Edges are treated as meaning \"depends on\", so an edge `A --> B` means \"A
+ depends on B\" and that B must come before A in the resulting list. Aside
+ from this restriction, the order of the resulting list is arbitrary.
+
+ The order in which the vertices are processed is unspecified.
+
+ An error will be signaled if the graph contains a cycle.
+
+ "
(let ((result nil))
- (mapc-topological (lambda (v) (push (funcall function v) result)) digraph)
+ (topological-sort% (lambda (v) (push (funcall function v) result)) digraph)
(nreverse result)))