;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Alpha Beta search - written by Shaul Markovitch                       ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Version: 7.02                                                      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Last time modified: 19/11/99
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;


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


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


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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; alpha-beta
;;;
;;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun alpha-beta (board player-color depth eval-fn type alpha beta)
  (let*
      ((winner (funcall (game-win-predicate *game*)
                        board (if (eq type :max) player-color
				  (opponent player-color)))))
   
    (cond ((eq winner player-color) *infinity*)
	  ((eq winner (opponent player-color)) (- *infinity*))
	  ((eq winner :draw) *draw-val*)
	  ((= depth 0) (funcall eval-fn board player-color))
	   ; else call expand-board with the current board.
		  
	  ((eql type :min)
	   (let ((children (funcall (game-expand-fn *game*)
                                    board (opponent player-color)))
                 (current-min  *infinity*))
	     (cond ((null children) (funcall eval-fn board player-color))
		   (t
                    (loop for c in children
                      for v = (alpha-beta c player-color
                                          (1- depth) eval-fn :max
                                          alpha beta)
                      do
                      (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 ((children (funcall (game-expand-fn *game*) board  player-color))
                 (current-max  (- *infinity*)))
	     (cond ((null children) (funcall eval-fn board player-color))
		   (t
                    (loop for c in children
                      for v = (alpha-beta c player-color
                                          (1- depth) eval-fn :min
                                          alpha beta)
                      do
                      (setf alpha (max alpha v))
                      (setf current-max (max current-max v))
                      (when (<= beta current-max) (loop-finish))
                      finally (return current-max)))))))))


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

(defvar *default-eval-fn* nil "The static evaluation function")
(defvar *default-search-depth* 2 "The default search depth")

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

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