unit-tests/test-graph.lisp

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