X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=dev%2Fgraph-algorithms.lisp;h=2455e183695e2409dc9a4529e7a06acef1670bc9;hb=18871eadb3f0704f6211e68fea61ed9043209885;hp=b3df8892d0e7fbd968557fdbed8b76a524a71d30;hpb=1fe64e8b966450697100fae6ec35cc5688a88bd6;p=cl-graph.git diff --git a/dev/graph-algorithms.lisp b/dev/graph-algorithms.lisp index b3df889..2455e18 100644 --- a/dev/graph-algorithms.lisp +++ b/dev/graph-algorithms.lisp @@ -141,15 +141,13 @@ (collect-elements (make-iterator (connected-components graph) :unique t :transform #'parent)))) -;;; --------------------------------------------------------------------------- - (defmethod find-connected-components ((graph basic-graph)) (collect-elements (make-iterator (connected-components graph) :unique t :transform #'parent) :transform (lambda (component) (subgraph-containing graph (element component) - most-positive-fixnum)))) + :depth most-positive-fixnum)))) #+Alternate (defmethod find-connected-components ((graph basic-graph)) @@ -230,46 +228,6 @@ graph) ;;; --------------------------------------------------------------------------- -;;; for completeness -;;; --------------------------------------------------------------------------- - -(defmethod make-graph-from-vertexes ((vertex-list list)) - (bind ((edges-to-keep nil) - (g (copy-template (graph (first vertex-list))))) - - (iterate-elements - vertex-list - (lambda (v) - (add-vertex g (element v)) - (iterate-elements - (edges v) - (lambda (e) - (when (and (member (vertex-1 e) vertex-list) - (member (vertex-2 e) vertex-list)) - (pushnew e edges-to-keep :test #'eq)))))) - - (iterate-elements - edges-to-keep - (lambda (e) - (bind ((v1 (source-vertex e)) - (v2 (target-vertex e))) - ;;?? can we use copy here... - (add-edge-between-vertexes - g (element v1) (element v2) - :edge-type (if (directed-edge-p e) - :directed - :undirected) - :if-duplicate-do :force - :edge-class (type-of e) - :value (value e) - :edge-id (edge-id e) - :element (element e) - :tag (tag e) - :graph g - :color (color e))))) - g)) - -;;; --------------------------------------------------------------------------- (defmethod edge-lessp-by-weight ((e1 basic-edge) (e2 basic-edge)) (< (weight e1) (weight e2)))