X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=dev%2Fgraph-container.lisp;h=b5305d93aec7a2132ce321ef3226ba767b5988b7;hb=fbbd5f255d84d9f24a47907cc68d048b18907a5c;hp=f7f09ad00f3869df9794bcd991d77a30f2aad277;hpb=b9b77eaf8b04ffe94412d5ff49cacae2d19ebb65;p=cl-graph.git diff --git a/dev/graph-container.lisp b/dev/graph-container.lisp index f7f09ad..b5305d9 100644 --- a/dev/graph-container.lisp +++ b/dev/graph-container.lisp @@ -20,7 +20,8 @@ DISCUSSION initial-contents-mixin basic-graph container-uses-nodes-mixin) - ((vertex-pair->edge (make-container 'simple-associative-container) r)) + ((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 @@ -155,7 +156,8 @@ DISCUSSION (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) ;;; --------------------------------------------------------------------------- @@ -175,10 +177,14 @@ DISCUSSION (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))) ;;; --------------------------------------------------------------------------- @@ -217,12 +223,26 @@ DISCUSSION ;;; --------------------------------------------------------------------------- (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 (cons vertex-1 vertex-2) + (item-at-1 (vertex-pair->edge graph) (cons vertex-1 vertex-2)) + :test #'equal))) edge) ;;; --------------------------------------------------------------------------- +(defmethod empty! :after ((graph graph-container)) + (empty! (vertex-pair->edge graph))) + + +;;; --------------------------------------------------------------------------- +;;; iteration +;;; --------------------------------------------------------------------------- + (defmethod iterate-edges ((graph graph-container) fn) (iterate-elements (graph-edges graph) fn))