mostly maintenance in maintaining internal conventions... a few more tests as well

darcs-hash:20071125171607-3cc5d-a44b7846b3e8fed909a6a4316467fa07a0aa0411.gz

diff --git a/cl-graph-test.asd b/cl-graph-test.asd
index e822084..529501a 100644 (file)
--- a/cl-graph-test.asd
+++ b/cl-graph-test.asd
@@ -1,8 +1,8 @@
 ;;; -*- Mode: Lisp; package: cl-user; Syntax: Common-lisp; Base: 10 -*-
 
 (in-package :common-lisp-user)
-(defpackage #:asdf-cl-graph-test (:use #:cl #:asdf))
-(in-package #:asdf-cl-graph-test)
+(defpackage #:cl-graph-test-system (:use #:cl #:asdf))
+(in-package #:cl-graph-test-system)
 
 (defsystem cl-graph-test
   :version "0.1"
@@ -10,7 +10,6 @@
   :maintainer "Gary Warren King <gwking@metabang.com>"
   :licence "MIT Style License"
   :description "Tests for CL-Graph"
-
   :components ((:module 
                "unit-tests"
                :components
@@ -26,4 +25,4 @@
                "dev"
                :components
                ((:static-file "notes.text"))))
-  :depends-on (cl-graph lift))
+  :depends-on (:cl-graph :lift))

diff --git a/cl-graph.asd b/cl-graph.asd
index d13ea3d..13b3e11 100644 (file)
--- a/cl-graph.asd
+++ b/cl-graph.asd
@@ -1,28 +1,25 @@
 ;;; -*- Mode: Lisp; package: cl-user; Syntax: Common-lisp; Base: 10 -*-
 
 (in-package #:common-lisp-user)
-(defpackage #:asdf-cl-graph (:use #:cl #:asdf))
-(in-package #:asdf-cl-graph)
+(defpackage #:cl-graph-system (:use #:cl #:asdf))
+(in-package #:cl-graph-system)
 
 (unless (find-system 'asdf-system-connections nil)
- (when (find-package 'asdf-install)
-   (print "Trying to install asdf-system-connections with ASDF-Install...")
-   (funcall (intern (symbol-name :install) :asdf-install) 'asdf-system-connections)))
-;; give up with a useful (?) error message
-(unless (find-system 'asdf-system-connections nil)
-  (error "The CL-Graph system requires ASDF-SYSTEM-CONNECTIONS. See 
+  (warn "The CL-Graph system would enjoy having asdf-system-connections 
+around. See 
 http://www.cliki.net/asdf-system-connections for details and download
 instructions."))
-
-(asdf:operate 'asdf:load-op 'asdf-system-connections)
+(when (find-system 'asdf-system-connections nil)
+  (operate 'load-op 'asdf-system-connections))
 
 (defsystem cl-graph
-  :version "0.8.3"
+  :version "0.8.4"
   :author "Gary Warren King <gwking@metabang.com>"
   :maintainer "Gary Warren King <gwking@metabang.com>"
   :licence "MIT Style License"
   :description "Graph manipulation utilities for Common Lisp"
-  :components ((:module 
+  :components ((:static-file "COPYING")
+              (:module 
                "dev"
                :components 
                ((:file "package")
@@ -50,11 +47,11 @@ instructions."))
                :components 
                ((:module "source"
                          :components ((:static-file "index.lml"))))))
-  :in-order-to ((test-op (load-op cl-graph-test)))
+  :in-order-to ((test-op (load-op :cl-graph-test)))
   :perform (test-op :after (op c)
-                    (describe 
-                    (funcall (intern (symbol-name '#:run-tests) :lift) 
-                             :suite '#:cl-graph-test)))
+                   (funcall
+                     (intern (symbol-name '#:run-tests) :lift)
+                     :config :generic))
   :depends-on (:metatilities 
               :cl-containers
               :metabang-bind

diff --git a/dev/graph-algorithms.lisp b/dev/graph-algorithms.lisp
index b3df889..99fe704 100644 (file)
--- 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))

diff --git a/dev/graph.lisp b/dev/graph.lisp
index ce450a4..3af3c47 100644 (file)
--- a/dev/graph.lisp
+++ b/dev/graph.lisp
@@ -622,7 +622,14 @@ something is putting something on the vertexes plist's
        (when error-if-not-found?
          (error 'graph-vertex-not-found-error :vertex value :graph graph))))
 
-;;; ---------------------------------------------------------------------------
+(defmethod find-vertex ((graph basic-graph) (vertex basic-vertex)
+                        &optional (error-if-not-found? t))
+  (cond ((eq graph (graph vertex))
+        vertex)
+       (t
+        (when error-if-not-found?
+          (error 'graph-vertex-not-found-error 
+                 :vertex vertex :graph graph)))))
 
 (defmethod find-vertex ((edge basic-edge) (value t)
                         &optional (error-if-not-found? t))

diff --git a/dev/package.lisp b/dev/package.lisp
index eb250c9..1706df5 100644 (file)
--- a/dev/package.lisp
+++ b/dev/package.lisp
@@ -117,7 +117,9 @@ DISCUSSION
    #:has-children-p
    #:has-parent-p
    #:number-of-neighbors
-   
+   #:graph-vertexes
+   #:replace-vertex
+
    #:edge-count                    ; graph
    #:vertex-count                  ; graph
    
@@ -160,7 +162,8 @@ DISCUSSION
    #:project-bipartite-graph
    
    #:make-vertex-edges-container 
-   
+   #:make-vertex-for-graph
+
    #:vertex-degree-counts
    #:vertex-degree
    #:average-vertex-degree
@@ -170,7 +173,12 @@ DISCUSSION
    #:graph-mixing-matrix
    #:graph-edge-mixture-matrix
    #:assortativity-coefficient
-   #:vertex-degree-summary)
+   #:vertex-degree-summary
+   #:connected-components
+   #:average-local-clustering-coefficient
+   #:vertex-triangle-count
+   #:graph-edges
+   #:graph-vertexes)
 
   (:export
    #:print-dot-key-value

diff --git a/unit-tests/test-graph-container.lisp b/unit-tests/test-graph-container.lisp
index 0c1657b..f2e2c89 100644 (file)
--- a/unit-tests/test-graph-container.lisp
+++ b/unit-tests/test-graph-container.lisp
@@ -47,6 +47,7 @@
     (ensure-same (size g) 6 :test '=)))
 
 
+#|
 ;;; ---------------------------------------------------------------------------
 ;;; copying
 ;;; ---------------------------------------------------------------------------
@@ -79,6 +80,5 @@
     (ensure (not 
              (find-edge-between-vertexes g2 (find-vertex g1 'a) (find-vertex g1 'b))))))
 
-;;; ---------------------------------------------------------------------------
-
+|#
 

diff --git a/unit-tests/test-graph.lisp b/unit-tests/test-graph.lisp
index a30df12..aae24be 100644 (file)
--- a/unit-tests/test-graph.lisp
+++ b/unit-tests/test-graph.lisp
@@ -12,7 +12,7 @@
 
 (deftestsuite cl-graph-test () ())
 
-(deftestsuite test-test-vertex () ())
+(deftestsuite test-test-vertex (cl-graph-test) ())
 
 (addtest (test-test-vertex)
   test-1
@@ -68,7 +68,7 @@
   (delete-edge-between-vertexes graph-directed 'a 'b)
   (ensure-same (size (graph-edges graph-directed)) 3))
 
-;;; ---------------------------------------------------------------------------
+#|
 
 (deftestsuite cl-graph-test-traversal (cl-graph-test)
   ((g (make-container 'graph-container)))
@@ -77,8 +77,6 @@
                                   (h j)) do
                (add-edge-between-vertexes g src dst :edge-type :directed)))
 
-;;; ---------------------------------------------------------------------------
-
 #|
 
 a - b - e
@@ -97,8 +95,6 @@ a - b - e
     (ensure-same (reverse result) 
                  '(e f b c g i j h d a) :test #'equal)))
 
-;;; ---------------------------------------------------------------------------
-
 (addtest (cl-graph-test-traversal)
   (let ((result nil))
     (traverse-elements
@@ -107,6 +103,7 @@ a - b - e
     (ensure-same (reverse result) 
                  '(a b c d e f g h i j) :test #'equal)))
     
+|#
     
 ;;; ---------------------------------------------------------------------------
 ;;; test-replace-vertex

diff --git a/unit-tests/tests-in-progress.lisp b/unit-tests/tests-in-progress.lisp
new file mode 100644 (file)
index 0000000..335f060
--- /dev/null
+++ b/unit-tests/tests-in-progress.lisp
@@ -0,0 +1,51 @@
+(in-package cl-graph)
+
+(defun foo ()
+  (let ((graph (cl-graph:make-graph 'cl-graph:graph-container 
+                                   :vertex-test #'equal)))
+    (cl-graph:add-vertex graph "a")
+    (cl-graph:add-vertex graph "b")
+    (cl-graph:add-vertex graph "c")
+    (cl-graph:add-vertex graph "d")
+    (cl-graph:add-vertex graph "e")
+    (cl-graph:add-edge-between-vertexes graph "a" "b" :edge-type :directed)
+    (cl-graph:add-edge-between-vertexes graph "b" "c" :edge-type :directed)
+    (cl-graph:add-edge-between-vertexes graph "c" "a" :edge-type :directed)
+    (cl-graph:add-edge-between-vertexes graph "d" "e" :edge-type :directed)
+    graph))
+
+(loop for component in 
+     (cl-graph:find-connected-components (foo)) 
+     for index from 1 do
+     (format t "~&Component ~D (~d node~:p and ~d edge~:p)" 
+            index (vertex-count component) (edge-count component))
+     (iterate-edges component (lambda (edge)
+                               (format t "~&  ~a to ~a" 
+                                       (source-vertex edge) 
+                                       (target-vertex edge))))
+     (format t "~%"))
+
+
+(defun mk-graph ()
+    (let ((graph (cl-graph:make-graph 'cl-graph:graph-container
+                                   :vertex-test #'equal)))
+    (cl-graph:add-vertex graph "a")
+    (cl-graph:add-vertex graph "b")
+    (cl-graph:add-vertex graph "c")
+    (cl-graph:add-vertex graph "d")
+    (cl-graph:add-vertex graph "e")
+    (cl-graph:add-edge-between-vertexes graph "a" "b" :edge-type :directed)
+    (cl-graph:add-edge-between-vertexes graph "b" "c" :edge-type :directed)
+    (cl-graph:add-edge-between-vertexes graph "c" "a" :edge-type :directed)
+    (cl-graph:add-edge-between-vertexes graph "d" "e" :edge-type :directed)
+    graph))
+
+(mk-graph)
+
+(setf *g* (mk-graph))
+
+(mapcar (lambda (v)
+         (list v (cl-graph:in-cycle-p *g* v)))
+       (cl-graph:vertexes *g*))
+
+(car (cl-graph:vertexes *g*))