From: Gary King <gwking@metabang.com>
Date: Tue, 10 Jun 2008 12:59:25 +0000 (-0400)
Subject: Bring graph-search in (copied from metatilities); continue reorg with packages and... 
X-Git-Url: http://repo.macrolet.net/gitweb/?p=cl-graph.git;a=commitdiff_plain;h=bf38951682661e4e59bfa0d3a6687bab94bee35a

Bring graph-search in (copied from metatilities); continue reorg with packages and such

darcs-hash:20080610125925-3cc5d-f7d1f22ee7d933bc30e64e5b45987e379a3469b4.gz
---

diff --git a/dev/graph-metrics.lisp b/dev/graph-metrics.lisp
index df4c395..066781d 100644
--- a/dev/graph-metrics.lisp
+++ b/dev/graph-metrics.lisp
@@ -11,6 +11,13 @@ DISCUSSION
 |#
 (in-package #:metabang.graph)
 
+(eval-always 
+  (import '(cl-mathstats:matrix-trace
+	    cl-mathstats:sum-of-array-elements
+	    cl-mathstats:matrix-multiply
+	    cl-mathstats:normalize-matrix
+	    cl-mathstats:combination-count
+	    )))
 
 (defun vertex-degree-counts (g)
   "Returns an associative-container mapping edge-counts to the number of vertexes with that edge-count."
diff --git a/dev/graph.lisp b/dev/graph.lisp
index e851b1a..663088b 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,6 +847,26 @@ something is putting something on the vertexes plist's
 
 ;;; ---------------------------------------------------------------------------
 
+;; also in metatilites
+(defun graph-search (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
+             (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
@@ -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))
 
 ;;; ---------------------------------------------------------------------------
diff --git a/dev/package.lisp b/dev/package.lisp
index 1706df5..0b3a3c3 100644
--- a/dev/package.lisp
+++ b/dev/package.lisp
@@ -11,7 +11,7 @@ DISCUSSION
 
 (defpackage #:cl-graph
   (:use #:common-lisp #:metatilities #:cl-containers 
-        #:metabang.bind)
+        #:metabang.bind #+(or) #:cl-mathstats #:moptilities)
   (:nicknames #:metabang.graph)
   (:documentation "CL-Graph is a Common Lisp library for manipulating graphs and running graph algorithms.")