1b9b79185f17

Add some docstrings
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 06 Nov 2016 21:22:16 +0000
parents b786d38cb2aa
children 412a127b7419
branches/tags (none)
files package.lisp src/directed-graph.lisp

Changes

--- 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)))