From bf38951682661e4e59bfa0d3a6687bab94bee35a Mon Sep 17 00:00:00 2001 From: Gary King Date: Tue, 10 Jun 2008 08:59:25 -0400 Subject: [PATCH] Bring graph-search in (copied from metatilities); continue reorg with packages and such darcs-hash:20080610125925-3cc5d-f7d1f22ee7d933bc30e64e5b45987e379a3469b4.gz --- dev/graph-metrics.lisp | 7 +++++++ dev/graph.lisp | 25 +++++++++++++++++++++++-- dev/package.lisp | 2 +- 3 files changed, 31 insertions(+), 3 deletions(-) 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.") -- 1.7.10.4