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