pathfinding.scm

(define (standard-transition state from to seed)
  (passable? state from to))

(define (make-standard-heuristic goal)
  (lambda (start)
    (min-distance start goal)))

(define (standard-cost state from to)
  (let ((dir (map - to from)))
    (cond ((door? to) 3)
	  ((bad-trap? to) 30)
	  ((and (boulder? to)
		(valid-coord? (map + to dir))
		(not (seen? (map + to dir))))
	   ; explore other areas first if we don't know where we're pushing
	   ; towards
	   15)
	  (else 1))))

(define (find-path-to state start goal)
  (find-path state
	     start
	     (specialize equal? goal)
	     (make-standard-heuristic goal)
	     standard-transition
	     #f
	     standard-cost))

(define (find-path-hard state start goal)
  (find-path state
	     start
	     (specialize equal? goal)
	     (make-standard-heuristic goal)
	     (lambda x #t)
	     #f
	     (lambda (state from to)
	       (if (passable? state from to)
		   (standard-cost state from to)
		   10))))

; include dark squares
(define (find-path-towards state start goal)
  (find-path state
	     start
	     (specialize equal? goal)
	     (make-standard-heuristic goal)
	     (lambda (state from to seed)
	       (or (passable? state from to)
		   (and (not (and (door? from)
				  (diagonal? (map - to from))))
			(not (seen? to))
			(char=? (square-char to) #\space))))
	     #f
	     (lambda (state from to)
	       (if (char=? (square-char to) #\space)
		   1.5
		   (standard-cost state from to)))))

(define (find-path state start pred heuristic transition transition-seed cost)
  (define (make-node parent seed sq)
    (let ((g-val (if parent (+ (g parent) (cost state (coord parent) sq)) 0))
	  (h-val (heuristic sq)))
      (list sq parent seed (+ g-val h-val) g-val h-val)))
  (define (make-start-node sq)
    (make-node #f transition-seed sq))
  (define (coord node) (list-ref node 0))
  (define (parent node) (list-ref node 1))
  (define (seed node) (list-ref node 2))
  (define (f node) (list-ref node 3))
  (define (g node) (list-ref node 4))
  (define (h node) (list-ref node 5))

  (define (path-to node)
    (define (acc n)
      (if (not (parent n))
	  (list (coord n))
	  (cons (coord n) (acc (parent n)))))
    (reverse (acc node)))

  (let loop ((open (list (make-start-node start)))
	     (closed '()))
    (cond
     ((null? open) #f)
     ((pred (coord (car open)))
      (path-to (car open)))
     (else
;      (display "examining ")
;      (write (car open))
;      (newline)
      (let* ((current (car open))
	     (neighbors
	      (let loop ((ls '())
			 (squares (neighbor-squares (coord current))))
		(cond
		 ((null? squares) ls)
		 ((member (car squares) closed)
		  (loop ls (cdr squares)))
		 (else
		  (let ((s (transition state
				       (coord current)
				       (car squares)
				       (seed current))))
		    (if s
			(loop (cons (make-node current s (car squares))
				    ls)
			      (cdr squares))
			(loop ls (cdr squares))))))))
	     (to-add
	      (filter
	       (lambda (node)
		 (or (not (member (coord node) (map coord open)))
		     (< (g node)
			(g (any (lambda (n)
				  (and (equal? (coord n) (coord node))
				       n))
				open)))))
	       neighbors)))
	(loop
	 (list-merge (lambda (a b) (< (f a) (f b)))
		     (filter (lambda (node)
			       (not (member (coord node) (map coord to-add))))
			     (cdr open))
		     to-add)
	 (cons (coord current) closed)))))))