Removed the need for metabang-bind

[cl-graph.git] / dev / graph-container.lisp

diff --git a/dev/graph-container.lisp b/dev/graph-container.lisp
index afafdda..1e24d33 100644 (file)
--- a/dev/graph-container.lisp
+++ b/dev/graph-container.lisp
@@ -9,7 +9,7 @@ DISCUSSION
 
 |#
 
-(in-package metabang.graph)
+(in-package #:metabang.graph)
 
 ;;; ---------------------------------------------------------------------------
 ;;; class defs
@@ -20,7 +20,8 @@ DISCUSSION
                             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
@@ -148,14 +149,15 @@ DISCUSSION
                      &key force-new?)
   (declare (ignore force-new?))
   
-  (bind ((vertex-1 (vertex-1 edge))
+  (let ((vertex-1 (vertex-1 edge))
          (vertex-2 (vertex-2 edge)))
         
     (cond ((eq vertex-1 vertex-2)
            (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)))
 
 ;;; ---------------------------------------------------------------------------
 
@@ -186,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))    
 
 ;;; ---------------------------------------------------------------------------
 
@@ -200,15 +209,14 @@ DISCUSSION
                                           (value-2 t)
                                           fn
                                           &key error-if-not-found?)
-  (bind ((v1 (find-vertex graph value-1 error-if-not-found?))
+  (let ((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)))))
 
 ;;; ---------------------------------------------------------------------------
 
-
 (defmethod find-edge ((graph graph-container) (edge graph-container-edge)
                       &optional error-if-not-found?)
   (find-edge-between-vertexes
@@ -218,10 +226,32 @@ 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 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)
@@ -238,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)))))
 
 ;;; ---------------------------------------------------------------------------
@@ -247,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)))))
 
@@ -312,7 +342,8 @@ DISCUSSION
   
   (values nil))
 
+;;; ---------------------------------------------------------------------------
+
+(defmethod edge-count ((graph graph-container))
+  (size (graph-edges graph)))
 
-;;; ***************************************************************************
-;;; *                              End of File                                *
-;;; ***************************************************************************
\ No newline at end of file