1 (in-package #:cl-graph-test)
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)
13 (deftestsuite cl-graph-test () ())
15 (deftestsuite test-test-vertex (cl-graph-test) ())
17 (addtest (test-test-vertex)
19 (metatilities:bind ((x (float 2.1d0))
21 (g (make-container 'graph-container)))
22 (add-vertex g (+ x y))
23 (add-vertex g (+ x y))
25 (ensure-same (size g) 2)))
27 (addtest (test-test-vertex)
29 (bind ((x (float 2.1d0))
31 (g (make-container 'graph-container :vertex-test #'=)))
32 (add-vertex g (+ x y))
33 (add-vertex g (+ x y))
35 (ensure-same (size g) 1)))
38 ;;; ---------------------------------------------------------------------------
39 ;;; should do this for each _kind_ of graph
40 ;;; ---------------------------------------------------------------------------
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))))
55 (let ((g (make-container 'graph-container
56 :default-edge-type :directed)))
57 (loop for v in '(a b c d e) do
59 (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
60 (add-edge-between-vertexes g v1 v2))
63 ;;; ---------------------------------------------------------------------------
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 #'=))
69 ;;; ---------------------------------------------------------------------------
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))))
76 ;;; ---------------------------------------------------------------------------
78 (addtest (test-basic-graph-properties)
79 (delete-edge-between-vertexes graph-directed 'a 'b)
80 (ensure-same (size (graph-edges graph-directed)) 3))
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)
89 (add-edge-between-vertexes g src dst :edge-type :directed)))
102 (addtest (cl-graph-test-traversal)
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)))
109 (addtest (cl-graph-test-traversal)
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)))
119 ;;; ---------------------------------------------------------------------------
120 ;;; test-replace-vertex
121 ;;; ---------------------------------------------------------------------------
123 (deftestsuite test-replace-vertex (test-basic-graph-properties) ())
125 ;;; ---------------------------------------------------------------------------
127 (addtest (test-replace-vertex)
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))))
138 ;;; ---------------------------------------------------------------------------
140 (addtest (test-replace-vertex)
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))))
151 ;;; ---------------------------------------------------------------------------
152 ;;; change vertex value
153 ;;; ---------------------------------------------------------------------------
155 (deftestsuite test-change-vertex-value (test-basic-graph-properties) ())
157 ;;; ---------------------------------------------------------------------------
159 (addtest (test-change-vertex-value)
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))))
171 ;;; ---------------------------------------------------------------------------
172 ;;; test-replace-edge
173 ;;; ---------------------------------------------------------------------------