;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Alpha Beta M search - written by Shaul Markovitch                   
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Version: 0.4                                                      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Last time modified: 28/12/00
;;;
;;;  This file contains an implementation of the alpha-beta search procedure.
;;;  The implementation is move-oriented.  It assumes that the game definition
;;;  stored in the global variable *game* contains functions for generating 
;;;  moves, testing for legality of moves, applying moves, and undoing moves.
;;;  Ths implementation requires very little memory since only one board is
;;;  stored at any moment.  The file alpha-beta.lisp contains similar implementation,
;;;  but for games defined by an expand function.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defvar *game* nil "Holds the functions defining the currrent game")


(defun opponent (color)(if (eq color :white) :black :white))


(defconstant *infinity* most-positive-fixnum)       ; maximum possible heuristic value
(defconstant *draw-val* 0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; alpha-beta-m
;;;
;;; This is the recursive alpha-beta function which returns the
;;; alpha-beta value of the root.  The user should use
;;; alpha-beta-search as the top level function.
;;; This version is based on moves.  The list of moves is generated,
;;; each legal move is destructively applied, the recursive call is made,
;;; and the move is undone.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun alpha-beta-m (board player-color depth eval-fn type alpha beta
		     &optional last-move)
  (let*
      ((winner (funcall (game-win-predicate *game*)
                        board (if (eq type :max) player-color
				(opponent player-color))
			:last-move last-move)))
   
    (cond ((eq winner player-color) (1- *infinity*))
	  ((eq winner (opponent player-color)) (- (1- *infinity*)))
	  ((eq winner :draw) *draw-val*)
	  ((= depth 0) (funcall eval-fn board player-color))
		  
	  ((eql type :min)
	   (let* ((opponent-color (opponent player-color))
		  (moves (funcall (game-moves-fn *game*)
                                    board opponent-color))
                 (current-min  *infinity*))
	     (cond ((null moves) (funcall eval-fn board player-color))
		   (t
                    (loop for move in moves with v
			when (funcall (game-legal-move-fn *game*)
				      move board opponent-color)
			do
			  (funcall (game-apply-move-fn *game*) move board opponent-color)
			  (setf v (alpha-beta-m board player-color (1- depth) eval-fn :max
                                          alpha beta move))
		    (funcall (game-undo-move-fn *game*) move board opponent-color)
                      (setf beta (min beta v))
                      (setf current-min (min current-min v))
                      (when (>= alpha current-min) (loop-finish))
                      finally (return current-min))))))
           (t   ;;(eql type :max)
	   (let ((moves (funcall (game-moves-fn *game*)
                                    board  player-color))
                 (current-max  (- *infinity*)))
	     (cond ((null moves) (funcall eval-fn board player-color))
		   (t
                    (loop for move in moves with v
			when (funcall (game-legal-move-fn *game*)
				      move board player-color)
			do
			  (funcall (game-apply-move-fn *game*) move board player-color)
			  (setf v (alpha-beta-m board player-color (1- depth) eval-fn :min
                                          alpha beta move))
		    (funcall (game-undo-move-fn *game*) move board player-color)
                      (setf alpha (max alpha v))
                      (setf current-max (max current-max v))
                      (when (<= beta current-max) (loop-finish))
                      finally (return current-max))))))
	  )))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; alpha-beta-m-search
;;;
;;; This is the the top level function.which returns a board chosen by 
;;; alpha-beta
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun alpha-beta-m-search (orig-board color depth  eval-fn)
;;; return a chosen move by alpha-beta search 
;;; for a given board
 
      (let*
	  ((board (funcall (game-copy-board-fn *game*) orig-board))
	   (moves (funcall (game-moves-fn *game*)
			   board  color))
	   (chosen-move (first moves))
	   (alpha (- *infinity*))  ; initialize lower bound 
	   (beta *infinity*))  ; initialize upper bound
	;; loop for all possible moves
	(when (game-init-move-fn *game*)(funcall (game-init-move-fn *game*) orig-board))
	(loop for move in moves with val 
	    when (funcall (game-legal-move-fn *game*)
			  move board color)
	    do 
	      (funcall (game-apply-move-fn *game*) move board color)
	      (setf val (alpha-beta-m board color (1- depth) eval-fn :min
                                          alpha beta move))
	      (funcall (game-undo-move-fn *game*) move board color)		  
	      
         
				;;  update the lower bound sent to alpha-beta
	    (when (< alpha val)
	      (setq alpha val)
	      (setq chosen-move move))
	       )
	(funcall (game-apply-move-fn *game*) chosen-move board color)
	board
        ))

;;; The random evaluation function below should be used for debugging only
(defun random-eval (board color) (random 10))
(defvar *default-eval-fn* #'random-eval "The static evaluation function")
(defvar *default-search-depth* 2 "The default search depth")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; make-alpha-beta-m-player
;;; Returns a fixed-depth alpha-beta player (tailored to the given
;;; depth and evaluation function)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun make-alpha-beta-m-player
  (&key (eval-fn *default-eval-fn*)(depth *default-search-depth*))
  (make-player :search-fn #'(lambda (board color)
                              (alpha-beta-m-search board color depth eval-fn))
	       :name (format nil "AB-~A-~D" eval-fn depth)))