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

;;;; Game-Playing

;;; Definitions generic to all of n-player turn-taking game-playing.  The
;;; idea is that each particular game we want to deal with will define a
;;; function to create a GAME structure, and we can then use
;;; game->environment to turn that into an environment, which we can then
;;; run.  The function PLAY-GAME provides a simple interface to do this.
;;; Throughout, a player is an atomic name: X or O, or BLACK or WHITE.
;;; Corresponding to player X there is an agent with name X and with an agent
;;; program that chooses a move for X, given a game-state as the percept.

;;;; Structure Definitions

(defstruct (game (:print-function print-game))
  "A game is defined in terms of the starting position (the initial-state),
  the legal moves that can be made in a state, the effects of each move on the
  state, and a test for when the game is over."
  initial-state				; a state in the domain
  legal-move-fn				; fn: state -> list of moves
  make-move-fn				; fn: state x move -> state
  terminal-test				; fn: state -> utilities or nil
  (best +1)				; Best score (for winning the game)
  (worst -1)				; Worst score (for losing the game)
  (domain "A game")			; a string, naming the problem domain 
  )

(defstruct (game-state (:print-function print-game-state))
  "Everything you need to know about the state of the game."
  ;; After X makes a move, the new state will have (O X) in the PLAYERS slot.
  board               ; the current state of the game
  (players '(X O))    ; list of the players, current player to move first
  (previous-move nil) ; The move just made to get to this position
  )

;;;; Top Level Function

(defun play-game (game &key (display 'unchanged) (max-steps 1000)
		       (agent-types (mapcar (constantly 'random-game-agent)
					    (game-players game))))
  "Play an N-person game."
  (let ((agents (mapcar #'(lambda (agent-type player)
			    (funcall agent-type player game))
			agent-types (game-players game))))
    (run-eval-environment (game->environment game :agents agents)
			  :display display :max-steps max-steps)))

;;;; Agent Types

(defun generic-game-agent (name game &optional (algorithm #'minimax-decision))
  "Define a game-playing agent"
  ;; Define an agent that plays a specific game using a specific algorithm.
  ;; Since the game state provides all necessary information, this can be
  ;; written as a simple reflex agent. A more sophisticated agent might keep
  ;; some internal state for the search tree between moves, or might update
  ;; an internal model of the situation in a game of partial information.
  (make-agent :name name
	      :program #'(lambda (state)
			   (when (equal (current-player state) name)
			     (funcall algorithm state game)))))

(defun random-game-agent (name game)
  "Define an agent that chooses a move at random."
  (generic-game-agent
   name game
   #'(lambda (state game)
       (random-element (or (funcall (game-legal-move-fn game) state)
			   '(nothing))))))

(defun human-game-agent (name game)
  "Define an agent that asks the human what move to make,
  making sure it is a legal move."
  (generic-game-agent
   name game
   #'(lambda (state game)
       (let ((legal-moves (funcall (game-legal-move-fn game) state))
	     move)
	 (loop (format t "~&~A's move? " name)
	       (setq move (read))
	       (when (member move legal-moves :test #'equal)
		 (RETURN move))
	       (format t "~&~A is illegal for ~A.  Choose one of:~%  ~A.~%"
		       move name legal-moves))))))

;;;; Auxiliary Functions

(defun game->environment (game &key agents)
  "Turn a game into an environment."
  (make-environment 
   :percept-fn #'(lambda (agent env) (declare (ignore agent))
		   (environment-state env))
   :update-fn
   #'(lambda (env)
       (let ((action (agent-action (current-agent env)))
	     (state (environment-state env)))
	 ;; Only allow legal moves
	 (when (legal-move? action state game)
	   (setf (environment-state env)
		 (funcall (game-make-move-fn game) state action)))))
   :performance-fn #'zero
   :termination-fn #'(lambda (env) (game-done? game env))
   :display-initial-fn #'game-display-update-fn
   :display-update-fn #'game-display-update-fn
   :state (game-initial-state game)
   :agents agents
   :name (game-domain game)))

(defun game-done? (game env)
  "If the game is done, put all the agents back and give them their scores."
  ;; The terminal test either returns nil, meaning the game is still on,
  ;; or a list of scores (utilities) for each player in the final state
  (let ((done (funcall (game-terminal-test game) (environment-state env))))
    (when done
      ;; Assign all the agents their final utilities
      (mapcar #'(lambda (player score)
		  (setf (agent-score (agent-with-name player env)) score))
	      (game-state-players (environment-state env))
	      done)
      done)))

(defun legal-move? (move state game)
  (member move (funcall (game-legal-move-fn game) state) :test #'equal))

(defun zero-evals (state)
  "Return 0 as the utility for every player."
  (mapcar (constantly 0) (game-state-players state)))

(defun current-player (game-state)
  (first (game-state-players game-state)))

(defun previous-player (game-state)
  (last1 (game-state-players game-state)))

(defun current-agent (env)
  (agent-with-name (current-player (environment-state env)) env))

(defun game-players (game)
  (game-state-players (game-initial-state game)))

(defun agent-with-name (name env)
  (find name (environment-agents env) :key #'agent-name :test #'equalp))

(defun print-game (game stream depth)
  (declare (ignore depth))
  (print-unreadable-object (game stream)
    (format stream "~A state: ~A"
	    (game-domain game) (game-initial-state game))))

(defun print-game-state (state stream &optional depth) 
  (declare (ignore depth))
  (when (game-state-previous-move state)
    (format stream "~&~A moved to ~A.~%" (previous-player state)
	    (game-state-previous-move state)))
  (print-grid (game-state-board state) :stream stream)
  (format stream "~&~A to move:" (current-player state)))

(defun game-display-update-fn (stream env)
  (print-game-state (environment-state env) stream))

(defun game-successors (state game)
  "Return a list (move . state) pairs that can be reached from this state."
  (mapcar #'(lambda (move)
	      (cons move (funcall (game-make-move-fn game) state move)))
	  (funcall (game-legal-move-fn game) state)))