test-graph-algorithms.lisp

(in-package #:cl-graph-test)

(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))

;;; ---------------------------------------------------------------------------

#+Ignore
(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))