From: Gary King Date: Sun, 28 Sep 2008 19:25:03 +0000 (-0400) Subject: Split out moptilities and dynamic-classes requirements into system-connections X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=18871eadb3f0704f6211e68fea61ed9043209885;p=cl-graph.git 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 --- 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 --- 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 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 --- 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 --- 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 --- 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.")