;;We shall start with a skeleton of the A* search algorithm:

(defun A* (nodes goalp children-fn fvalue-fn)
  (cond ((null nodes) nil)
	;; Return the first node if it is a goal node.
	((funcall goalp (first nodes)) (first nodes))
	;; Append the children to the set of old nodes
	(t (A* (sort (append (funcall children-fn 
		                (first nodes))
			     (rest nodes)) 
		     #'<		
		     :key fvalue-fn 
		     )
		 goalp
		 children-fn
		 fvalue-fn))))


;(The sort function we are using is a built-in function for
;commonlisp. It takes three arguments: List to be sorted, the
;comparision predicate with which sorting is done (in our case <) , and
;an optional argument :key, which takes a function and applies it to
;the elements of the list, to get the field over which items of the
;list are compared (in our case, the f-value))
;
;To make our life simple, we shall assume that search nodes are defined
;as structures with at least the following slots:

(defstruct node
  STATE   ;;the state of the problem corresponding to this node
  PARENT  ;;the node which is this nodes' parent
  ACTION  ;;the action which was taken at the nodes parent to get here
  G-VAL   ;;The g-value of the node
  H-VAL   ;;THe h-value of the node
  F-VAL   ;;THE f-value of the node
)

;;generating children
(defun puzzle-children (state)
 (append (left-child state)
	 (right-child state)
         (up-child state)
         (down-child state))


;We start with a small auxiliary function which tells us where the
;blank is in the current state.

(defun where-is-blank (state)
  (loop for x from 0 to 2
    do (loop  for y from 0 to 2
               when (zerop (aref state x y))
               do (return-from where-is-blank (list x y)))))

;We also need an auxiliary function that makes a new copy of the puzzle
;state (so we can modify it appropriately to generate the child state):

(defun copy-puzzle-state (state)
  (let ((new-array (make-array '(3 3))))
	(loop for x from 0 to 2
              do (loop for y from 0 to 2
                    do (setf (aref new-array x y)
		             (aref state x y))))
	;;return new-array
         new-array))

;Now we can write the code for generating the left-child:

(defun left-child (state)
  (let* ((blank-pos (where-is-blank state))
         (left-pos (list (first blank-pos)
		         (- (second blank-pos) 1)))
         ;;left position has the same row coordnate, but a different column
         ;;coordinate..
 	)
	(if (>=  (second left-pos) 0)
	  ;;going left doesn't make us go out of the board
         (let ((left-state (copy-puzzle-state state)))
	      ;;shift the left tile into the blank-pos
             (setf (aref left-state (first blank-pos) 
				   (second blank-pos))
		    (aref left-state (first left-pos) 
				    (second left-pos)))
               ;;shift the blank into the left-tile position
             (setf (aref left-state (first left-pos) 
				    (second left-pos))
			0)
             ;;return the action and state
            (list (list 'go-left left-state))))))

;In the function above, let* is important as it does the initialization
;sequentially. "let" will do the initialization concurrently.
;
;Here is how it works:
;
;    USER(107): j
;        #2A((1 2 3) (4 5 6) (7 8 0))
;    USER(108): (left-child j)
;        ((GO-LEFT #2A((1 2 3) (4 5 6) (7 0 8))))
;    USER(109):             

;Code for generating random-puzzle-state

;The code is given below. You can, for example, experiment with a
;series of random problems of increasing solution length using your
;manhattan and misplaced heuristics and see how the performance
;degrades.
;
;Here is the code. It expects that you have puzzle-children function
;that returns children of a state in the form of list whose elements
;are of the form (<action> <state>)

;;---------code start
(defun random-puzzle-state (distance &optional state &aux path cstate)
;;geneate a state that is distance away from the given state
;;if no goalstate is given we set it to the normal goal state config
  (unless state 
    (setq state  (make-array '(3 3) :initial-contents '((1 2 3) (4 5 6) (7 8 0)))))
  (setq cstate state)
  (push cstate path)
  (loop for move from 1 to distance
      do 
	(let ((children (mapcar #'second (puzzle-children cstate))))
	  ;;find a random child that is not on the path
	  ;; (otherwise you get loopy paths)
	  (loop for child in (random-permute children)
	      thereis (if (not (member child path :test #'puzzle-equal))
			  (progn (setq cstate child)
				 (push cstate path))))))
  (if (null cstate)
      (random-puzzle-state state distance)
    cstate))


(defun puzzle-equal (state1 state2)
  (loop for x from 0 to 2
      always (loop for y from 0 to 2
		 always (equal (aref state1 x y) (aref state2 x y)))))

(defun random-PERMUTE (list)
  ;;takes a list and permutes the list randomly
  (let ((l (copy-list list))
	(ret nil))
    (do ()
	((null l) ret)
      (let ((i (random (length l))))
	;;picks a random element of the list, deletes it
	;;and pushes it into the newlist
	(push (nth i l) ret)
	(setf l (delete (nth i l) l))))))


;;;;;;;;;;;;;;;USAGE
;USER(55): (random-puzzle-state 1)
;#2A((1 2 3) (4 5 0) (7 8 6))
;USER(56): (random-puzzle-state  1)
;2A((1 2 3) (4 5 6) (7 0 8))
;;notice how it generated two different states when it was called with
;;the same arguments two times. There is a random part to the code!
;USER(50): (random-puzzle-state  5)
;#2A((2 0 3) (1 5 6) (4 7 8))
;USER(51): (random-puzzle-state  10)
;#2A((1 6 2) (4 0 5) (7 8 3))
;USER(52): (random-puzzle-state  24)
;#2A((0 1 2) (6 5 3) (8 7 4))