Split out moptilities and dynamic-classes requirements into system-connections

darcs-hash:20080928192503-3cc5d-54117472c8e4a03f4d2b05750b84c95c6929d16a.gz

diff --git a/cl-graph-test.asd b/cl-graph-test.asd
index b5532ed..83c980c 100644 (file)
--- a/cl-graph-test.asd
+++ b/cl-graph-test.asd
@@ -23,7 +23,6 @@
                :components
                ((:file "test-graph-container")
                 (:file "test-connected-components")
-                (:file "test-graph-metrics")
                 ;;(:file "test-graph-algorithms")
                 (:file "test-api")
                 ))
@@ -33,3 +32,13 @@
                :components
                ((:static-file "notes.text"))))
   :depends-on (:cl-graph :lift))
+
+;; 2008-09-24 - I don't know if this will work or not 
+;; i.e., will it happen at the right time wrt everything else
+#+asdf-system-connections
+(asdf:defsystem-connection cl-graph-test-and-cl-mathstats
+  :requires (cl-graph moptilities)
+  :components ((:module 
+               "unit-tests"
+               :components
+               ((:file "test-graph-metrics")))))

diff --git a/cl-graph.asd b/cl-graph.asd
index e6eb3ca..2f93908 100644 (file)
--- a/cl-graph.asd
+++ b/cl-graph.asd
@@ -51,11 +51,8 @@ instructions."))
                      (intern (symbol-name '#:run-tests) :lift)
                      :config :generic))
   :depends-on ((:version :metatilities-base "0.6.0")
-              :dynamic-classes
               :cl-containers
               :metabang-bind
-              ;:cl-mathstats
-              :moptilities
               ))
 
 (defmethod operation-done-p 
@@ -96,3 +93,23 @@ instructions."))
                "dev"
                :components
                ((:file "graph-metrics")))))
+
+#+asdf-system-connections
+(asdf:defsystem-connection cl-graph-and-moptilities
+  :requires (cl-graph moptilities)
+  :components ((:module 
+               "dev"
+               :components
+               ((:file "subgraph-containing")))))
+
+#+asdf-system-connections
+(asdf:defsystem-connection cl-graph-and-dynamic-classes
+  :requires (cl-graph dynamic-classes)
+  :components ((:module 
+               "dev"
+               :components
+               ((:file "dynamic-classes")))))
+
+
+
+

