Setting a test suite at last

[cl-graph.git] / unit-tests / test-graph-algorithms.lisp

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