unit-tests/test-graph.lisp

   1 (in-package #:cl-graph-test)
   2
   3 #|
   4 (let ((g (make-container 'graph-container)))
   5   (add-edge-between-vertexes g 'a 'b)
   6   (let ((v-a (find-vertex g 'a))
   7         (v-b (find-vertex g 'b)))
   8     (print (compute-applicable-methods #'(SETF ELEMENT) (list :NEW-A V-A)))
   9     (setf (element v-a) :new-a)
  10     (inspect g)))
  11 |#
  12
  13 (deftestsuite cl-graph-test () ())
  14
  15 (deftestsuite test-test-vertex (cl-graph-test) ())
  16
  17 (addtest (test-test-vertex)
  18   test-1
  19   (metatilities:bind ((x (float 2.1d0))
  20                      (y (float 2.1d0))
  21                      (g (make-container 'graph-container)))
  22     (add-vertex g (+ x y))
  23     (add-vertex g (+ x y))
  24
  25     (ensure-same (size g) 2)))
  26
  27 (addtest (test-test-vertex)
  28   test-2
  29   (bind ((x (float 2.1d0))
  30          (y (float 2.1d0))
  31          (g (make-container 'graph-container :vertex-test #'=)))
  32     (add-vertex g (+ x y))
  33     (add-vertex g (+ x y))
  34
  35     (ensure-same (size g) 1)))
  36
  37
  38 ;;; ---------------------------------------------------------------------------
  39 ;;; should do this for each _kind_ of graph
  40 ;;; ---------------------------------------------------------------------------
  41
  42 (deftestsuite test-basic-graph-properties (cl-graph-test)
  43   ((graph-undirected (make-container 'graph-container
  44                                      :default-edge-type :undirected))
  45    (graph-directed (make-container 'graph-container
  46                                    :default-edge-type :directed)))
  47   :setup ((loop for v in '(a b c d e) do
  48                 (add-vertex graph-undirected v)
  49                 (add-vertex graph-directed v))
  50           (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
  51                 (add-edge-between-vertexes graph-undirected v1 v2)
  52                 (add-edge-between-vertexes graph-directed v1 v2))))
  53
  54 #+(or)
  55 (let ((g (make-container 'graph-container
  56                          :default-edge-type :directed)))
  57   (loop for v in '(a b c d e) do
  58                 (add-vertex g v))
  59   (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
  60        (add-edge-between-vertexes g v1 v2))
  61   g)
  62
  63 ;;; ---------------------------------------------------------------------------
  64
  65 (addtest (test-basic-graph-properties)
  66   (ensure-same (size (graph-vertexes graph-directed)) 5 :test #'=)
  67   (ensure-same (size (graph-edges graph-directed)) 4 :test #'=))
  68
  69 ;;; ---------------------------------------------------------------------------
  70
  71 (addtest (test-basic-graph-properties)
  72   (delete-edge-between-vertexes graph-directed 'a 'b)
  73   (ensure (null (find-edge-between-vertexes graph-directed 'a 'b
  74                                             :error-if-not-found? nil))))
  75
  76 ;;; ---------------------------------------------------------------------------
  77
  78 (addtest (test-basic-graph-properties)
  79   (delete-edge-between-vertexes graph-directed 'a 'b)
  80   (ensure-same (size (graph-edges graph-directed)) 3))
  81
  82 #|
  83
  84 (deftestsuite cl-graph-test-traversal (cl-graph-test)
  85   ((g (make-container 'graph-container)))
  86   :setup (loop for (src dst) in '((a b) (a c) (a d) (b e)
  87                                   (b f) (d g) (d h) (h i)
  88                                   (h j)) do
  89                (add-edge-between-vertexes g src dst :edge-type :directed)))
  90
  91 #|
  92
  93 a - b - e
  94       - f
  95   - c
  96   - d - g
  97       - h - i
  98           - j
  99
 100 |#
 101
 102 (addtest (cl-graph-test-traversal)
 103   (let ((result nil))
 104     (traverse-elements
 105      g :depth (lambda (v) (push (element v) result)))
 106     (ensure-same (reverse result)
 107                  '(e f b c g i j h d a) :test #'equal)))
 108
 109 (addtest (cl-graph-test-traversal)
 110   (let ((result nil))
 111     (traverse-elements
 112      g :breadth (lambda (v) (push (element v) result)))
 113     ;(print (reverse result))
 114     (ensure-same (reverse result)
 115                  '(a b c d e f g h i j) :test #'equal)))
 116
 117 |#
 118
 119 ;;; ---------------------------------------------------------------------------
 120 ;;; test-replace-vertex
 121 ;;; ---------------------------------------------------------------------------
 122
 123 (deftestsuite test-replace-vertex (test-basic-graph-properties) ())
 124
 125 ;;; ---------------------------------------------------------------------------
 126
 127 (addtest (test-replace-vertex)
 128   test-directed
 129   (let ((b (find-vertex graph-directed 'b))
 130         (x (make-vertex-for-graph graph-directed :element 'x)))
 131     (replace-vertex graph-directed b x)
 132     (ensure (find-vertex graph-directed 'x))
 133     (ensure (not (find-vertex graph-directed 'b nil)))
 134     (ensure-same (edge-count (find-vertex graph-directed 'x)) 2 :test =)
 135     (ensure (find-edge-between-vertexes graph-directed 'a 'x))
 136     (ensure (find-edge-between-vertexes graph-directed 'x 'd))))
 137
 138 ;;; ---------------------------------------------------------------------------
 139
 140 (addtest (test-replace-vertex)
 141   test-undirected
 142   (let ((b (find-vertex graph-undirected 'b))
 143         (x (make-vertex-for-graph graph-undirected :element 'x)))
 144     (replace-vertex graph-undirected b x)
 145     (ensure (find-vertex graph-undirected 'x))
 146     (ensure (not (find-vertex graph-undirected 'b nil)))
 147     (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
 148     (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
 149     (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
 150
 151 ;;; ---------------------------------------------------------------------------
 152 ;;; change vertex value
 153 ;;; ---------------------------------------------------------------------------
 154
 155 (deftestsuite test-change-vertex-value (test-basic-graph-properties) ())
 156
 157 ;;; ---------------------------------------------------------------------------
 158
 159 (addtest (test-change-vertex-value)
 160   test-undirected
 161   (let ((b (find-vertex graph-undirected 'b)))
 162     (setf (element b) 'x)
 163     (ensure (find-vertex graph-undirected 'x))
 164     (ensure (not (find-vertex graph-undirected 'b nil)))
 165     (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
 166     (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
 167     (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
 168
 169
 170
 171 ;;; ---------------------------------------------------------------------------
 172 ;;; test-replace-edge
 173 ;;; ---------------------------------------------------------------------------
 174