s/graph-search/graph-search-for-cl-graph/ to keep packages happy

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

diff --git a/dev/graph.lisp b/dev/graph.lisp
index 3af3c47..d71ab6c 100644 (file)
--- a/dev/graph.lisp
+++ b/dev/graph.lisp
@@ -252,7 +252,7 @@ something is putting something on the vertexes plist's
 ;;; ---------------------------------------------------------------------------
 
 (defmethod make-graph ((classes list) &rest args)
-  (let ((name (find-or-create-class 'basic-graph classes))) 
+  (let ((name (dynamic-classes:find-or-create-class 'basic-graph classes))) 
     (apply #'make-instance name args)))
 
 ;;; ---------------------------------------------------------------------------
@@ -456,14 +456,14 @@ something is putting something on the vertexes plist's
 
 ;;; ---------------------------------------------------------------------------
 
-(defmethod find-edge-between-vertexes ((graph basic-graph) (value-1 t) (value-2 t)
-                                       &key (error-if-not-found? t))
-  (let ((v1 (find-vertex graph value-1 error-if-not-found?))
-        (v2 (find-vertex graph value-2 error-if-not-found?)))
-    (aif (and v1 v2 (find-edge-between-vertexes graph v1 v2))
-         it
-         (when error-if-not-found?
-           (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2)))))
+(defmethod find-edge-between-vertexes
+    ((graph basic-graph) (value-1 t) (value-2 t)
+     &key (error-if-not-found? t))
+  (let* ((v1 (find-vertex graph value-1 error-if-not-found?))
+        (v2 (find-vertex graph value-2 error-if-not-found?)))
+    (or (and v1 v2 (find-edge-between-vertexes graph v1 v2)))
+    (when error-if-not-found?
+      (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2))))
 
 ;;; ---------------------------------------------------------------------------
 
@@ -617,10 +617,9 @@ something is putting something on the vertexes plist's
 
 (defmethod find-vertex ((graph basic-graph) (value t)
                         &optional (error-if-not-found? t))
-  (aif (find-item (graph-vertexes graph) (funcall (vertex-key graph) value))
-       it
-       (when error-if-not-found?
-         (error 'graph-vertex-not-found-error :vertex value :graph graph))))
+  (or (find-item (graph-vertexes graph) (funcall (vertex-key graph) value))
+      (when error-if-not-found?
+       (error 'graph-vertex-not-found-error :vertex value :graph graph))))
 
 (defmethod find-vertex ((graph basic-graph) (vertex basic-vertex)
                         &optional (error-if-not-found? t))
@@ -646,18 +645,16 @@ something is putting something on the vertexes plist's
 (defmethod search-for-vertex ((graph basic-graph) (vertex basic-vertex)
                               &key (key (vertex-key graph)) (test 'equal)
                               (error-if-not-found? t))
-  (aif (search-for-node (graph-vertexes graph) vertex :test test :key key)
-       it
-       (when error-if-not-found?
-         (error "~A not found in ~A" vertex graph))))
+  (or (search-for-node (graph-vertexes graph) vertex :test test :key key)
+      (when error-if-not-found?
+       (error "~A not found in ~A" vertex graph))))
 
 (defmethod search-for-vertex ((graph basic-graph) (vertex t)
                               &key (key (vertex-key graph)) (test 'equal)
                               (error-if-not-found? t))
-  (aif (search-for-element (graph-vertexes graph) vertex :test test :key key)
-       it
-       (when error-if-not-found?
-         (error "~A not found in ~A" vertex graph))))
+  (or (search-for-element (graph-vertexes graph) vertex :test test :key key)
+      (when error-if-not-found?
+       (error "~A not found in ~A" vertex graph))))
 
 (defmethod iterate-elements ((graph basic-graph) fn)
    (iterate-elements (graph-vertexes graph) 
@@ -820,7 +817,7 @@ something is putting something on the vertexes plist's
 
 (defmethod traverse-elements-helper ((thing basic-vertex) (style (eql :depth)) marker fn)
   (when (eq (tag thing) marker)
-    (nilf (tag thing))
+    (setf (tag thing) nil)
     (iterate-children
      thing
      (lambda (vertex)
@@ -832,7 +829,7 @@ something is putting something on the vertexes plist's
 
 (defmethod traverse-elements-helper ((thing basic-vertex) (style (eql :breadth)) marker fn)
   (when (eq (tag thing) marker)
-    (nilf (tag thing))
+    (setf (tag thing) nil)
     (funcall fn thing))
   
   (iterate-neighbors
@@ -845,19 +842,39 @@ something is putting something on the vertexes plist's
    thing
    (lambda (vertex)
      (when (eq (tag vertex) marker)
-       (nilf (tag vertex))
+       (setf (tag vertex) nil)
        (traverse-elements-helper vertex style marker fn)))))
 
 ;;; ---------------------------------------------------------------------------
 
+;; also in metatilites
+(defun graph-search-for-cl-graph (states goal-p successors combiner
+                                 &key (state= #'eql) old-states
+                                 (new-state-fn #'new-states))
+  "Find a state that satisfies goal-p.  Start with states,
+  and search according to successors and combiner.  
+  Don't try the same state twice."
+  (cond ((null states) nil)
+        ((funcall goal-p (first states)) (first states))
+        (t (graph-search-for-cl-graph
+             (funcall
+               combiner
+               (funcall new-state-fn states successors state= old-states)
+               (rest states))
+             goal-p successors combiner
+             :state= state=
+             :old-states (adjoin (first states) old-states
+                                 :test state=)
+             :new-state-fn new-state-fn))))
+
 (defmethod in-cycle-p ((graph basic-graph) (start-vertex basic-vertex))
   (let ((first-time? t))
     (not (null
-          (graph-search 
+          (graph-search-for-cl-graph 
            (list start-vertex)
            (lambda (v)
              (if first-time?
-               (nilf first-time?)
+               (setf first-time? nil)
                (eq (find-vertex graph v) start-vertex)))
            (lambda (v)
              (child-vertexes v))
@@ -880,7 +897,7 @@ something is putting something on the vertexes plist's
             &optional (marked (make-container 'simple-associative-container))
             (previous nil))
   (block do-it
-    (tf (item-at-1 marked current))
+    (setf (item-at-1 marked current) t)
     (iterate-children current
                       (lambda (child)
                         (cond 
@@ -1072,7 +1089,8 @@ nil gathers the entire closure(s)."
   (assign-level graph 0)
   (let ((depth 0))
     (iterate-vertexes graph (lambda (vertex)
-                              (maxf depth (depth-level vertex))))
+                              (when (> (depth-level vertex) depth)
+                               (setf depth (depth-level vertex)))))
     depth))
 
 ;;; ---------------------------------------------------------------------------