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