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 () ())
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 :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))))
52 ;;; ---------------------------------------------------------------------------
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 #'=))
58 ;;; ---------------------------------------------------------------------------
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))))
65 ;;; ---------------------------------------------------------------------------
67 (addtest (test-basic-graph-properties)
68 (delete-edge-between-vertexes graph-directed 'a 'b)
69 (ensure-same (size (graph-edges graph-directed)) 3))
71 ;;; ---------------------------------------------------------------------------
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)
78 (add-edge-between-vertexes g src dst :edge-type :directed)))
80 ;;; ---------------------------------------------------------------------------
93 (addtest (cl-graph-test-traversal)
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)))
100 ;;; ---------------------------------------------------------------------------
102 (addtest (cl-graph-test-traversal)
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)))
111 ;;; ---------------------------------------------------------------------------
112 ;;; test-replace-vertex
113 ;;; ---------------------------------------------------------------------------
115 (deftestsuite test-replace-vertex (test-basic-graph-properties) ())
117 ;;; ---------------------------------------------------------------------------
119 (addtest (test-replace-vertex)
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))))
130 ;;; ---------------------------------------------------------------------------
132 (addtest (test-replace-vertex)
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))))
143 ;;; ---------------------------------------------------------------------------
144 ;;; change vertex value
145 ;;; ---------------------------------------------------------------------------
147 (deftestsuite test-change-vertex-value (test-basic-graph-properties) ())
149 ;;; ---------------------------------------------------------------------------
151 (addtest (test-change-vertex-value)
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))))
163 ;;; ---------------------------------------------------------------------------
164 ;;; test-replace-edge
165 ;;; ---------------------------------------------------------------------------