From: Gary King Date: Thu, 9 Mar 2006 14:43:21 +0000 (-0500) Subject: Added additional generation methods that dispatch on symbols instead of graphs X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ca59f054a82701af97d9692576a5ce301980c60d;p=cl-graph.git Added additional generation methods that dispatch on symbols instead of graphs darcs-hash:20060309144321-3cc5d-fc17088be840ff8632cefba46828abd28109b855.gz --- diff --git a/dev/graph-generation.lisp b/dev/graph-generation.lisp index 46d813e..4df3ca7 100644 --- a/dev/graph-generation.lisp +++ b/dev/graph-generation.lisp @@ -99,6 +99,7 @@ (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 @@ -1653,6 +1654,15 @@ should include pointer back to original graph ;;; --------------------------------------------------------------------------- + +(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)) @@ -1696,7 +1706,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 @@ -1712,6 +1722,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