4 $Id: graph-container.lisp,v 1.12 2005/07/20 20:39:09 moody Exp $
12 (in-package #:metabang.graph)
16 (defclass* graph-container (iteratable-container-mixin
17 non-associative-container-mixin
18 initial-contents-mixin
20 container-uses-nodes-mixin)
21 ((vertex-pair->edge (make-container 'simple-associative-container
24 :vertex-class 'graph-container-vertex
25 :directed-edge-class 'graph-container-directed-edge
26 :undirected-edge-class 'graph-container-edge)
28 (:documentation "A graph container is essentially an adjacency list graph representation [?? The Bad name comes from it being implemented with containers... ugh]"))
31 (defclass* graph-container-edge (basic-edge)
32 ((vertex-1 nil ir "`Vertex-1` is one of the two vertexes that an edge connects. In a directed-edge, `vertex-1` is also the `source-edge`.")
33 (vertex-2 nil ir "`Vertex-2` is one of the two vertexes that an edge connects. In a directed edge, `vertex-2` is also the `target-vertex`."))
34 (:export-slots vertex-1 vertex-2)
36 (:documentation "This is the root class for edges in graph-containers. It adds vertex-1 and vertex-2 slots."))
39 (defmethod print-object ((object graph-container-edge) stream)
40 (print-unreadable-object (object stream :type t)
41 (format stream "<~A ~A ~A>" (vertex-1 object) (vertex-2 object)
45 (defclass* weighted-edge (weighted-edge-mixin graph-container-edge)
48 (:documentation "A weighted edge is both a weighted-edge-mixin and a graph-container-edge."))
51 (defclass* graph-container-vertex (basic-vertex)
52 ((vertex-edges nil r))
55 :vertex-edges-container-class 'vector-container)
56 (:documentation "A graph container vertex keeps track of its edges in the the vertex-edges slot. The storage for this defaults to a vector-container but can be changed using the vertex-edges-container-class initarg."))
59 (defmethod make-vertex-edges-container ((vertex graph-container-vertex)
60 container-class &rest args)
61 (apply #'make-container container-class args))
64 (defmethod initialize-instance :after ((object graph-container-vertex) &key
65 vertex-edges-container-class)
66 (setf (slot-value object 'vertex-edges)
67 (make-vertex-edges-container object vertex-edges-container-class)))
70 (defmethod make-vertex-container ((graph graph-container) initial-size)
71 (make-container 'simple-associative-container
72 :initial-size initial-size
73 :test (vertex-test graph)))
76 (defmethod make-edge-container ((graph graph-container) initial-size)
77 (make-container 'vector-container :initial-size initial-size
81 ;;; graph-container-directed-edge
83 (defclass* graph-container-directed-edge (directed-edge-mixin
87 (:documentation "A graph-container-directed-edge is both a directed-edge-mixin and a graph-container-edge."))
90 (defmethod initialize-instance :after ((object graph-container-directed-edge)
91 &key source-vertex target-vertex)
92 (when (and source-vertex (vertex-1 object))
93 (error "Specify source-vertex or vertex-1, but not both"))
94 (when (and target-vertex (vertex-2 object))
95 (error "Specify target-vertex or vertex-2, but not both"))
97 (setf (slot-value object 'vertex-1) source-vertex))
99 (setf (slot-value object 'vertex-2) target-vertex)))
101 ;;; vertex-1 is defined to be the source vertex of an undirected edge
103 (defmethod source-vertex ((edge graph-container-edge))
106 ;;; vertex-2 is defined to be the target vertex of an undirected edge
108 (defmethod target-vertex ((edge graph-container-edge))
112 (defmethod other-vertex ((edge graph-container-edge)
113 (v graph-container-vertex))
114 (cond ((eq v (vertex-1 edge))
115 (values (vertex-2 edge)))
117 ((eq v (vertex-2 edge))
118 (values (vertex-1 edge)))
120 (t (error "Vertex ~A not part of Edge ~A" v edge))))
123 (defmethod other-vertex ((edge graph-container-edge)
125 (other-vertex edge (find-vertex edge value)))
128 (defmethod add-edge ((graph graph-container) (edge graph-container-edge)
130 (declare (ignore force-new?))
132 (let ((vertex-1 (vertex-1 edge))
133 (vertex-2 (vertex-2 edge)))
135 (cond ((eq vertex-1 vertex-2)
136 (add-edge-to-vertex edge vertex-1))
138 (add-edge-to-vertex edge vertex-1)
139 (add-edge-to-vertex edge vertex-2)))
140 (push edge (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2))))
144 (defmethod add-edge-to-vertex :around ((edge graph-container-edge)
145 (vertex graph-container-vertex))
146 (insert-item (vertex-edges vertex) edge))
149 (defmethod make-node-for-container ((graph graph-container) (node t) &key)
150 (make-vertex-for-graph graph :element node))
153 (defmethod find-edge-between-vertexes ((graph graph-container)
154 (vertex-1 graph-container-vertex)
155 (vertex-2 graph-container-vertex)
156 &key error-if-not-found?)
157 (multiple-value-bind (value found?)
158 (item-at-1 (vertex-pair->edge graph)
159 (cons vertex-1 vertex-2))
160 (when (and error-if-not-found?
162 (error 'graph-edge-not-found-error
163 :vertex-1 vertex-1 :vertex-2 vertex-1))
167 (defmethod find-edge-between-vertexes-if ((graph graph-container)
168 (vertex-1 graph-container-vertex)
169 (vertex-2 graph-container-vertex)
171 &key error-if-not-found?)
172 (let ((it (search-for-match (vertex-edges vertex-1)
174 (and (eq vertex-2 (other-vertex edge vertex-1))
175 (funcall fn edge))))))
176 (when (and error-if-not-found? (not it))
177 (error 'graph-edge-not-found-error
178 :vertex-1 vertex-1 :vertex-2 vertex-1))
182 (defmethod find-edge-between-vertexes-if ((graph graph-container)
186 &key error-if-not-found?)
187 (let ((v1 (find-vertex graph value-1 error-if-not-found?))
188 (v2 (find-vertex graph value-2 error-if-not-found?)))
189 (or (and v1 v2 (find-edge-between-vertexes-if graph v1 v2 fn))
190 (when error-if-not-found?
191 (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2)))))
194 (defmethod find-edge ((graph graph-container) (edge graph-container-edge)
195 &optional error-if-not-found?)
196 (find-edge-between-vertexes
197 graph (vertex-1 edge) (vertex-2 edge)
198 :error-if-not-found? error-if-not-found?))
201 (defmethod delete-edge ((graph graph-container) (edge graph-container-edge))
202 (let ((vertex-1 (vertex-1 edge))
203 (vertex-2 (vertex-2 edge)))
204 (delete-item (vertex-edges vertex-1) edge)
205 (delete-item (vertex-edges vertex-2) edge)
206 (setf (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2))
208 (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2))
212 (defmethod delete-all-edges ((graph graph-container))
216 (empty! (vertex-edges vertex))))
217 (empty! (vertex-pair->edge graph))
221 (defmethod empty! :after ((graph graph-container))
222 (empty! (vertex-pair->edge graph)))
227 (defmethod iterate-edges ((graph graph-container) fn)
228 (iterate-elements (graph-edges graph) fn))
231 (defmethod iterate-edges ((vertex graph-container-vertex) fn)
232 (iterate-elements (vertex-edges vertex) fn))
235 (defmethod iterate-source-edges ((vertex graph-container-vertex) fn)
236 (iterate-elements (vertex-edges vertex)
238 (when (or (undirected-edge-p edge)
239 (eq vertex (source-vertex edge)))
240 (funcall fn edge)))))
243 (defmethod iterate-target-edges ((vertex graph-container-vertex) fn)
244 (iterate-elements (vertex-edges vertex)
246 (when (or (undirected-edge-p edge)
247 (eq vertex (target-vertex edge)))
248 (funcall fn edge)))))
251 (defmethod iterate-children ((vertex graph-container-vertex) fn)
252 (iterate-source-edges vertex
254 (funcall fn (other-vertex edge vertex)))))
257 (defmethod iterate-parents ((vertex graph-container-vertex) fn)
258 (iterate-target-edges vertex
260 (funcall fn (other-vertex edge vertex)))))
263 (defmethod iterate-neighbors ((vertex graph-container-vertex) fn)
264 (iterate-edges vertex
266 (funcall fn (other-vertex edge vertex)))))
269 (defmethod vertexes ((edge graph-container-edge))
270 (collect-using #'iterate-vertexes nil edge))
273 (defmethod has-children-p ((vertex graph-container-vertex))
274 (iterate-target-edges vertex
276 (declare (ignore edge))
277 (return-from has-children-p t)))
281 (defmethod has-parent-p ((vertex graph-container-vertex))
282 (iterate-source-edges vertex
284 (declare (ignore edge))
285 (return-from has-parent-p t)))
289 (defmethod vertices-share-edge-p ((vertex-1 graph-container-vertex)
290 (vertex-2 graph-container-vertex))
291 (iterate-target-edges vertex-1
293 (when (or (eq (target-vertex e) vertex-2)
294 (eq (source-vertex e) vertex-2))
295 (return-from vertices-share-edge-p t))))
297 (iterate-source-edges vertex-1
299 (when (or (eq (target-vertex e) vertex-2)
300 (eq (source-vertex e) vertex-2))
301 (return-from vertices-share-edge-p t))))
306 (defmethod edge-count ((graph graph-container))
307 (size (graph-edges graph)))