-(in-package metabang.graph)
+(in-package #:metabang.graph)
;;; ---------------------------------------------------------------------------
;;;
;;; ---------------------------------------------------------------------------
-(defstruct (vertex-datum (:conc-name "NODE-") (:type list))
+(defstruct (vertex-datum (:conc-name node-) (:type list))
(color nil)
(depth most-positive-fixnum)
(parent nil))
(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))
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)))
;;; ---------------------------------------------------------------------------
-#+ignore ;;; shit
+#+ignore ;;; shoot
(defmethod minimum-spanning-tree ((vertex-list list)
&key
(edge-sorter #'edge-lessp-by-weight))
(iterate-container
vertex-list
(lambda (v)
- (mst-make-set v)))
-
-
+ (mst-make-set v)))
(loop for edge in (sort v-edges edge-sorter) do
(bind ((v1 (source-vertex edge))