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

[cl-graph.git] / dev / graph.lisp

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