# HG changeset patch # User Steve Losh # Date 1478467336 0 # Node ID 1b9b79185f177683766c23d30acf9e0c6245ee11 # Parent b786d38cb2aa1312b03d749188b11ac10d36416c Add some docstrings diff -r b786d38cb2aa -r 1b9b79185f17 package.lisp --- 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 diff -r b786d38cb2aa -r 1b9b79185f17 src/directed-graph.lisp --- 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)))