; NAME:           Keith Pomakis
; STUDENT NUMBER: 88115027
;
;                                  CS3750A
;
;                               Assignment #1
;
;                             October 14,  1992
;
; This program implements a Connect-4 game.
;
; The game can be called up in several different ways.  They are:
;
; (two-player)     - Start a two-player game.
;
; (one-player)     - Start a one-player game with the computer as the
;                    opponent.  You will be asked which playing piece
;                    you wish to be and who you would like to go first.
;
; (no-players)     - Pit the computer against itself.  You will be asked
;                    for the skill level (look-ahead) of each computer.
;
; (connect n f l)  - Start a one-player game as outlined in the assignment
;                    description.  n = size of the board (n+1 by n)
;                                  f = who goes first (0 = computer)
;                                  l = skill level (look-ahead) of computer
;
; For the (two-player) and (one-player) games, several parameters can be set.
; They are:
;
; Parameter             Description                              Default
; ---------             -----------                              -------
; *number-to-connect*  The number of pieces that have to be        4
;                      connected in order to constitute a win.
;                      Therefore, a player can play a game of
;                      Connect-3, Connect-5, etc.
;
; *size-x*             The number of columns on the board.         7
;
; *size-y*             The deepness of the board.                  6
;
; *pieces*             What the pieces look like.  (list of    ("X" "O" " ")
;                      player 0, player 1 and empty space)
;
; *look-ahead*         The number of moves the computer will       4
;                      look ahead when determining which move
;                      to make.

; Changable parameters.

