X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=dev%2Fgraph-generation.lisp;h=cf983a0775657c3af0d12cb5ec6eecb18c615d6b;hb=1fe64e8b966450697100fae6ec35cc5688a88bd6;hp=36bcbb7fdab00a1a9238508f180d4010a1f05ea7;hpb=438d1e0593dc62fe7b975a5865ec27955afcb7a1;p=cl-graph.git

diff --git a/dev/graph-generation.lisp b/dev/graph-generation.lisp
index 36bcbb7..cf983a0 100644
--- a/dev/graph-generation.lisp
+++ b/dev/graph-generation.lisp
@@ -1,31 +1,32 @@
-(in-package metabang.graph)
-
-(export '(generate-Gnp
-          generate-Gnm
-          generate-undirected-graph-via-assortativity-matrix
-          generate-undirected-graph-via-vertex-probabilities
-          generate-multi-group-graph-fixed
-          #+Ignore generate-girvan-newman-graph
-          generate-scale-free-graph
-          generate-assortative-graph-with-degree-distributions
-          
-          generate-simple-preferential-attachment-graph
-          generate-preferential-attachment-graph
-          
-          generate-acquaintance-network
-          generate-acquaintance-network-until-stable
-
-          generate-graph-by-resampling-edges
-
-          sample-edge
-          basic-edge-sampler
-          weighted-edge-sampler
-          simple-group-id-generator
-          simple-group-id-parser
-          
-          make-degree-sampler
-          poisson-vertex-degree-distribution
-          power-law-vertex-degree-distribution))
+(in-package #:metabang.graph)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (export '(generate-gnp
+            generate-gnm
+            generate-undirected-graph-via-assortativity-matrix
+            generate-undirected-graph-via-vertex-probabilities
+            generate-multi-group-graph-fixed
+            #+Ignore generate-girvan-newman-graph
+            generate-scale-free-graph
+            generate-assortative-graph-with-degree-distributions
+            
+            generate-simple-preferential-attachment-graph
+            generate-preferential-attachment-graph
+            
+            generate-acquaintance-network
+            generate-acquaintance-network-until-stable
+            
+            generate-graph-by-resampling-edges
+            
+            sample-edge
+            basic-edge-sampler
+            weighted-edge-sampler
+            simple-group-id-generator
+            simple-group-id-parser
+            
+            make-degree-sampler
+            poisson-vertex-degree-distribution
+            power-law-vertex-degree-distribution)))
 
 ;;; ---------------------------------------------------------------------------
 ;;; classes
@@ -59,16 +60,16 @@
 
 
 ;;; ---------------------------------------------------------------------------
-;;; generate-Gnp
+;;; generate-gnp
 ;;; ---------------------------------------------------------------------------
 
-(defmethod generate-Gnp (generator (graph-class symbol) n p &key (label 'identity))
-  (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 basic-graph) n p &key (label 'identity))
+(defmethod generate-gnp (generator (graph basic-graph) n p &key (label 'identity))
   (let ((v 1)
         (w -1)
         (log-1-p (log (- 1 p))))
@@ -88,17 +89,18 @@
     graph))
 
 ;;; ---------------------------------------------------------------------------
-;;; generate-Gnm
+;;; generate-gnm
 ;;; ---------------------------------------------------------------------------
 
-(defmethod generate-Gnm (generator (graph-class symbol) n p &key (label 'identity))
-  (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 basic-graph) n m &key (label 'identity))
+(defmethod generate-gnm (generator (graph basic-graph) n m &key (label 'identity))
   (let ((max-edge-index (1- (combination-count n 2))))
+    (assert (<= m max-edge-index))
     #+Ignore
     (save-generation-information graph generator 'generate-gnm)
     (loop for i from 0 to (1- n) do
@@ -1428,6 +1430,13 @@ should include pointer back to original graph
 ;;; ---------------------------------------------------------------------------
 
 (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)
   (bind ((m (make-array (list (* 2 size minimum-degree)))))
     (loop for v from 0 to (1- size) do
@@ -1646,7 +1655,16 @@ should include pointer back to original graph
 
 ;;; ---------------------------------------------------------------------------
 
-(Defmethod generate-acquaintance-network 
+
+(defmethod generate-acquaintance-network 
+    (generator (class-name symbol) size death-probability iterations vertex-labeler
+     &key (duplicate-edge-function :ignore))
+  (generate-acquaintance-network 
+	 generator (make-instance class-name)
+	 size death-probability iterations vertex-labeler
+	 :duplicate-edge-function duplicate-edge-function))
+
+(defmethod generate-acquaintance-network 
            (generator graph size death-probability iterations vertex-labeler
                       &key (duplicate-edge-function :ignore))
   ;; bring the graph up to size
@@ -1689,7 +1707,7 @@ should include pointer back to original graph
     (flet ((sample-other-vertex ()
              (loop for result = (sample-element (graph-vertexes graph) generator)
                    until (not (eq vertex result))
-                   finally (return result))))  ;; CTM: 'finally do' not legal in openMCL
+                   finally (return result))))
       (if neighbors
         (add-edge-between-vertexes 
          graph
@@ -1705,6 +1723,12 @@ should include pointer back to original graph
     (let ((vertex (sample-element (graph-vertexes graph) generator)))
       (delete-vertex graph vertex)
       (add-vertex graph (element vertex)))))
+
+#+Ignore
+(defun sv (v)
+  (format t "~%~A ~A" 
+	  v 
+	  (adjustable-array-p (contents (vertex-edges v)))))
   
 #+Test
 (generate-acquaintance-network