[plt-scheme] Depth first search critique?

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Star Simpson wrote:
> I'd take a gander - send it over!
Oops, I thought I'd sent it already, guess that was just to Jos.

After his recommendations, I've made a few changes.

(define-struct edge (origin destination cost))

(define-struct node (state depth cost parent))

;make-child-node: node edge -> node
; take a node and an edge from that node, yield a descendent node  
with an appropriate state, depth, cost and state
(define (make-child-node node edge)
   (make-node (edge-destination edge)
              (+ 1 (node-depth node))
              (+ (edge-cost edge) (node-cost node))
              node))

(define-struct map (origin destination edges heuristics))

;map-root map -> node
; return the root node of a map
(define (map-root map)
   (make-node (map-origin map) 0 0 null))

;map-success? node map -> boolean
; return whether a node is in the success state of a map
(define (map-success? node map)
   (eqv? (map-destination map) (node-state node)))

;map-node-children: node map -> `(node)
; yield a list of child nodes, given a node and a map
(define (map-node-children node map)
   (let ~map-node-children ((node node)
                            (edges (map-edges map)))
     (cond ((null? edges) null)
           ((eqv? (edge-origin (car edges)) (node-state node))
            (cons (make-child-node node (car edges)) (~map-node- 
children node (cdr edges))))
           (else (~map-node-children node (cdr edges))))))

;search-children: `(node) problem int -> node, cutoff, or failure
; given a list of nodes, search each for the goal. Return the  
successful node if available, or return 'cutoff if the search was  
ended due to the depth limit, or return 'failure otherwise
(define (search-children nodes problem limit)
   (let ~search-children ((nodes nodes)
                          (problem problem)
                          (limit limit)
                          (fail-result 'failure))
     (if (null? nodes) fail-result
         (let ((result (~depth-limited-search (car nodes) problem  
limit)))
           (if (symbol? result)
               (~search-children (cdr nodes) problem limit result)
               result)))))

;depth-limited-search: problem int -> node, cutoff, or failure
; given a problem and depth limit, search the children of the problem  
root for the goal. Return the successful node if available, or return  
'cutoff if the search was ended due to the depth limit, or return  
'failure otherwise
(define (depth-limited-search problem limit)
   (~depth-limited-search (map-root problem) problem limit))
(define (~depth-limited-search node problem limit)
   (cond ((map-success? node problem) node)
         ((>= (node-depth node) limit) 'cutoff)
         (else (search-children (map-node-children node problem)  
problem limit))))

;iterative-deepening-search: problem -> node or failure
; given a starting node or state, goal state, and a list of edges,  
search the starting node's children for the goal. Return the  
successful node if available, or return 'failure otherwise. If  
success is not found within depth n, search will continue to include  
depth n+1, starting at depth n = 0;
(define (iterative-deepening-search problem)
   (let ~ids ((problem problem)
              (acc 0)
              (limit 20))
     (if (>= acc limit) 'cutoff
         (let ((result (depth-limited-search problem acc)))
           (if (eqv? 'cutoff result)
               (~ids problem (+ 1 acc) limit)
               result)))))


;Tests
(require (lib "64.ss""srfi"))

(define-syntax test-group
   (syntax-rules ()
     ((test-group suite-name . body)
      (dynamic-wind
       (lambda () (test-begin suite-name))
       (lambda () . body)
       (lambda () (test-end  suite-name))))))


(define test-edges (list
                     (make-edge 'arad 'zerind 75)
                     (make-edge 'arad 'sibiu 140)
                     (make-edge 'arad 'timisoara 118)
                     (make-edge 'bucharest 'fagaras 211)
                     (make-edge 'bucharest 'pitesti 101)
                     (make-edge 'zerind 'oradea 71)))

(test-begin "Depth Limited Search")
(test-group "should cutoff at limit"
             (test-eqv 'cutoff (depth-limited-search (make-map 'arad  
'zerind test-edges null)  0)))

(test-group "should fail at edge of map"
             (test-eqv 'cutoff (depth-limited-search (make-map 'arad  
'nowhere test-edges null) 0)))

(test-group "should succeed in single step path"
             (let ((node (depth-limited-search (make-map 'arad 'arad  
test-edges null) 0)))
               (test-eqv 'arad  (node-state node))
               (test-eqv 0 (node-depth node))))

(test-group "should succeed in two step path"
             (let ((node (depth-limited-search (make-map 'arad  
'zerind test-edges null) 1)))
               (test-eqv 'zerind  (node-state node))
               (test-eqv 1 (node-depth node))
               (test-eqv 75 (node-cost node))))

(test-group "should should succeed in two step path"
             (let ((node (depth-limited-search (make-map 'arad  
'oradea test-edges null) 2)))
               (test-eqv 'oradea (node-state node))
               (test-eqv 2 (node-depth node))
               (test-eqv (+ 71 75) (node-cost node))))
(test-end "Depth Limited Search")


(test-group "Iterative Deepening Search"
             (let ((node (iterative-deepening-search (make-map 'arad  
'oradea test-edges null))))
               (test-eqv 'oradea (node-state node))
               (test-eqv 2 (node-depth node))
               (test-eqv (+ 71 75) (node-cost node))))
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.7 (Darwin)

iD8DBQFHAFG8xYqeHL30HVYRAgmFAJ0eXGPsgAgCibyX2bS6hEKCY5PpQQCeJxUK
9YajPl+ju1RFCrMJKHEtbEE=
=e52s
-----END PGP SIGNATURE-----