;; D. Vrajitoru, C463/B551 Spring 2006 

;; Implementation of a depth-first search for a solution to the
;; goat-wolf-cabbage puzzle.

;; Problem: a man is transporting a goat, a wolf, and a cabbage. He
;; must cross a river and has a boat that can only carry 1 item
;; beside himself at a time. He cannot leave the goat alone on one
;; side of the river with the cabbage because the goat will eat the
;; cabbage. The same thing with the wolf and the goat. Find a sequence
;; of actions that the man can execute to get everybody on the other
;; side safely.

;; Finds out if an object is a member of a list. We use the equal
;; operator such that if we test this for complex objects that are
;; alike, the result is true. Nil is not a member of a list unless
;; it's explicitly stored in an element of the list.
(defun is-member (x L)
  (cond ((eq L nil) nil)
	((equal x (car L)) t)
	(t (is-member x (cdr L)))))

;; Defines who can eat whom. It's not used by the problem-solving
;; fucntion.
(defun eats (x y)
  (cond ((and (equal x 'goat) (equal y 'cabbage)) t)
	((and (equal x 'wolf) (equal y 'goat)) t)))

;; Defines if a pair of entities is safe to be left alone on one side
;; of the river. It's not used by the problem-solving fucntion.
(defun safe-pair (x y)
  (cond ((eats x y) nil)
	((eats y x) nil)
	(t t)))

;; Returns the state of the symbol who in the associate list al. It
;; returns its value and not a reference to it so it can be used for
;; testing but not modified. If the symbol who is not part of the list
;; it return nil.
(defun state-of (who al)
  "Returns the state of the symbol who in the associate list al."
  (if (assoc who al) (cdr (assoc who al)) nil))

;; Verifies if the state defined as an associate list is safe. If the
;; goat is on the same side as the man, then we're safe. Otherwise if
;; the cabbage or the wolf is also on the other side, then we're not
;; safe.
(defun safe-state (al)
  "Verifies if the state defined as an associate list is safe."
  (cond ((equal (state-of 'man al) (state-of 'goat al)) t)
	((equal (state-of 'goat al) (state-of 'wolf al)) nil)
	((equal (state-of 'goat al) (state-of 'cabbage al)) nil)
	(t t))) ; anything else is safe

;; Moves the entity from one side to the other in the sate al. It is a
;; list mutator. The positions of all the entities are defined by 0
;; and 1 so the move replaces the current position with 1 - it. It
;; returns the resulting list.
(defun move (who al)
  "Moves the entity from one side to the other in the sate al."
  (if (state-of who al)
      (setcdr (assq who al) (- 1 (state-of who al))))
  al)

;; Tests if the state al has reached the goal. This is the case if all
;; four entities are on the other side.
(defun goal-reach (al)
  "Tests if the state al has reached the goal."
  (if (not al) nil
    (= (+ (state-of 'man al) (state-of 'goat al) 
	  (state-of 'wolf al) (state-of 'cabbage al)) 4)))

(defun check-add-child (child al)
  (if (safe-state child) 
	(append al (list child))
    al))


(defun expand-states (al)
  "Generates all possible states that can be reached from the state al."
  (let ((children nil) (child nil))
    ; the man can also move alone
    (setq child (move 'man (copy-alist al)))
    (setq children (check-add-child child children))
    (dolist (ent entity)
       ; Move one object on the same side as the man
      (if (= (state-of ent al) (state-of 'man al))
	  (progn (setq child (move 'man (move ent (copy-alist al))))
		 (setq children (check-add-child child children)))
	;(print (list "unsafe state" child))
	))
    children))

(defun search-sol (al)
  (let ((next (copy-alist al)) (nl nil))
    (while (and (not (goal-reach next)) next)
      (setq nl (expand-states next))
      (setq next nil)
      (while (and nl (not next))
	(if (not (is-member (car nl) path))
	    (progn 
	      (setq next (car nl))
	      (push next path)))
	(setq nl (cdr nl))))
    next))


;; Initialization of the global variables
(setq initial-state '((man . 0) (goat . 0) (wolf . 0) (cabbage . 0)))
(setq path (list initial-state))
(setq entity '(goat wolf cabbage))

;; To see what all the child states from the current one look like
(expand-states initial-state)

;; Construct the full olution after evaluating the previous statements
(search-sol initial-state)

;; Evaluate the variable path to see the solution backwards.
path


;; Some examples of evaluation
;; (is-member 1 '(2 3 1 4 5))
;; t
;; (is-member 1 '(2 3 4 5))
;; nil
;; (is-member 1 '(1))
;; t
;; (is-member 1 nil)
;; nil
;; (is-member nil '(1 2 3 4))
;; nil
;; (is-member nil '(1 nil 2 3))
;; t