; 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)