; David T. (Tom) Harper
; Using BFS Method, and Showing All Steps

(defun build-record (state parent) (list state parent) )

(defun left-tuple (tuple)
        (car tuple) )

(defun mid-tuple (tuple)
        (car (cdr tuple)) )

(defun right-tuple (tuple)
	(car (cdr (cdr tuple))) )

(defun get-left (state) (nth 0 state) )

(defun get-right (state) (nth 1 state) )

(defun find-state (state list_of_states)
   (cond 
       ( (null list_of_states) nil)
       ( (null state) nil)
       ( (equal state (get-left (car list_of_states))) (car list_of_states) )
       (t (find-state state (cdr list_of_states)) )
   )
)

(defun build-solution-list ()
   (setq child nil)
   (setq parent nil)
   (dolist (duple (reverse *soln*))
      (setq child (car duple))
      (setq parent (car (cdr duple)))
      (get-print-move child parent)
   ); end dolist
)

(defun get-print-move (child parent)
  (setq child-m (left-tuple child) )
  (setq child-c (mid-tuple child) )
  (setq child-b (right-tuple child) )

  (setq parent-m (left-tuple parent) )
  (setq parent-c (mid-tuple parent) )
  (setq parent-b (right-tuple parent) )

  (decf child-m parent-m)
  (decf child-c parent-c)
  (decf child-b parent-b)

(setq miss nil)
(setq cann nil)
  (if (> child-m 0) (setq miss (list (abs child-m) "missionaries to right")) )
  (if (< child-m 0) (setq miss (list (abs child-m) "missionaries to left")) )
  (if (= child-m 0) (setq miss (list (abs child-m) "missionaries to right")) )

  (if (> child-c 0) (setq cann (list (abs child-c) "cannibals to right")) )
  (if (< child-c 0) (setq cann (list (abs child-c) "cannibals to left")) )
  (if (= child-c 0) (setq cann (list (abs child-c) "cannibals to right")) )
(print miss)
(print cann)
(print child)
) ;end fun


(defun bfs ()
	(setq next (pop *open*) ) ; grab state off open
	(setq *closed* (cons next *closed*)) ; put it on the closed list
	(cond 
	   ( (equal (get-left next) *goal*)  ; if this is our goal, bail!
		(pushnew next *soln*) ;  push our current item onto sol'n stack
		(build-solution-list) ; display results
	   )
           (t (setq myvar (get-next-states (get-left next)) ) ; get the allowable next steps
		(setq *open* (append myvar *open*) ) ; append them to the correct spot on the open list
		(if (not( null myvar) ) (pushnew next *soln*) ) ; if there were children, next is a soln
		(bfs) ; search for children's children
           )
	) ; end inner cond
) ; end fun

;(pushnew (cons (list state-m state-c state-b) (list state)) *closed*) ; put on closed 

(defun get-next-states (state)
  (if (equal state nil) nil)
  (setq all nil) 
  (setq temp nil) 
  (if (= (right-tuple state) 0) 
; here we are moving left
	(dolist (action '((+1 0 +1) (0 +1 +1) (+2 0 +1) (0 +2 +1) (+1 +1 +1)))
	     (setq temp (move-boat-across state action))
		(if (not(equal temp nil)) (setq all (append all (list temp) ))  ) ; if not nil append
	); end dolist
; else we are moving right
	(dolist (action '((-1 0 -1) (0 -1 -1) (-2 0 -1) (0 -2 -1) (-1 -1 -1)))
	     (setq temp (move-boat-across state action))
		(if (not(equal temp nil)) (setq all (append all (list temp) ))  ) ; if not nil append
	); end dolist
  ); end if
(setq all all) ; return states- if only there was a return (sigh)
); end fun

; All of the following must apply to move boat, otherwise we return null
;	- #missionaries >= 0
;	- #cannibals >=0
;	- #missionaries <= 3
;	- #cannibals <= 3
;	- One of the following:
;		- #missionaries >= #cannibals on both sides
;		- #missionaries = 0 on either side
;	- Current state is not initial state
;	- Current move does not repeat previous move in state
; other states to avoid:
;	(not (and (= state-m 0) (= state-c 0) (= state-b 0) ) )
;	(not (and (= state-m 1) (= state-c 0) (= state-b 1) ) )
;	(not (and (= state-m 1) (= state-c 0) (= state-b 1) ) )
;	(not (and (= state-m 1) (= state-c 1) (= state-b 1) ) )
;	(not (and (= state-m 0) (= state-c 2) (= state-b 1) ) )

(defun move-boat-across (state action)
  (if (equal action nil) nil)
  (if (equal state nil) nil)

  (setq delta-m (left-tuple action) )
  (setq delta-c (mid-tuple action) )
  (setq delta-b (right-tuple action) )
  (setq state-m (left-tuple state) )
  (setq state-c (mid-tuple state) )
  (setq state-b (right-tuple state) )

  (incf state-m delta-m)
  (incf state-c delta-c)
  (incf state-b delta-b)

  (if (and 
	(<= state-m 3) 
	(>= state-m 0) 
	(<= state-c 3) 
	(>= state-c 0) 
	(or 
		(= state-m state-c)
		(= 0 state-m) 
		(= 3 state-m)
	)
	(equal (find-state (list state-m state-c state-b) *closed*) nil) ; don't repeat a closed state
	(equal (find-state (list state-m state-c state-b) *open*) nil) ; don't repeat an open state
      )
	(list (list state-m state-c state-b) state) ; return the state duple
	(= 1 0) ; return nil 
   ); end if
) ; end fun


(defun test-move-boat()
	(setq *open* (list (build-record '(0 0 0) nil)))
	(setq *closed* nil)
	(setq *soln* nil)
	(move-boat-across '(0 0 0) '(0 1 1))
)
;(test-move-boat)

(defun test-get-next-states ()
	(setq *open* (list (build-record '(0 0 0) nil)))
	(setq *closed* nil)
	(setq *soln* nil)
	(setq foo (get-next-states '(2 0 1)))
)
;(test-get-next-states)

(defun run-mc (start goal)
; set globals
	(setq *open* (list (build-record start '(0 0 0) )))
	(setq *closed* nil)
	(setq *soln* nil)
	(setq *goal* goal )
; start search
	(bfs)
)

( run-mc '(0 0 0) '(3 3 1) )
;( run-mc '(3 3 1) '(0 0 0) ) ; hey, it works the other way too.