cleanup; reduce bitrot

[cl-graph.git] / dev / graph-generation.lisp

diff --git a/dev/graph-generation.lisp b/dev/graph-generation.lisp
index 36bcbb7..eed4009 100644 (file)
--- 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
@@ -396,7 +398,7 @@
 ;;; ---------------------------------------------------------------------------
 
 (defun poisson-vertex-degree-distribution (z k)
-  (/ (* (expt z k) (expt +e+ (- z)))
+  (/ (* (expt z k) (expt cl-mathstats:+e+ (- z)))
      (factorial k)))
 
 #|
@@ -407,7 +409,8 @@ from this distribution
 ;;; ---------------------------------------------------------------------------
 
 (defun power-law-vertex-degree-distribution (kappa k)
-  (* (- 1 (expt +e+ (- (/ kappa)))) (expt +e+ (- (/ k kappa)))))
+  (* (- 1 (expt cl-mathstats:+e+ (- (/ kappa)))) 
+     (expt cl-mathstats:+e+ (- (/ k kappa)))))
 
 ;;; ---------------------------------------------------------------------------
 
@@ -1428,6 +1431,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 +1656,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 +1708,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 +1724,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