diff --git a/dev/dynamic-classes.lisp b/dev/dynamic-classes.lisp
new file mode 100644 (file)
index 0000000..e20f28a
--- /dev/null
+++ b/dev/dynamic-classes.lisp
@@ -0,0 +1,6 @@
+(in-package cl-graph)
+
+(defmethod make-graph ((classes list) &rest args)
+  (let ((name (dynamic-classes:find-or-create-class 'basic-graph classes))) 
+    (apply #'make-instance name args)))
+

diff --git a/dev/graph-algorithms.lisp b/dev/graph-algorithms.lisp
index 99fe704..2455e18 100644 (file)
--- a/dev/graph-algorithms.lisp
+++ b/dev/graph-algorithms.lisp
@@ -228,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)))

diff --git a/dev/graph.lisp b/dev/graph.lisp
index 6ff6b65..8531652 100644 (file)
--- a/dev/graph.lisp
+++ b/dev/graph.lisp
@@ -250,12 +250,6 @@ something is putting something on the vertexes plist's
   (apply #'make-instance graph-type args))
 
 ;;; ---------------------------------------------------------------------------
-
-(defmethod make-graph ((classes list) &rest args)
-  (let ((name (dynamic-classes:find-or-create-class 'basic-graph classes))) 
-    (apply #'make-instance name args)))
-
-;;; ---------------------------------------------------------------------------
 ;;; generic implementation 
 ;;; ---------------------------------------------------------------------------
 
@@ -961,99 +955,6 @@ nil gathers the entire closure(s)."
     (collect-transitive-closure vertex-list vertex-list depth)))
 
 ;;; ---------------------------------------------------------------------------
-;;; make-filtered-graph
-;;; ---------------------------------------------------------------------------
-
-(defmethod complete-links ((new-graph basic-graph) 
-                           (old-graph basic-graph))
-  ;; Copy links from old-graph ONLY for nodes already in new-graph
-  (iterate-vertexes 
-   new-graph
-   (lambda (vertex)
-     (let ((old-graph-vertex (find-vertex old-graph (value vertex))))
-       (iterate-edges
-        old-graph-vertex
-        (lambda (old-edge)
-          (let* ((old-other-vertex (other-vertex old-edge old-graph-vertex))
-                 (new-other-vertex (find-vertex new-graph (value old-other-vertex) nil)))
-            (when (and new-other-vertex
-                       (< (vertex-id vertex) (vertex-id new-other-vertex)))
-              (let* ((new-edge (copy-template old-edge)))
-                (if (eq old-graph-vertex (vertex-1 old-edge))
-                  (setf (slot-value new-edge 'vertex-1) vertex
-                        (slot-value new-edge 'vertex-2) new-other-vertex)
-                  (setf (slot-value new-edge 'vertex-2) vertex
-                        (slot-value new-edge 'vertex-1) new-other-vertex))
-                (add-edge new-graph new-edge))))))))))
-
-#+Old
-(defmethod complete-links ((new-graph basic-graph) 
-                           (old-graph basic-graph))
-  ;; Copy links from old-graph ONLY for nodes already in new-graph
-  (iterate-vertexes 
-   new-graph
-   (lambda (vertex)
-     (let ((old-graph-vertex (find-vertex old-graph (value vertex))))
-       (iterate-edges
-        old-graph-vertex
-        (lambda (edge)
-          (let* ((old-other-vertex (other-vertex edge old-graph-vertex))
-                 (new-other-vertex (find-vertex new-graph (value old-other-vertex) nil))
-                 (edge-type (if (directed-edge-p edge)
-                              :directed :undirected)))
-            (when new-other-vertex
-              (if (and (directed-edge-p edge)
-                       (eq old-graph-vertex (target-vertex edge)))
-                (add-edge-between-vertexes new-graph new-other-vertex vertex
-                                           :value (value edge)
-                                           :edge-type edge-type)
-                (add-edge-between-vertexes new-graph vertex new-other-vertex
-                                           :value (value edge)
-                                           :edge-type edge-type))))))))))
-
-;;; ---------------------------------------------------------------------------
-
-(defmethod make-filtered-graph ((old-graph basic-graph)
-                                test-fn
-                                &key
-                                (graph-completion-method nil)
-                                (depth nil)
-                               (new-graph 
-                                (copy-template old-graph)))
-  (ecase graph-completion-method
-    ((nil 
-      :complete-links)
-     (iterate-vertexes old-graph
-                      (lambda (vertex)
-                        (when (funcall test-fn vertex)
-                          (add-vertex new-graph (value vertex))))))
-    ((:complete-closure-nodes-only 
-      :complete-closure-with-links)
-     (let* ((old-graph-vertexes  (collect-items old-graph :filter test-fn))
-           (closure-vertexes 
-            (get-transitive-closure old-graph-vertexes depth)))
-       (dolist (vertex closure-vertexes)
-        (add-vertex new-graph (copy-template vertex))))))
-  (ecase graph-completion-method
-      ((nil :complete-closure-nodes-only) nil)
-      ((:complete-links
-        :complete-closure-with-links)
-       (complete-links new-graph old-graph)))
-  new-graph)
-
-;;; ---------------------------------------------------------------------------
-
-(defmethod subgraph-containing ((graph basic-graph) (vertex basic-vertex)
-                                &rest args &key (depth nil) (new-graph nil))
-  (declare (ignore depth new-graph))
-  (apply #'make-filtered-graph
-        graph
-        #'(lambda (v)
-            (equal v vertex))
-        :graph-completion-method :complete-closure-with-links
-        args))
-
-;;; ---------------------------------------------------------------------------
 
 (defmethod edge-count ((graph basic-graph))
   (count-using #'iterate-edges nil graph))

diff --git a/dev/package.lisp b/dev/package.lisp
index 0b3a3c3..4775542 100644 (file)
--- a/dev/package.lisp
+++ b/dev/package.lisp
@@ -11,7 +11,7 @@ DISCUSSION
 
 (defpackage #:cl-graph
   (:use #:common-lisp #:metatilities #:cl-containers 
-        #:metabang.bind #+(or) #:cl-mathstats #:moptilities)
+        #:metabang.bind #+(or) #:cl-mathstats #+(or) #:moptilities)
   (:nicknames #:metabang.graph)
   (:documentation "CL-Graph is a Common Lisp library for manipulating graphs and running graph algorithms.")