;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This is a minimax file designed specifically for two player isolation.
;; You'll want to rewrite it to work for arbitary n-player games and to 
;; use time instead of depth.
;;
;;
;; To start the game running execute:
;;  (play-game board-width board-height maxdepth)
;;
;; For example:
;;
;;  (play-game 5 5 3)
;;  (play-game 10 10 3)
;;
;; Be careful on board and depth size.  Make it too big and things will
;; die rather quickly. Remember: you can always hit C-c to stop an 
;; out-of-control lisp evaluation.  I recommend 5 x 5 and 6 x 5 boards.
;;
;; Also look at the code for play-stat and play-game-b
;;
;; See eval-01 for a simple evaluation function. Naturally, you
;; can write your own and create your own players.
;;
;; For example, to test another evaluation function against the one
;; provided here, simple execute:
;;
;;  (setq ai_player1 (make-player #'your-eval-you-wrote)))
;;
;; where your-eval-you-wrote is a function you've defun'd.
;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; constants & global variables

(defconstant open_block '-)
(defconstant closed_block '*)
(defconstant player1 'x)
(defconstant player2 'o)
(defconstant d8 '((0 -1) (1 -1) (1 0) (1 1) (0 1) (-1 1) (-1 0) (-1 -1)))

; should we use minimax or alpha-beta?
(unless (boundp 'play-method)
  (defparameter play-method nil))

; in play function, should we pause after each move
(unless (boundp 'pause-per-move)
  (defparameter pause-per-move nil))

; who goes first?
(unless (boundp 'first_player)
  (defparameter first_player player1))

; this will be a func pointer to the move generation code
;  that we want to use
(unless (boundp 'ai_player1)
  (defparameter ai_player1 nil))

(unless (boundp 'ai_player2)
  (defparameter ai_player2 nil))

; whose turn is it?
(defparameter turn first_player)

; global board variable
(unless (boundp 'board)
  (defparameter board nil))

; print out a lot of info?
(unless (boundp 'verbose)
  (defparameter verbose t))

; how many nodes were searched?
(unless (boundp 'nNodes)
  (defparameter nNodes 0))

; list of boards during game
(unless (boundp 'game-boards)
  (defparameter game-boards nil))

; global, temporary workspace board
(unless (boundp 'tboard)
  (defparameter tboard nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; move choosing

;; score = (# my moves)
(defun eval-01 (myPos hisPos board my-turn?)
  (if my-turn? 
      (length (gen-moves myPos board))
    (length (gen-moves hisPos board))))

;; returns a player function that uses the specified evaluation function
(defun make-player (eval-func)
  #'(lambda (player myPos hisPos board max-depth)
      (funcall play-method player myPos hisPos board max-depth eval-func)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; top level function

;; top-level player call in the format specified by the ps
(defun player-dcm (player xpos opos max-depth board)
  (setf turn player)
  (second (minimax player
              (if (equal player player1) xpos opos)
              (if (equal player player1) opos xpos)
              board
              max-depth
              #'eval-02)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; minimax with alpha-beta pruning

;; Someone should write this....

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; minimax

;; top-level function for standard minimax
(defun minimax (player myPos hisPos board max-depth eval-func)
  (setf nNodes -1)
  (let ((ret (minimax2 t #'> player myPos hisPos
                       board 1 max-depth eval-func)))
    (if verbose (format t "Nodes searched: ~A  Score: ~A~%"
                        nNodes (first ret)))
    ret))

;; helper function for minimax
(defun minimax2 (max? mmfunc player myPos hisPos board depth max-depth eval-func)

  ;; we keep track of how many nodes are searched
  (setf nNodes (1+ nNodes))

  ;; generate moves and associated boards
  (let* ((moves (gen-moves myPos board))
         (boards (mapcar #'(lambda (move)
                             (effect-move player myPos move board))
                         moves)))

    ;; if no moves, do static evaluation on current board
    (cond ((null moves)
           (list (funcall eval-func
                          (if max? myPos hisPos)
                          (if max? hisPos myPos)
                          board max?)
                 '(nil nil)))
          
          ;; if we've reached max-depth, static eval child boards
          ((>= depth max-depth)
           (setf nNodes (+ nNodes (length moves)))
           (minimax-leaf (not max?) mmfunc myPos hisPos moves boards 
eval-func))

          ;; recurse on all child boards
          (t (minimax-interior max? mmfunc player myPos hisPos moves boards
                               depth max-depth eval-func)))))

;; process leaf nodes
(defun minimax-leaf (max? mmfunc myPos hisPos moves boards eval-func)

  ;; calculate scores for each board via static evaluation
  (let* ((scores (mapcar #'(lambda (move board)
                             (funcall eval-func
                                      (if max? move hisPos)
                                      (if max? hisPos move)
                                      board max?))
                             moves boards))
         (best_score (first scores))
         (best_move (first moves)))

    ;; choose the best (according to mmfunc (i.e. > or <)) board
    (mapcar #'(lambda (score move)
                (if (funcall mmfunc score best_score)
                    (progn
                      (setf best_score score)
                      (setf best_move move))))
            scores moves)

    ;; return the best move and corresponding score
    (list best_score best_move)))

;; process interior nodes
(defun minimax-interior (max? mmfunc player myPos hisPos moves boards
                              depth max-depth eval-func)

  (let ((score)(best_score)(best_move)
        (n (length moves)))

    ;; for each board...
    (do* ((i 0 (1+ i))
          (move (first moves) (nth i moves))
          (board (first boards) (nth i boards)))
         ((>= i n))

      ;; calculate the score via a recursive call to minimax2
      (setf score (minimax2 (not max?)
                            (if max? #'< #'>)
                            (other-player player)
                            hisPos
                            move
                            board
                            (1+ depth)
                            max-depth
                            eval-func))

      ;; if this is the best score so far, save the relevant info
      (if (or (null best_score)
              (funcall mmfunc (first score) best_score))
          (progn
            (setf best_move move)
            (setf best_score (first score)))))
     
    ;; return the best move and corresponding score
    (list best_score best_move)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; game logic

;; play n games and keep winner statistics
(defun play-stat (w h max-depth n)
  (setf verbose nil)
  (let ((winner)(nx 0)(ny 0))
    (dotimes (i n)
      (setf winner (play-game w h max-depth))
      (if (equal winner player1) (setf nx (1+ nx))
        (setf ny (1+ ny))))
    (format t "~A: ~A   ~A: ~A  (~A)~%" player1 nx player2 ny n)))      

;; play a game with the given board
(defun play-game-b (board max-depth)
  (setf turn first_player)
  (play board max-depth))

;; play a game with an empty board and random starting points
(defun play-game (w h max-depth)
  (setf turn first_player)
  (play (init-game w h) max-depth))

;; play a game with the given board
(defun play (board max-depth)
  (if verbose
      (progn
        (format t "Starting position:~%")
        (print-board board)
        (setf game-boards nil)))
  (do ((n 2 (1+ n)))
      (nil)
    (if verbose (format t "Round ~A: Player ~A to move...~%"
                        (floor (/ n 2)) turn))
    (setf board (do-turn turn board max-depth))
    (if verbose (progn
                  (print-board board)
                  (setf game-boards (nconc game-boards (list board)))))
    (if (win? turn board)
        (progn (format t "Player ~A wins!~%" turn)
          (return-from play turn)))
    (change-turn)
    (if (and pause-per-move verbose)
        (progn (format t "Press any key to continue...")
          (if (string= (read-line) "q") (return-from play nil))))))

;; make a single move with the given board
(defun play1b (b max-depth)
  (setf board b)
  (play1 max-depth))

;; make a single move using the global board
(defun play1 (max-depth)
  (format t "Player ~A to move...~%" turn)
  (print-board board)
  (setf board (do-turn turn board max-depth))
  (print-board board)
  (if (win? turn board)
      (progn (format t "Player ~A wins!~%" turn) t)
    (progn (change-turn) nil)))

;; interface to allow a human to make a move on the global board
(defun make-move (move)
  (format t "Human move for ~A...~%" turn)
  (let ((pos (get-player-pos turn board)))
    (if (not (legal? pos move board))
        (progn
          (format t "Illegal move!~%")
          (return-from make-move nil)))
    (setf board (effect-move turn pos move board))
    (print-board board)  
    (if (win? turn board)
        (progn (format t "Player ~A wins!~%" turn) t)
      (progn (change-turn) nil))))
    
;; create an empty board with random starting positions
(defun init-game (w h)
  (setf turn first_player)
  (setf board (init-positions (make-board w h))))

;; if turn == x, turn = o else turn = x
(defun change-turn ()
  (setf turn (other-player turn)))

;; given an empty board, place O and X in random spots
(defun init-positions (board)
  (let ((nopen (count-open-spaces board)))
    (if (< nopen 2) nil
      (init-position player1 (random (1- nopen))
                     (init-position player2 (random nopen) board)))))

;; place the given player in the nth open square
(defun init-position (player n board)
  (if (null board) nil
    (let ((nopen_row (count-open-spaces-row (first board))))
      (if (< n nopen_row) (cons (set-nth-open-pos player n (first board))
                                (rest board))
        (cons (first board) (init-position player (- n nopen_row) (rest board)))))))

;; let the computer make a move
(defun do-turn (player board max-depth)
  (let* ((myPos (get-player-pos player board))
         (hisPos (get-player-pos (other-player player) board)) 
         (temp (funcall (get-ai-player player)
                        player myPos hisPos board max-depth))
         (move (second temp)))

    (if (legal? myPos move board)
        (effect-move player myPos move board)
      (progn (format t "Illegal move: ~A~%" move) board))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; changing board state

;; given a player and his move, update the board
(defun effect-move (player oldpos move board)
  (set-board-pos player move
                 (set-board-pos closed_block oldpos board)))

;; set the square at the given position (move) to symbol
(defun set-board-pos (symbol move board)
  (let ((x (get-x move))
        (y (get-y move)))
    (cond ((null board) nil)
          ((<= y 1) (cons (set-row-pos symbol x (first board)) (rest board)))
          (t (cons (first board)
                   (set-board-pos symbol (addm move '(-1 0)) (rest board)))))))

;; set the xth position of the row to symbol
(defun set-row-pos (symbol x row)
  (cond ((null row) nil)
        ((<= x 1) (cons symbol (rest row)))
        (t (cons (first row) (set-row-pos symbol (1- x) (rest row))))))

;; set the nth open position in row to symbol
(defun set-nth-open-pos (symbol n row)
  (cond ((null row) nil)
        ((equal (first row) open_block)
         (if (<= n 0) (cons symbol (rest row))
           (cons open_block (set-nth-open-pos symbol (1- n) (rest row)))))
        (t (cons (first row) (set-nth-open-pos symbol n (rest row))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; move generation

;; add to moves together
(defun addm (x y)
  (list (+ (first x) (first y))
        (+ (second x) (second y))))

;; generate moves all legal moves from the given position on the given board
(defun gen-moves (start board)
  (gen-moves2 start board d8 nil))

;; try to move in every direction
(defun gen-moves2 (start board dirs moves)
  (if (null dirs) moves
    (gen-moves2 start board (rest dirs)
                (gen-moves3 (addm start (first dirs))
                            board (first dirs) moves))))

;; see how far we can go in the given direction
(defun gen-moves3 (start board dir moves)
  (if (open? start board)
      (gen-moves3 (addm start dir) board dir (cons start moves))
    moves))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; predicates

;; has the given player won?
(defun win? (player board)
  (null (gen-moves (get-player-pos (other-player player) board)  board)))

;; is the given position on the board?
(defun on-board? (move board)
  (let ((w (board-width board))
        (h (board-height board))
        (x (get-x move))
        (y (get-y move)))
    (and (> x 0) (> y 0) (<= x w) (<= y h))))    

;; is the given position open?
(defun open? (move board)
  (equal (get-square move board) open_block))

;; is it posible to move from position a to b on the given board?
(defun path-free? (a b board)
  (let* ((ax (get-x a))
         (ay (get-y a))
         (bx (get-x b))
         (by (get-y b))
         (dx (- bx ax))
         (dy (- by ay)))
    (if (not (or (equal (abs dx) (abs dy))
                 (equal dx 0)
                 (equal dy 0))) (return-from path-free? nil))
    (setf dx (cond ((> dx 0) 1)((< dx 0) -1)(t 0)))
    (setf dy (cond ((> dy 0) 1)((< dy 0) -1)(t 0)))
    (do ((x (+ ax dx) (+ x dx))
         (y (+ ay dy) (+ y dy)))
        ((and (equal x bx) (equal y by)) t)
      (if (not (equal (get-square (build-move x y) board) open_block))
          (return-from path-free? nil)))))

;; is the given move legal?
(defun legal? (start move board)
  ;(format t "start: ~A  move: ~A~%" start move)
  (and (on-board? move board) (open? move board)
       (path-free? start move board)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; info extraction

;; create a copy of a board
(defun copy-board (board)
  (mapcar #'copy-row board))

;; create a copy of a row
(defun copy-row (row)
  (mapcar #'(lambda (x) x) row))

;; do a flood fill of open squares starting at the given position
;;  return the number of squares in the 'blob'
(defun count-adj-squares (pos board)
  (setf tboard (copy-board board))
  (let ((n 0))
    (dolist (dir '((1 0) (1 1) (0 1) (-1 1) (-1 0) (-1 -1) (0 -1) (1 -1)) n)
      (setf n (count-adj-squares2 (addm pos dir) n)))
    n))

;; helper function ofr flood filll
(defun count-adj-squares2 (pos n)
  (cond ((>= n 16) n)
        ((not (equal (get-square pos tboard) open_block)) n)
        (t 
         (setf (nth (- (get-x pos) 1) (nth (- (get-y pos) 1) tboard))
               closed_block)
         (setf n (1+ n))
         (dolist (dir '((1 0) (1 1) (0 1) (-1 1) (-1 0) (-1 -1) (0 -1) (1 -1)) n)
             (setf n (count-adj-squares2 (addm pos dir) n))))))

;; give a player, return the function used to make moves
(defun get-ai-player (player)
  (if (equal player player1) ai_player1 ai_player2))

;; count total number of open squares on a board
(defun count-open-spaces (board)
  (apply #'+ (mapcar #'count-open-spaces-row board)))

;; count total number of open squares on a row
(defun count-open-spaces-row (row)
  (let ((n 0))
    (dolist (p row n)
      (if (equal p open_block) (setf n (1+ n))))))

;; given a player find his position on a board
(defun get-player-pos (player board)
  (get-player-pos2 player board 1))

;; helper function to find a player's position
(defun get-player-pos2 (player board y)
  (cond ((null board) nil)
        ((member player (first board))
         (build-move (get-player-pos-row player (first board) 1) y))
        (t (get-player-pos2 player (rest board) (1+ y)))))

;; find a player on a row
(defun get-player-pos-row (player row x)
  (cond ((null row) nil)
        ((equal player (first row)) x)
        (t (get-player-pos-row player (rest row) (1+ x)))))

;; return the symbol at the given position on the board
(defun get-square (move board)
  (let ((x (1- (get-x move)))
        (y (1- (get-y move))))
    (nth x (nth y board))))

;; return the x coordinate (column) of a position
(defun get-x (move)
  (second move))

;; return the y coordinate (row) of a position
(defun get-y (move)
  (first move))

;; return the width of a board
(defun board-width (board)
  (length (first board)))

;; return the height of a board
(defun board-height (board)
  (length board))

;; if (player == X) return O else return X
(defun other-player (player)
  (if (equal player player1) player2 player1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; debug stuff

;; pretty print a board
(defun print-board (board)
  (mapcar #'print-row board)
  (format t "~%"))

;; pretty print a row
(defun print-row (row)
  (format t "~A~%" row))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; structure creation

;; build a position from an x and y coordnate
(defun build-move (x y)
  (list y x))

;; make a board with the given size representing the playable area
(defun make-board (width height)
  (cons (make-row closed_block (+ width 2))
        (append
         (make-interior-rows (+ width 2) height)
        (list (make-row closed_block (+ width 2))))))

;; helper function to make a board
(defun make-interior-rows (width n)
  (cond ((<= n 0) nil)
        (t (cons (make-row open_block width)
                 (make-interior-rows width (1- n))))))

;; create a row filled with the given block symbol
(defun make-row (block width)
  (cons closed_block (append (nlist block (- width 2)) (list closed_block))))

;; create a list of length n filled with symbol a
(defun nlist (a n)
  (cond ((<= n 0) nil)
        (t (cons a (nlist a (1- n))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; misc that depends on earlier stuff

;; build a default board
(when (null board) (init-game 4 3))

;; which ai players should we use
(when (null ai_player1) (setq ai_player1 (make-player #'eval-01)))
(when (null ai_player2) (setq ai_player2 (make-player #'eval-01)))

;; should we use pure minimax or alpha-beta pruning
(when (null play-method) (setq play-method #'minimax))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; a nice sample board
(defparameter map1 
  '((* * * * * * * *)
    (* - - - - - - *)
    (* - - - - - - *)
    (* - - X O - - *)
    (* - - - - - - *)
    (* - - - - - - *)
    (* * * * * * * *)))