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 :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 a - b - e
  83       - f
  84   - c
  85   - d - g
  86       - h - i
  87           - j
  88
  89 |#
  90
  91 (addtest (cl-graph-test-traversal)
  92   (let ((result nil))
  93     (traverse-elements
  94      g :depth (lambda (v) (push (element v) result)))
  95     (ensure-same (reverse result)
  96                  '(e f b c g i j h d a) :test #'equal)))
  97
  98 (addtest (cl-graph-test-traversal)
  99   (let ((result nil))
 100     (traverse-elements
 101      g :breadth (lambda (v) (push (element v) result)))
 102     ;(print (reverse result))
 103     (ensure-same (reverse result)
 104                  '(a b c d e f g h i j) :test #'equal)))
 105
 106 |#
 107
 108 ;;; ---------------------------------------------------------------------------
 109 ;;; test-replace-vertex
 110 ;;; ---------------------------------------------------------------------------
 111
 112 (deftestsuite test-replace-vertex (test-basic-graph-properties) ())
 113
 114 ;;; ---------------------------------------------------------------------------
 115
 116 (addtest (test-replace-vertex)
 117   test-directed
 118   (let ((b (find-vertex graph-directed 'b))
 119         (x (make-vertex-for-graph graph-directed :element 'x)))
 120     (replace-vertex graph-directed b x)
 121     (ensure (find-vertex graph-directed 'x))
 122     (ensure (not (find-vertex graph-directed 'b nil)))
 123     (ensure-same (edge-count (find-vertex graph-directed 'x)) 2 :test =)
 124     (ensure (find-edge-between-vertexes graph-directed 'a 'x))
 125     (ensure (find-edge-between-vertexes graph-directed 'x 'd))))
 126
 127 ;;; ---------------------------------------------------------------------------
 128
 129 (addtest (test-replace-vertex)
 130   test-undirected
 131   (let ((b (find-vertex graph-undirected 'b))
 132         (x (make-vertex-for-graph graph-undirected :element 'x)))
 133     (replace-vertex graph-undirected b x)
 134     (ensure (find-vertex graph-undirected 'x))
 135     (ensure (not (find-vertex graph-undirected 'b nil)))
 136     (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
 137     (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
 138     (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
 139
 140 ;;; ---------------------------------------------------------------------------
 141 ;;; change vertex value
 142 ;;; ---------------------------------------------------------------------------
 143
 144 (deftestsuite test-change-vertex-value (test-basic-graph-properties) ())
 145
 146 ;;; ---------------------------------------------------------------------------
 147
 148 (addtest (test-change-vertex-value)
 149   test-undirected
 150   (let ((b (find-vertex graph-undirected 'b)))
 151     (setf (element b) 'x)
 152     (ensure (find-vertex graph-undirected 'x))
 153     (ensure (not (find-vertex graph-undirected 'b nil)))
 154     (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
 155     (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
 156     (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
 157
 158
 159
 160 ;;; ---------------------------------------------------------------------------
 161 ;;; test-replace-edge
 162 ;;; ---------------------------------------------------------------------------
 163