dev/test-graph-algorithms.lisp

   1 (in-package cl-graph)
   2
   3 (deftestsuite test-connected-components ()
   4   ())
   5
   6 (addtest (test-connected-components)
   7   test-1
   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))
  12
  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)))
  17                             result)))
  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))))))
  21
  22 ;;; ---------------------------------------------------------------------------
  23
  24 (deftestsuite test-minimum-spanning-tree ()
  25   ())
  26
  27 (deftestsuite test-mst-kruskal (test-minimum-spanning-tree)
  28   ())
  29
  30 (addtest (test-mst-kruskal)
  31   test-1
  32   (let ((g (make-container 'graph-container
  33                            :default-edge-type :undirected
  34                            :undirected-edge-class 'weighted-edge))
  35         (m nil))
  36     (loop for (v1 v2 w) in '((a b 4) (a h 9)
  37                              (b c 8) (b h 11)
  38                              (c i 2) (c d 7) (c f 4)
  39                              (d e 9) (d f 14)
  40                              (e f 10)
  41                              (f g 2)
  42                              (g h 1) (g i 6)
  43                              (h i 7)) do
  44           (add-edge-between-vertexes g v1 v2 :weight w))
  45     (setf m (minimum-spanning-tree-kruskal g))
  46     (ensure (set-equal
  47              '(a b c d e f g h i)
  48              (flatten (mapcar (lambda (e)
  49                                 (list (element (vertex-1 e)) (element (vertex-2 e))))
  50                               m))))
  51     (ensure-same (reduce #'+ m :key 'weight) 37 :test '=)
  52     (ensure-same (size m) 8)))
  53
  54 #+Test
  55 (defclass* directed-weighted-edge (weighted-edge-mixin graph-container-directed-edge)
  56   ())
  57
  58 #+Test
  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)
  64                            (b c 8) (b h 11)
  65                            (c i 2) (c d 7) (c f 4)
  66                            (d e 9) (d f 14)
  67                            (e f 10)
  68                            (f g 2)
  69                            (g h 1) (g i 6)
  70                            (h i 7)
  71
  72                            (a h 3)) do
  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))
  77
  78 #+Test
  79 (graph->dot
  80  (let ((g (make-container 'graph-container
  81                           :default-edge-type :undirected
  82                           :undirected-edge-class 'weighted-edge))
  83        (m nil))
  84    (loop for (v1 v2 w) in '((a b 10) (a b 1) (a d 3)
  85                            (b c 1) (b d 3)
  86                            (c d 1)) do
  87          (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force))
  88    (setf m (minimum-spanning-tree-kruskal g))
  89    g)
  90  "p2dis:data;x.dot")
  91
  92 #+Test
  93 (let ((g (make-container 'graph-container
  94                          :default-edge-type :undirected
  95                          :undirected-edge-class 'weighted-edge))
  96       (m nil))
  97   (loop for (v1 v2 w) in '((a b 1) (a d 3)
  98                            (b c 5) (b d 2)
  99                            (c d 1)) do
 100         (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force))
 101   (setf m (minimum-spanning-tree-kruskal g))
 102   m)
 103
 104 ;;; ---------------------------------------------------------------------------
 105
 106 #+test
 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))
 111
 112   (breadth-first-search-graph graph 's))
 113
 114 ;;; ---------------------------------------------------------------------------
 115
 116 (let ((graph (make-container 'graph-container)))
 117   (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x)
 118                        (u y) (w x) (x y)) do
 119         (add-edge-between-vertexes graph a b))
 120
 121   (breadth-first-visitor graph 's #'print))