1 (in-package #:cl-graph-test)
3 (deftestsuite test-connected-components ()
6 (addtest (test-connected-components)
8 (let ((g (make-container 'graph-container :default-edge-type :undirected)))
9 (loop for v in '(a b c d e f g h i j) do (add-vertex g v))
10 (loop for (v1 v2) in '((a b) (a c) ( b c) (b d) (e f) (e g) (h i)) do
11 (add-edge-between-vertexes g v1 v2))
13 (let ((cc (connected-components g)))
14 (flet ((test (a b result)
15 (ensure-same (eq (representative-node cc (find-vertex g a))
16 (representative-node cc (find-vertex g b)))
18 (loop for (v1 v2 result) in '((a b t) (a e nil) (f g t)
19 (j c nil) (b a t) (d c t)) do
20 (test v1 v2 result))))))
22 ;;; ---------------------------------------------------------------------------
24 (deftestsuite test-minimum-spanning-tree ()
27 (deftestsuite test-mst-kruskal (test-minimum-spanning-tree)
30 (addtest (test-mst-kruskal)
32 (let ((g (make-container 'graph-container
33 :default-edge-type :undirected
34 :undirected-edge-class 'weighted-edge))
36 (loop for (v1 v2 w) in '((a b 4) (a h 9)
38 (c i 2) (c d 7) (c f 4)
44 (add-edge-between-vertexes g v1 v2 :weight w))
45 (setf m (minimum-spanning-tree-kruskal g))
48 (flatten (mapcar (lambda (e)
49 (list (element (vertex-1 e)) (element (vertex-2 e))))
51 (ensure-same (reduce #'+ m :key 'weight) 37 :test '=)
52 (ensure-same (size m) 8)))
55 (defclass* directed-weighted-edge (weighted-edge-mixin graph-container-directed-edge)
59 (let ((g (make-container 'graph-container
60 :default-edge-type :undirected
61 :undirected-edge-class 'weighted-edge
62 :directed-edge-class 'directed-weighted-edge)))
63 (loop for (v1 v2 w) in '((a b 4) (a h 9)
65 (c i 2) (c d 7) (c f 4)
73 (add-edge-between-vertexes g v1 v2 :weight w
74 :edge-type (if (random-boolean *random-generator* 0.3)
75 :directed :undirected)))
76 (minimum-spanning-tree-kruskal g))
80 (let ((g (make-container 'graph-container
81 :default-edge-type :undirected
82 :undirected-edge-class 'weighted-edge))
84 (loop for (v1 v2 w) in '((a b 10) (a b 1) (a d 3)
87 (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force))
88 (setf m (minimum-spanning-tree-kruskal g))
93 (let ((g (make-container 'graph-container
94 :default-edge-type :undirected
95 :undirected-edge-class 'weighted-edge))
97 (loop for (v1 v2 w) in '((a b 1) (a d 3)
100 (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force))
101 (setf m (minimum-spanning-tree-kruskal g))
104 ;;; ---------------------------------------------------------------------------
107 (let ((graph (make-container 'graph-container)))
108 (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x)
109 (u y) (w x) (x y)) do
110 (add-edge-between-vertexes graph a b))
112 (breadth-first-search-graph graph 's))
114 ;;; ---------------------------------------------------------------------------
117 (let ((graph (make-container 'graph-container)))
118 (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x)
119 (u y) (w x) (x y)) do
120 (add-edge-between-vertexes graph a b))
122 (breadth-first-visitor graph 's #'print))