|#
-(in-package metabang.graph)
+(in-package #:metabang.graph)
;;; ---------------------------------------------------------------------------
;;; class defs
initial-contents-mixin
basic-graph
container-uses-nodes-mixin)
- ()
+ ((vertex-pair->edge (make-container 'simple-associative-container
+ :test #'equal) r))
(:default-initargs
:vertex-class 'graph-container-vertex
:directed-edge-class 'graph-container-directed-edge
(add-edge-to-vertex edge vertex-1))
(t
(add-edge-to-vertex edge vertex-1)
- (add-edge-to-vertex edge vertex-2))))
+ (add-edge-to-vertex edge vertex-2)))
+ (push edge (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2))))
edge)
;;; ---------------------------------------------------------------------------
(vertex-1 graph-container-vertex)
(vertex-2 graph-container-vertex)
&key error-if-not-found?)
- (declare (ignore error-if-not-found?))
- (search-for-match (vertex-edges vertex-1)
- (lambda (edge)
- (eq vertex-2 (other-vertex edge vertex-1)))))
+ (multiple-value-bind (value found?)
+ (item-at-1 (vertex-pair->edge graph)
+ (cons vertex-1 vertex-2))
+ (when (and error-if-not-found?
+ (not found?))
+ (error 'graph-edge-not-found-error
+ :vertex-1 vertex-1 :vertex-2 vertex-1))
+ (first value)))
;;; ---------------------------------------------------------------------------
(vertex-1 graph-container-vertex)
(vertex-2 graph-container-vertex)
fn
- &key error-if-not-found?)
- (declare (ignore error-if-not-found?))
- (search-for-match (vertex-edges vertex-1)
- (lambda (edge)
- (and (eq vertex-2 (other-vertex edge vertex-1))
- (funcall fn edge)))))
+ &key error-if-not-found?)
+ (let ((it (search-for-match (vertex-edges vertex-1)
+ (lambda (edge)
+ (and (eq vertex-2 (other-vertex edge vertex-1))
+ (funcall fn edge))))))
+ (when (and error-if-not-found? (not it))
+ (error 'graph-edge-not-found-error
+ :vertex-1 vertex-1 :vertex-2 vertex-1))
+ it))
;;; ---------------------------------------------------------------------------
&key error-if-not-found?)
(bind ((v1 (find-vertex graph value-1 error-if-not-found?))
(v2 (find-vertex graph value-2 error-if-not-found?)))
- (find-edge-between-vertexes-if
- graph v1 v2 fn
- :error-if-not-found? error-if-not-found?)))
+ (aif (and v1 v2 (find-edge-between-vertexes-if graph v1 v2 fn))
+ it
+ (when error-if-not-found?
+ (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2)))))
;;; ---------------------------------------------------------------------------
;;; ---------------------------------------------------------------------------
(defmethod delete-edge ((graph graph-container) (edge graph-container-edge))
- (delete-item (vertex-edges (vertex-1 edge)) edge)
- (delete-item (vertex-edges (vertex-2 edge)) edge)
+ (let ((vertex-1 (vertex-1 edge))
+ (vertex-2 (vertex-2 edge)))
+ (delete-item (vertex-edges vertex-1) edge)
+ (delete-item (vertex-edges vertex-2) edge)
+ (setf (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2))
+ (delete edge
+ (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2))
+ :test #'eq)))
edge)
+(defmethod delete-all-edges ((graph graph-container))
+ (iterate-vertexes
+ graph
+ (lambda (vertex)
+ (empty! (vertex-edges vertex))))
+ (empty! (vertex-pair->edge graph))
+ graph)
+
+;;; ---------------------------------------------------------------------------
+
+(defmethod empty! :after ((graph graph-container))
+ (empty! (vertex-pair->edge graph)))
+
+
+;;; ---------------------------------------------------------------------------
+;;; iteration
;;; ---------------------------------------------------------------------------
(defmethod iterate-edges ((graph graph-container) fn)