X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=dev%2Fgraph.lisp;h=d71ab6ce0d27437d457784501804948b9e33ae23;hb=e95dd49b959e672614b7eb2c109c2d842b6f4a23;hp=e851b1ab2a0db1d0caaf67aba740d5ad828d5b12;hpb=a6bbd850d6392387184d32ffecb83d513a76395c;p=cl-graph.git diff --git a/dev/graph.lisp b/dev/graph.lisp index e851b1a..d71ab6c 100644 --- 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))) ;;; --------------------------------------------------------------------------- @@ -847,10 +847,30 @@ something is putting something on the vertexes plist's ;;; --------------------------------------------------------------------------- +;; 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? @@ -1069,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)) ;;; ---------------------------------------------------------------------------