removed ;;; -+ lines

author Gary King <gwking@metabang.com>

Tue, 30 Sep 2008 02:35:31 +0000 (22:35 -0400)

committer Gary King <gwking@metabang.com>

Tue, 30 Sep 2008 02:35:31 +0000 (22:35 -0400)
author Gary King <gwking@metabang.com>
Tue, 30 Sep 2008 02:35:31 +0000 (22:35 -0400)
committer Gary King <gwking@metabang.com>
Tue, 30 Sep 2008 02:35:31 +0000 (22:35 -0400)
diff --git a/dev/api.lisp b/dev/api.lisp

index 421cc81..b7f6e00 100644 (file)
--- a/dev/api.lisp
+++ b/dev/api.lisp
@@ -1,18 +1,14 @@
  (in-package #:cl-graph)
  
  (in-package #:cl-graph)
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric make-vertex-container (graph initial-size)
    (:documentation "Make-vertex-container is called during graph creation and can be used to create specialized containers to hold graph vertexes."))
  
  
  (defgeneric make-vertex-container (graph initial-size)
    (:documentation "Make-vertex-container is called during graph creation and can be used to create specialized containers to hold graph vertexes."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric make-edge-container (graph initial-size)
    (:documentation "Make-edge-container is called during graph creation and can be used to create specialized containers to hold graph edges."))
  
  
  (defgeneric make-edge-container (graph initial-size)
    (:documentation "Make-edge-container is called during graph creation and can be used to create specialized containers to hold graph edges."))
  
-;;; ---------------------------------------------------------------------------
  ;;; API
  ;;; API
-;;; ---------------------------------------------------------------------------
  
  (defgeneric make-graph (graph-type &key &allow-other-keys)
    (:documentation "Create a new graph of type `graph-type'. Graph type can be 
  
  (defgeneric make-graph (graph-type &key &allow-other-keys)
    (:documentation "Create a new graph of type `graph-type'. Graph type can be 
@@ -21,18 +17,15 @@ different classes. If graph-type is a list, then a class which has all of the li
  classes as superclasses will be found (or created). In either case, the new graph will
  be created as if with a call to make-instance."))
  
  classes as superclasses will be found (or created). In either case, the new graph will
  be created as if with a call to make-instance."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric make-edge-for-graph (graph vertex-1 vertex-2 
                                         &key edge-type edge-class &allow-other-keys)
    (:documentation "It should not usually necessary to call this in user code. Creates a new edge between vertex-1 and vertex-2 for the graph. If the edge-type and edge-class are not specified, they will be determined from the defaults of the graph."))
  
  
  (defgeneric make-edge-for-graph (graph vertex-1 vertex-2 
                                         &key edge-type edge-class &allow-other-keys)
    (:documentation "It should not usually necessary to call this in user code. Creates a new edge between vertex-1 and vertex-2 for the graph. If the edge-type and edge-class are not specified, they will be determined from the defaults of the graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric add-edge (graph edge &rest args &key force-new?)
    (:documentation "Add-edge adds an existing edge to a graph. As add-edge-between-vertexes is generally more natural to use, this method is rarely called."))
  
  
  (defgeneric add-edge (graph edge &rest args &key force-new?)
    (:documentation "Add-edge adds an existing edge to a graph. As add-edge-between-vertexes is generally more natural to use, this method is rarely called."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric add-edge-between-vertexes (graph value-or-vertex-1 value-or-vertex-2
                                                &rest args &key if-duplicate-do
  
  (defgeneric add-edge-between-vertexes (graph value-or-vertex-1 value-or-vertex-2
                                                &rest args &key if-duplicate-do
@@ -54,23 +47,19 @@ the previously added edge is returned; if it is :force, then another edge is
  added between the two vertexes; if it is a function, then this function will
  be called with the previous edge."))
  
  added between the two vertexes; if it is a function, then this function will
  be called with the previous edge."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric delete-edge (graph edge)
    (:documentation "Delete the `edge' from the `graph' and returns it."))
  
  
  (defgeneric delete-edge (graph edge)
    (:documentation "Delete the `edge' from the `graph' and returns it."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric delete-edge-between-vertexes (graph value-or-vertex-1
                                                  value-or-vertex-2 &rest args)
    (:documentation "Finds an edge in the graph between the two specified vertexes. If values (i.e., non-vertexes) are passed in, then the graph will be searched for matching vertexes."))
  
  
  (defgeneric delete-edge-between-vertexes (graph value-or-vertex-1
                                                  value-or-vertex-2 &rest args)
    (:documentation "Finds an edge in the graph between the two specified vertexes. If values (i.e., non-vertexes) are passed in, then the graph will be searched for matching vertexes."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric add-vertex (graph value-or-vertex &key if-duplicate-do &allow-other-keys)
    (:documentation  "Adds a vertex to a graph. If called with a vertex, then this vertex is added. If called with a value, then a new vertex is created to hold the value. If-duplicate-do can be one of :ignore, :force, :replace, :replace-value or a function. The default is :ignore."))
  
  
  (defgeneric add-vertex (graph value-or-vertex &key if-duplicate-do &allow-other-keys)
    (:documentation  "Adds a vertex to a graph. If called with a vertex, then this vertex is added. If called with a value, then a new vertex is created to hold the value. If-duplicate-do can be one of :ignore, :force, :replace, :replace-value or a function. The default is :ignore."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric delete-vertex (graph value-or-vertex)
    (:documentation "Remove a vertex from a graph. The 'vertex-or-value' argument can be
  
  (defgeneric delete-vertex (graph value-or-vertex)
    (:documentation "Remove a vertex from a graph. The 'vertex-or-value' argument can be
@@ -78,124 +67,100 @@ a vertex of the graph or a 'value' that will find a vertex via a call to find-ve
  graph-vertex-not-found-error will be raised if the vertex is not found or is not part of
  the graph."))
  
  graph-vertex-not-found-error will be raised if the vertex is not found or is not part of
  the graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric find-vertex (graph value &optional error-if-not-found?)
    (:documentation "Search 'graph' for a vertex with element 'value'. The search is fast but inflexible because it uses an associative-container. If you need more flexibity, see search-for-vertex."))
  
  
  (defgeneric find-vertex (graph value &optional error-if-not-found?)
    (:documentation "Search 'graph' for a vertex with element 'value'. The search is fast but inflexible because it uses an associative-container. If you need more flexibity, see search-for-vertex."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric search-for-vertex (graph value &key key test error-if-not-found?)
    (:documentation "Search 'graph' for a vertex with element 'value'. The 'key' function is applied to each element before that element is compared with the value. The comparison is done using the function 'test'. If you don't need to use key or test, then consider using find-vertex instead."))
  
  
  (defgeneric search-for-vertex (graph value &key key test error-if-not-found?)
    (:documentation "Search 'graph' for a vertex with element 'value'. The 'key' function is applied to each element before that element is compared with the value. The comparison is done using the function 'test'. If you don't need to use key or test, then consider using find-vertex instead."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric find-edge (graph edge &optional error-if-not-found?)
    (:documentation "Search `graph` for an edge whose vertexes match `edge`. This means that `vertex-1` of the edge in the graph must match `vertex-1` of `edge` and so forth. Wil signal an error of type `graph-edge-not-found-error` unless `error-if-not-found?` is nil. [?? Unused. Remove?]"))
  
  
  (defgeneric find-edge (graph edge &optional error-if-not-found?)
    (:documentation "Search `graph` for an edge whose vertexes match `edge`. This means that `vertex-1` of the edge in the graph must match `vertex-1` of `edge` and so forth. Wil signal an error of type `graph-edge-not-found-error` unless `error-if-not-found?` is nil. [?? Unused. Remove?]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric find-edge-between-vertexes (graph value-or-vertex-1 value-or-vertex-2
                                                &key error-if-not-found?)
    (:documentation "Searches `graph` for an edge that connects vertex-1 and vertex-2.  [?? Ignores error-if-not-found? Does directedness matter? need test]"))
  
  
  (defgeneric find-edge-between-vertexes (graph value-or-vertex-1 value-or-vertex-2
                                                &key error-if-not-found?)
    (:documentation "Searches `graph` for an edge that connects vertex-1 and vertex-2.  [?? Ignores error-if-not-found? Does directedness matter? need test]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric source-vertex (edge)
    (:documentation "Returns the source-vertex of a directed edge. Compare with `vertex-1`."))
  
  
  (defgeneric source-vertex (edge)
    (:documentation "Returns the source-vertex of a directed edge. Compare with `vertex-1`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric target-vertex (edge)
    (:documentation "Returns the target-vertex of a directed edge. Compare with `vertex-2`."))
  
  
  (defgeneric target-vertex (edge)
    (:documentation "Returns the target-vertex of a directed edge. Compare with `vertex-2`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric iterate-edges (graph-or-vertex fn)
    (:documentation "Calls `fn` on each edge of graph or vertex."))
  
  
  (defgeneric iterate-edges (graph-or-vertex fn)
    (:documentation "Calls `fn` on each edge of graph or vertex."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric iterate-source-edges (vertex fn)
    (:documentation "In a directed graph, calls `fn` on each edge of a vertex that begins at vertex. In an undirected graph, this is equivalent to `iterate-edges`."))
  
  
  (defgeneric iterate-source-edges (vertex fn)
    (:documentation "In a directed graph, calls `fn` on each edge of a vertex that begins at vertex. In an undirected graph, this is equivalent to `iterate-edges`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric iterate-target-edges (vertex fn)
    (:documentation "In a directed graph, calls `fn` on each edge of a vertex that ends at vertex. In an undirected graph, this is equivalent to `iterate-edges`."))
  
  
  (defgeneric iterate-target-edges (vertex fn)
    (:documentation "In a directed graph, calls `fn` on each edge of a vertex that ends at vertex. In an undirected graph, this is equivalent to `iterate-edges`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric iterate-children (vertex fn)
    (:documentation "Calls fn on every vertex that is either connected to vertex by an undirected edge or is at the target end of a directed edge."))
  
  
  (defgeneric iterate-children (vertex fn)
    (:documentation "Calls fn on every vertex that is either connected to vertex by an undirected edge or is at the target end of a directed edge."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric has-children-p (vertex)
    (:documentation "In a directed graph, returns true if vertex has any edges that point from vertex to some other vertex (cf. iterate-target-edges). In an undirected graph, `has-children-p` is testing only whether or not the vertex has any edges."))
  
  
  (defgeneric has-children-p (vertex)
    (:documentation "In a directed graph, returns true if vertex has any edges that point from vertex to some other vertex (cf. iterate-target-edges). In an undirected graph, `has-children-p` is testing only whether or not the vertex has any edges."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric has-parent-p (vertex)
    (:documentation "In a directed graph, returns true if vertex has any edges that point from some other vertex to this vertex (cf. iterate-source-edges). In an undirected graph, `has-parent-p` is testing only whether or not the vertex has any edges."))
  
  
  (defgeneric has-parent-p (vertex)
    (:documentation "In a directed graph, returns true if vertex has any edges that point from some other vertex to this vertex (cf. iterate-source-edges). In an undirected graph, `has-parent-p` is testing only whether or not the vertex has any edges."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric iterate-parents (vertex fn)
    (:documentation "Calls fn on every vertex that is either connected to vertex by an undirected edge or is at the source end of a directed edge."))
  
  
  (defgeneric iterate-parents (vertex fn)
    (:documentation "Calls fn on every vertex that is either connected to vertex by an undirected edge or is at the source end of a directed edge."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric iterate-neighbors (vertex fn)
    (:documentation "Calls fn on every vertex adjecent to vertex See also iterate-children and iterate-parents."))
  
  
  (defgeneric iterate-neighbors (vertex fn)
    (:documentation "Calls fn on every vertex adjecent to vertex See also iterate-children and iterate-parents."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric renumber-vertexes (graph)
    (:documentation "Assign a number to each vertex in a graph in some unspecified order. [?? internal]"))
  
  
  (defgeneric renumber-vertexes (graph)
    (:documentation "Assign a number to each vertex in a graph in some unspecified order. [?? internal]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric renumber-edges (graph)
    (:documentation "Assign a number to each edge in a graph in some unspecified order. [?? internal]"))
  
  
  (defgeneric renumber-edges (graph)
    (:documentation "Assign a number to each edge in a graph in some unspecified order. [?? internal]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-directed-free-tree (graph root)
    (:documentation "Returns a version of graph which is a directed free tree
  rooted at root."))
  
  
  (defgeneric generate-directed-free-tree (graph root)
    (:documentation "Returns a version of graph which is a directed free tree
  rooted at root."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric in-undirected-cycle-p (graph start-vertex &optional marked previous)
    (:documentation "Return true if-and-only-if an undirected cycle in graph is reachable from start-vertex."))
  
  
  (defgeneric in-undirected-cycle-p (graph start-vertex &optional marked previous)
    (:documentation "Return true if-and-only-if an undirected cycle in graph is reachable from start-vertex."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric undirected-edge-p (edge)
    (:documentation "Returns true if-and-only-if edge is undirected"))
  
  
  (defgeneric undirected-edge-p (edge)
    (:documentation "Returns true if-and-only-if edge is undirected"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric directed-edge-p (edge)
    (:documentation "Returns true if-and-only-if edge is directed"))
  
  
  (defgeneric directed-edge-p (edge)
    (:documentation "Returns true if-and-only-if edge is directed"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric tagged-edge-p (edge)
    (:documentation "Returns true if-and-only-if edge's tag slot is t"))
  
  
  (defgeneric tagged-edge-p (edge)
    (:documentation "Returns true if-and-only-if edge's tag slot is t"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric untagged-edge-p (edge)
    (:documentation "Returns true if-and-only-if edge's tage slot is nil"))
            
  
  (defgeneric untagged-edge-p (edge)
    (:documentation "Returns true if-and-only-if edge's tage slot is nil"))
            
-;;; ---------------------------------------------------------------------------
  
  (defgeneric adjacentp (graph vertex-1 vertex-2)
    (:documentation "Return true if vertex-1 and vertex-2 are connected by an edge. [?? compare with vertices-share-edge-p and remove one or maybe call one directed-adjacentp]"))
  
  
  (defgeneric adjacentp (graph vertex-1 vertex-2)
    (:documentation "Return true if vertex-1 and vertex-2 are connected by an edge. [?? compare with vertices-share-edge-p and remove one or maybe call one directed-adjacentp]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric make-filtered-graph (old-graph test-fn &key
                                            graph-completion-method depth
  
  (defgeneric make-filtered-graph (old-graph test-fn &key
                                            graph-completion-method depth
@@ -240,14 +205,12 @@ one link away from the source).  The default value is NIL, indicating
  that all vertexes are to be included, no matter their depth.  This
  value is ignored in non closure options."))
  
  that all vertexes are to be included, no matter their depth.  This
  value is ignored in non closure options."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric project-bipartite-graph  
    (new-graph existing-graph vertex-class vertex-classifier)
    (:documentation "Creates the unimodal bipartite projects of existing-graph with
  vertexes for each vertex of existing graph whose `vertex-classifier` is eq to `vertex-class` and where an edge existing between two vertexes of the graph if and only if they are connected to a shared vertex in the existing-graph."))
  
  
  (defgeneric project-bipartite-graph  
    (new-graph existing-graph vertex-class vertex-classifier)
    (:documentation "Creates the unimodal bipartite projects of existing-graph with
  vertexes for each vertex of existing graph whose `vertex-classifier` is eq to `vertex-class` and where an edge existing between two vertexes of the graph if and only if they are connected to a shared vertex in the existing-graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric assortativity-coefficient (mixing-matrix)
    (:documentation "An assortative graph is one where vertexes of the same type are more likely to 
  
  (defgeneric assortativity-coefficient (mixing-matrix)
    (:documentation "An assortative graph is one where vertexes of the same type are more likely to 
@@ -256,7 +219,6 @@ assortative a graph is based on its mixing matrix. The definition we use is from
  Mixing Patterns in Networks by Mark Newman. See the citation 'newman200-mixing' in moab 
  or the URL 'http://arxiv.org/abs/cond-mat/0209450'."))
  
  Mixing Patterns in Networks by Mark Newman. See the citation 'newman200-mixing' in moab 
  or the URL 'http://arxiv.org/abs/cond-mat/0209450'."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric graph->dot (graph output
                         &key 
  
  (defgeneric graph->dot (graph output
                         &key 
@@ -296,34 +258,28 @@ Here is an example;
  For more information about DOT file format, search the web for 'DOTTY' and 
  'GRAPHVIZ'."))
  
  For more information about DOT file format, search the web for 'DOTTY' and 
  'GRAPHVIZ'."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric graph->dot-properties (g stream)
    (:documentation "Unless a different graph-formatter is specified, this method is called by graph->dot to output graph-properties onto a stream. The function can assume that the openning and closing brackets will be taken care of by the graph->dot."))
  
  
  (defgeneric graph->dot-properties (g stream)
    (:documentation "Unless a different graph-formatter is specified, this method is called by graph->dot to output graph-properties onto a stream. The function can assume that the openning and closing brackets will be taken care of by the graph->dot."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric vertex->dot (vertex stream)
    (:documentation "Unless a different vertex-formatter is specified with a keyword argument, this is used by graph->dot to output vertex formatting for `vertex` onto the `stream`. The function can assume that openning and closing square brackets and label have already been taken care of."))
  
  
  (defgeneric vertex->dot (vertex stream)
    (:documentation "Unless a different vertex-formatter is specified with a keyword argument, this is used by graph->dot to output vertex formatting for `vertex` onto the `stream`. The function can assume that openning and closing square brackets and label have already been taken care of."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric edge->dot (edge stream)
    (:documentation "Used by graph->dot to output edge formatting for `edge` onto the `stream`. The function can assume that openning and closing square brackets and label have already been taken care of."))
  
  
  (defgeneric edge->dot (edge stream)
    (:documentation "Used by graph->dot to output edge formatting for `edge` onto the `stream`. The function can assume that openning and closing square brackets and label have already been taken care of."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-gnm (generator graph n m &key)
    (:documentation "Generate a 'classic' random graph G(n, m) with n vertexes and m edges."))
  
  
  (defgeneric generate-gnm (generator graph n m &key)
    (:documentation "Generate a 'classic' random graph G(n, m) with n vertexes and m edges."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-gnp (generator graph n p &key)
    (:documentation  "Generate the Erd\"os-R\'enyi random graph G\(n, p\). I.e., a graph with n vertexes where
  each possible edge appears with probability p. This implementation is from Efficient Generation
  of Large Random Networks \(see batagelj-generation-2005 in doab\)."))
  
  
  (defgeneric generate-gnp (generator graph n p &key)
    (:documentation  "Generate the Erd\"os-R\'enyi random graph G\(n, p\). I.e., a graph with n vertexes where
  each possible edge appears with probability p. This implementation is from Efficient Generation
  of Large Random Networks \(see batagelj-generation-2005 in doab\)."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-undirected-graph-via-assortativity-matrix 
    (generator graph-class size edge-count kind-matrix assortativity-matrix
  
  (defgeneric generate-undirected-graph-via-assortativity-matrix 
    (generator graph-class size edge-count kind-matrix assortativity-matrix
@@ -335,7 +291,6 @@ The assortativity-matrix specifies the number of edges between vertexes of diffe
  
  The vertex-labeler is a function of two parameters: the vertex kind and the index. It should return whatever the 'value' of the vertex ought to be."))
  
  
  The vertex-labeler is a function of two parameters: the vertex kind and the index. It should return whatever the 'value' of the vertex ought to be."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-undirected-graph-via-vertex-probabilities 
    (generator graph-class size kind-matrix probability-matrix vertex-labeler)
  
  (defgeneric generate-undirected-graph-via-vertex-probabilities 
    (generator graph-class size kind-matrix probability-matrix vertex-labeler)
@@ -351,7 +306,6 @@ called to create values for vertexes. It will be called only once for each verte
  The clever sequential sampling technique in this implementation is from Efficient Generation
  of Large Random Networks \(see batagelj-generation-2005 in moab\)."))
  
  The clever sequential sampling technique in this implementation is from Efficient Generation
  of Large Random Networks \(see batagelj-generation-2005 in moab\)."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-scale-free-graph 
    (generator graph size kind-matrix add-edge-count
  
  (defgeneric generate-scale-free-graph 
    (generator graph size kind-matrix add-edge-count
@@ -364,7 +318,6 @@ add-edge-count is the number of edges to add for each vertex;
  other-vertex-kind-samplers are confusing...; and
  vertex-labeler is used to create vertex elements \(as in other generators\)."))
  
  other-vertex-kind-samplers are confusing...; and
  vertex-labeler is used to create vertex elements \(as in other generators\)."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-assortative-graph-with-degree-distributions
    (generator graph
  
  (defgeneric generate-assortative-graph-with-degree-distributions
    (generator graph
@@ -375,14 +328,12 @@ vertex-labeler is used to create vertex elements \(as in other generators\)."))
               &key)
    (:documentation ""))
  
               &key)
    (:documentation ""))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-simple-preferential-attachment-graph (generator graph size minimum-degree)
    (:documentation "Generate a simple scale-free graph using the preferential attachment
  mechanism of Barabasi and Albert. The implementation is from Efficient Generation
  of Large Random Networks \(see batagelj-generation-2005 in moab\). Self-edges are possible."))
  
  
  (defgeneric generate-simple-preferential-attachment-graph (generator graph size minimum-degree)
    (:documentation "Generate a simple scale-free graph using the preferential attachment
  mechanism of Barabasi and Albert. The implementation is from Efficient Generation
  of Large Random Networks \(see batagelj-generation-2005 in moab\). Self-edges are possible."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric generate-preferential-attachment-graph 
    (generator graph size kind-matrix minimum-degree 
  
  (defgeneric generate-preferential-attachment-graph 
    (generator graph size kind-matrix minimum-degree 
@@ -394,9 +345,7 @@ The idea behind this implementation is from Efficient Generation
  of Large Random Networks \(see batagelj-generation-2005 in moab\)."))
  
  
  of Large Random Networks \(see batagelj-generation-2005 in moab\)."))
  
  
-;;; ---------------------------------------------------------------------------
  ;;; more
  ;;; more
-;;; ---------------------------------------------------------------------------
  
  (defgeneric make-vertex-for-graph (graph &key &allow-other-keys)
    (:documentation "Creates a new vertex for graph `graph`. The keyword arguments include:
  
  (defgeneric make-vertex-for-graph (graph &key &allow-other-keys)
    (:documentation "Creates a new vertex for graph `graph`. The keyword arguments include:
@@ -406,49 +355,40 @@ of Large Random Networks \(see batagelj-generation-2005 in moab\)."))
  
  and any other initialization arguments that make sense for the vertex class."))
  
  
  and any other initialization arguments that make sense for the vertex class."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric tag-all-edges (thing)
    (:documentation "Sets the `tag` of all the edges of `thing` to true. [?? why does this exist?\]"))
  
  
  (defgeneric tag-all-edges (thing)
    (:documentation "Sets the `tag` of all the edges of `thing` to true. [?? why does this exist?\]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric untag-all-edges (thing)
    (:documentation "Sets the `tag` of all the edges of `thing` to nil.  [?? why does this exist?\]"))
  
  
  (defgeneric untag-all-edges (thing)
    (:documentation "Sets the `tag` of all the edges of `thing` to nil.  [?? why does this exist?\]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric untag-edges (edges)
    (:documentation "Sets the `tag` of all the edges of `thing` to true. [?? why does this exist?\]"))
  
  
  (defgeneric untag-edges (edges)
    (:documentation "Sets the `tag` of all the edges of `thing` to true. [?? why does this exist?\]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric tag-edges (edges)
    (:documentation "Sets the `tag` of all the edges of `thing` to true. [?? why does this exist?\]"))
  
  
  (defgeneric tag-edges (edges)
    (:documentation "Sets the `tag` of all the edges of `thing` to true. [?? why does this exist?\]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric replace-vertex (graph old new)
    (:documentation "Replace vertex `old` in graph `graph` with vertex `new`. The edge structure of the graph is maintained."))
  
  
  (defgeneric replace-vertex (graph old new)
    (:documentation "Replace vertex `old` in graph `graph` with vertex `new`. The edge structure of the graph is maintained."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric add-edge-to-vertex (edge vertex)
    (:documentation "Attaches the edge `edge` to the vertex `vertex`."))
  
  
  (defgeneric add-edge-to-vertex (edge vertex)
    (:documentation "Attaches the edge `edge` to the vertex `vertex`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric source-edges (vertex &optional filter)
    (:documentation "Returns a list of the source edges of `vertex`. I.e., 
  the edges that begin at `vertex`."))
  
  
  (defgeneric source-edges (vertex &optional filter)
    (:documentation "Returns a list of the source edges of `vertex`. I.e., 
  the edges that begin at `vertex`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric target-edges (vertex &optional filter)
    (:documentation "Returns a list of the target edges of `vertex`. 
  I.e., the edges that end at `vertex`."))
  
  
  (defgeneric target-edges (vertex &optional filter)
    (:documentation "Returns a list of the target edges of `vertex`. 
  I.e., the edges that end at `vertex`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric child-vertexes (vertex &optional filter)
    (:documentation "Returns a list of the vertexes to which `vertex` 
  
  (defgeneric child-vertexes (vertex &optional filter)
    (:documentation "Returns a list of the vertexes to which `vertex` 
@@ -456,92 +396,74 @@ is connected by an edge and for which `vertex` is the source vertex.
  If the connecting edge is undirected, then the vertex is always 
  counted as a source. [?? Could be a defun]."))
  
  If the connecting edge is undirected, then the vertex is always 
  counted as a source. [?? Could be a defun]."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric parent-vertexes (vertex &optional filter)
    (:documentation "Returns a list of the vertexes to which `vertex` is connected by an edge and for which `vertex` is the target vertex. If the connecting edge is undirected, then the vertex is always counted as a target. [?? Could be a defun]."))
  
  
  (defgeneric parent-vertexes (vertex &optional filter)
    (:documentation "Returns a list of the vertexes to which `vertex` is connected by an edge and for which `vertex` is the target vertex. If the connecting edge is undirected, then the vertex is always counted as a target. [?? Could be a defun]."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric neighbor-vertexes (vertex &optional filter)
    (:documentation "Returns a list of the vertexes to which `vertex` is connected by an edge disregarding edge direction. In a directed graph, neighbor-vertexes is the union of parent-vertexes and child-vertexes. [?? Could be a defun]."))
  
  
  (defgeneric neighbor-vertexes (vertex &optional filter)
    (:documentation "Returns a list of the vertexes to which `vertex` is connected by an edge disregarding edge direction. In a directed graph, neighbor-vertexes is the union of parent-vertexes and child-vertexes. [?? Could be a defun]."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric number-of-neighbors (vertex)
    (:documentation "Returns the number of neighbors of `vertex` (cf. `neighbor-vertexes`). [?? could be a defun]"))
  
  
  (defgeneric number-of-neighbors (vertex)
    (:documentation "Returns the number of neighbors of `vertex` (cf. `neighbor-vertexes`). [?? could be a defun]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric in-cycle-p (graph start-vertex)
    (:documentation "Returns true if `start-vertex` is in some cycle in `graph`. This uses child-vertexes to generate the vertexes adjacent to a vertex."))
  
  
  (defgeneric in-cycle-p (graph start-vertex)
    (:documentation "Returns true if `start-vertex` is in some cycle in `graph`. This uses child-vertexes to generate the vertexes adjacent to a vertex."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric iterate-vertexes (thing fn)
    (:documentation "Calls `fn` on each of the vertexes of `thing`."))
  
  
  (defgeneric iterate-vertexes (thing fn)
    (:documentation "Calls `fn` on each of the vertexes of `thing`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric edges (thing)
    (:documentation "Returns a list of the edges of `thing`."))
  
  
  (defgeneric edges (thing)
    (:documentation "Returns a list of the edges of `thing`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric vertex-count (graph)
    (:documentation "Returns the number of vertexes in `graph`. [?? could be a defun]"))
  
  
  (defgeneric vertex-count (graph)
    (:documentation "Returns the number of vertexes in `graph`. [?? could be a defun]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric vertexes (thing)
    (:documentation "Returns a list of the vertexes of `thing`."))
  
  
  (defgeneric vertexes (thing)
    (:documentation "Returns a list of the vertexes of `thing`."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric source-edge-count (vertex)
    (:documentation "Returns the number of source edges of vertex (cf. source-edges). [?? could be a defun]"))
  
  
  (defgeneric source-edge-count (vertex)
    (:documentation "Returns the number of source edges of vertex (cf. source-edges). [?? could be a defun]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric target-edge-count (vertex)
    (:documentation "Returns the number of target edges of vertex (cf. target-edges). [?? could be a defun]"))
  
  
  (defgeneric target-edge-count (vertex)
    (:documentation "Returns the number of target edges of vertex (cf. target-edges). [?? could be a defun]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric graph-roots (graph)
    (:documentation "Returns a list of the roots of graph. A root is defined as a vertex with no source edges \(i.e., all of the edges are out-going\). (cf. rootp) [?? could be a defun]"))
  
  
  (defgeneric graph-roots (graph)
    (:documentation "Returns a list of the roots of graph. A root is defined as a vertex with no source edges \(i.e., all of the edges are out-going\). (cf. rootp) [?? could be a defun]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric rootp (vertex)
    (:documentation "Returns true if `vertex` is a root vertex \(i.e., it has no incoming \(source\) edges\)."))
  
  
  (defgeneric rootp (vertex)
    (:documentation "Returns true if `vertex` is a root vertex \(i.e., it has no incoming \(source\) edges\)."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric find-vertex-if (thing predicate &key key)
    (:documentation "Returns the first vertex in `thing` for which the `predicate` function returns non-nil. If the `key` is supplied, then it is applied to the vertex before the predicate is."))
  
  
  (defgeneric find-vertex-if (thing predicate &key key)
    (:documentation "Returns the first vertex in `thing` for which the `predicate` function returns non-nil. If the `key` is supplied, then it is applied to the vertex before the predicate is."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric find-edge-if (graph fn &key key)
    (:documentation "Returns the first edge in `thing` for which the `predicate` function returns non-nil. If the `key` is supplied, then it is applied to the edge before the predicate is."))
  
  
  (defgeneric find-edge-if (graph fn &key key)
    (:documentation "Returns the first edge in `thing` for which the `predicate` function returns non-nil. If the `key` is supplied, then it is applied to the edge before the predicate is."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric find-edges-if (thing predicate)
    (:documentation "Returns a list of edges in `thing` for which the `predicate` returns non-nil. [?? why no key function?]"))
  
  
  (defgeneric find-edges-if (thing predicate)
    (:documentation "Returns a list of edges in `thing` for which the `predicate` returns non-nil. [?? why no key function?]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric find-vertexes-if (thing predicate)
    (:documentation "Returns a list of vertexes in `thing` for which the `predicate` returns non-nil. [?? why no key function?]"))
  
  
  (defgeneric find-vertexes-if (thing predicate)
    (:documentation "Returns a list of vertexes in `thing` for which the `predicate` returns non-nil. [?? why no key function?]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric force-undirected (graph)
    (:documentation "Ensures that the graph is undirected (possibly by calling change-class on the edges)."))
  
  
  (defgeneric force-undirected (graph)
    (:documentation "Ensures that the graph is undirected (possibly by calling change-class on the edges)."))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric traverse-elements (thing style fn)
    (:documentation "WIP"))
  
  (defgeneric traverse-elements (thing style fn)
    (:documentation "WIP"))
@@ -667,7 +589,6 @@ counted as a source. [?? Could be a defun]."))
  (defgeneric subgraph-containing (graph vertex &key)
    (:documentation "Returns a new graph that is a subset of `graph` that contains `vertex` and all of the other vertexes that can be reached from vertex by paths of less than or equal of length `depth`. If depth is not specified, then the entire sub-graph reachable from vertex will be returned. [?? Edge weights are always assumed to be one.]"))
  
  (defgeneric subgraph-containing (graph vertex &key)
    (:documentation "Returns a new graph that is a subset of `graph` that contains `vertex` and all of the other vertexes that can be reached from vertex by paths of less than or equal of length `depth`. If depth is not specified, then the entire sub-graph reachable from vertex will be returned. [?? Edge weights are always assumed to be one.]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defgeneric weight (edge)
    (:documentation "Returns the weight of an edge. This defaults to 1.0 and can only be altered if the edge is a sub-class of `weighted-edge-mixin`."))
  
  (defgeneric weight (edge)
    (:documentation "Returns the weight of an edge. This defaults to 1.0 and can only be altered if the edge is a sub-class of `weighted-edge-mixin`."))
diff --git a/dev/graph-algorithms.lisp b/dev/graph-algorithms.lisp

index 3280fff..30cac2d 100644 (file)
--- a/dev/graph-algorithms.lisp
+++ b/dev/graph-algorithms.lisp
@@ -1,15 +1,12 @@
  (in-package #:metabang.graph)
  
  (in-package #:metabang.graph)
  
-;;; ---------------------------------------------------------------------------
  ;;;
  ;;;
-;;; ---------------------------------------------------------------------------
  
  (defstruct (vertex-datum (:conc-name node-) (:type list))
    (color nil)
    (depth most-positive-fixnum)
    (parent nil))
  
  
  (defstruct (vertex-datum (:conc-name node-) (:type list))
    (color nil)
    (depth most-positive-fixnum)
    (parent nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-vertex-data ((graph basic-graph))
    (let ((vertex-data (make-container 'simple-associative-container)))
  
  (defmethod initialize-vertex-data ((graph basic-graph))
    (let ((vertex-data (make-container 'simple-associative-container)))
@@ -18,14 +15,11 @@
                                      (make-vertex-datum :color :white))))
      (values vertex-data)))
    
                                      (make-vertex-datum :color :white))))
      (values vertex-data)))
    
-;;; ---------------------------------------------------------------------------
  ;;; breadth-first-search by GWK
  ;;; breadth-first-search by GWK
-;;; ---------------------------------------------------------------------------
  
  (defmethod breadth-first-visitor ((graph basic-graph) (source t) fn)
    (breadth-first-visitor graph (find-vertex graph source) fn))
  
  
  (defmethod breadth-first-visitor ((graph basic-graph) (source t) fn)
    (breadth-first-visitor graph (find-vertex graph source) fn))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod breadth-first-visitor ((graph basic-graph) (source basic-vertex) fn)
    ;; initialize
  
  (defmethod breadth-first-visitor ((graph basic-graph) (source basic-vertex) fn)
    ;; initialize
@@ -57,12 +51,10 @@
        
        vertex-data)))
  
        
        vertex-data)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod breadth-first-search-graph ((graph basic-graph) (source t))
    (breadth-first-search-graph graph (find-vertex graph source)))
  
  
  (defmethod breadth-first-search-graph ((graph basic-graph) (source t))
    (breadth-first-search-graph graph (find-vertex graph source)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod breadth-first-search-graph ((graph basic-graph) (source basic-vertex))
    ;; initialize
  
  (defmethod breadth-first-search-graph ((graph basic-graph) (source basic-vertex))
    ;; initialize
@@ -93,9 +85,7 @@
        
        vertex-data)))
      
        
        vertex-data)))
      
-;;; ---------------------------------------------------------------------------
  ;;; single-source-shortest-paths - gwk
  ;;; single-source-shortest-paths - gwk
-;;; ---------------------------------------------------------------------------
  
  #+NotYet
  (defmethod single-source-shortest-paths ((graph basic-graph))
  
  #+NotYet
  (defmethod single-source-shortest-paths ((graph basic-graph))
@@ -105,9 +95,7 @@
        (setf (node-depth source-datum) 0))
      ))
  
        (setf (node-depth source-datum) 0))
      ))
  
-;;; ---------------------------------------------------------------------------
  ;;; connected-components - gwk
  ;;; connected-components - gwk
-;;; ---------------------------------------------------------------------------
  
  (defmethod connected-components ((graph basic-graph))
    (let ((union (make-container 'union-find-container)))
  
  (defmethod connected-components ((graph basic-graph))
    (let ((union (make-container 'union-find-container)))
@@ -124,7 +112,6 @@
      (iterate-elements union 'find-set)
      union))
  
      (iterate-elements union 'find-set)
      union))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod connected-component-count ((graph basic-graph))
    ;;?? Gary King 2005-11-28: Super ugh
  
  (defmethod connected-component-count ((graph basic-graph))
    ;;?? Gary King 2005-11-28: Super ugh
@@ -168,9 +155,7 @@
  
  
           
  
  
           
-;;; ---------------------------------------------------------------------------
  ;;; minimum-spanning-tree based on kruskal's algorithm detailed in clrs2 -jjm
  ;;; minimum-spanning-tree based on kruskal's algorithm detailed in clrs2 -jjm
-;;; ---------------------------------------------------------------------------
  
  (defmethod mst-find-set ((vertex basic-vertex))
    #+ignore
  
  (defmethod mst-find-set ((vertex basic-vertex))
    #+ignore
@@ -180,18 +165,15 @@
      (setf (previous-node vertex) (mst-find-set (previous-node vertex))))
    (previous-node vertex))
  
      (setf (previous-node vertex) (mst-find-set (previous-node vertex))))
    (previous-node vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod mst-make-set ((vertex basic-vertex))
    (setf (previous-node vertex) vertex
          (rank vertex) 0))
  
  
  (defmethod mst-make-set ((vertex basic-vertex))
    (setf (previous-node vertex) vertex
          (rank vertex) 0))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod mst-tree-union ((v1 basic-vertex) (v2 basic-vertex))
    (mst-link (mst-find-set v1) (mst-find-set v2)))
  
  
  (defmethod mst-tree-union ((v1 basic-vertex) (v2 basic-vertex))
    (mst-link (mst-find-set v1) (mst-find-set v2)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod mst-link ((v1 basic-vertex) (v2 basic-vertex))
    (cond ((> (rank v1) (rank v2))
  
  (defmethod mst-link ((v1 basic-vertex) (v2 basic-vertex))
    (cond ((> (rank v1) (rank v2))
@@ -200,11 +182,9 @@
             (when (= (rank v1) (rank v2))
               (incf (rank v2))))))
  
             (when (= (rank v1) (rank v2))
               (incf (rank v2))))))
  
-;;; ---------------------------------------------------------------------------
  ;;; jjm's implementation of mst depends on this
  ;;; todo - figure out some what to add and edge we create to a graph rather
  ;;; than always using add-edge-between-vertexes interface
  ;;; jjm's implementation of mst depends on this
  ;;; todo - figure out some what to add and edge we create to a graph rather
  ;;; than always using add-edge-between-vertexes interface
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-edges-to-graph ((graph basic-graph) (edges list) 
                                 &key (if-duplicate-do :ignore))
  
  (defmethod add-edges-to-graph ((graph basic-graph) (edges list) 
                                 &key (if-duplicate-do :ignore))
@@ -227,14 +207,11 @@
          :if-duplicate-do if-duplicate-do))))
    graph)
  
          :if-duplicate-do if-duplicate-do))))
    graph)
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod edge-lessp-by-weight ((e1 basic-edge) (e2 basic-edge))
    (< (weight e1) (weight e2)))
  
  
  (defmethod edge-lessp-by-weight ((e1 basic-edge) (e2 basic-edge))
    (< (weight e1) (weight e2)))
  
-;;; ---------------------------------------------------------------------------
  ;;; minumum spanning tree
  ;;; minumum spanning tree
-;;; ---------------------------------------------------------------------------
  
  
  (defmethod minimum-spanning-tree ((graph basic-graph) 
  
  
  (defmethod minimum-spanning-tree ((graph basic-graph) 
@@ -260,7 +237,6 @@
                    (values t result))
                   (t (values nil result)))))))
  
                    (values t result))
                   (t (values nil result)))))))
  
-;;; ---------------------------------------------------------------------------
  
  #+ignore ;;; shoot
  (defmethod minimum-spanning-tree ((vertex-list list) 
  
  #+ignore ;;; shoot
  (defmethod minimum-spanning-tree ((vertex-list list) 
@@ -296,16 +272,13 @@
                    (values t result))
                   (t (values nil result)))))))
  
                    (values t result))
                   (t (values nil result)))))))
  
-;;; ---------------------------------------------------------------------------
  ;;; uses mst to determine if the graph is connected
  ;;; uses mst to determine if the graph is connected
-;;; ---------------------------------------------------------------------------
  
  (defmethod connected-graph-p ((graph basic-graph) &key 
                                (edge-sorter 'edge-lessp-by-weight))
    (minimum-spanning-tree graph :edge-sorter edge-sorter))
  
    
  
  (defmethod connected-graph-p ((graph basic-graph) &key 
                                (edge-sorter 'edge-lessp-by-weight))
    (minimum-spanning-tree graph :edge-sorter edge-sorter))
  
    
-;;; ---------------------------------------------------------------------------
  
  #+test
  (let ((g (make-container 'graph-container)))
  
  #+test
  (let ((g (make-container 'graph-container)))
@@ -320,11 +293,9 @@
                               :if-duplicate-do :force)
    (minimum-spanning-tree g))
  
                               :if-duplicate-do :force)
    (minimum-spanning-tree g))
  
-;;; ---------------------------------------------------------------------------
  ;;; GWK's implementation of kruskal's - slightly faster, but it doesn't return 
  ;;; a tree (still faster even if it does).  Will decide later if which to use
  ;;; ignoring for now -jjm
  ;;; GWK's implementation of kruskal's - slightly faster, but it doesn't return 
  ;;; a tree (still faster even if it does).  Will decide later if which to use
  ;;; ignoring for now -jjm
-;;; ---------------------------------------------------------------------------
  
  #+not-yet
  (defmethod minimum-spanning-tree ((graph basic-graph) &key (weight 'weight))
  
  #+not-yet
  (defmethod minimum-spanning-tree ((graph basic-graph) &key (weight 'weight))
@@ -342,7 +313,6 @@
      
      (values a)))
  
      
      (values a)))
  
-;;; ---------------------------------------------------------------------------
  
  #+test
  (loop for f in '(mst-kruskal minimum-spanning-tree-kruskal) do
  
  #+test
  (loop for f in '(mst-kruskal minimum-spanning-tree-kruskal) do
@@ -361,26 +331,18 @@
                                         (declare (ignore a b))
                                         0)))))))
  
                                         (declare (ignore a b))
                                         0)))))))
  
-;;; ---------------------------------------------------------------------------
  ;;; end minimum spanning tree
  ;;; end minimum spanning tree
-;;; ---------------------------------------------------------------------------
  
      
  
      
-;;; ---------------------------------------------------------------------------
  ;;; depth-first-search - clrs2
  ;;; todo - figure out how to name this depth-first-search, which is already
  ;;; defined in search.lisp
  ;;; depth-first-search - clrs2
  ;;; todo - figure out how to name this depth-first-search, which is already
  ;;; defined in search.lisp
-;;; ---------------------------------------------------------------------------
  
  
-;;; ---------------------------------------------------------------------------
  ;;; should probably make this special
  ;;; should probably make this special
-;;; ---------------------------------------------------------------------------
  
  (defparameter *depth-first-search-timer* -1)
  
  
  (defparameter *depth-first-search-timer* -1)
  
-;;; ---------------------------------------------------------------------------
  ;;; undirected edges are less than edges that are directed
  ;;; undirected edges are less than edges that are directed
-;;; ---------------------------------------------------------------------------
  
  #+ignore ;;; incorrect, methinks - jjm
  (defmethod edge-lessp-by-direction ((e1 basic-edge) (e2 basic-edge))
  
  #+ignore ;;; incorrect, methinks - jjm
  (defmethod edge-lessp-by-direction ((e1 basic-edge) (e2 basic-edge))
@@ -394,7 +356,6 @@
  (defmethod edge-lessp-by-direction ((e1 basic-edge) (e2 basic-edge))
    (and (undirected-edge-p e1) (directed-edge-p e2)))
  
  (defmethod edge-lessp-by-direction ((e1 basic-edge) (e2 basic-edge))
    (and (undirected-edge-p e1) (directed-edge-p e2)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod out-edge-for-vertex-p ((edge basic-edge) (vertex basic-vertex))
    (cond ((and (directed-edge-p edge)
  
  (defmethod out-edge-for-vertex-p ((edge basic-edge) (vertex basic-vertex))
    (cond ((and (directed-edge-p edge)
@@ -406,15 +367,12 @@
           t)
          (t nil)))
  
           t)
          (t nil)))
  
-;;; ---------------------------------------------------------------------------
  ;;; depth-first-search
  ;;; depth-first-search
-;;; ---------------------------------------------------------------------------
                                                    
  (defmethod dfs ((graph basic-graph) (root t) fn &key 
                  (out-edge-sorter #'edge-lessp-by-direction))
    (dfs graph (find-vertex graph root) fn :out-edge-sorter out-edge-sorter))
  
                                                    
  (defmethod dfs ((graph basic-graph) (root t) fn &key 
                  (out-edge-sorter #'edge-lessp-by-direction))
    (dfs graph (find-vertex graph root) fn :out-edge-sorter out-edge-sorter))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod dfs ((graph basic-graph) (root basic-vertex) fn &key
                  (out-edge-sorter #'edge-lessp-by-direction))
  
  (defmethod dfs ((graph basic-graph) (root basic-vertex) fn &key
                  (out-edge-sorter #'edge-lessp-by-direction))
@@ -442,7 +400,6 @@
     (sort (copy-list (vertexes graph)) #'< :key #'finish-time)
     graph))
  
     (sort (copy-list (vertexes graph)) #'< :key #'finish-time)
     graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod dfs-visit ((graph graph-container) (u basic-vertex)
                                       fn sorter)
  
  (defmethod dfs-visit ((graph graph-container) (u basic-vertex)
                                       fn sorter)
@@ -472,9 +429,7 @@
    (setf (color u) :black
          (finish-time u) *depth-first-search-timer*))
  
    (setf (color u) :black
          (finish-time u) *depth-first-search-timer*))
  
-;;; ---------------------------------------------------------------------------
  ;;; from clrs2
  ;;; from clrs2
-;;; ---------------------------------------------------------------------------
  
  #+test
  (let ((g (make-container 'graph-container)))
  
  #+test
  (let ((g (make-container 'graph-container)))
@@ -490,19 +445,15 @@
    (assert (equal '(:X :Y :V :U :Z :W)
                   (mapcar #'element (dfs g :u #'identity)))))
  
    (assert (equal '(:X :Y :V :U :Z :W)
                   (mapcar #'element (dfs g :u #'identity)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod dfs-tree-edge-p ((edge graph-container-edge))
    (eql (color edge) :white))
  
  
  (defmethod dfs-tree-edge-p ((edge graph-container-edge))
    (eql (color edge) :white))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod dfs-back-edge-p ((edge graph-container-edge))
    (eql (color edge) :gray))
  
  
  (defmethod dfs-back-edge-p ((edge graph-container-edge))
    (eql (color edge) :gray))
  
-;;; ---------------------------------------------------------------------------
  ;;; not correct - has to look at combination of discovery-time and finish-time
  ;;; not correct - has to look at combination of discovery-time and finish-time
-;;; ---------------------------------------------------------------------------
  
  (defmethod dfs-forward-edge-p ((edge graph-container-edge))
    (warn "implementation is not correct.")
  
  (defmethod dfs-forward-edge-p ((edge graph-container-edge))
    (warn "implementation is not correct.")
@@ -511,9 +462,7 @@
      (< (discovery-time (source-vertex edge))
         (discovery-time (target-vertex edge)))))
  
      (< (discovery-time (source-vertex edge))
         (discovery-time (target-vertex edge)))))
  
-;;; ---------------------------------------------------------------------------
  ;;; not correct - has to look at combination of discovery-time and finish-time
  ;;; not correct - has to look at combination of discovery-time and finish-time
-;;; ---------------------------------------------------------------------------
  
  (defmethod dfs-cross-edge-p ((edge graph-container-edge))
    (warn "implementation is not correct.")
  
  (defmethod dfs-cross-edge-p ((edge graph-container-edge))
    (warn "implementation is not correct.")
@@ -522,7 +471,6 @@
      (> (discovery-time (source-vertex edge))
         (discovery-time (target-vertex edge)))))
  
      (> (discovery-time (source-vertex edge))
         (discovery-time (target-vertex edge)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod dfs-edge-type ((edge graph-container-edge))
    (cond ((dfs-tree-edge-p edge)
  
  (defmethod dfs-edge-type ((edge graph-container-edge))
    (cond ((dfs-tree-edge-p edge)
@@ -535,17 +483,11 @@
           :cross)
          (t nil)))
  
           :cross)
          (t nil)))
  
-;;; ---------------------------------------------------------------------------
  ;;; end dfs
  ;;; end dfs
-;;; ---------------------------------------------------------------------------
  
  
-;;; ---------------------------------------------------------------------------
  ;;; mapping functions
  ;;; mapping functions
-;;; ---------------------------------------------------------------------------
  
  
-;;; ---------------------------------------------------------------------------
  ;;; over vertexes
  ;;; over vertexes
-;;; ---------------------------------------------------------------------------
  
  (defmethod map-over-all-combinations-of-k-vertexes ((graph basic-graph) k fn)
    (let* ((vertex-count (size graph))
  
  (defmethod map-over-all-combinations-of-k-vertexes ((graph basic-graph) k fn)
    (let* ((vertex-count (size graph))
@@ -559,7 +501,6 @@
                                 (nth-element vertexes vertex-index))
                               vertex-indexes)))))))
  
                                 (nth-element vertexes vertex-index))
                               vertex-indexes)))))))
  
-;;; ---------------------------------------------------------------------------
  
  #+test
  (let ((result nil)
  
  #+test
  (let ((result nil)
@@ -581,10 +522,8 @@
           (push graph-from-vertexes result)))))
    result)
  
           (push graph-from-vertexes result)))))
    result)
  
-;;; ---------------------------------------------------------------------------
  ;;; over edges 
  ;;; todo: merge these two defs
  ;;; over edges 
  ;;; todo: merge these two defs
-;;; ---------------------------------------------------------------------------
  
  (defmethod map-over-all-combinations-of-k-edges ((graph basic-graph) k fn)
    (let* ((edge-count (edge-count graph))
  
  (defmethod map-over-all-combinations-of-k-edges ((graph basic-graph) k fn)
    (let* ((edge-count (edge-count graph))
@@ -599,7 +538,6 @@
                                 (nth-element edges edge-index))
                               edge-indexes)))))))
  
                                 (nth-element edges edge-index))
                               edge-indexes)))))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod map-over-all-combinations-of-k-edges ((vertex basic-vertex) k fn)
    (let* ((edge-count (edge-count vertex))
  
  (defmethod map-over-all-combinations-of-k-edges ((vertex basic-vertex) k fn)
    (let* ((edge-count (edge-count vertex))
@@ -613,7 +551,6 @@
           (funcall fn (mapcar (lambda (edge-index)
                                 (nth-element edges edge-index))
                               edge-indexes)))))))
           (funcall fn (mapcar (lambda (edge-index)
                                 (nth-element edges edge-index))
                               edge-indexes)))))))
-;;; ---------------------------------------------------------------------------
  
  #+test
  (map-over-all-combinations-of-k-edges 
  
  #+test
  (map-over-all-combinations-of-k-edges 
diff --git a/dev/graph-container.lisp b/dev/graph-container.lisp

index 1e24d33..58ce70f 100644 (file)
--- a/dev/graph-container.lisp
+++ b/dev/graph-container.lisp
@@ -11,9 +11,7 @@ DISCUSSION
  
  (in-package #:metabang.graph)
  
  
  (in-package #:metabang.graph)
  
-;;; ---------------------------------------------------------------------------
  ;;; class defs
  ;;; class defs
-;;; ---------------------------------------------------------------------------
  
  (defclass* graph-container (iteratable-container-mixin
                              non-associative-container-mixin
  
  (defclass* graph-container (iteratable-container-mixin
                              non-associative-container-mixin
@@ -29,7 +27,6 @@ DISCUSSION
    (:export-p t)
    (:documentation "A graph container is essentially an adjacency list graph representation [?? The Bad name comes from it being implemented with containers... ugh]"))
  
    (:export-p t)
    (:documentation "A graph container is essentially an adjacency list graph representation [?? The Bad name comes from it being implemented with containers... ugh]"))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* graph-container-edge (basic-edge)
    ((vertex-1 nil ir "`Vertex-1` is one of the two vertexes that an edge connects. In a directed-edge, `vertex-1` is also the `source-edge`.")
  
  (defclass* graph-container-edge (basic-edge)
    ((vertex-1 nil ir "`Vertex-1` is one of the two vertexes that an edge connects. In a directed-edge, `vertex-1` is also the `source-edge`.")
@@ -38,21 +35,18 @@ DISCUSSION
    (:export-p t)
    (:documentation "This is the root class for edges in graph-containers. It adds vertex-1 and vertex-2 slots."))
  
    (:export-p t)
    (:documentation "This is the root class for edges in graph-containers. It adds vertex-1 and vertex-2 slots."))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod print-object ((object graph-container-edge) stream)
    (print-unreadable-object (object stream :type t) 
      (format stream "<~A ~A ~A>" (vertex-1 object) (vertex-2 object) 
              (value object))))
  
  
  (defmethod print-object ((object graph-container-edge) stream)
    (print-unreadable-object (object stream :type t) 
      (format stream "<~A ~A ~A>" (vertex-1 object) (vertex-2 object) 
              (value object))))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* weighted-edge (weighted-edge-mixin graph-container-edge)
    ()
    (:export-p t)
    (:documentation "A weighted edge is both a weighted-edge-mixin and a graph-container-edge."))
  
  
  (defclass* weighted-edge (weighted-edge-mixin graph-container-edge)
    ()
    (:export-p t)
    (:documentation "A weighted edge is both a weighted-edge-mixin and a graph-container-edge."))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* graph-container-vertex (basic-vertex)
    ((vertex-edges nil r))
  
  (defclass* graph-container-vertex (basic-vertex)
    ((vertex-edges nil r))
@@ -61,36 +55,30 @@ DISCUSSION
      :vertex-edges-container-class 'vector-container)
    (:documentation "A graph container vertex keeps track of its edges in the the vertex-edges slot. The storage for this defaults to a vector-container but can be changed using the vertex-edges-container-class initarg."))
  
      :vertex-edges-container-class 'vector-container)
    (:documentation "A graph container vertex keeps track of its edges in the the vertex-edges slot. The storage for this defaults to a vector-container but can be changed using the vertex-edges-container-class initarg."))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-vertex-edges-container ((vertex graph-container-vertex) 
                                          container-class &rest args)
    (apply #'make-container container-class args))
  
  
  (defmethod make-vertex-edges-container ((vertex graph-container-vertex) 
                                          container-class &rest args)
    (apply #'make-container container-class args))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object graph-container-vertex) &key
                                         vertex-edges-container-class)
    (setf (slot-value object 'vertex-edges)
          (make-vertex-edges-container object vertex-edges-container-class)))
  
  
  (defmethod initialize-instance :after ((object graph-container-vertex) &key
                                         vertex-edges-container-class)
    (setf (slot-value object 'vertex-edges)
          (make-vertex-edges-container object vertex-edges-container-class)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-vertex-container ((graph graph-container) initial-size) 
    (make-container 'simple-associative-container
                    :initial-size initial-size
                    :test (vertex-test graph)))
  
  
  (defmethod make-vertex-container ((graph graph-container) initial-size) 
    (make-container 'simple-associative-container
                    :initial-size initial-size
                    :test (vertex-test graph)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-edge-container ((graph graph-container) initial-size) 
    (make-container 'vector-container :initial-size initial-size
                    :fill-pointer 0))
  
  
  
  (defmethod make-edge-container ((graph graph-container) initial-size) 
    (make-container 'vector-container :initial-size initial-size
                    :fill-pointer 0))
  
  
-;;; ---------------------------------------------------------------------------
  ;;; graph-container-directed-edge
  ;;; graph-container-directed-edge
-;;; ---------------------------------------------------------------------------
  
  (defclass* graph-container-directed-edge (directed-edge-mixin 
                                            graph-container-edge)
  
  (defclass* graph-container-directed-edge (directed-edge-mixin 
                                            graph-container-edge)
@@ -98,7 +86,6 @@ DISCUSSION
    (:export-p t)
    (:documentation "A graph-container-directed-edge is both a directed-edge-mixin and a graph-container-edge."))
  
    (:export-p t)
    (:documentation "A graph-container-directed-edge is both a directed-edge-mixin and a graph-container-edge."))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object graph-container-directed-edge)
                                         &key source-vertex target-vertex)
  
  (defmethod initialize-instance :after ((object graph-container-directed-edge)
                                         &key source-vertex target-vertex)
@@ -111,21 +98,16 @@ DISCUSSION
    (when target-vertex
      (setf (slot-value object 'vertex-2) target-vertex)))
  
    (when target-vertex
      (setf (slot-value object 'vertex-2) target-vertex)))
  
-;;; ---------------------------------------------------------------------------
  ;;; vertex-1 is defined to be the source vertex of an undirected edge
  ;;; vertex-1 is defined to be the source vertex of an undirected edge
-;;; ---------------------------------------------------------------------------
  
  (defmethod source-vertex ((edge graph-container-edge))
    (vertex-1 edge))
  
  
  (defmethod source-vertex ((edge graph-container-edge))
    (vertex-1 edge))
  
-;;; ---------------------------------------------------------------------------
  ;;; vertex-2 is defined to be the target vertex of an undirected edge
  ;;; vertex-2 is defined to be the target vertex of an undirected edge
-;;; ---------------------------------------------------------------------------
  
  (defmethod target-vertex ((edge graph-container-edge))
    (vertex-2 edge))
  
  
  (defmethod target-vertex ((edge graph-container-edge))
    (vertex-2 edge))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod other-vertex ((edge graph-container-edge) 
                           (v graph-container-vertex))
  
  (defmethod other-vertex ((edge graph-container-edge) 
                           (v graph-container-vertex))
@@ -137,13 +119,11 @@ DISCUSSION
          
          (t (error "Vertex ~A not part of Edge ~A" v edge))))
  
          
          (t (error "Vertex ~A not part of Edge ~A" v edge))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod other-vertex ((edge graph-container-edge) 
                           (value t))
    (other-vertex edge (find-vertex edge value)))
  
  
  (defmethod other-vertex ((edge graph-container-edge) 
                           (value t))
    (other-vertex edge (find-vertex edge value)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-edge ((graph graph-container) (edge graph-container-edge)
                       &key force-new?)
  
  (defmethod add-edge ((graph graph-container) (edge graph-container-edge)
                       &key force-new?)
@@ -160,18 +140,15 @@ DISCUSSION
      (push edge (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2))))
    edge)
  
      (push edge (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2))))
    edge)
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-edge-to-vertex :around ((edge graph-container-edge) 
                                         (vertex graph-container-vertex))
    (insert-item (vertex-edges vertex) edge))
  
  
  (defmethod add-edge-to-vertex :around ((edge graph-container-edge) 
                                         (vertex graph-container-vertex))
    (insert-item (vertex-edges vertex) edge))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-node-for-container ((graph graph-container) (node t) &key)
    (make-vertex-for-graph graph :element node))
  
  
  (defmethod make-node-for-container ((graph graph-container) (node t) &key)
    (make-vertex-for-graph graph :element node))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-edge-between-vertexes ((graph graph-container) 
                                         (vertex-1 graph-container-vertex) 
  
  (defmethod find-edge-between-vertexes ((graph graph-container) 
                                         (vertex-1 graph-container-vertex) 
@@ -186,7 +163,6 @@ DISCUSSION
               :vertex-1 vertex-1 :vertex-2 vertex-1))
      (first value)))
  
               :vertex-1 vertex-1 :vertex-2 vertex-1))
      (first value)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-edge-between-vertexes-if ((graph graph-container) 
                                            (vertex-1 graph-container-vertex) 
  
  (defmethod find-edge-between-vertexes-if ((graph graph-container) 
                                            (vertex-1 graph-container-vertex) 
@@ -202,7 +178,6 @@ DISCUSSION
               :vertex-1 vertex-1 :vertex-2 vertex-1))
      it))    
  
               :vertex-1 vertex-1 :vertex-2 vertex-1))
      it))    
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-edge-between-vertexes-if ((graph graph-container) 
                                            (value-1 t) 
  
  (defmethod find-edge-between-vertexes-if ((graph graph-container) 
                                            (value-1 t) 
@@ -215,7 +190,6 @@ DISCUSSION
         (when error-if-not-found?
           (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2)))))
  
         (when error-if-not-found?
           (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-edge ((graph graph-container) (edge graph-container-edge)
                        &optional error-if-not-found?)
  
  (defmethod find-edge ((graph graph-container) (edge graph-container-edge)
                        &optional error-if-not-found?)
@@ -223,7 +197,6 @@ DISCUSSION
     graph (vertex-1 edge) (vertex-2 edge)
     :error-if-not-found? error-if-not-found?))
  
     graph (vertex-1 edge) (vertex-2 edge)
     :error-if-not-found? error-if-not-found?))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod delete-edge ((graph graph-container) (edge graph-container-edge))
    (let ((vertex-1 (vertex-1 edge))
  
  (defmethod delete-edge ((graph graph-container) (edge graph-container-edge))
    (let ((vertex-1 (vertex-1 edge))
@@ -244,25 +217,20 @@ DISCUSSION
    (empty! (vertex-pair->edge graph))
    graph)
  
    (empty! (vertex-pair->edge graph))
    graph)
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod empty! :after ((graph graph-container))
    (empty! (vertex-pair->edge graph)))
  
  
  
  (defmethod empty! :after ((graph graph-container))
    (empty! (vertex-pair->edge graph)))
  
  
-;;; ---------------------------------------------------------------------------
  ;;; iteration
  ;;; iteration
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-edges ((graph graph-container) fn)
    (iterate-elements (graph-edges graph) fn))
  
  
  (defmethod iterate-edges ((graph graph-container) fn)
    (iterate-elements (graph-edges graph) fn))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-edges ((vertex graph-container-vertex) fn)
    (iterate-elements (vertex-edges vertex) fn))
  
  
  (defmethod iterate-edges ((vertex graph-container-vertex) fn)
    (iterate-elements (vertex-edges vertex) fn))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-source-edges ((vertex graph-container-vertex) fn)
    (iterate-elements (vertex-edges vertex)
  
  (defmethod iterate-source-edges ((vertex graph-container-vertex) fn)
    (iterate-elements (vertex-edges vertex)
@@ -271,7 +239,6 @@ DISCUSSION
                                  (eq vertex (source-vertex edge)))
                          (funcall fn edge)))))
  
                                  (eq vertex (source-vertex edge)))
                          (funcall fn edge)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-target-edges ((vertex graph-container-vertex) fn)
    (iterate-elements (vertex-edges vertex)
  
  (defmethod iterate-target-edges ((vertex graph-container-vertex) fn)
    (iterate-elements (vertex-edges vertex)
@@ -280,33 +247,28 @@ DISCUSSION
                                  (eq vertex (target-vertex edge)))
                          (funcall fn edge)))))
  
                                  (eq vertex (target-vertex edge)))
                          (funcall fn edge)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-children ((vertex graph-container-vertex) fn)
    (iterate-source-edges vertex
                          (lambda (edge)
                            (funcall fn (other-vertex edge vertex)))))
  
  
  (defmethod iterate-children ((vertex graph-container-vertex) fn)
    (iterate-source-edges vertex
                          (lambda (edge)
                            (funcall fn (other-vertex edge vertex)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-parents ((vertex graph-container-vertex) fn)
    (iterate-target-edges vertex
                          (lambda (edge)
                            (funcall fn (other-vertex edge vertex)))))
  
  
  (defmethod iterate-parents ((vertex graph-container-vertex) fn)
    (iterate-target-edges vertex
                          (lambda (edge)
                            (funcall fn (other-vertex edge vertex)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-neighbors ((vertex graph-container-vertex) fn)
    (iterate-edges vertex
                   (lambda (edge)
                     (funcall fn (other-vertex edge vertex)))))
  
  
  (defmethod iterate-neighbors ((vertex graph-container-vertex) fn)
    (iterate-edges vertex
                   (lambda (edge)
                     (funcall fn (other-vertex edge vertex)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod vertexes ((edge graph-container-edge))
    (collect-using #'iterate-vertexes nil edge))
  
  
  (defmethod vertexes ((edge graph-container-edge))
    (collect-using #'iterate-vertexes nil edge))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod has-children-p ((vertex graph-container-vertex))
    (iterate-target-edges vertex
  
  (defmethod has-children-p ((vertex graph-container-vertex))
    (iterate-target-edges vertex
@@ -315,7 +277,6 @@ DISCUSSION
                            (return-from has-children-p t)))
    (values nil))
  
                            (return-from has-children-p t)))
    (values nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod has-parent-p ((vertex graph-container-vertex))
    (iterate-source-edges vertex
  
  (defmethod has-parent-p ((vertex graph-container-vertex))
    (iterate-source-edges vertex
@@ -324,7 +285,6 @@ DISCUSSION
                            (return-from has-parent-p t)))
    (values nil))
  
                            (return-from has-parent-p t)))
    (values nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod vertices-share-edge-p ((vertex-1 graph-container-vertex) 
                                    (vertex-2 graph-container-vertex))
  
  (defmethod vertices-share-edge-p ((vertex-1 graph-container-vertex) 
                                    (vertex-2 graph-container-vertex))
@@ -342,7 +302,6 @@ DISCUSSION
    
    (values nil))
  
    
    (values nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod edge-count ((graph graph-container))
    (size (graph-edges graph)))
  
  (defmethod edge-count ((graph graph-container))
    (size (graph-edges graph)))
diff --git a/dev/graph-generation.lisp b/dev/graph-generation.lisp

index ee5b9d3..1f53b14 100644 (file)
--- a/dev/graph-generation.lisp
+++ b/dev/graph-generation.lisp
@@ -28,15 +28,12 @@
              poisson-vertex-degree-distribution
              power-law-vertex-degree-distribution)))
  
              poisson-vertex-degree-distribution
              power-law-vertex-degree-distribution)))
  
-;;; ---------------------------------------------------------------------------
  ;;; classes
  ;;; classes
-;;; ---------------------------------------------------------------------------
  
  (defclass* generated-graph-mixin ()
    ((generation-method nil ir)
     (random-seed nil ir)))
  
  
  (defclass* generated-graph-mixin ()
    ((generation-method nil ir)
     (random-seed nil ir)))
  
-;;; ---------------------------------------------------------------------------
  
  (defun save-generation-information (graph generator method)
    ;; No
  
  (defun save-generation-information (graph generator method)
    ;; No
@@ -48,26 +45,21 @@
    (setf (slot-value graph 'generation-method) method
          (slot-value graph 'random-seed) (random-seed generator)))
  
    (setf (slot-value graph 'generation-method) method
          (slot-value graph 'random-seed) (random-seed generator)))
  
-;;; ---------------------------------------------------------------------------
  
  (defun simple-group-id-generator (kind count) 
    (form-keyword "H" (format nil "~2,'0D~4,'0D" kind count)))
  
  
  (defun simple-group-id-generator (kind count) 
    (form-keyword "H" (format nil "~2,'0D~4,'0D" kind count)))
  
-;;; ---------------------------------------------------------------------------
  
  (defun simple-group-id-parser (vertex) 
    (parse-integer (subseq (symbol-name (element vertex)) 1 3)))
  
  
  
  (defun simple-group-id-parser (vertex) 
    (parse-integer (subseq (symbol-name (element vertex)) 1 3)))
  
  
-;;; ---------------------------------------------------------------------------
  ;;; generate-gnp
  ;;; generate-gnp
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-gnp (generator (graph-class symbol) n p &key (label 'identity))
    (generate-gnp
     generator (make-instance graph-class) n p :label label))
  
  
  (defmethod generate-gnp (generator (graph-class symbol) n p &key (label 'identity))
    (generate-gnp
     generator (make-instance graph-class) n p :label label))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-gnp (generator (graph basic-graph) n p &key (label 'identity))
    (let ((v 1)
  
  (defmethod generate-gnp (generator (graph basic-graph) n p &key (label 'identity))
    (let ((v 1)
@@ -88,15 +80,12 @@
      
      graph))
  
      
      graph))
  
-;;; ---------------------------------------------------------------------------
  ;;; generate-gnm
  ;;; generate-gnm
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-gnm (generator (graph-class symbol) n p &key (label 'identity))
    (generate-gnm
     generator (make-instance graph-class) n p :label label))
  
  
  (defmethod generate-gnm (generator (graph-class symbol) n p &key (label 'identity))
    (generate-gnm
     generator (make-instance graph-class) n p :label label))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-gnm (generator (graph basic-graph) n m &key (label 'identity))
    (let ((max-edge-index (1- (combination-count n 2))))
  
  (defmethod generate-gnm (generator (graph basic-graph) n m &key (label 'identity))
    (let ((max-edge-index (1- (combination-count n 2))))
@@ -125,12 +114,10 @@
             'graph-container 10000 (floor (* 0.0001 (combination-count 10000 2)))))
    )
          
             'graph-container 10000 (floor (* 0.0001 (combination-count 10000 2)))))
    )
          
-;;; ---------------------------------------------------------------------------
           
  (defun vertex-group (v)
    (aref (symbol-name (element v)) 1))
  
           
  (defun vertex-group (v)
    (aref (symbol-name (element v)) 1))
  
-;;; ---------------------------------------------------------------------------
  
  (defun in-group-degree (v &key (key 'vertex-group))
    (vertex-degree 
  
  (defun in-group-degree (v &key (key 'vertex-group))
    (vertex-degree 
@@ -138,12 +125,10 @@
                      (declare (ignore e))
                      (in-same-group-p v ov key))))
  
                      (declare (ignore e))
                      (in-same-group-p v ov key))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun in-same-group-p (v1 v2 key)
    (eq (funcall key v1) (funcall key v2)))
  
  
  (defun in-same-group-p (v1 v2 key)
    (eq (funcall key v1) (funcall key v2)))
  
-;;; ---------------------------------------------------------------------------
  
  (defun out-group-degree (v &key (key 'vertex-group))
    (vertex-degree 
  
  (defun out-group-degree (v &key (key 'vertex-group))
    (vertex-degree 
@@ -151,9 +136,7 @@
                      (declare (ignore e))
                      (not (in-same-group-p v ov key)))))
  
                      (declare (ignore e))
                      (not (in-same-group-p v ov key)))))
  
-;;; ---------------------------------------------------------------------------
  ;;; generate-undirected-graph-via-assortativity-matrix 
  ;;; generate-undirected-graph-via-assortativity-matrix 
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-undirected-graph-via-assortativity-matrix
             (generator (graph-class symbol) size edge-count 
  
  (defmethod generate-undirected-graph-via-assortativity-matrix
             (generator (graph-class symbol) size edge-count 
@@ -164,7 +147,6 @@
     kind-matrix assortativity-matrix vertex-creator
     :duplicate-edge-function duplicate-edge-function))
  
     kind-matrix assortativity-matrix vertex-creator
     :duplicate-edge-function duplicate-edge-function))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-undirected-graph-via-assortativity-matrix
             (generator graph size edge-count 
  
  (defmethod generate-undirected-graph-via-assortativity-matrix
             (generator graph size edge-count 
@@ -217,9 +199,7 @@
        
        (values graph)))
  
        
        (values graph)))
  
-;;; ---------------------------------------------------------------------------
  ;;; generate-undirected-graph-via-verex-probabilities
  ;;; generate-undirected-graph-via-verex-probabilities
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-undirected-graph-via-vertex-probabilities
             (generator (graph-class symbol) size 
  
  (defmethod generate-undirected-graph-via-vertex-probabilities
             (generator (graph-class symbol) size 
@@ -228,7 +208,6 @@
     generator (make-instance graph-class) size 
     kind-matrix probability-matrix vertex-creator))
  
     generator (make-instance graph-class) size 
     kind-matrix probability-matrix vertex-creator))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-undirected-graph-via-vertex-probabilities
             (generator graph size 
  
  (defmethod generate-undirected-graph-via-vertex-probabilities
             (generator graph size 
@@ -360,7 +339,6 @@
   (lambda (kind count) 
     (form-keyword "H" (format nil "~2,'0D~4,'0D" kind count))))
  
   (lambda (kind count) 
     (form-keyword "H" (format nil "~2,'0D~4,'0D" kind count))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun sample-edges-of-same-kind (generator n p fn)
    (when (plusp p)
  
  (defun sample-edges-of-same-kind (generator n p fn)
    (when (plusp p)
@@ -379,7 +357,6 @@
  #+Test
  (sample-edges-of-same-kind *random-generator* 10 0.2 (lambda (a b) (print (list a b))))
  
  #+Test
  (sample-edges-of-same-kind *random-generator* 10 0.2 (lambda (a b) (print (list a b))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun sample-edges-of-different-kinds (generator rows cols p fn)
    (when (plusp p)
  
  (defun sample-edges-of-different-kinds (generator rows cols p fn)
    (when (plusp p)
@@ -395,7 +372,6 @@
                (when (< v rows) 
                  (funcall fn v w))))))) 
  
                (when (< v rows) 
                  (funcall fn v w))))))) 
  
-;;; ---------------------------------------------------------------------------
  
  (defun poisson-vertex-degree-distribution (z k)
    (/ (* (expt z k) (expt cl-mathstats:+e+ (- z)))
  
  (defun poisson-vertex-degree-distribution (z k)
    (/ (* (expt z k) (expt cl-mathstats:+e+ (- z)))
@@ -406,20 +382,17 @@ We know the probability of finding a vertex of degree k is p_k. We want to sampl
  from this distribution
  |#
  
  from this distribution
  |#
  
-;;; ---------------------------------------------------------------------------
  
  (defun power-law-vertex-degree-distribution (kappa k)
    (* (- 1 (expt cl-mathstats:+e+ (- (/ kappa)))) 
       (expt cl-mathstats:+e+ (- (/ k kappa)))))
  
  
  (defun power-law-vertex-degree-distribution (kappa k)
    (* (- 1 (expt cl-mathstats:+e+ (- (/ kappa)))) 
       (expt cl-mathstats:+e+ (- (/ k kappa)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun create-specified-vertex-degree-distribution (degrees)
    (lambda (z k)
      (declare (ignore z k))
      degrees))
  
  
  (defun create-specified-vertex-degree-distribution (degrees)
    (lambda (z k)
      (declare (ignore z k))
      degrees))
  
-;;; ---------------------------------------------------------------------------
  
  (defun make-degree-sampler (p_k &key (generator *random-generator*)
                                  (max-degree 1000)
  
  (defun make-degree-sampler (p_k &key (generator *random-generator*)
                                  (max-degree 1000)
@@ -441,7 +414,6 @@ from this distribution
      (lambda ()
        (first (next-element wsc)))))
  
      (lambda ()
        (first (next-element wsc)))))
  
-;;; ---------------------------------------------------------------------------
  
  #+Old
  (defun sample-edges-for-assortative-graph (generator edge-count assortativity-matrix)
  
  #+Old
  (defun sample-edges-for-assortative-graph (generator edge-count assortativity-matrix)
@@ -455,14 +427,12 @@ from this distribution
      (loop repeat edge-count collect
            (next-element c))))
  
      (loop repeat edge-count collect
            (next-element c))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun sample-edges-for-assortative-graph (generator edge-count assortativity-matrix)
    (let ((s (make-edge-sampler-for-assortative-graph generator assortativity-matrix)))
      (loop repeat edge-count collect
            (funcall s))))
  
  
  (defun sample-edges-for-assortative-graph (generator edge-count assortativity-matrix)
    (let ((s (make-edge-sampler-for-assortative-graph generator assortativity-matrix)))
      (loop repeat edge-count collect
            (funcall s))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun make-edge-sampler-for-assortative-graph (generator assortativity-matrix)
    (let ((c (make-container 'weighted-sampling-container
  
  (defun make-edge-sampler-for-assortative-graph (generator assortativity-matrix)
    (let ((c (make-container 'weighted-sampling-container
@@ -474,7 +444,6 @@ from this distribution
          (insert-item c (list i j))))
      (lambda () (next-element c))))
  
          (insert-item c (list i j))))
      (lambda () (next-element c))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun sample-vertexes-for-mixed-graph (generator size kind-matrix)
    (cond ((every-element-p kind-matrix (lambda (x) (fixnump x)))
  
  (defun sample-vertexes-for-mixed-graph (generator size kind-matrix)
    (cond ((every-element-p kind-matrix (lambda (x) (fixnump x)))
@@ -554,9 +523,7 @@ from this distribution
              mixing-matrix)))
  
  
              mixing-matrix)))
  
  
-;;; ---------------------------------------------------------------------------
  ;;; girvan-newman-test-graphs
  ;;; girvan-newman-test-graphs
-;;; ---------------------------------------------------------------------------
  
  (defun generate-girvan-newman-graph (generator graph-class z-in)
    (warn "This is broken!")
  
  (defun generate-girvan-newman-graph (generator graph-class z-in)
    (warn "This is broken!")
@@ -649,12 +616,10 @@ from this distribution
    
    (values g)))
  
    
    (values g)))
  
-;;; ---------------------------------------------------------------------------
  
  (defun gn-id->group (id)
    (parse-integer (subseq (symbol-name id) 1 2)))
  
  
  (defun gn-id->group (id)
    (parse-integer (subseq (symbol-name id) 1 2)))
  
-;;; ---------------------------------------------------------------------------
  
  (defun collect-edge-counts (g)
    (let ((vertexes (make-container 'simple-associative-container 
  
  (defun collect-edge-counts (g)
    (let ((vertexes (make-container 'simple-associative-container 
@@ -679,13 +644,11 @@ from this distribution
       #'string-lessp
       :key #'first)))
  
       #'string-lessp
       :key #'first)))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* weighted-sampler-with-lookup-container ()
    ((sampler nil r)
     (lookup nil r)))
  
  
  (defclass* weighted-sampler-with-lookup-container ()
    ((sampler nil r)
     (lookup nil r)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object weighted-sampler-with-lookup-container)
                                         &key random-number-generator key)
  
  (defmethod initialize-instance :after ((object weighted-sampler-with-lookup-container)
                                         &key random-number-generator key)
@@ -696,7 +659,6 @@ from this distribution
          (slot-value object 'lookup)
          (make-container 'simple-associative-container)))
  
          (slot-value object 'lookup)
          (make-container 'simple-associative-container)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod insert-item ((container weighted-sampler-with-lookup-container)
                          (item t))
  
  (defmethod insert-item ((container weighted-sampler-with-lookup-container)
                          (item t))
@@ -705,25 +667,21 @@ from this distribution
      (assert (not (null node)))
      (setf (item-at-1 (lookup container) item) node)))
  
      (assert (not (null node)))
      (setf (item-at-1 (lookup container) item) node)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-node ((container weighted-sampler-with-lookup-container)
                        (item t))
    (item-at-1 (lookup container) item))
  
  
  (defmethod find-node ((container weighted-sampler-with-lookup-container)
                        (item t))
    (item-at-1 (lookup container) item))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod delete-node ((container weighted-sampler-with-lookup-container)
                          (node t))
    ;; not going to worry about the hash table
    (delete-node (sampler container) node))
  
  
  (defmethod delete-node ((container weighted-sampler-with-lookup-container)
                          (node t))
    ;; not going to worry about the hash table
    (delete-node (sampler container) node))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod next-element ((container weighted-sampler-with-lookup-container))
    (next-element (sampler container)))
  
  
  (defmethod next-element ((container weighted-sampler-with-lookup-container))
    (next-element (sampler container)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-scale-free-graph
             (generator graph size kind-matrix add-edge-count
  
  (defmethod generate-scale-free-graph
             (generator graph size kind-matrix add-edge-count
@@ -784,7 +742,6 @@ from this distribution
        
        graph)))
  
        
        graph)))
  
-;;; ---------------------------------------------------------------------------
  
  #+Test
  (defun poisson-connector (count generator)
  
  #+Test
  (defun poisson-connector (count generator)
@@ -1082,14 +1039,11 @@ generate-scale-free-graph <t> <t> <t> <t> <t> <t> <t>        2%      2%    1,700
  
  |#
  
  
  |#
  
-;;; ---------------------------------------------------------------------------
  ;;; generate-assortative-graph-with-degree-distributions
  ;;; generate-assortative-graph-with-degree-distributions
-;;; ---------------------------------------------------------------------------
  
  #+Ignore
  (define-debugging-class generate-assortative-graph-with-degree-distributions ())
  
  
  #+Ignore
  (define-debugging-class generate-assortative-graph-with-degree-distributions ())
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-assortative-graph-with-degree-distributions
             (generator (graph-class symbol)
  
  (defmethod generate-assortative-graph-with-degree-distributions
             (generator (graph-class symbol)
@@ -1285,9 +1239,7 @@ Split into a function to compute some of the intermediate pieces and one to use
         (0.2222222222222222 0.4444444444444444))))
   :test #'eq)
  
         (0.2222222222222222 0.4444444444444444))))
   :test #'eq)
  
-;;; ---------------------------------------------------------------------------
  ;;; generate-graph-by-resampling-edges
  ;;; generate-graph-by-resampling-edges
-;;; ---------------------------------------------------------------------------
  
  #|
  doesn't take edge weights into account when sampling
  
  #|
  doesn't take edge weights into account when sampling
@@ -1299,12 +1251,10 @@ should include pointer back to original graph
    ((generator nil ir)
     (graph nil ir)))
  
    ((generator nil ir)
     (graph nil ir)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod next-element ((sampler basic-edge-sampler))
    (sample-element (graph-edges (graph sampler)) (generator sampler)))
  
  
  (defmethod next-element ((sampler basic-edge-sampler))
    (sample-element (graph-edges (graph sampler)) (generator sampler)))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* weighted-edge-sampler (basic-edge-sampler)
    ((weight-so-far 0 a)
  
  (defclass* weighted-edge-sampler (basic-edge-sampler)
    ((weight-so-far 0 a)
@@ -1312,7 +1262,6 @@ should include pointer back to original graph
     (edge-iterator nil r)
     (size nil ir)))
  
     (edge-iterator nil r)
     (size nil ir)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object weighted-edge-sampler) &key)
    (let ((generator (generator object))
  
  (defmethod initialize-instance :after ((object weighted-edge-sampler) &key)
    (let ((generator (generator object))
@@ -1329,7 +1278,6 @@ should include pointer back to original graph
            (slot-value object 'edge-iterator) 
            (make-iterator (graph-edges (graph object))))))
         
            (slot-value object 'edge-iterator) 
            (make-iterator (graph-edges (graph object))))))
         
-;;; ---------------------------------------------------------------------------
  
  (defmethod next-element ((object weighted-edge-sampler))
    (let ((edge-iterator (edge-iterator object))
  
  (defmethod next-element ((object weighted-edge-sampler))
    (let ((edge-iterator (edge-iterator object))
@@ -1420,22 +1368,18 @@ should include pointer back to original graph
                        (generate-graph-by-resampling-edges
                         *random-generator* g 'weighted-edge-sampler (edge-count g)))))))))
  
                        (generate-graph-by-resampling-edges
                         *random-generator* g 'weighted-edge-sampler (edge-count g)))))))))
  
-;;; ---------------------------------------------------------------------------
  ;;; some preferential attachment algorithms 
  ;;; some preferential attachment algorithms 
-;;; ---------------------------------------------------------------------------
  
  #+Ignore
  (define-debugging-class generate-preferential-attachment-graph
    (graph-generation))
  
  
  #+Ignore
  (define-debugging-class generate-preferential-attachment-graph
    (graph-generation))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-simple-preferential-attachment-graph
             (generator (graph-class symbol) size minimum-degree)
    (generate-simple-preferential-attachment-graph
     generator (make-instance graph-class) size minimum-degree))
  
  
  (defmethod generate-simple-preferential-attachment-graph
             (generator (graph-class symbol) size minimum-degree)
    (generate-simple-preferential-attachment-graph
     generator (make-instance graph-class) size minimum-degree))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-simple-preferential-attachment-graph
             (generator graph size minimum-degree)
  
  (defmethod generate-simple-preferential-attachment-graph
             (generator graph size minimum-degree)
@@ -1467,7 +1411,6 @@ should include pointer back to original graph
     :sort #'>
     :sort-on :values)
  
     :sort #'>
     :sort-on :values)
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-preferential-attachment-graph
             (generator (graph-class symbol) size kind-matrix minimum-degree 
  
  (defmethod generate-preferential-attachment-graph
             (generator (graph-class symbol) size kind-matrix minimum-degree 
@@ -1480,7 +1423,6 @@ should include pointer back to original graph
     :vertex-labeler vertex-labeler
     :duplicate-edge-function duplicate-edge-function))
  
     :vertex-labeler vertex-labeler
     :duplicate-edge-function duplicate-edge-function))
  
-;;; ---------------------------------------------------------------------------
    
  (defmethod generate-preferential-attachment-graph
             (generator (graph basic-graph) size kind-matrix minimum-degree 
    
  (defmethod generate-preferential-attachment-graph
             (generator (graph basic-graph) size kind-matrix minimum-degree 
@@ -1600,7 +1542,6 @@ should include pointer back to original graph
      
      graph))
  
      
      graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defun make-edge-sampler-for-preferential-attachment-graph (generator assortativities)
    (let ((c (make-container 'weighted-sampling-container
  
  (defun make-edge-sampler-for-preferential-attachment-graph (generator assortativities)
    (let ((c (make-container 'weighted-sampling-container
@@ -1654,7 +1595,6 @@ should include pointer back to original graph
         (0.02 0.25 0.25)
         (0.02 0.25 0.25))))
  
         (0.02 0.25 0.25)
         (0.02 0.25 0.25))))
  
-;;; ---------------------------------------------------------------------------
  
  
  (defmethod generate-acquaintance-network 
  
  
  (defmethod generate-acquaintance-network 
@@ -1677,7 +1617,6 @@ should include pointer back to original graph
           generator graph death-probability duplicate-edge-function)) 
    (values graph))
  
           generator graph death-probability duplicate-edge-function)) 
    (values graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod generate-acquaintance-network-until-stable 
             (generator graph size death-probability step-count 
  
  (defmethod generate-acquaintance-network-until-stable 
             (generator graph size death-probability step-count 
@@ -1696,7 +1635,6 @@ should include pointer back to original graph
    
    (values graph))
  
    
    (values graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defun add-acquaintance-and-maybe-kill-something 
         (generator graph death-probability duplicate-edge-function)
  
  (defun add-acquaintance-and-maybe-kill-something 
         (generator graph death-probability duplicate-edge-function)
diff --git a/dev/graph-iterators.lisp b/dev/graph-iterators.lisp

index 5cf3b3c..6f0b535 100644 (file)
--- a/dev/graph-iterators.lisp
+++ b/dev/graph-iterators.lisp
@@ -1,17 +1,13 @@
  
  
-;;; ---------------------------------------------------------------------------
  ;;; vertex-iterator
  ;;; vertex-iterator
-;;; ---------------------------------------------------------------------------
  
  (u:defclass* vertex-iterator (containers::forward-iterator)
    ())
  
  
  (u:defclass* vertex-iterator (containers::forward-iterator)
    ())
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object vertex-iterator) &key)
    (reset object))
  
  
  (defmethod initialize-instance :after ((object vertex-iterator) &key)
    (reset object))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod reset ((iterator vertex-iterator))
    (let ((vertex (containers::initial-container iterator)))
  
  (defmethod reset ((iterator vertex-iterator))
    (let ((vertex (containers::initial-container iterator)))
@@ -20,12 +16,10 @@
                           :transform (lambda (e) (other-vertex e vertex)))))
    iterator)
  
                           :transform (lambda (e) (other-vertex e vertex)))))
    iterator)
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod containers::base-class-for-iteratee ((container basic-vertex))
    'vertex-iterator)
  
  
  (defmethod containers::base-class-for-iteratee ((container basic-vertex))
    'vertex-iterator)
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod containers::base-class-for-iteratee ((container basic-vertex))
    (containers::base-class-for-iteratee (vertex-edges container)))
  
  (defmethod containers::base-class-for-iteratee ((container basic-vertex))
    (containers::base-class-for-iteratee (vertex-edges container)))
diff --git a/dev/graph-matrix.lisp b/dev/graph-matrix.lisp

index 8f5bb4d..ccafdf0 100644 (file)
--- a/dev/graph-matrix.lisp
+++ b/dev/graph-matrix.lisp
@@ -18,7 +18,6 @@ I think I'd like a numeric class and then a object one... maybe someday
  |#
  (in-package #:metabang.graph)
  
  |#
  (in-package #:metabang.graph)
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* graph-matrix (basic-graph)
    ((adjencency-matrix nil r))
  
  (defclass* graph-matrix (basic-graph)
    ((adjencency-matrix nil r))
@@ -28,25 +27,21 @@ I think I'd like a numeric class and then a object one... maybe someday
    (:export-p t)
    (:documentation "Stub for matrix based graph. Not implemented."))
  
    (:export-p t)
    (:documentation "Stub for matrix based graph. Not implemented."))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object graph-matrix) &key)
    (setf (slot-value object 'adjencency-matrix) 
          nil))
  
  
  (defmethod initialize-instance :after ((object graph-matrix) &key)
    (setf (slot-value object 'adjencency-matrix) 
          nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-vertex-container ((graph graph-matrix) initial-size) 
    (make-container 'vector-container :initial-size initial-size
                    :fill-pointer 0))
  
  
  (defmethod make-vertex-container ((graph graph-matrix) initial-size) 
    (make-container 'vector-container :initial-size initial-size
                    :fill-pointer 0))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-edge-container ((graph graph-matrix) initial-size) 
    (make-container 'vector-container :initial-size initial-size
                    :fill-pointer 0))
  
  
  (defmethod make-edge-container ((graph graph-matrix) initial-size) 
    (make-container 'vector-container :initial-size initial-size
                    :fill-pointer 0))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* graph-matrix-edge (basic-edge)
    ()
  
  (defclass* graph-matrix-edge (basic-edge)
    ()
@@ -54,12 +49,10 @@ I think I'd like a numeric class and then a object one... maybe someday
    (:export-p t)
    (:documentation "Stub for matrix based graph. Not implemented."))
  
    (:export-p t)
    (:documentation "Stub for matrix based graph. Not implemented."))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* graph-matrix-vertex (basic-vertex)
    ()
    (:export-p t)
    (:documentation "Stub for matrix based graph. Not implemented."))
  
  
  (defclass* graph-matrix-vertex (basic-vertex)
    ()
    (:export-p t)
    (:documentation "Stub for matrix based graph. Not implemented."))
  
-;;; ---------------------------------------------------------------------------
  
  
diff --git a/dev/graph-metrics.lisp b/dev/graph-metrics.lisp

index 95dfe8a..65c27cc 100644 (file)
--- a/dev/graph-metrics.lisp
+++ b/dev/graph-metrics.lisp
@@ -28,7 +28,6 @@ DISCUSSION
         (incf (item-at c (edge-count v)))))
      c))
  
         (incf (item-at c (edge-count v)))))
      c))
  
-;;; ---------------------------------------------------------------------------
  
  (defun average-vertex-degree (graph &key 
                                  (vertex-filter (constantly t))
  
  (defun average-vertex-degree (graph &key 
                                  (vertex-filter (constantly t))
@@ -47,7 +46,6 @@ DISCUSSION
        (values (float (/ total size)))
        nil)))
  
        (values (float (/ total size)))
        nil)))
  
-;;; ---------------------------------------------------------------------------
  
  (defun vertex-degree (vertex &key 
                               (edge-filter (constantly t))
  
  (defun vertex-degree (vertex &key 
                               (edge-filter (constantly t))
@@ -56,7 +54,6 @@ DISCUSSION
    (declare (inline %vertex-degree)) 
    (%vertex-degree vertex edge-filter edge-size))
  
    (declare (inline %vertex-degree)) 
    (%vertex-degree vertex edge-filter edge-size))
  
-;;; ---------------------------------------------------------------------------
  
  (defun %vertex-degree (vertex edge-filter edge-size)
    "Called internally by `vertex-degree` and `average-vertex-degree`."
  
  (defun %vertex-degree (vertex edge-filter edge-size)
    "Called internally by `vertex-degree` and `average-vertex-degree`."
@@ -68,7 +65,6 @@ DISCUSSION
           (incf degree (funcall edge-size e)))))
      degree))
  
           (incf degree (funcall edge-size e)))))
      degree))
  
-;;; ---------------------------------------------------------------------------
  
  (defun vertex-degree-summary (graph vertex-classifier
                                      &key (edge-size (constantly 1)))
  
  (defun vertex-degree-summary (graph vertex-classifier
                                      &key (edge-size (constantly 1)))
@@ -102,7 +98,6 @@ DISCUSSION
             "Average vertex degree between ~A and ~A:"
             k-1 k-2))))))
  
             "Average vertex degree between ~A and ~A:"
             k-1 k-2))))))
  
-;;; ---------------------------------------------------------------------------
  
  #|
  Transitivity or Clustering.
  
  #|
  Transitivity or Clustering.
@@ -157,7 +152,6 @@ the sociological literature, where it is referred to as the network density
      (float (/ (vertex-triangle-count vertex)
                (combination-count (edge-count vertex) 2)))))
  
      (float (/ (vertex-triangle-count vertex)
                (combination-count (edge-count vertex) 2)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun vertex-triangle-count (vertex)
    (let ((neighbors (neighbor-vertexes vertex)))
  
  (defun vertex-triangle-count (vertex)
    (let ((neighbors (neighbor-vertexes vertex)))
@@ -166,7 +160,6 @@ the sociological literature, where it is referred to as the network density
                           (member v neighbors))
                         (neighbor-vertexes neighbor)) 2))))
  
                           (member v neighbors))
                         (neighbor-vertexes neighbor)) 2))))
  
-;;; ---------------------------------------------------------------------------
  
  (defun row-sums (matrix)
    (let* ((row-count (array-dimension matrix 1))
  
  (defun row-sums (matrix)
    (let* ((row-count (array-dimension matrix 1))
@@ -176,7 +169,6 @@ the sociological literature, where it is referred to as the network density
          (incf (aref result row) (aref matrix column row))))
      result))
  
          (incf (aref result row) (aref matrix column row))))
      result))
  
-;;; ---------------------------------------------------------------------------
  
  (defun column-sums (matrix)
    (let* ((column-count (array-dimension matrix 0))
  
  (defun column-sums (matrix)
    (let* ((column-count (array-dimension matrix 0))
@@ -186,7 +178,6 @@ the sociological literature, where it is referred to as the network density
          (incf (aref result column) (aref matrix column row))))
      result))
  
          (incf (aref result column) (aref matrix column row))))
      result))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod assortativity-coefficient ((matrix array))
    
  
  (defmethod assortativity-coefficient ((matrix array))
    
@@ -197,7 +188,6 @@ the sociological literature, where it is referred to as the network density
        (values 1)
        (values (/ (- trace sum-squared) (- 1 sum-squared))))))
  
        (values 1)
        (values (/ (- trace sum-squared) (- 1 sum-squared))))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod graph-edge-mixture-matrix ((graph basic-graph) vertex-classifier &key
                                  (edge-weight (constantly 1)))
  
  (defmethod graph-edge-mixture-matrix ((graph basic-graph) vertex-classifier &key
                                  (edge-weight (constantly 1)))
@@ -226,7 +216,6 @@ the sociological literature, where it is referred to as the network density
       (0.013 0.023 0.306 0.035)
       (0.005 0.007 0.024 0.016)))
  
       (0.013 0.023 0.306 0.035)
       (0.005 0.007 0.024 0.016)))
  
-;;; ---------------------------------------------------------------------------
  
  ;;OPT we call the classifier a lot, probably better to make a new ht for that
  
  
  ;;OPT we call the classifier a lot, probably better to make a new ht for that
  
diff --git a/dev/graph.lisp b/dev/graph.lisp

index 98049a7..f05dfcc 100644 (file)
--- a/dev/graph.lisp
+++ b/dev/graph.lisp
@@ -16,9 +16,7 @@ something is putting something on the vertexes plist's
  
  (in-package #:metabang.graph)
  
  
  (in-package #:metabang.graph)
  
-;;; ---------------------------------------------------------------------------
  ;;; classes
  ;;; classes
-;;; ---------------------------------------------------------------------------
  
  (defcondition graph-error (error)
    ((graph nil ir))
  
  (defcondition graph-error (error)
    ((graph nil ir))
@@ -26,7 +24,6 @@ something is putting something on the vertexes plist's
    (:export-slots-p t)
    (:documentation "This is the root condition for errors that occur while running code in CL-Graph."))
  
    (:export-slots-p t)
    (:documentation "This is the root condition for errors that occur while running code in CL-Graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defcondition edge-error (graph-error)
    ((edge nil ir "The `edge` that is implicated in the condition."))
  
  (defcondition edge-error (graph-error)
    ((edge nil ir "The `edge` that is implicated in the condition."))
@@ -34,7 +31,6 @@ something is putting something on the vertexes plist's
    (:export-slots-p t)
    (:documentation "This is the root condition for graph errors that have to do with edges."))
  
    (:export-slots-p t)
    (:documentation "This is the root condition for graph errors that have to do with edges."))
  
-;;; ---------------------------------------------------------------------------
  
  (defcondition graph-vertex-not-found-error (graph-error)
    ((vertex nil ir "The vertex or value that could not be found in the graph."))
  
  (defcondition graph-vertex-not-found-error (graph-error)
    ((vertex nil ir "The vertex or value that could not be found in the graph."))
@@ -44,7 +40,6 @@ something is putting something on the vertexes plist's
    (:export-slots-p t)
    (:documentation "This condition is signaled when a vertex can not be found in a graph."))
  
    (:export-slots-p t)
    (:documentation "This condition is signaled when a vertex can not be found in a graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defcondition graph-vertex-not-found-in-edge-error (edge-error)
    ((vertex nil ir))
  
  (defcondition graph-vertex-not-found-in-edge-error (edge-error)
    ((vertex nil ir))
@@ -53,7 +48,6 @@ something is putting something on the vertexes plist's
    (:export-p t)
    (:documentation "This condition is signaled when a vertex can not be found in an edge."))
  
    (:export-p t)
    (:documentation "This condition is signaled when a vertex can not be found in an edge."))
  
-;;; ---------------------------------------------------------------------------
  
  (defcondition graph-edge-not-found-error (graph-error)
    ((vertex-1 nil ir "One of the vertexes for which no connecting edge could be found.")
  
  (defcondition graph-edge-not-found-error (graph-error)
    ((vertex-1 nil ir "One of the vertexes for which no connecting edge could be found.")
@@ -65,7 +59,6 @@ something is putting something on the vertexes plist's
    (:export-slots-p t)
    (:documentation "This condition is signaled when an edge cannot be found in a graph."))
  
    (:export-slots-p t)
    (:documentation "This condition is signaled when an edge cannot be found in a graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* basic-vertex (container-node-mixin) 
    ((depth-level 0 ia :type number "`Depth-level` is used by some algorithms for bookkeeping.  [?? Should be in a mixin]")
  
  (defclass* basic-vertex (container-node-mixin) 
    ((depth-level 0 ia :type number "`Depth-level` is used by some algorithms for bookkeeping.  [?? Should be in a mixin]")
@@ -85,7 +78,6 @@ something is putting something on the vertexes plist's
    (:make-load-form-p t)
    (:documentation "This is the root class for all vertexes in CL-Graph."))
  
    (:make-load-form-p t)
    (:documentation "This is the root class for all vertexes in CL-Graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object basic-vertex) &key graph vertex-id)
    (when (and graph (not vertex-id))
  
  (defmethod initialize-instance :after ((object basic-vertex) &key graph vertex-id)
    (when (and graph (not vertex-id))
@@ -93,7 +85,6 @@ something is putting something on the vertexes plist's
            (largest-vertex-id graph))
      (incf (slot-value graph 'largest-vertex-id)))) 
  
            (largest-vertex-id graph))
      (incf (slot-value graph 'largest-vertex-id)))) 
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod print-object ((vertex basic-vertex) stream)
    (print-unreadable-object (vertex stream :identity nil)
  
  (defmethod print-object ((vertex basic-vertex) stream)
    (print-unreadable-object (vertex stream :identity nil)
@@ -101,7 +92,6 @@ something is putting something on the vertexes plist's
              (if (and (slot-exists-p vertex 'element) (slot-boundp vertex 'element))
                (element vertex) "#unbound#"))))
  
              (if (and (slot-exists-p vertex 'element) (slot-boundp vertex 'element))
                (element vertex) "#unbound#"))))
  
-;;; ---------------------------------------------------------------------------
    
  (defclass* basic-edge ()
    ((edge-id 0 ia "The `edge-id` is used internally by CL-Graph for bookkeeping.")
    
  (defclass* basic-edge ()
    ((edge-id 0 ia "The `edge-id` is used internally by CL-Graph for bookkeeping.")
@@ -114,7 +104,6 @@ something is putting something on the vertexes plist's
    (:make-load-form-p t)
    (:documentation "This is the root class for all edges in CL-Graph."))
  
    (:make-load-form-p t)
    (:documentation "This is the root class for all edges in CL-Graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object basic-edge) &key graph edge-id)
    (when (and graph (not edge-id))
  
  (defmethod initialize-instance :after ((object basic-edge) &key graph edge-id)
    (when (and graph (not edge-id))
@@ -122,19 +111,16 @@ something is putting something on the vertexes plist's
            (largest-edge-id graph))
      (incf (slot-value graph 'largest-edge-id))))
  
            (largest-edge-id graph))
      (incf (slot-value graph 'largest-edge-id))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod print-object ((object basic-edge) stream)
    (print-unreadable-object (object stream :type t) 
      (format stream "<~A ~A>" (vertex-1 object) (vertex-2 object))))
  
  
  (defmethod print-object ((object basic-edge) stream)
    (print-unreadable-object (object stream :type t) 
      (format stream "<~A ~A>" (vertex-1 object) (vertex-2 object))))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* directed-edge-mixin () ()
    (:export-p t)
    (:documentation "This mixin class is used to indicate that an edge is directed."))
  
  
  (defclass* directed-edge-mixin () ()
    (:export-p t)
    (:documentation "This mixin class is used to indicate that an edge is directed."))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* weighted-edge-mixin ()
    ((weight 1d0 ia "The value of the weight of this edge. Defaults to 1.0d0"))
  
  (defclass* weighted-edge-mixin ()
    ((weight 1d0 ia "The value of the weight of this edge. Defaults to 1.0d0"))
@@ -142,11 +128,9 @@ something is putting something on the vertexes plist's
    (:export-p t)
    (:documentation "This mixin class adds a `weight` slot to an edge."))
  
    (:export-p t)
    (:documentation "This mixin class adds a `weight` slot to an edge."))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod weight ((edge basic-edge)) (values 1.0))
  
  
  (defmethod weight ((edge basic-edge)) (values 1.0))
  
-;;; ---------------------------------------------------------------------------
  
  (defclass* basic-graph ()
    ((graph-vertexes :unbound ir)
  
  (defclass* basic-graph ()
    ((graph-vertexes :unbound ir)
@@ -178,7 +162,6 @@ something is putting something on the vertexes plist's
      :initial-size 25)
    (:documentation "This is the root class for all graphs in CL-Graph."))
  
      :initial-size 25)
    (:documentation "This is the root class for all graphs in CL-Graph."))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod initialize-instance :after ((object basic-graph) &key initial-size
                                         &allow-other-keys)
  
  (defmethod initialize-instance :after ((object basic-graph) &key initial-size
                                         &allow-other-keys)
@@ -187,23 +170,19 @@ something is putting something on the vertexes plist's
    (setf (slot-value object 'graph-edges) 
          (make-edge-container object initial-size)))
  
    (setf (slot-value object 'graph-edges) 
          (make-edge-container object initial-size)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod print-object ((graph basic-graph) stream)
    (print-unreadable-object (graph stream :type t :identity t)
      (format stream "[~A,~A]" (size graph) (edge-count graph))))
  
  
  
  (defmethod print-object ((graph basic-graph) stream)
    (print-unreadable-object (graph stream :type t :identity t)
      (format stream "[~A,~A]" (size graph) (edge-count graph))))
  
  
-;;; ---------------------------------------------------------------------------
  ;;; internals 
  ;;; internals 
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-vertex
      ((graph basic-graph) (value basic-vertex) &key if-duplicate-do)
    (declare (ignore if-duplicate-do))
    (values value))
  
  
  (defmethod add-vertex
      ((graph basic-graph) (value basic-vertex) &key if-duplicate-do)
    (declare (ignore if-duplicate-do))
    (values value))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-vertex-for-graph ((graph basic-graph) &rest args &key 
                                    (vertex-class (vertex-class graph)) 
  
  (defmethod make-vertex-for-graph ((graph basic-graph) &rest args &key 
                                    (vertex-class (vertex-class graph)) 
@@ -213,7 +192,6 @@ something is putting something on the vertexes plist's
            "Vertex class '~A' must be a subtype of ~A" vertex-class (vertex-class graph))
    (apply #'make-instance vertex-class :graph graph args))
  
            "Vertex class '~A' must be a subtype of ~A" vertex-class (vertex-class graph))
    (apply #'make-instance vertex-class :graph graph args))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-edge-for-graph ((graph basic-graph) 
                                  (vertex-1 basic-vertex) (vertex-2 basic-vertex)
  
  (defmethod make-edge-for-graph ((graph basic-graph) 
                                  (vertex-1 basic-vertex) (vertex-2 basic-vertex)
@@ -245,34 +223,27 @@ something is putting something on the vertexes plist's
           :graph graph
           :vertex-1 vertex-1 :vertex-2 vertex-2 args))
  
           :graph graph
           :vertex-1 vertex-1 :vertex-2 vertex-2 args))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-graph ((graph-type symbol) &rest args &key &allow-other-keys)
    (apply #'make-instance graph-type args))
  
  
  (defmethod make-graph ((graph-type symbol) &rest args &key &allow-other-keys)
    (apply #'make-instance graph-type args))
  
-;;; ---------------------------------------------------------------------------
  ;;; generic implementation 
  ;;; generic implementation 
-;;; ---------------------------------------------------------------------------
  
  (defmethod undirected-edge-p ((edge basic-edge))
    (not (directed-edge-p edge)))
  
  
  (defmethod undirected-edge-p ((edge basic-edge))
    (not (directed-edge-p edge)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod directed-edge-p ((edge basic-edge))
    (typep edge 'directed-edge-mixin))
  
  
  (defmethod directed-edge-p ((edge basic-edge))
    (typep edge 'directed-edge-mixin))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod tagged-edge-p ((edge basic-edge))
    (tag edge))
  
  
  (defmethod tagged-edge-p ((edge basic-edge))
    (tag edge))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod untagged-edge-p ((edge basic-edge))
    (null (tag edge)))
  
  
  (defmethod untagged-edge-p ((edge basic-edge))
    (null (tag edge)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod tag-all-edges ((graph basic-graph))
    (iterate-edges
  
  (defmethod tag-all-edges ((graph basic-graph))
    (iterate-edges
@@ -280,7 +251,6 @@ something is putting something on the vertexes plist's
     (lambda (e)
       (setf (tag e) t))))
  
     (lambda (e)
       (setf (tag e) t))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod tag-all-edges ((vertex basic-vertex))
    (iterate-edges
  
  (defmethod tag-all-edges ((vertex basic-vertex))
    (iterate-edges
@@ -288,7 +258,6 @@ something is putting something on the vertexes plist's
     (lambda (e)
       (setf (tag e) t))))
  
     (lambda (e)
       (setf (tag e) t))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod untag-all-edges ((graph basic-graph))
    (iterate-edges
  
  (defmethod untag-all-edges ((graph basic-graph))
    (iterate-edges
@@ -296,7 +265,6 @@ something is putting something on the vertexes plist's
     (lambda (e)
       (setf (tag e) nil))))
  
     (lambda (e)
       (setf (tag e) nil))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod untag-all-edges ((vertex basic-vertex))
    (iterate-edges
  
  (defmethod untag-all-edges ((vertex basic-vertex))
    (iterate-edges
@@ -304,7 +272,6 @@ something is putting something on the vertexes plist's
     (lambda (e)
       (setf (tag e) nil))))
  
     (lambda (e)
       (setf (tag e) nil))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod untag-edges ((edges list))
    (iterate-nodes
  
  (defmethod untag-edges ((edges list))
    (iterate-nodes
@@ -312,7 +279,6 @@ something is putting something on the vertexes plist's
     (lambda (e)
       (setf (tag e) nil))))
  
     (lambda (e)
       (setf (tag e) nil))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod tag-edges ((edges list))
    (iterate-nodes
  
  (defmethod tag-edges ((edges list))
    (iterate-nodes
@@ -321,13 +287,11 @@ something is putting something on the vertexes plist's
       (setf (tag e) t))))
  
  
       (setf (tag e) t))))
  
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod (setf element) :around ((value t) (vertex basic-vertex))
    (with-changing-vertex (vertex)
      (call-next-method)))
  
  
  (defmethod (setf element) :around ((value t) (vertex basic-vertex))
    (with-changing-vertex (vertex)
      (call-next-method)))
  
-;;; ---------------------------------------------------------------------------
  
  ;; :ignore, :force, :replace, <function>
  
  
  ;; :ignore, :force, :replace, <function>
  
@@ -360,7 +324,6 @@ something is putting something on the vertexes plist's
          ;; not found, add
          (add-it :new)))))
  
          ;; not found, add
          (add-it :new)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod replace-vertex ((graph basic-graph) (old basic-vertex) (new basic-vertex))
    ;; we need the graph and the new vertex to reference each other
  
  (defmethod replace-vertex ((graph basic-graph) (old basic-vertex) (new basic-vertex))
    ;; we need the graph and the new vertex to reference each other
@@ -381,7 +344,6 @@ something is putting something on the vertexes plist's
    (delete-vertex graph old)
    (add-vertex graph new))
  
    (delete-vertex graph old)
    (add-vertex graph new))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-edge-between-vertexes ((graph basic-graph) (value-1 t) (value-2 t)
                                        &rest args &key (if-duplicate-do :ignore)
  
  (defmethod add-edge-between-vertexes ((graph basic-graph) (value-1 t) (value-2 t)
                                        &rest args &key (if-duplicate-do :ignore)
@@ -394,10 +356,8 @@ something is putting something on the vertexes plist's
                  (add-vertex graph value-2  :if-duplicate-do :replace))))
      (apply #'add-edge-between-vertexes graph v1 v2 args)))
  
                  (add-vertex graph value-2  :if-duplicate-do :replace))))
      (apply #'add-edge-between-vertexes graph v1 v2 args)))
  
-;;; ---------------------------------------------------------------------------
  ;;; to-do - add-edge-between-vertexes needs to be able to grab the weight and
  ;;; color from edges that inherit from weight and color mixins
  ;;; to-do - add-edge-between-vertexes needs to be able to grab the weight and
  ;;; color from edges that inherit from weight and color mixins
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-edge-between-vertexes ((graph basic-graph) 
                                        (v-1 basic-vertex) (v-2 basic-vertex)
  
  (defmethod add-edge-between-vertexes ((graph basic-graph) 
                                        (v-1 basic-vertex) (v-2 basic-vertex)
@@ -444,12 +404,10 @@ something is putting something on the vertexes plist's
          (add-it :new)))))
  
  
          (add-it :new)))))
  
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-edge-to-vertex ((edge basic-edge) (vertex basic-vertex))
    (values))
  
  
  (defmethod add-edge-to-vertex ((edge basic-edge) (vertex basic-vertex))
    (values))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-edge-between-vertexes
      ((graph basic-graph) (value-1 t) (value-2 t)
  
  (defmethod find-edge-between-vertexes
      ((graph basic-graph) (value-1 t) (value-2 t)
@@ -461,7 +419,6 @@ something is putting something on the vertexes plist's
           (error 'graph-edge-not-found-error
                  :graph graph :vertex-1 v1 :vertex-2 v2)))))
  
           (error 'graph-edge-not-found-error
                  :graph graph :vertex-1 v1 :vertex-2 v2)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod delete-edge-between-vertexes ((graph basic-graph)
                                           (value-or-vertex-1 t)
  
  (defmethod delete-edge-between-vertexes ((graph basic-graph)
                                           (value-or-vertex-1 t)
@@ -471,7 +428,6 @@ something is putting something on the vertexes plist's
      (when edge
        (delete-edge graph edge))))
  
      (when edge
        (delete-edge graph edge))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod delete-edge :after ((graph basic-graph) (edge basic-edge))
    (delete-item (graph-edges graph) edge)
  
  (defmethod delete-edge :after ((graph basic-graph) (edge basic-edge))
    (delete-item (graph-edges graph) edge)
@@ -482,12 +438,10 @@ something is putting something on the vertexes plist's
    (empty! (graph-edges graph))
    graph)
  
    (empty! (graph-edges graph))
    graph)
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod delete-vertex ((graph basic-graph) value-or-vertex)
    (delete-vertex graph (find-vertex graph value-or-vertex)))
  
  
  (defmethod delete-vertex ((graph basic-graph) value-or-vertex)
    (delete-vertex graph (find-vertex graph value-or-vertex)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod delete-vertex ((graph basic-graph) (vertex basic-vertex))
    (unless (eq graph (graph vertex))
  
  (defmethod delete-vertex ((graph basic-graph) (vertex basic-vertex))
    (unless (eq graph (graph vertex))
@@ -502,7 +456,6 @@ something is putting something on the vertexes plist's
    (empty! (vertex-edges vertex))
    (values vertex graph))
  
    (empty! (vertex-edges vertex))
    (values vertex graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod delete-vertex :after ((graph basic-graph) 
                                   (vertex basic-vertex))
  
  (defmethod delete-vertex :after ((graph basic-graph) 
                                   (vertex basic-vertex))
@@ -510,42 +463,34 @@ something is putting something on the vertexes plist's
    (delete-item-at (graph-vertexes graph)
                    (funcall (vertex-key graph) (element vertex))))
  
    (delete-item-at (graph-vertexes graph)
                    (funcall (vertex-key graph) (element vertex))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod insert-item ((graph basic-graph) value)
    (add-vertex graph value))
  
  
  (defmethod insert-item ((graph basic-graph) value)
    (add-vertex graph value))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod source-edges ((vertex basic-vertex) &optional filter)
    (collect-using #'iterate-source-edges filter vertex))
  
  
  (defmethod source-edges ((vertex basic-vertex) &optional filter)
    (collect-using #'iterate-source-edges filter vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod target-edges ((vertex basic-vertex) &optional filter)
    (collect-using #'iterate-target-edges filter vertex))
  
  
  (defmethod target-edges ((vertex basic-vertex) &optional filter)
    (collect-using #'iterate-target-edges filter vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod child-vertexes (vertex &optional filter)
    (collect-using #'iterate-children filter vertex))
  
  
  (defmethod child-vertexes (vertex &optional filter)
    (collect-using #'iterate-children filter vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod parent-vertexes (vertex &optional filter)
    (collect-using #'iterate-parents filter vertex))
  
  
  (defmethod parent-vertexes (vertex &optional filter)
    (collect-using #'iterate-parents filter vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod neighbor-vertexes (vertex &optional filter)
    (collect-using #'iterate-neighbors filter vertex))
  
  
  (defmethod neighbor-vertexes (vertex &optional filter)
    (collect-using #'iterate-neighbors filter vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod adjacentp ((graph basic-graph) vertex-1 vertex-2)
    (adjacentp graph (find-vertex graph vertex-1) (find-vertex graph vertex-2)))
  
  
  (defmethod adjacentp ((graph basic-graph) vertex-1 vertex-2)
    (adjacentp graph (find-vertex graph vertex-1) (find-vertex graph vertex-2)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod adjacentp ((graph basic-graph) (vertex-1 basic-vertex) (vertex-2 basic-vertex))
    (iterate-neighbors 
  
  (defmethod adjacentp ((graph basic-graph) (vertex-1 basic-vertex) (vertex-2 basic-vertex))
    (iterate-neighbors 
@@ -555,17 +500,14 @@ something is putting something on the vertexes plist's
         (return-from adjacentp t))))
    (values nil))
  
         (return-from adjacentp t))))
    (values nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod number-of-neighbors (vertex)
    (count-using #'iterate-neighbors nil vertex))
  
  
  (defmethod number-of-neighbors (vertex)
    (count-using #'iterate-neighbors nil vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod in-cycle-p ((graph basic-graph) (vertex t))
    (in-cycle-p graph (find-vertex graph vertex)))
  
  
  (defmethod in-cycle-p ((graph basic-graph) (vertex t))
    (in-cycle-p graph (find-vertex graph vertex)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod renumber-vertexes ((graph basic-graph))
    (let ((count 0))
  
  (defmethod renumber-vertexes ((graph basic-graph))
    (let ((count 0))
@@ -574,7 +516,6 @@ something is putting something on the vertexes plist's
                                (incf count)))
      (setf (slot-value graph 'largest-vertex-id) count)))
  
                                (incf count)))
      (setf (slot-value graph 'largest-vertex-id) count)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod renumber-edges ((graph basic-graph))
    (let ((count 0))
  
  (defmethod renumber-edges ((graph basic-graph))
    (let ((count 0))
@@ -583,13 +524,11 @@ something is putting something on the vertexes plist's
                             (incf count)))
      (setf (slot-value graph 'largest-edge-id) count)))
  
                             (incf count)))
      (setf (slot-value graph 'largest-edge-id) count)))
  
-;;; ---------------------------------------------------------------------------
  
  (deprecated
    (defmethod container->list ((graph basic-graph))
      (collect-elements (graph-vertexes graph))))
  
  
  (deprecated
    (defmethod container->list ((graph basic-graph))
      (collect-elements (graph-vertexes graph))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-vertex :before ((graph basic-graph) (vertex basic-vertex) 
                                 &key &allow-other-keys)
  
  (defmethod add-vertex :before ((graph basic-graph) (vertex basic-vertex) 
                                 &key &allow-other-keys)
@@ -599,7 +538,6 @@ something is putting something on the vertexes plist's
                   (funcall (vertex-key graph) (element vertex))) vertex
          (slot-value vertex 'graph) graph))
  
                   (funcall (vertex-key graph) (element vertex))) vertex
          (slot-value vertex 'graph) graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod add-edge :before ((graph basic-graph) (edge basic-edge) &key force-new?)
    (declare (ignore force-new?))
  
  (defmethod add-edge :before ((graph basic-graph) (edge basic-edge) &key force-new?)
    (declare (ignore force-new?))
@@ -609,7 +547,6 @@ something is putting something on the vertexes plist's
      (progn (setf (contains-directed-edge-p graph) t))
      (progn (setf (contains-undirected-edge-p graph) t))))
  
      (progn (setf (contains-directed-edge-p graph) t))
      (progn (setf (contains-undirected-edge-p graph) t))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-vertex ((graph basic-graph) (value t)
                          &optional (error-if-not-found? t))
  
  (defmethod find-vertex ((graph basic-graph) (value t)
                          &optional (error-if-not-found? t))
@@ -656,71 +593,58 @@ something is putting something on the vertexes plist's
     (iterate-elements (graph-vertexes graph) 
                       (lambda (vertex) (funcall fn (element vertex)))))
  
     (iterate-elements (graph-vertexes graph) 
                       (lambda (vertex) (funcall fn (element vertex)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-nodes ((graph basic-graph) fn)
     (iterate-nodes (graph-vertexes graph) fn))
  
  
  (defmethod iterate-nodes ((graph basic-graph) fn)
     (iterate-nodes (graph-vertexes graph) fn))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-vertexes ((graph basic-graph) fn)
     (iterate-nodes (graph-vertexes graph) fn))
  
  
  (defmethod iterate-vertexes ((graph basic-graph) fn)
     (iterate-nodes (graph-vertexes graph) fn))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod iterate-vertexes ((edge basic-edge) fn)
    (funcall fn (vertex-1 edge))
    (funcall fn (vertex-2 edge)))
  
  
  (defmethod iterate-vertexes ((edge basic-edge) fn)
    (funcall fn (vertex-1 edge))
    (funcall fn (vertex-2 edge)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod size ((graph basic-graph))
    (size (graph-vertexes graph)))
  
  
  (defmethod size ((graph basic-graph))
    (size (graph-vertexes graph)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod edges ((graph basic-graph))
    (collect-using #'iterate-edges nil graph))
  
  
  (defmethod edges ((graph basic-graph))
    (collect-using #'iterate-edges nil graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod edges ((vertex basic-vertex))
    (collect-using #'iterate-edges nil vertex))
  
  
  (defmethod edges ((vertex basic-vertex))
    (collect-using #'iterate-edges nil vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (deprecated
    "Use size instead"
    (defmethod vertex-count ((graph basic-graph))
      (size graph)))
  
  
  (deprecated
    "Use size instead"
    (defmethod vertex-count ((graph basic-graph))
      (size graph)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod vertexes ((graph basic-graph))
    (collect-elements (graph-vertexes graph)))
  
  
  (defmethod vertexes ((graph basic-graph))
    (collect-elements (graph-vertexes graph)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod source-edge-count ((vertex basic-vertex))
    (count-using 'iterate-source-edges nil vertex))
  
  
  (defmethod source-edge-count ((vertex basic-vertex))
    (count-using 'iterate-source-edges nil vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod target-edge-count ((vertex basic-vertex))
    (count-using 'iterate-target-edges nil vertex))
  
  
  (defmethod target-edge-count ((vertex basic-vertex))
    (count-using 'iterate-target-edges nil vertex))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod graph-roots ((graph basic-graph))
    (collect-elements (graph-vertexes graph) :filter #'rootp))
  
  
  (defmethod graph-roots ((graph basic-graph))
    (collect-elements (graph-vertexes graph) :filter #'rootp))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod rootp ((vertex basic-vertex))
    ;;?? this is inefficient in the same way that (zerop (length <list>)) is...
    (zerop (source-edge-count vertex)))
  
  
  (defmethod rootp ((vertex basic-vertex))
    ;;?? this is inefficient in the same way that (zerop (length <list>)) is...
    (zerop (source-edge-count vertex)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-vertex-if ((graph basic-graph) fn &key key)
    (iterate-vertexes graph 
  
  (defmethod find-vertex-if ((graph basic-graph) fn &key key)
    (iterate-vertexes graph 
@@ -729,7 +653,6 @@ something is putting something on the vertexes plist's
                          (return-from find-vertex-if v))))
    (values nil))
  
                          (return-from find-vertex-if v))))
    (values nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-vertex-if ((edge basic-edge) fn &key key)
    (iterate-vertexes edge
  
  (defmethod find-vertex-if ((edge basic-edge) fn &key key)
    (iterate-vertexes edge
@@ -738,7 +661,6 @@ something is putting something on the vertexes plist's
                          (return-from find-vertex-if v))))
    (values nil))
  
                          (return-from find-vertex-if v))))
    (values nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-edge-if ((graph basic-graph) fn &key key)
    (iterate-edges graph
  
  (defmethod find-edge-if ((graph basic-graph) fn &key key)
    (iterate-edges graph
@@ -747,17 +669,14 @@ something is putting something on the vertexes plist's
                       (return-from find-edge-if e))))
    (values nil))
  
                       (return-from find-edge-if e))))
    (values nil))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-edges-if ((graph basic-graph) fn)
    (collect-using 'iterate-edges fn graph))
  
  
  (defmethod find-edges-if ((graph basic-graph) fn)
    (collect-using 'iterate-edges fn graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod find-vertexes-if ((graph basic-graph) fn)
    (collect-using 'iterate-vertexes fn graph))
  
  
  (defmethod find-vertexes-if ((graph basic-graph) fn)
    (collect-using 'iterate-vertexes fn graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod empty! ((graph basic-graph))
    (empty! (graph-edges graph))
  
  (defmethod empty! ((graph basic-graph))
    (empty! (graph-edges graph))
@@ -766,7 +685,6 @@ something is putting something on the vertexes plist's
    (renumber-vertexes graph)
    (values))
  
    (renumber-vertexes graph)
    (values))
  
-;;; ---------------------------------------------------------------------------
  
  (defun neighbors-to-children (new-graph root &optional visited-list)
    (pushnew root visited-list)
  
  (defun neighbors-to-children (new-graph root &optional visited-list)
    (pushnew root visited-list)
@@ -778,12 +696,10 @@ something is putting something on the vertexes plist's
          new-graph (value root) (value c) :edge-type :directed)
         (neighbors-to-children new-graph c visited-list)))))
  
          new-graph (value root) (value c) :edge-type :directed)
         (neighbors-to-children new-graph c visited-list)))))
  
-;;; ---------------------------------------------------------------------------
                                  
  (defmethod generate-directed-free-tree ((graph basic-graph) root)
    (generate-directed-free-tree graph (find-vertex graph root)))
  
                                  
  (defmethod generate-directed-free-tree ((graph basic-graph) root)
    (generate-directed-free-tree graph (find-vertex graph root)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod force-undirected ((graph basic-graph))
    (iterate-edges 
  
  (defmethod force-undirected ((graph basic-graph))
    (iterate-edges 
@@ -793,9 +709,7 @@ something is putting something on the vertexes plist's
  
  
  
  
  
  
-;;; ---------------------------------------------------------------------------
  ;;; traversal
  ;;; traversal
-;;; ---------------------------------------------------------------------------
  
  (defmethod traverse-elements ((thing basic-graph) (style symbol) fn)
    (let ((marker (gensym)))
  
  (defmethod traverse-elements ((thing basic-graph) (style symbol) fn)
    (let ((marker (gensym)))
@@ -809,7 +723,6 @@ something is putting something on the vertexes plist's
       (lambda (vertex)
         (traverse-elements-helper vertex style marker fn)))))
  
       (lambda (vertex)
         (traverse-elements-helper vertex style marker fn)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod traverse-elements-helper ((thing basic-vertex) (style (eql :depth)) marker fn)
    (when (eq (tag thing) marker)
  
  (defmethod traverse-elements-helper ((thing basic-vertex) (style (eql :depth)) marker fn)
    (when (eq (tag thing) marker)
@@ -821,7 +734,6 @@ something is putting something on the vertexes plist's
      
      (funcall fn thing)))
  
      
      (funcall fn thing)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod traverse-elements-helper ((thing basic-vertex) (style (eql :breadth)) marker fn)
    (when (eq (tag thing) marker)
  
  (defmethod traverse-elements-helper ((thing basic-vertex) (style (eql :breadth)) marker fn)
    (when (eq (tag thing) marker)
@@ -841,7 +753,6 @@ something is putting something on the vertexes plist's
         (setf (tag vertex) nil)
         (traverse-elements-helper vertex style marker fn)))))
  
         (setf (tag vertex) nil)
         (traverse-elements-helper vertex style marker fn)))))
  
-;;; ---------------------------------------------------------------------------
  
  ;; also in metatilites
  (defun graph-search-for-cl-graph (states goal-p successors combiner
  
  ;; also in metatilites
  (defun graph-search-for-cl-graph (states goal-p successors combiner
@@ -886,7 +797,6 @@ something is putting something on the vertexes plist's
                             (member state old-states :test state=))))
                (funcall successors (first states)))))))))
  
                             (member state old-states :test state=))))
                (funcall successors (first states)))))))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod in-undirected-cycle-p 
             ((graph basic-graph) (current basic-vertex)
  
  (defmethod in-undirected-cycle-p 
             ((graph basic-graph) (current basic-vertex)
@@ -902,7 +812,6 @@ something is putting something on the vertexes plist's
                           (t
                            (in-undirected-cycle-p graph child marked current)))))))
  
                           (t
                            (in-undirected-cycle-p graph child marked current)))))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod any-undirected-cycle-p ((graph basic-graph))
    (let ((marked (make-container 'simple-associative-container)))
  
  (defmethod any-undirected-cycle-p ((graph basic-graph))
    (let ((marked (make-container 'simple-associative-container)))
@@ -912,7 +821,6 @@ something is putting something on the vertexes plist's
                                    (return-from any-undirected-cycle-p v)))))
      (values nil)))
  
                                    (return-from any-undirected-cycle-p v)))))
      (values nil)))
  
-;;; ---------------------------------------------------------------------------
  
  (defun remove-list (original target)
    "Removes all elements in original from target."
  
  (defun remove-list (original target)
    "Removes all elements in original from target."
@@ -920,7 +828,6 @@ something is putting something on the vertexes plist's
                 (member target-element original))
               target))
  
                 (member target-element original))
               target))
  
-;;; ---------------------------------------------------------------------------
  
  (defun get-nodelist-relatives (node-list)
    "Collects set of unique relatives of nodes in node-list."
  
  (defun get-nodelist-relatives (node-list)
    "Collects set of unique relatives of nodes in node-list."
@@ -930,7 +837,6 @@ something is putting something on the vertexes plist's
              (append-unique (neighbor-vertexes node) unique-relatives)))
      unique-relatives))
  
              (append-unique (neighbor-vertexes node) unique-relatives)))
      unique-relatives))
  
-;;; ---------------------------------------------------------------------------
  
  (defun get-transitive-closure (vertex-list &optional (depth nil))
    "Given a list of vertices, returns a combined list of all of the nodes
  
  (defun get-transitive-closure (vertex-list &optional (depth nil))
    "Given a list of vertices, returns a combined list of all of the nodes
@@ -955,30 +861,25 @@ nil gathers the entire closure(s)."
                 (values visited))))
      (collect-transitive-closure vertex-list vertex-list depth)))
  
                 (values visited))))
      (collect-transitive-closure vertex-list vertex-list depth)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod edge-count ((graph basic-graph))
    (count-using #'iterate-edges nil graph))
  
  
  (defmethod edge-count ((graph basic-graph))
    (count-using #'iterate-edges nil graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod edge-count ((vertex basic-vertex))
    (size (vertex-edges vertex)))
  
  
  (defmethod edge-count ((vertex basic-vertex))
    (size (vertex-edges vertex)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod topological-sort ((graph basic-graph))
    (assign-level graph 0)
    (sort (collect-elements (graph-vertexes graph))  #'<
          :key (lambda (x) (depth-level x))))
  
  
  (defmethod topological-sort ((graph basic-graph))
    (assign-level graph 0)
    (sort (collect-elements (graph-vertexes graph))  #'<
          :key (lambda (x) (depth-level x))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod assign-level ((graph basic-graph) (level number))
    (loop for node in (graph-roots graph)
          do (assign-level node 0)))
  
  
  (defmethod assign-level ((graph basic-graph) (level number))
    (loop for node in (graph-roots graph)
          do (assign-level node 0)))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod assign-level ((node basic-vertex) (level number))
    (if (or (not (depth-level node))
  
  (defmethod assign-level ((node basic-vertex) (level number))
    (if (or (not (depth-level node))
@@ -986,7 +887,6 @@ nil gathers the entire closure(s)."
      (setf (depth-level node) level))
    (iterate-children node (lambda (x) (assign-level x (1+ level)))))
  
      (setf (depth-level node) level))
    (iterate-children node (lambda (x) (assign-level x (1+ level)))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod depth ((graph basic-graph))
    (assign-level graph 0)
  
  (defmethod depth ((graph basic-graph))
    (assign-level graph 0)
@@ -996,9 +896,7 @@ nil gathers the entire closure(s)."
                                 (setf depth (depth-level vertex)))))
      depth))
  
                                 (setf depth (depth-level vertex)))))
      depth))
  
-;;; ---------------------------------------------------------------------------
  ;;; mapping
  ;;; mapping
-;;; ---------------------------------------------------------------------------
  
  (defun map-paths (graph start-vertex length fn &key (filter (constantly t)))
    "Apply fn to each path that starts at start-vertex and is of exactly length 
  
  (defun map-paths (graph start-vertex length fn &key (filter (constantly t)))
    "Apply fn to each path that starts at start-vertex and is of exactly length 
@@ -1024,7 +922,6 @@ length"
           (follow-path v (list v start-vertex) (1- length))))))
    (values graph))
  
           (follow-path v (list v start-vertex) (1- length))))))
    (values graph))
  
-;;; ---------------------------------------------------------------------------
  
  (defun map-shortest-paths
      (graph start-vertex depth fn &key (filter (constantly t)))
  
  (defun map-shortest-paths
      (graph start-vertex depth fn &key (filter (constantly t)))
@@ -1050,23 +947,18 @@ length"
                   :filter filter))))
  
  
                   :filter filter))))
  
  
-;;; ---------------------------------------------------------------------------
  ;;; utilities
  ;;; utilities
-;;; ---------------------------------------------------------------------------
  
  (defun append-unique (list1 list2)
    (remove-duplicates (append list1 list2)))
  
  
  (defun append-unique (list1 list2)
    (remove-duplicates (append list1 list2)))
  
-;;; ---------------------------------------------------------------------------
  ;;; project-bipartite-graph
  ;;; project-bipartite-graph
-;;; ---------------------------------------------------------------------------
  
  (defmethod project-bipartite-graph 
             ((new-graph symbol) graph vertex-class vertex-classifier)
    (project-bipartite-graph
     (make-instance new-graph) graph vertex-class  vertex-classifier))
  
  
  (defmethod project-bipartite-graph 
             ((new-graph symbol) graph vertex-class vertex-classifier)
    (project-bipartite-graph
     (make-instance new-graph) graph vertex-class  vertex-classifier))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod project-bipartite-graph 
             ((new-graph basic-graph) graph vertex-class vertex-classifier)
  
  (defmethod project-bipartite-graph 
             ((new-graph basic-graph) graph vertex-class vertex-classifier)
diff --git a/dev/subgraph-containing.lisp b/dev/subgraph-containing.lisp

index c4f33df..813d577 100644 (file)
--- a/dev/subgraph-containing.lisp
+++ b/dev/subgraph-containing.lisp
@@ -3,9 +3,7 @@
  (in-package #:cl-graph)
  
  
  (in-package #:cl-graph)
  
  
-;;; ---------------------------------------------------------------------------
  ;;; make-filtered-graph
  ;;; make-filtered-graph
-;;; ---------------------------------------------------------------------------
  
  (defmethod complete-links ((new-graph basic-graph) 
                             (old-graph basic-graph))
  
  (defmethod complete-links ((new-graph basic-graph) 
                             (old-graph basic-graph))
@@ -54,7 +52,6 @@
                                             :value (value edge)
                                             :edge-type edge-type))))))))))
  
                                             :value (value edge)
                                             :edge-type edge-type))))))))))
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-filtered-graph ((old-graph basic-graph)
                                  test-fn
  
  (defmethod make-filtered-graph ((old-graph basic-graph)
                                  test-fn
@@ -84,7 +81,6 @@
         (complete-links new-graph old-graph)))
    new-graph)
  
         (complete-links new-graph old-graph)))
    new-graph)
  
-;;; ---------------------------------------------------------------------------
  
  (defmethod subgraph-containing ((graph basic-graph) (vertex basic-vertex)
                                  &rest args &key (depth nil) (new-graph nil))
  
  (defmethod subgraph-containing ((graph basic-graph) (vertex basic-vertex)
                                  &rest args &key (depth nil) (new-graph nil))
@@ -96,9 +92,7 @@
          :graph-completion-method :complete-closure-with-links
          args))
  
          :graph-completion-method :complete-closure-with-links
          args))
  
-;;; ---------------------------------------------------------------------------
  ;;; for completeness 
  ;;; for completeness 
-;;; ---------------------------------------------------------------------------
  
  (defmethod make-graph-from-vertexes ((vertex-list list))
    (bind ((edges-to-keep nil)
  
  (defmethod make-graph-from-vertexes ((vertex-list list))
    (bind ((edges-to-keep nil)
author	Gary King <gwking@metabang.com>
	Tue, 30 Sep 2008 02:35:31 +0000 (22:35 -0400)
committer	Gary King <gwking@metabang.com>
	Tue, 30 Sep 2008 02:35:31 +0000 (22:35 -0400)
dev/api.lisp		patch \| blob \| history
dev/graph-algorithms.lisp		patch \| blob \| history
dev/graph-container.lisp		patch \| blob \| history
dev/graph-generation.lisp		patch \| blob \| history
dev/graph-iterators.lisp		patch \| blob \| history
dev/graph-matrix.lisp		patch \| blob \| history
dev/graph-metrics.lisp		patch \| blob \| history
dev/graph.lisp		patch \| blob \| history
dev/subgraph-containing.lisp		patch \| blob \| history