(setq *number-to-connect* 4)
(setq *size-x* 7)
(setq *size-y* 6)
(setq *pieces* '("X" "O" " "))
(setq *look-ahead* 4)

; This function sets up some global variables for efficiency.

(defun setup ()
    (setq *board-map* (getmap))
    (setq *board-size* (* *size-x* *size-y*))
    (setq *win-power* (expt 2 *number-to-connect*))
    (setq *seed* (make-random-state t)))

; This function returns a blank playing board of dimensions *size-x* and
; *size-y*.

(defun newboard ()
    (let (brd)
        (dotimes (num1 *size-x* brd)
            (setq brd (cons (let (col)
                (dotimes (num2 *size-y* col)
                    (setq col (cons 2 col)))) brd)))))

; This function prints out a graphical representation of a playing board.

(defun print-board (board)
    (let ((indent "           "))
        (terpri)
        (dotimes (num *size-y*)
            (princ indent)
            (princ "|")
            (dolist (col board)
                (princ "     |"))
            (terpri)
            (princ indent)
            (princ "|")
            (dolist (col board)
                (princ "  ")
                (princ (nth (nth (- (1- *size-y*) num) col) *pieces*))
                (princ "  |"))
            (terpri)
            (princ indent)
            (princ "|")
            (dolist (columns board)
                (princ "_____|"))
            (terpri))
        (princ indent)
        (dotimes (colnum *size-x*)
            (princ "   ")
            (princ (1+ colnum))
            (princ "  "))
        (terpri) (terpri)))

; This function prints out the playing board of state.

(defun print-board-of (state)
    (print-board (board-of state)))
    
; This function returns the number of the opponent of player.

(defun other (player) (- 1 player))

; This function advances state ahead a turn without making a move,
; effectively switching who the next player will be.

(defun next-turn (state)
    (setf (nth 2 state) (other (next-turn-of state))))

; This function drops the playing piece of the current player into column
; colnum of the board of state, and advances state to be the turn of the next
; player if successful. If unsuccessful (i.e column is full or doesn't exist),
; nil is returned.

(defun drop-piece (colnum state)
    (if (> colnum *size-x*)
        nil
        (let ((column (nth (1- colnum) (board-of state))))
            ; Find first free position in column if it exists.
            (let ((freespace (member 2 column)) (player (next-turn-of state)))
                (cond ((not freespace) nil) (t
                    ; Drop piece in position.
                    (setf (car freespace) player)
                    ; Change player's stats to reflect move.
                    (dolist (win-spot (nth (- *size-y* (length freespace))
                                        (nth (1- colnum) *board-map*)))
                        (setf (nth win-spot (stats-of player state))
                            (* (nth win-spot (stats-of player state)) 2))
                        (setf (nth win-spot (stats-of (other player) state)) 0))
                    (setf (nth 3 state) (1+ (pieces-of state)))
                    (next-turn state)
                    t))))))

; This function returns the number of possible win positions on a board of
; dimensions *size-x* and *size-y* with *number-to-connect* being the number
; of pieces required in a row in order to win.
; This is 4xy - 3xn - 3yn + 3x + 3y - 4n + 2n^2 + 2.

(defun number-of-win-places ()
    (+ (* 4 *size-x* *size-y*)
       (- (* 3 *size-x* *number-to-connect*))
       (- (* 3 *size-y* *number-to-connect*))
       (* 3 *size-x*)
       (* 3 *size-y*)
       (- (* 4 *number-to-connect*))
       (* 2 *number-to-connect* *number-to-connect*)
       2))

; This function generates a map of the playing board of dimensions *size-x*
; and *size-y*.  It maps the possible positions on the board where a win
; can occur, and numbers them.

(defun getmap ()
    (let (map)
        
        ; Generate an empty map.
        (dotimes (num1 *size-x*)
            (setq map (cons (let (col)
                (dotimes (num2 *size-y* col)
                    (setq col (cons nil col)))) map)))
        
        ; Fill in the map.
        (let ((count 0))
            
            ; Fill in the horizontal wins.
            (dotimes (num1 (1+ (- *size-y* *number-to-connect*)))
                (dolist (column map)
                    (let ((colpart (nthcdr num1 column)))
                        (dotimes (num2 *number-to-connect*)
                            (setf (nth num2 colpart)
                                (cons count (nth num2 colpart))))
                        (setq count (1+ count)))))
            
            ; Fill in the vertical wins.
            (dotimes (num1 (1+ (- *size-x* *number-to-connect*)))
                (let ((boardpart (nthcdr num1 map)))
                    (dotimes (num2 *size-y*)
                        (dotimes (num3 *number-to-connect*)
                            (setf (nth num2 (nth num3 boardpart))
                                (cons count (nth num2 (nth num3 boardpart)))))
                        (setq count (1+ count)))))

            ; Fill in the forward diagonal wins.
            (dotimes (num1 (1+ (- *size-y* *number-to-connect*)))
                (dotimes (num2 (1+ (- *size-x* *number-to-connect*)))
                    (let ((boardpart (nthcdr num2 map)))
                        (dotimes (num3 *number-to-connect*)
                            (setf (nth (+ num3 num1) (nth num3 boardpart))
                                (cons count 
                                    (nth (+ num3 num1) (nth num3 boardpart)))))
                         (setq count (1+ count)))))

            ; Fill in the backward diagonal wins.
            (dotimes (num1 (1+ (- *size-y* *number-to-connect*)))
                (dotimes (num2 (1+ (- *size-x* *number-to-connect*)))
                    (let ((boardpart (nthcdr num2 map)))
                        (dotimes (num3 *number-to-connect*)
                            (setf (nth (- *size-y* (+ num3 num1) 1)
                                                    (nth num3 boardpart))
                                (cons count 
                                    (nth (- *size-y* (+ num3 num1) 1)
                                                    (nth num3 boardpart)))))
                         (setq count (1+ count)))))
            (if (/= count (number-of-win-places))
                (error "getmap - something has gone wrong")))
        map))

; This function returns fresh statistics for a single player.

(defun newstats ()
    (let (stats)
        (dotimes (num (number-of-win-places) stats)
            (setq stats (cons 1 stats)))))

; Generate a new state consisting of a blank board, fresh player statistics,
; player 0's move first, and 0 moves made so far.

(defun newstate()
    (list (newboard) (list (newstats) (newstats)) 0 0))

; These functions allows easy access to the different aspects of state.

(defun board-of (state) (first state))
(defun stats-of (player state) (nth player (second state)))
(defun next-turn-of (state) (third state))
(defun pieces-of (state) (fourth state))

; This function performs a static evaluation of state, analysing how good
; state is for player.

(defun static-of (player state)
    (- (eval (cons '+ (stats-of player state)))
       (eval (cons '+ (stats-of (other player) state)))))

; This function returns true if player is the winner of state.

(defun is-winner (player state)
    (if (member *win-power* (stats-of player state)) t nil))

; This function returns true if all pieces on state have been played and
; there has been no winner.

(defun is-tie (state)
    (if (= (pieces-of state) *board-size*) t nil))

; Return a deep copy of list.  This copies list to the atomic level, and not
; just the first level.

(defun deep-copy (list)
    (let (newlist)
        (dolist (element list (reverse newlist))
            (setq newlist (cons
                (if (listp element) (deep-copy element) element) newlist)))))

; This function returns the minimum value of list.

(defun min-of-list (list)
    (eval (cons 'min list)))

; This function returns the position of the minimum value in list.  If the
; minimum value occurs more than once, one of the positions is chosen
; randomly.

(defun minpos (list)
    (let ((minimum (eval (cons 'min list))) positions)
        (dotimes (pos (length list))
            (if (= (nth pos list) minimum)
                (setq positions (cons pos positions))))
        (nth (random (length positions) *seed*) positions)))

; This function returns the best next move for the next player of state by
; performing a minimax evaluation of the possible future states.

(defun minimax (state)
    (1+ (minpos (reverse (static-list-of state 0)))))

; This function returns the list of how bad of a position the current player
; can be in after the next move.  If does this by looking ahead *look-ahead*
; levels and comparing static-evaluations.

(defun static-list-of (state depth)
    ; assumes state is not a win and is below look-ahead depth
    (let (static-list tempstate)
        (dotimes (col *size-x*)
            (setq tempstate (deep-copy state))
            (if (drop-piece (1+ col) tempstate)
                (setq static-list (cons (-
                    (look-ahead-of tempstate (1+ depth))) static-list))
                (setq static-list (cons 2000 static-list))))
        ; Insure computer takes the closest win.
        (mapcar #'(lambda (x) (if (<= x -950) (1+ x) x)) static-list)))

; This function returns how bad state is for the current player.
; It does this by looking ahead *look-ahead* levels and comparing static
; evaluations.

(defun look-ahead-of (state depth)
    (if (is-winner (other (next-turn-of state)) state)
        1000
        (if (>= depth *look-ahead*)
            (static-of (other (next-turn-of state)) state)
                (min-of-list (static-list-of state depth)))))

; This function queries a human player for his/her next desired move.  It
; returns the column the player wishes to drop his/her piece into, or 0 if the
; player wishes to quit.

(defun query-player (state)
    (princ "Player ")
    (princ (nth (next-turn-of state) *pieces*))
    (princ " - drop into which column? ")
    (let ((col (read)))
        (case col
            ((0 q Q)
                (princ "Are you sure you want to quit? ")
                (case (read)
                    ((y Y) nil)
                    (t (query-player state))))
            (t
                (if (and (numberp col) (drop-piece col state)) 
                    t
                    (query-player state))))))

; This function causes the computer to make a move.

(defun computer-move (state)
    (princ "Thinking...") (terpri)
    (let ((move (minimax state)))
        (drop-piece move state)
        (princ "I dropped my ")
        (princ (nth (other (next-turn-of state)) *pieces*))
        (princ " into column ")
        (princ move) (terpri)))

; This function sets up a two-player game.

(defun two-player ()
    (setup)
    (two-player-play (newstate)))

; This function generates a two-player game.

(defun two-player-play (state)
    (print-board-of state)
    (if (query-player state)
        (cond
            ((is-winner (other (next-turn-of state)) state)
                (print-board-of state)
                (princ "Player ")
                (princ (nth (next-turn-of state) *pieces*))
                (princ " - you have won!") (terpri)
                t)
            ((is-tie state)
                (print-board-of state)
                (princ "There has been a tie.") (terpri)
                t)
            (t
                (two-player-play state)))))

; This function sets up a one-player game.

(defun one-player()
    (setup)
    (let ((state (newstate)))
        (princ "What piece would you like to be (0 for ")
        (princ (nth 0 *pieces*))
        (princ ", 1 for ")
        (princ (nth 1 *pieces*))
        (princ ")? ")
        (let ((input (read)))
            (if (and (numberp input) (= 1 input))
                (next-turn state)))
        (princ "Who first (0 for you, 1 for computer)? ")
        (let ((input (read)))
            (cond
                ((and (numberp input) (= 1 input))
                    (next-turn state)
                    (print-board-of state)
                    (computer-move state))))
        (one-player-game state)))

; This function generates a one-player game.

(defun one-player-game (state)
    (print-board-of state)
    (if (query-player state)
        (cond
            ((is-winner (other (next-turn-of state)) state)
                (print-board-of state)
                (princ "Congratulations!  You have beaten me!") (terpri)
                t)
            ((is-tie state)
                (print-board-of state)
                (princ "There has been a tie.") (terpri)
                t)
            (t
                (print-board-of state)
                (computer-move state)
                (cond
                    ((is-winner (other (next-turn-of state)) state)
                        (print-board-of state)
                        (princ "Ha!  I win!") (terpri)
                        t)
                    ((is-tie state)
                        (print-board-of state)
                        (princ "There has been a tie.") (terpri)
                        t)
                    (t
                        (one-player-game state)))))))

; This function sets up a no-player game.

(defun no-players ()
    (setup)
    (let (la1 la2 oldla)
        (princ "Enter lookahead level for computer player #1: ")
        (setq la1 (read))
        (unless (numberp la1)
            (setq la1 4))
        (princ "Enter lookahead level for computer player #2: ")
        (setq la2 (read))
        (unless (numberp la2)
            (setq la2 4))
        (setq oldla *look-ahead*)
        (no-player-game (newstate) la1 la2)
        (setq *look-ahead* oldla)))

; This function generates up a no-player game.

(defun no-player-game (state la1 la2)
    (print-board-of state)
    (setq *look-ahead* la1)
    (computer-move state)
    (cond
        ((is-winner (other (next-turn-of state)) state)
            (print-board-of state)
            (princ "Computer player #1 (look-ahead of ")
            (princ la1) (princ ")") (terpri)
            (princ "has beaten computer player #2 (look-ahead of ")
            (princ la2)
            (princ ")!") (terpri)
            t)
        ((is-tie state)
            (print-board-of state)
            (princ "There has been a tie!") (terpri)
            t)
        (t
            (setq *look-ahead* la2)
            (print-board-of state)
            (computer-move state)
            (cond
                ((is-winner (other (next-turn-of state)) state)
                    (print-board-of state)
                    (princ "Computer player #2 (look-ahead of ")
                    (princ la2) (princ ")") (terpri)
                    (princ "has beaten computer player #1 (look-ahead of ")
                    (princ la1)
                    (princ ")!") (terpri)
                    t)
                ((is-tie state)
                    (print-board-of state)
                    (princ "There has been a tie!") (terpri)
                    t)
                (t
                    (no-player-game state la1 la2))))))

; This function implements the connect-4 calling mechanism as outlined in
; the assignment description.

(defun connect (size first-move look-ahead-level)
    (let ((state (newstate)))
        (setq *size-x* (1+ size))
        (setq *size-y* size)
        (setq *look-ahead* look-ahead-level)
        (cond
            ((= first-move 0)
                (print-board-of state)
                (computer-move state)))
        (one-player-game state)))

(setup)