;; bfs search for a number
;;
;; This code is similar to bfs.scm, the difference is that
;;  this version is able to produce the path from the start state to
;;  the goal with the help of a data structure that keeps track
;;  of the parent of each state added to the queue.
;; We also use this data structure to avoid re-visiting states

;; This procedure makes it easy to generate
;; output...
(define show 
  (lambda x
    (map display x)))

;; parentlist is the data structure that keeps track of 
;; which states have been placed on the queue, and for each of
;; these states it records the parent state so we can generate
;;  a backtrace of states that led to the goal (after the search 
;;  is complete).
;; parentlist is an association list
(define parentlist ())

(define (parentlist-init)
  (set! parentlist ()))

(define (parentlist-add! child parent)
  (show "Adding (" child "  " parent ") to parentlist\n")
  (set! parentlist (cons (list child parent) parentlist)))

;; returns the parent state number if found
;;  (the second element in the association list pair whose
;;   car is child).
;;  returns #f if not found
(define (parentlist-member? child)
  (let ((alistelem (assoc child parentlist)))
	(if alistelem
		(cadr alistelem)
		#f)))


;; this will generate a list of states from x back to the start state
;; by preceding each state with it's parent (in the list generated)
;; Stops once it finds a state whose parent is 'start, this is how
;; we mark the initial state.

(define (getpath x)
  (let ((parent (parentlist-member? x)))
	(cond
	 ;; if we didn't find x in the parentlist, something is wrong
	 ((not parent) (show "huh? a state with no parent?\n"))
	 ;; if we found the start state, we are done.
	 ((equal? parent 'start)
	  (list x))
	 (else
	  ;; create a list from the parent back to the goal, 
	  ;; and add this state at the end of that list
	  (begin
		(append (getpath parent) (list x)))))))

;; successor states of a state numbered x are x-1 and x+1
;; 
(define (successor x)
  (list (- x 1) (+ x 1)))

;;
;; a wrapper for successor that does the following:
;;  - won't return a state that is already been 
;;    generated (found in parentlist)
;;  - add new states to parentlist
(define (unique-successor x)
  (let us-helper ((s (successor x)) (uniquestates ()))
	(if (null? s)
		uniquestates
		  (if (not (parentlist-member? (car s)))
			  ;; we found a unique state, add to the list
			  ;; we will return (uniquestates)
			  (begin
				(parentlist-add! (car s) x)
				(us-helper (cdr s) (cons (car s) uniquestates)))
			  ;; we found the state in parentlist, don't
			  ;; add to the list of states we will return
			  (us-helper (cdr s) uniquestates)))))

;; Breadth first seach example. Uses a BFS to search for a number (goal)
;; in search tree rooted at startnum. The successor function is used to
;; generate a list of child states.
;;
;; This procedure generates a trace of what it is doing, displaying
;; a line each time it visits a state
;;
;;  bfs keeps a queue (list) of states it needs to explore
;;  Each time it looks at a state, it generates the list of
;;  successor states checks for the goal state, and if not found
;;   adds the successor states to the queue.
;;
;;  bfs uses a named let to introduce the queue which initially
;;   holds only the start state.
;;   The recursion is all on the named let instead of the
;;   top level bfs procedure
;;
;; This version adds each state visited to the parentlist, and
;;  avoids duplicate states by calling the successor wrapper function
;;  unique-successor (which takes care of adding new states to the
;;  parentlist

(define (bfs startnum goal)
  (parentlist-init )
  (parentlist-add! startnum 'start)
  ;; named let. initialize states with list of
  ;; all successor states. We will recurse over this
  ;; list using the named let.
  (let bfs-helper ((states (list startnum)))
	(if (null? states)
		(begin
		  (show "FAILURE: ran out of states!\n")
		  #f)
		(let ((nextstate (car states)))
		  (show "state: " nextstate "\n")
		  (if (equal? goal nextstate)
			  (begin
				(show "GOAL FOUND: " nextstate "\n")
				#t)
			  (begin
				(bfs-helper (append (cdr states) (unique-successor nextstate)))))))))

;; here is a sample call:
;;   start at 0, find the number 3 and limit depth to 4.
(bfs 0 3)
parentlist
(getpath 3)