;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- File: search/domains/ttt.lisp

;;;; The Game of Tic-Tac-Toe

;;; Generalized Tic-Tac-Toe, in which any number of players take turns
;;; placing marks on an MxN board, trying to get K marks in a row.  There
;;; are much more efficient representations than what we have chosen here,
;;; but this suffices to run an environment quickly.  If an agent wants to
;;; search a large number of possible game states, then the agent should use
;;; its own efficient representation.  After all, an agent's internal
;;; representation is independent of what's "actually" out there in the
;;; environment.

;;;; Top Level Game-Creating Function

(defun ttt-game (&key (m 3) (n m) (k m) (players '(X O)))
  "Define an MxN tic-tac-toe game in which the object is to get K in a row."
  (make-game
   :initial-state (make-game-state
		   :board (make-array (list m n) :initial-element '-)
		   :players players)
   :legal-move-fn #'ttt-legal-moves
   :make-move-fn  #'ttt-make-move 
   :terminal-test #'(lambda (state) (ttt-terminal-test state m n k))
   :domain        "Tic-Tac-Toe"))

;;;; Legal Move, Make Move, and Termination Functions

(defun ttt-legal-moves (state)
  "Generate all possible (move . new-state) pairs."
  (let ((board (game-state-board state)))
    ;; Iterate over all squares; make moves in empty ones.
    (with-collection ()
     (dotimes (x (array-dimension board 0))
       (dotimes (y (array-dimension board 1))
	 (when (eq (aref board x y) '-)
	   (collect (@ x y))))))))

(defun ttt-make-move (state move)
  "Return the new state that results from making this move."
  (make-game-state
   :board (let ((new-board (copy-array (game-state-board state))))
	    (setf (aref new-board (xy-x move) (xy-y move))
		  (current-player state))
	    new-board)
   :players (left-rotate (game-state-players state))
   :previous-move move))

(defun ttt-terminal-test (state m n k)
  "Checks if the last player to move made a complete row,
   column, or diagonal of length k, or if the board is full.
   If so, return utilities, else nil."
  (let* ((board (game-state-board state))
	 (players (game-state-players state))
	 (x (xy-x (game-state-previous-move state)))
	 (y (xy-y (game-state-previous-move state)))
	 (previous (previous-player state)))
    (cond ((or (check-k-in-a-row board x y m n k +1  0 previous)
	       (check-k-in-a-row board x y m n k  0 +1 previous)
	       (check-k-in-a-row board x y m n k -1 +1 previous)
	       (check-k-in-a-row board x y m n k +1 +1 previous)) ; WIN!
	   (with-collection ()
	     (for each player in players do
		  (collect (if (eq player previous) +1 -1)))))
	   ((not (find '- (array->vector board)))                 ; DRAW!
	    (zero-evals state))
	   (t nil))))
	     
(defun check-k-in-a-row (board x y m n k dx dy player)
  "Does player have k in a row, through (x y) in direction (+/-dx +/-dy)?"
  (= (+ k 1) (+ (count-pieces-in-direction board x y m n (- dx) (- dy) player)
		(count-pieces-in-direction board x y m n dx dy player))))

(defun count-pieces-in-direction (board x y m n dx dy player)
  "Count player's pieces starting at (x y) going in direction (dx dy)."
  (if (and (< -1 x m) (< -1 y n) (eq (aref board x y) player))
      (+ 1 (count-pieces-in-direction board (+ x dx) (+ y dy)
				      m n dx dy player))
    0))

;;;; Evaluation Function

(defun ttt-eval (state)
  "Evaluate a TTT board on a scale from -1 to +1."
  ;; This is a rather poor evaluation function.
  ;; Note that it doesn't even pay attention to K.
  ;; We just count the number of blank squares next to each player.
  ;; The more of these, the better.
  (let* ((board (game-state-board state))
	 (values (zero-evals state))
	 (players (game-state-players state))
	 (max-x (array-dimension board 0))
	 (max-y (array-dimension board 1)))
    (dotimes (x max-x)
      (dotimes (y max-y)
	(when (eq (aref board x y) '-)
	  (for each delta in '((1 0) (0 1) (-1 0) (0 -1)) do
	       (let* ((neighbor (xy-add delta (@ x y)))
		      (piece (when (inside neighbor max-x max-y)
			       (aref board (xy-x neighbor) (xy-y neighbor)))))
		 (unless (member piece '(- nil))
		   ;; You get points for having your piece neighboring an empty
		   (incf (elt values (position piece players)) 0.001)))))))
    values))

(defun alpha-beta-ttt-agent (name game)
  "Create a game-playing agent that uses ttt-eval to do alpha-beta search."
  (generic-game-agent
   name game
   #'(lambda (state game)
       (alpha-beta-decision state game #'ttt-eval))))