Setting a test suite at last

darcs-hash:20060428153042-3cc5d-3d06a0a10e151e99f7774fa486a8a87ea7d72e8e.gz

diff --git a/cl-graph-test.asd b/cl-graph-test.asd
new file mode 100644 (file)
index 0000000..1c58ada
--- /dev/null
+++ b/cl-graph-test.asd
@@ -0,0 +1,39 @@
+;;; -*- 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)
+
+(defsystem cl-graph-test
+  :version "0.1"
+  :author "Gary Warren King <gwking@metabang.com>"
+  :maintainer "Gary Warren King <gwking@metabang.com>"
+  :licence "MIT Style License"
+  :description "Tests for CL-Graph"
+
+  :components ((:module "unit-tests"
+                        :components ((:file "package")
+                                     (:file "test*" :depends-on ("package"))))
+               
+               (:module "dev"
+                        :components ((:static-file "notes.text"))))
+  
+  :in-order-to ((test-op (load-op moptilities-test)))
+  
+  :perform (test-op :after (op c)
+                    (describe
+                     (funcall 
+                      (intern (symbol-name '#:run-tests) '#:lift) 
+                      :suite (intern (symbol-name '#:cl-graph-test) '#:cl-graph-test))))
+  :depends-on (cl-graph lift))
+
+;;; ---------------------------------------------------------------------------
+
+(defmethod operation-done-p 
+           ((o test-op)
+            (c (eql (find-system 'moptilities-test))))
+  (values nil))

diff --git a/dev/test-connected-components.lisp b/dev/test-connected-components.lisp
deleted file mode 100644 (file)
index 53b8fce..0000000
--- a/dev/test-connected-components.lisp
+++ /dev/null
@@ -1,44 +0,0 @@
-(in-package metabang.graph)
-
-(deftestsuite test-connected-component ()
-  ())
-
-;;; ---------------------------------------------------------------------------
-
-(defun make-connected-component-graph-1 ()
-  (let ((g (make-container 'graph-container)))
-    (loop for label in '(wk-6-0 wp-5-1 wp-1-2 wp-2-3 wb-1-1
-                         wp-4-4 bp-5-6 bk-6-5 bb-5-7 bp-2-4
-                         bp-2-6 bp-1-5) do
-          (add-vertex g label))
-    (loop for (source target) in '((wk-6-0 wp-5-1)
-                                   (wp-1-2 wp-2-3)
-                                   (wb-1-1 wp-4-4)
-                                   (bp-5-6 bk-6-5)
-                                   (bk-6-5 bb-5-7)
-                                   (bb-5-7 bp-2-4)
-                                   (bp-2-6 bp-1-5)
-                                   (bp-1-5 bp-2-4)) do
-          (add-edge-between-vertexes g source target :edge-type :directed
-                                     :value :defend))
-    (loop for (source target) in '((bk-6-5 wp-4-4)) do
-          (add-edge-between-vertexes g source target :edge-type :directed 
-                                     :value :attack))
-    (loop for (source target) in '((wp-2-3 bp-2-4)) do
-          (add-edge-between-vertexes g source target :edge-type :undirected))
-    g))
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-connected-component)
-  test-1
-  (let ((g (make-connected-component-graph-1)))
-    (ensure-same
-     (mapcar #'size (find-connected-components g)) '(2 10) :test 'set-equal)))
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-connected-component)
-  test-connected-component-count-1
-  (let ((g (make-connected-component-graph-1)))
-    (ensure-same (connected-component-count g) 2 :test '=)))

diff --git a/dev/test-graph-algorithms.lisp b/dev/test-graph-algorithms.lisp
deleted file mode 100644 (file)
index f54b879..0000000
--- a/dev/test-graph-algorithms.lisp
+++ /dev/null
@@ -1,121 +0,0 @@
-(in-package cl-graph)
-
-(deftestsuite test-connected-components ()
-  ())
-
-(addtest (test-connected-components)
-  test-1
-  (let ((g (make-container 'graph-container  :default-edge-type :undirected)))
-    (loop for v in '(a b c d e f g h i j) do (add-vertex g v))
-    (loop for (v1 v2) in '((a b) (a c) ( b c) (b d) (e f) (e g) (h i)) do
-          (add-edge-between-vertexes g v1 v2))
-    
-    (let ((cc (connected-components g)))
-      (flet ((test (a b result)
-               (ensure-same (eq (representative-node cc (find-vertex g a))
-                                (representative-node cc (find-vertex g b)))
-                            result)))
-        (loop for (v1 v2 result) in '((a b t) (a e nil) (f g t)
-                               (j c nil) (b a t) (d c t)) do
-              (test v1 v2 result))))))
-
-;;; ---------------------------------------------------------------------------
-
-(deftestsuite test-minimum-spanning-tree ()
-  ())
-
-(deftestsuite test-mst-kruskal (test-minimum-spanning-tree)
-  ())
-
-(addtest (test-mst-kruskal)
-  test-1
-  (let ((g (make-container 'graph-container
-                           :default-edge-type :undirected
-                           :undirected-edge-class 'weighted-edge))
-        (m nil))
-    (loop for (v1 v2 w) in '((a b 4) (a h 9)
-                             (b c 8) (b h 11)
-                             (c i 2) (c d 7) (c f 4)
-                             (d e 9) (d f 14)
-                             (e f 10) 
-                             (f g 2)
-                             (g h 1) (g i 6)
-                             (h i 7)) do
-          (add-edge-between-vertexes g v1 v2 :weight w))
-    (setf m (minimum-spanning-tree-kruskal g))
-    (ensure (set-equal 
-             '(a b c d e f g h i)
-             (flatten (mapcar (lambda (e)
-                                (list (element (vertex-1 e)) (element (vertex-2 e)))) 
-                              m))))
-    (ensure-same (reduce #'+ m :key 'weight) 37 :test '=)
-    (ensure-same (size m) 8)))
-
-#+Test
-(defclass* directed-weighted-edge (weighted-edge-mixin graph-container-directed-edge)
-  ())
-
-#+Test
-(let ((g (make-container 'graph-container
-                         :default-edge-type :undirected
-                         :undirected-edge-class 'weighted-edge
-                         :directed-edge-class 'directed-weighted-edge)))
-  (loop for (v1 v2 w) in '((a b 4) (a h 9)
-                           (b c 8) (b h 11)
-                           (c i 2) (c d 7) (c f 4)
-                           (d e 9) (d f 14)
-                           (e f 10) 
-                           (f g 2)
-                           (g h 1) (g i 6)
-                           (h i 7)
-                           
-                           (a h 3)) do
-        (add-edge-between-vertexes g v1 v2 :weight w 
-                                   :edge-type (if (random-boolean *random-generator* 0.3) 
-                                                :directed :undirected)))
-  (minimum-spanning-tree-kruskal g))
-        
-#+Test
-(graph->dot 
- (let ((g (make-container 'graph-container
-                          :default-edge-type :undirected
-                          :undirected-edge-class 'weighted-edge))
-       (m nil))
-   (loop for (v1 v2 w) in '((a b 10) (a b 1) (a d 3)
-                           (b c 1) (b d 3)
-                           (c d 1)) do
-         (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force))
-   (setf m (minimum-spanning-tree-kruskal g))
-   g)
- "p2dis:data;x.dot")
-
-#+Test
-(let ((g (make-container 'graph-container
-                         :default-edge-type :undirected
-                         :undirected-edge-class 'weighted-edge))
-      (m nil))
-  (loop for (v1 v2 w) in '((a b 1) (a d 3)
-                           (b c 5) (b d 2)
-                           (c d 1)) do
-        (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force))
-  (setf m (minimum-spanning-tree-kruskal g))
-  m)
-
-;;; ---------------------------------------------------------------------------
-
-#+test
-(let ((graph (make-container 'graph-container)))
-  (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x) 
-                       (u y) (w x) (x y)) do
-        (add-edge-between-vertexes graph a b))
-  
-  (breadth-first-search-graph graph 's))
-
-;;; ---------------------------------------------------------------------------
-
-(let ((graph (make-container 'graph-container)))
-  (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x) 
-                       (u y) (w x) (x y)) do
-        (add-edge-between-vertexes graph a b))
-  
-  (breadth-first-visitor graph 's #'print))
\ No newline at end of file

diff --git a/dev/test-graph-container.lisp b/dev/test-graph-container.lisp
deleted file mode 100644 (file)
index c2697da..0000000
--- a/dev/test-graph-container.lisp
+++ /dev/null
@@ -1,77 +0,0 @@
-(in-package metabang.graph)
-
-;;; ---------------------------------------------------------------------------
-;;; utilities
-;;; ---------------------------------------------------------------------------
-
-(defun make-simple-test-graph ()
-  (let ((g (make-container 'graph-container))) 
-    (loop for v in '(a b c d e) do
-          (add-vertex g v))
-    (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
-          (add-edge-between-vertexes g v1 v2))
-    g))
-
-;;; ---------------------------------------------------------------------------
-;;; tests
-;;; --------------------------------------------------------------------------- 
-
-(deftestsuite test-graph-container () ())
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-graph-container)
-  test-simple-copying
-  (let ((g1 (make-simple-test-graph))
-        (g2 nil))
-    (setf g2 (copy-top-level g1))
-    (ensure-same (size g1) (size g2))
-    (iterate-vertexes
-     g1 (lambda (v)
-          (ensure (find-vertex g2 (value v)))))
-    (iterate-edges 
-     g1 (lambda (e)
-          (ensure (find-edge-between-vertexes 
-                   g2 (value (source-vertex e))
-                   (value (target-vertex e))))))))
-
-;;; ---------------------------------------------------------------------------
-
-;; fails because find-edge-between-vertexes for graph containers doesn't
-;; care about the graph...
-(addtest (test-graph-container)
-  test-find-edge-between-vertexes
-  (let ((g1 (make-simple-test-graph))
-        (g2 nil))
-    (setf g2 (copy-top-level g1))
-    
-    (ensure (not 
-             (find-edge-between-vertexes g2 (find-vertex g1 'a) (find-vertex g1 'b))))))
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-graph-container)
-  test-empty!
-  (let ((g1 (make-simple-test-graph)))
-    (empty! g1)
-    (ensure-same (size g1) 0)))
-
-;;; ---------------------------------------------------------------------------
-;;; vertex test 
-;;; ---------------------------------------------------------------------------
-
-;;?? should be in test-graph and work for every graph container type
-
-(addtest (test-graph-container)
-  no-vertex-test
-  (let ((g (make-container 'graph-container)))
-    (loop for (src dst) in '((a b) (a c) (c d) (a d) (d e) (e f) (b f)) do
-          (add-edge-between-vertexes g (list src) (list dst)))
-    (ensure-same (size g) 14 :test '=)))
-
-(addtest (test-graph-container)
-  vertex-test
-  (let ((g (make-container 'graph-container :vertex-test #'equal)))
-    (loop for (src dst) in '((a b) (a c) (c d) (a d) (d e) (e f) (b f)) do
-          (add-edge-between-vertexes g (list src) (list dst)))
-    (ensure-same (size g) 6 :test '=)))

diff --git a/dev/test-graph-metrics.lisp b/dev/test-graph-metrics.lisp
deleted file mode 100644 (file)
index 8071a08..0000000
--- a/dev/test-graph-metrics.lisp
+++ /dev/null
@@ -1,38 +0,0 @@
-(in-package metabang.graph)
-
-;;; ---------------------------------------------------------------------------
-
-(lift:deftestsuite test-vertex-triangle-count ()
-  ((g (make-container 'graph-container))))
-
-(lift:deftestsuite test-vertex-triangle-count-1 (test-vertex-triangle-count)
-  ()
-  (:setup
-   (loop for v in '(a b c d e f g h) do (add-vertex g v))
-   (loop for (s d) in '((a b) (b c) (a c) (b d) (d e) (d f) (d g) (e f) (f g) (g h)) do
-         (add-edge-between-vertexes g s d))))
-
-(lift:addtest (test-vertex-triangle-count-1)
-  (lift:ensure-same (vertex-triangle-count (find-vertex g 'a)) 1 :test '=))
-
-
-(lift:addtest (test-vertex-triangle-count-1)
-  (lift:ensure-same (vertex-triangle-count (find-vertex g 'd)) 2 :test '=))
-
-(lift:addtest (test-vertex-triangle-count-1)
-  (lift:ensure-same (vertex-triangle-count (find-vertex g 'h)) 0 :test '=)) 
-
-(lift:deftestsuite test-vertex-triangle-count-2 (test-vertex-triangle-count)
-  ()
-  (:setup
-   (loop for v in '(a b c d e) do (add-vertex g v))
-   (loop for (s d) in '((a b) (b c) (a c) (c d) (c e)) do
-         (add-edge-between-vertexes g s d))))
-
-(lift:addtest (test-vertex-triangle-count-2)
-  (lift:ensure-same (vertex-triangle-count (find-vertex g 'c)) 1 :test '=)
-  (lift:ensure-same (vertex-triangle-count (find-vertex g 'd)) 0 :test '=))
-
-(lift:addtest (test-vertex-triangle-count-2)
-  (lift:ensure-same (average-local-clustering-coefficient g) 
-               (float (/ 13 30)) :test 'samep))
\ No newline at end of file

diff --git a/dev/test-graph.lisp b/dev/test-graph.lisp
deleted file mode 100644 (file)
index a94dd28..0000000
--- a/dev/test-graph.lisp
+++ /dev/null
@@ -1,167 +0,0 @@
-(in-package metabang.graph)
-
-#|
-(let ((g (make-container 'graph-container))) 
-  (add-edge-between-vertexes g 'a 'b)
-  (let ((v-a (find-vertex g 'a))
-        (v-b (find-vertex g 'b)))
-    (print (compute-applicable-methods #'(SETF ELEMENT) (list :NEW-A V-A)))
-    (setf (element v-a) :new-a)
-    (inspect g)))
-|#
-
-(deftestsuite test-graph () ())
-
-
-(deftestsuite test-test-vertex () ())
-
-(addtest (test-test-vertex)
-  test-1
-  (bind ((x (float 2.1d0))
-         (y (float 2.1d0))
-         (g (make-container 'graph-container)))
-    (add-vertex g (+ x y))
-    (add-vertex g (+ x y))
-    
-    (ensure-same (size g) 2)))
-
-(addtest (test-test-vertex)
-  test-1
-  (bind ((x (float 2.1d0))
-         (y (float 2.1d0))
-         (g (make-container 'graph-container :vertex-test #'=)))
-    (add-vertex g (+ x y))
-    (add-vertex g (+ x y))
-    
-    (ensure-same (size g) 1)))
-
-
-;;; ---------------------------------------------------------------------------
-;;; should do this for each _kind_ of graph
-;;; ---------------------------------------------------------------------------
-
-(deftestsuite test-basic-graph-properties (test-graph)
-  ((graph-undirected (make-container 'graph-container :default-edge-type :undirected))
-   (graph-directed (make-container 'graph-container :default-edge-type :directed)))
-  :setup ((loop for v in '(a b c d e) do
-                (add-vertex graph-undirected v)
-                (add-vertex graph-directed v))
-          (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
-                (add-edge-between-vertexes graph-undirected v1 v2)
-                (add-edge-between-vertexes graph-directed v1 v2))))
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-basic-graph-properties)
-  (ensure-same (size (graph-vertexes graph-directed)) 5 :test #'=)
-  (ensure-same (size (graph-edges graph-directed)) 4 :test #'=))
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-basic-graph-properties)
-  (delete-edge-between-vertexes graph-directed 'a 'b)
-  (ensure (null (find-edge-between-vertexes graph-directed 'a 'b
-                                            :error-if-not-found? nil))))
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-basic-graph-properties)
-  (delete-edge-between-vertexes graph-directed 'a 'b)
-  (ensure-same (size (graph-edges graph-directed)) 3))
-
-;;; ---------------------------------------------------------------------------
-
-(deftestsuite test-graph-traversal (test-graph)
-  ((g (make-container 'graph-container)))
-  :setup (loop for (src dst) in '((a b) (a c) (a d) (b e) 
-                                  (b f) (d g) (d h) (h i)
-                                  (h j)) do
-               (add-edge-between-vertexes g src dst :edge-type :directed)))
-
-;;; ---------------------------------------------------------------------------
-
-#|
-
-a - b - e
-      - f
-  - c 
-  - d - g
-      - h - i
-          - j
-
-|#
-
-(addtest (test-graph-traversal)
-  (let ((result nil))
-    (traverse-elements
-     g :depth (lambda (v) (push (element v) result)))
-    (ensure-same (reverse result) 
-                 '(e f b c g i j h d a) :test #'equal)))
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-graph-traversal)
-  (let ((result nil))
-    (traverse-elements
-     g :breadth (lambda (v) (push (element v) result)))
-    ;(print (reverse result))
-    (ensure-same (reverse result) 
-                 '(a b c d e f g h i j) :test #'equal)))
-    
-    
-;;; ---------------------------------------------------------------------------
-;;; test-replace-vertex
-;;; ---------------------------------------------------------------------------
-
-(deftestsuite test-replace-vertex (test-basic-graph-properties) ())
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-replace-vertex)
-  test-directed
-  (let ((b (find-vertex graph-directed 'b))
-        (x (make-vertex-for-graph graph-directed :element 'x)))
-    (replace-vertex graph-directed b x)
-    (ensure (find-vertex graph-directed 'x))
-    (ensure (not (find-vertex graph-directed 'b nil)))
-    (ensure-same (edge-count (find-vertex graph-directed 'x)) 2 :test =)
-    (ensure (find-edge-between-vertexes graph-directed 'a 'x))
-    (ensure (find-edge-between-vertexes graph-directed 'x 'd))))
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-replace-vertex)
-  test-undirected
-  (let ((b (find-vertex graph-undirected 'b))
-        (x (make-vertex-for-graph graph-undirected :element 'x)))
-    (replace-vertex graph-undirected b x)
-    (ensure (find-vertex graph-undirected 'x))
-    (ensure (not (find-vertex graph-undirected 'b nil)))
-    (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
-    (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
-    (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
-
-;;; ---------------------------------------------------------------------------
-;;; change vertex value
-;;; ---------------------------------------------------------------------------
-
-(deftestsuite test-change-vertex-value (test-basic-graph-properties) ())
-
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-change-vertex-value)
-  test-undirected
-  (let ((b (find-vertex graph-undirected 'b)))
-    (setf (element b) 'x)
-    (ensure (find-vertex graph-undirected 'x))
-    (ensure (not (find-vertex graph-undirected 'b nil)))
-    (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
-    (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
-    (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
-
-
-
-;;; ---------------------------------------------------------------------------
-;;; test-replace-edge
-;;; ---------------------------------------------------------------------------
-

diff --git a/unit-tests/test-connected-components.lisp b/unit-tests/test-connected-components.lisp
new file mode 100644 (file)
index 0000000..53b8fce
--- /dev/null
+++ b/unit-tests/test-connected-components.lisp
@@ -0,0 +1,44 @@
+(in-package metabang.graph)
+
+(deftestsuite test-connected-component ()
+  ())
+
+;;; ---------------------------------------------------------------------------
+
+(defun make-connected-component-graph-1 ()
+  (let ((g (make-container 'graph-container)))
+    (loop for label in '(wk-6-0 wp-5-1 wp-1-2 wp-2-3 wb-1-1
+                         wp-4-4 bp-5-6 bk-6-5 bb-5-7 bp-2-4
+                         bp-2-6 bp-1-5) do
+          (add-vertex g label))
+    (loop for (source target) in '((wk-6-0 wp-5-1)
+                                   (wp-1-2 wp-2-3)
+                                   (wb-1-1 wp-4-4)
+                                   (bp-5-6 bk-6-5)
+                                   (bk-6-5 bb-5-7)
+                                   (bb-5-7 bp-2-4)
+                                   (bp-2-6 bp-1-5)
+                                   (bp-1-5 bp-2-4)) do
+          (add-edge-between-vertexes g source target :edge-type :directed
+                                     :value :defend))
+    (loop for (source target) in '((bk-6-5 wp-4-4)) do
+          (add-edge-between-vertexes g source target :edge-type :directed 
+                                     :value :attack))
+    (loop for (source target) in '((wp-2-3 bp-2-4)) do
+          (add-edge-between-vertexes g source target :edge-type :undirected))
+    g))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-connected-component)
+  test-1
+  (let ((g (make-connected-component-graph-1)))
+    (ensure-same
+     (mapcar #'size (find-connected-components g)) '(2 10) :test 'set-equal)))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-connected-component)
+  test-connected-component-count-1
+  (let ((g (make-connected-component-graph-1)))
+    (ensure-same (connected-component-count g) 2 :test '=)))

diff --git a/unit-tests/test-graph-algorithms.lisp b/unit-tests/test-graph-algorithms.lisp
new file mode 100644 (file)
index 0000000..f54b879
--- /dev/null
+++ b/unit-tests/test-graph-algorithms.lisp
@@ -0,0 +1,121 @@
+(in-package cl-graph)
+
+(deftestsuite test-connected-components ()
+  ())
+
+(addtest (test-connected-components)
+  test-1
+  (let ((g (make-container 'graph-container  :default-edge-type :undirected)))
+    (loop for v in '(a b c d e f g h i j) do (add-vertex g v))
+    (loop for (v1 v2) in '((a b) (a c) ( b c) (b d) (e f) (e g) (h i)) do
+          (add-edge-between-vertexes g v1 v2))
+    
+    (let ((cc (connected-components g)))
+      (flet ((test (a b result)
+               (ensure-same (eq (representative-node cc (find-vertex g a))
+                                (representative-node cc (find-vertex g b)))
+                            result)))
+        (loop for (v1 v2 result) in '((a b t) (a e nil) (f g t)
+                               (j c nil) (b a t) (d c t)) do
+              (test v1 v2 result))))))
+
+;;; ---------------------------------------------------------------------------
+
+(deftestsuite test-minimum-spanning-tree ()
+  ())
+
+(deftestsuite test-mst-kruskal (test-minimum-spanning-tree)
+  ())
+
+(addtest (test-mst-kruskal)
+  test-1
+  (let ((g (make-container 'graph-container
+                           :default-edge-type :undirected
+                           :undirected-edge-class 'weighted-edge))
+        (m nil))
+    (loop for (v1 v2 w) in '((a b 4) (a h 9)
+                             (b c 8) (b h 11)
+                             (c i 2) (c d 7) (c f 4)
+                             (d e 9) (d f 14)
+                             (e f 10) 
+                             (f g 2)
+                             (g h 1) (g i 6)
+                             (h i 7)) do
+          (add-edge-between-vertexes g v1 v2 :weight w))
+    (setf m (minimum-spanning-tree-kruskal g))
+    (ensure (set-equal 
+             '(a b c d e f g h i)
+             (flatten (mapcar (lambda (e)
+                                (list (element (vertex-1 e)) (element (vertex-2 e)))) 
+                              m))))
+    (ensure-same (reduce #'+ m :key 'weight) 37 :test '=)
+    (ensure-same (size m) 8)))
+
+#+Test
+(defclass* directed-weighted-edge (weighted-edge-mixin graph-container-directed-edge)
+  ())
+
+#+Test
+(let ((g (make-container 'graph-container
+                         :default-edge-type :undirected
+                         :undirected-edge-class 'weighted-edge
+                         :directed-edge-class 'directed-weighted-edge)))
+  (loop for (v1 v2 w) in '((a b 4) (a h 9)
+                           (b c 8) (b h 11)
+                           (c i 2) (c d 7) (c f 4)
+                           (d e 9) (d f 14)
+                           (e f 10) 
+                           (f g 2)
+                           (g h 1) (g i 6)
+                           (h i 7)
+                           
+                           (a h 3)) do
+        (add-edge-between-vertexes g v1 v2 :weight w 
+                                   :edge-type (if (random-boolean *random-generator* 0.3) 
+                                                :directed :undirected)))
+  (minimum-spanning-tree-kruskal g))
+        
+#+Test
+(graph->dot 
+ (let ((g (make-container 'graph-container
+                          :default-edge-type :undirected
+                          :undirected-edge-class 'weighted-edge))
+       (m nil))
+   (loop for (v1 v2 w) in '((a b 10) (a b 1) (a d 3)
+                           (b c 1) (b d 3)
+                           (c d 1)) do
+         (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force))
+   (setf m (minimum-spanning-tree-kruskal g))
+   g)
+ "p2dis:data;x.dot")
+
+#+Test
+(let ((g (make-container 'graph-container
+                         :default-edge-type :undirected
+                         :undirected-edge-class 'weighted-edge))
+      (m nil))
+  (loop for (v1 v2 w) in '((a b 1) (a d 3)
+                           (b c 5) (b d 2)
+                           (c d 1)) do
+        (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force))
+  (setf m (minimum-spanning-tree-kruskal g))
+  m)
+
+;;; ---------------------------------------------------------------------------
+
+#+test
+(let ((graph (make-container 'graph-container)))
+  (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x) 
+                       (u y) (w x) (x y)) do
+        (add-edge-between-vertexes graph a b))
+  
+  (breadth-first-search-graph graph 's))
+
+;;; ---------------------------------------------------------------------------
+
+(let ((graph (make-container 'graph-container)))
+  (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x) 
+                       (u y) (w x) (x y)) do
+        (add-edge-between-vertexes graph a b))
+  
+  (breadth-first-visitor graph 's #'print))
\ No newline at end of file

diff --git a/unit-tests/test-graph-container.lisp b/unit-tests/test-graph-container.lisp
new file mode 100644 (file)
index 0000000..c2697da
--- /dev/null
+++ b/unit-tests/test-graph-container.lisp
@@ -0,0 +1,77 @@
+(in-package metabang.graph)
+
+;;; ---------------------------------------------------------------------------
+;;; utilities
+;;; ---------------------------------------------------------------------------
+
+(defun make-simple-test-graph ()
+  (let ((g (make-container 'graph-container))) 
+    (loop for v in '(a b c d e) do
+          (add-vertex g v))
+    (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
+          (add-edge-between-vertexes g v1 v2))
+    g))
+
+;;; ---------------------------------------------------------------------------
+;;; tests
+;;; --------------------------------------------------------------------------- 
+
+(deftestsuite test-graph-container () ())
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-graph-container)
+  test-simple-copying
+  (let ((g1 (make-simple-test-graph))
+        (g2 nil))
+    (setf g2 (copy-top-level g1))
+    (ensure-same (size g1) (size g2))
+    (iterate-vertexes
+     g1 (lambda (v)
+          (ensure (find-vertex g2 (value v)))))
+    (iterate-edges 
+     g1 (lambda (e)
+          (ensure (find-edge-between-vertexes 
+                   g2 (value (source-vertex e))
+                   (value (target-vertex e))))))))
+
+;;; ---------------------------------------------------------------------------
+
+;; fails because find-edge-between-vertexes for graph containers doesn't
+;; care about the graph...
+(addtest (test-graph-container)
+  test-find-edge-between-vertexes
+  (let ((g1 (make-simple-test-graph))
+        (g2 nil))
+    (setf g2 (copy-top-level g1))
+    
+    (ensure (not 
+             (find-edge-between-vertexes g2 (find-vertex g1 'a) (find-vertex g1 'b))))))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-graph-container)
+  test-empty!
+  (let ((g1 (make-simple-test-graph)))
+    (empty! g1)
+    (ensure-same (size g1) 0)))
+
+;;; ---------------------------------------------------------------------------
+;;; vertex test 
+;;; ---------------------------------------------------------------------------
+
+;;?? should be in test-graph and work for every graph container type
+
+(addtest (test-graph-container)
+  no-vertex-test
+  (let ((g (make-container 'graph-container)))
+    (loop for (src dst) in '((a b) (a c) (c d) (a d) (d e) (e f) (b f)) do
+          (add-edge-between-vertexes g (list src) (list dst)))
+    (ensure-same (size g) 14 :test '=)))
+
+(addtest (test-graph-container)
+  vertex-test
+  (let ((g (make-container 'graph-container :vertex-test #'equal)))
+    (loop for (src dst) in '((a b) (a c) (c d) (a d) (d e) (e f) (b f)) do
+          (add-edge-between-vertexes g (list src) (list dst)))
+    (ensure-same (size g) 6 :test '=)))

diff --git a/unit-tests/test-graph-metrics.lisp b/unit-tests/test-graph-metrics.lisp
new file mode 100644 (file)
index 0000000..8071a08
--- /dev/null
+++ b/unit-tests/test-graph-metrics.lisp
@@ -0,0 +1,38 @@
+(in-package metabang.graph)
+
+;;; ---------------------------------------------------------------------------
+
+(lift:deftestsuite test-vertex-triangle-count ()
+  ((g (make-container 'graph-container))))
+
+(lift:deftestsuite test-vertex-triangle-count-1 (test-vertex-triangle-count)
+  ()
+  (:setup
+   (loop for v in '(a b c d e f g h) do (add-vertex g v))
+   (loop for (s d) in '((a b) (b c) (a c) (b d) (d e) (d f) (d g) (e f) (f g) (g h)) do
+         (add-edge-between-vertexes g s d))))
+
+(lift:addtest (test-vertex-triangle-count-1)
+  (lift:ensure-same (vertex-triangle-count (find-vertex g 'a)) 1 :test '=))
+
+
+(lift:addtest (test-vertex-triangle-count-1)
+  (lift:ensure-same (vertex-triangle-count (find-vertex g 'd)) 2 :test '=))
+
+(lift:addtest (test-vertex-triangle-count-1)
+  (lift:ensure-same (vertex-triangle-count (find-vertex g 'h)) 0 :test '=)) 
+
+(lift:deftestsuite test-vertex-triangle-count-2 (test-vertex-triangle-count)
+  ()
+  (:setup
+   (loop for v in '(a b c d e) do (add-vertex g v))
+   (loop for (s d) in '((a b) (b c) (a c) (c d) (c e)) do
+         (add-edge-between-vertexes g s d))))
+
+(lift:addtest (test-vertex-triangle-count-2)
+  (lift:ensure-same (vertex-triangle-count (find-vertex g 'c)) 1 :test '=)
+  (lift:ensure-same (vertex-triangle-count (find-vertex g 'd)) 0 :test '=))
+
+(lift:addtest (test-vertex-triangle-count-2)
+  (lift:ensure-same (average-local-clustering-coefficient g) 
+               (float (/ 13 30)) :test 'samep))
\ No newline at end of file

diff --git a/unit-tests/test-graph.lisp b/unit-tests/test-graph.lisp
new file mode 100644 (file)
index 0000000..a94dd28
--- /dev/null
+++ b/unit-tests/test-graph.lisp
@@ -0,0 +1,167 @@
+(in-package metabang.graph)
+
+#|
+(let ((g (make-container 'graph-container))) 
+  (add-edge-between-vertexes g 'a 'b)
+  (let ((v-a (find-vertex g 'a))
+        (v-b (find-vertex g 'b)))
+    (print (compute-applicable-methods #'(SETF ELEMENT) (list :NEW-A V-A)))
+    (setf (element v-a) :new-a)
+    (inspect g)))
+|#
+
+(deftestsuite test-graph () ())
+
+
+(deftestsuite test-test-vertex () ())
+
+(addtest (test-test-vertex)
+  test-1
+  (bind ((x (float 2.1d0))
+         (y (float 2.1d0))
+         (g (make-container 'graph-container)))
+    (add-vertex g (+ x y))
+    (add-vertex g (+ x y))
+    
+    (ensure-same (size g) 2)))
+
+(addtest (test-test-vertex)
+  test-1
+  (bind ((x (float 2.1d0))
+         (y (float 2.1d0))
+         (g (make-container 'graph-container :vertex-test #'=)))
+    (add-vertex g (+ x y))
+    (add-vertex g (+ x y))
+    
+    (ensure-same (size g) 1)))
+
+
+;;; ---------------------------------------------------------------------------
+;;; should do this for each _kind_ of graph
+;;; ---------------------------------------------------------------------------
+
+(deftestsuite test-basic-graph-properties (test-graph)
+  ((graph-undirected (make-container 'graph-container :default-edge-type :undirected))
+   (graph-directed (make-container 'graph-container :default-edge-type :directed)))
+  :setup ((loop for v in '(a b c d e) do
+                (add-vertex graph-undirected v)
+                (add-vertex graph-directed v))
+          (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
+                (add-edge-between-vertexes graph-undirected v1 v2)
+                (add-edge-between-vertexes graph-directed v1 v2))))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-basic-graph-properties)
+  (ensure-same (size (graph-vertexes graph-directed)) 5 :test #'=)
+  (ensure-same (size (graph-edges graph-directed)) 4 :test #'=))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-basic-graph-properties)
+  (delete-edge-between-vertexes graph-directed 'a 'b)
+  (ensure (null (find-edge-between-vertexes graph-directed 'a 'b
+                                            :error-if-not-found? nil))))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-basic-graph-properties)
+  (delete-edge-between-vertexes graph-directed 'a 'b)
+  (ensure-same (size (graph-edges graph-directed)) 3))
+
+;;; ---------------------------------------------------------------------------
+
+(deftestsuite test-graph-traversal (test-graph)
+  ((g (make-container 'graph-container)))
+  :setup (loop for (src dst) in '((a b) (a c) (a d) (b e) 
+                                  (b f) (d g) (d h) (h i)
+                                  (h j)) do
+               (add-edge-between-vertexes g src dst :edge-type :directed)))
+
+;;; ---------------------------------------------------------------------------
+
+#|
+
+a - b - e
+      - f
+  - c 
+  - d - g
+      - h - i
+          - j
+
+|#
+
+(addtest (test-graph-traversal)
+  (let ((result nil))
+    (traverse-elements
+     g :depth (lambda (v) (push (element v) result)))
+    (ensure-same (reverse result) 
+                 '(e f b c g i j h d a) :test #'equal)))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-graph-traversal)
+  (let ((result nil))
+    (traverse-elements
+     g :breadth (lambda (v) (push (element v) result)))
+    ;(print (reverse result))
+    (ensure-same (reverse result) 
+                 '(a b c d e f g h i j) :test #'equal)))
+    
+    
+;;; ---------------------------------------------------------------------------
+;;; test-replace-vertex
+;;; ---------------------------------------------------------------------------
+
+(deftestsuite test-replace-vertex (test-basic-graph-properties) ())
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-replace-vertex)
+  test-directed
+  (let ((b (find-vertex graph-directed 'b))
+        (x (make-vertex-for-graph graph-directed :element 'x)))
+    (replace-vertex graph-directed b x)
+    (ensure (find-vertex graph-directed 'x))
+    (ensure (not (find-vertex graph-directed 'b nil)))
+    (ensure-same (edge-count (find-vertex graph-directed 'x)) 2 :test =)
+    (ensure (find-edge-between-vertexes graph-directed 'a 'x))
+    (ensure (find-edge-between-vertexes graph-directed 'x 'd))))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-replace-vertex)
+  test-undirected
+  (let ((b (find-vertex graph-undirected 'b))
+        (x (make-vertex-for-graph graph-undirected :element 'x)))
+    (replace-vertex graph-undirected b x)
+    (ensure (find-vertex graph-undirected 'x))
+    (ensure (not (find-vertex graph-undirected 'b nil)))
+    (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
+    (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
+    (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
+
+;;; ---------------------------------------------------------------------------
+;;; change vertex value
+;;; ---------------------------------------------------------------------------
+
+(deftestsuite test-change-vertex-value (test-basic-graph-properties) ())
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-change-vertex-value)
+  test-undirected
+  (let ((b (find-vertex graph-undirected 'b)))
+    (setf (element b) 'x)
+    (ensure (find-vertex graph-undirected 'x))
+    (ensure (not (find-vertex graph-undirected 'b nil)))
+    (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
+    (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
+    (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
+
+
+
+;;; ---------------------------------------------------------------------------
+;;; test-replace-edge
+;;; ---------------------------------------------------------------------------
+