X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=dev%2Fgraph-container.lisp;h=21ca52e32f91ce88b509a3d533795ad26f91529e;hb=30d6c8f9bd55ddefd48d333bfeb73b1a2a333e99;hp=2bc250460531b177bf9e9d6ad22767930d6e486e;hpb=a8ac5bf925e0d89ba03b0b8082cd497c7b93608c;p=cl-graph.git diff --git a/dev/graph-container.lisp b/dev/graph-container.lisp index 2bc2504..21ca52e 100644 --- a/dev/graph-container.lisp +++ b/dev/graph-container.lisp @@ -192,12 +192,15 @@ DISCUSSION (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)) ;;; --------------------------------------------------------------------------- @@ -208,9 +211,9 @@ DISCUSSION &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?))) + (or (and v1 v2 (find-edge-between-vertexes-if graph v1 v2 fn)) + (when error-if-not-found? + (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2))))) ;;; --------------------------------------------------------------------------- @@ -233,6 +236,14 @@ DISCUSSION :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)) @@ -257,7 +268,7 @@ DISCUSSION (iterate-elements (vertex-edges vertex) (lambda (edge) (when (or (undirected-edge-p edge) - (eq vertex (target-vertex edge))) + (eq vertex (source-vertex edge))) (funcall fn edge))))) ;;; --------------------------------------------------------------------------- @@ -266,20 +277,20 @@ DISCUSSION (iterate-elements (vertex-edges vertex) (lambda (edge) (when (or (undirected-edge-p edge) - (eq vertex (source-vertex edge))) + (eq vertex (target-vertex edge))) (funcall fn edge))))) ;;; --------------------------------------------------------------------------- (defmethod iterate-children ((vertex graph-container-vertex) fn) - (iterate-target-edges vertex + (iterate-source-edges vertex (lambda (edge) (funcall fn (other-vertex edge vertex))))) ;;; --------------------------------------------------------------------------- (defmethod iterate-parents ((vertex graph-container-vertex) fn) - (iterate-source-edges vertex + (iterate-target-edges vertex (lambda (edge) (funcall fn (other-vertex edge vertex)))))