;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; connect4.scm
;
; Copyright (c) 2000, 2001 Wesley H. Huang.  All rights reserved.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This file contains the basic code for the connect 4 game.  The state
; representation, accessors, some simple player procedures, and some
; feature detectors are in this file.  Everything you need to know to
; understand the state and write your own feature detectors for your
; evaluation function is in this file.
;
; The a4code.com file contains procedures for printing boards, running
; a game, etc.  Some procedures in this file call procedures from
; a4code.com.
;
; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; How to get started:
;
; First try playing the game!  You can play against the computer
; (well, against a dumb random strategy) by calling:
;
;   (play-c4 random-player human-player)
;
; The first player plays X (and X always goes first).  The second
; player plays O.
;
; There are also a number of Java applets available on the web for you
; to play against.
; 
; What next?
;
; - Read the bit about representation below so you understand how the
;   state of the game is stored and what functions are available to
;   you to get information about the game.
;
; - Look at the random-player and human-player functions.  They're
;   pretty simple.
;
; - Implement your ab-minimax function.  You can use the sample
;   create-ab-minimax-player I'll put on the Assignment 4 information
;   page, or you can write your own if you want to use some other node
;   representation. 
;
; - Write your evaluation function c4-eval.  
;
; - Try playing against your ab-minimax player!
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; The Connect 4 board representation:
; 
; You don't need to understand the implementation in full detail, but
; I've described it here for your information in case you want to
; implement some efficient feature detectors.  There are some
; accessors defined below that you can use without understanding the
; details of the representation.
; 
; I've chosen to represent the board in a string for speed,
; compactness, and ease of printing the board, but also to make it
; easy to search for patterns with regular expressions.  To simplify
; certain calculations, I'm also keeping track of the number of pieces
; that have been played in each column.  The actual representation is:
;
; board =  (board-string pieces-list)
;   
; The board-string stores the actual state of the board.  The
; pieces-list is a list of seven integers corresponding to colums 1
; through 7 (column 1 is on the left).
;
; You shouldn't actually have to mess around with the string
; representation unless you want to write some fast pattern
; recognition procedures of your own.  I've provided a few useful
; functions to help analyze the board:
;
;  - (c4-end? board) tells you who won if the game is over and returns
;    #f otherwise
;    
;  - (open-rows board player)
;  - (open-columns board player)
;  - (open-diagonals board player)
;
; These functions look for straight sequences of pieces.  See the
; comments before the code at the end of this file.
;
; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(display "\nConnect 4 support code Version 1.2
CSCI 4150 Introduction to Artificial Intelligence, Fall 2001
Copyright (c) 2000, 2001 by Wesley H. Huang.  All rights reserved.\n")
(load-option 'regular-expression)

;
; Accessors for the board state
;
(define (board-string board)
  (car board))
(define (pieces-list board)
  (cadr board))

;
; Accessor for the board
;
; (piece-at board row col)
; 
; given a row and column number (1 indexed) return either 'X 'O or 'empty
;
(define (piece-at board row col)
  (if (and (<= 1 row 6)
	   (<= 1 col 7))
      (case (board-character (board-string board) row col)
	((#\X) 'X)
	((#\O) 'O)
	((#\space) 'empty)
	(else
	 (error "There's something other than an X, O, or space in the board!"
		(list 'piece-at board row col))))
      (error "Invalid row/column!"
	     (list 'piece-at board row col))))

;
; returns the character stored at the specified board location
;
(define (board-character board-string row col)
  (string-ref board-string (string-piece-position row col)))

;
; This function simply calculates the string position given the row
; and the column.  Many functions need this, so it is "centralized" here.  
;
; The board-string contains the top row (row 6), then row 5, and so on
; down to row 1.  Rows are separated by a "|", so there are 47
; characters in this string.  Columns are numbered from 1 to 7 (going
; from left to right).
;
(define (string-piece-position row col)
  (+ (* (- 6 row) 8)
     col
     -1))

;
; the starting board state (a completely empty board)
;
; the dividers between rows are very important because I'm using
; regular expressions to find patterns in the board!
;
(define c4-start (list "       |       |       |       |       |       "
		       '(0 0 0 0 0 0 0)))

;
; For a given board, return a list of all the child boards, i.e. a
; list of all the boards that can result from a valid move.  "player"
; must be either 'X or 'O.
;
; the "play-piece" procedure is defined in a4code.com
; 
(define (c4-children board player)
  (map (lambda (move) 
	 (play-piece board player move))
       (valid-moves board)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;	
;
; The human-player function
;
; This function asks you what move you want to make; it won't let you
; give it an invalid move.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (human-player board player)
  (define (getmove)
    (print-stuff "Which column do you want to play in? (1-7 inclusive)\n"
	 "Enter your move and press return (or C-x C-e in Emacs/Edwin\n")
    (let ((move (read)))
      (cond
       ((not (and (integer? move)
		  (>= 7 move 1)))
	(print-stuff
	 "\nILLEGAL MOVE!  You must give an integer between\n"
	 "1 and 7 inclusive.  Try again...\n\n")
	(getmove))
       ((>= (list-ref (cadr board) (-1+ move)) 6)
	(print-stuff
	 "That move is illegal.  Column " move " is full!\n"
	 "Try again...\n\n")
	(getmove))
       (else move))))
	
  (print-stuff "\nYou are playing " (player-str player) "\n\n")
  (getmove))
	    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; The random-player function
;
; This function simply picks at random one of the valid moves!
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (random-player board player)
  (let ((possible-moves (valid-moves board)))
    (list-ref possible-moves (random (length possible-moves)))))


(define (valid-moves board)
  (define (vm-helper column-list col-no)
    (if (null? column-list)
	'()
	(if (< (car column-list) 6)
	    (cons col-no (vm-helper (cdr column-list) (1+ col-no)))
	    (vm-helper (cdr column-list) (1+ col-no)))))
  (vm-helper (cadr board) 1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (c4-end? board)
;
; returns the winning player ('X or 'O) or 'draw if the game is over
; and #f otherwise
;
; uses regular expressions to search for four in a row in the board-string
; representation of the board.  This is where it's important to have a
; space separating the rows!  The first search (of each set) finds
; four in a row, the next four in a column, the third four on a
; diagonal slanting up and to the right, the fourth finds four on a
; diagonal slanting up and to the left.
;
; For more information on using regular expressions in Scheme, see the
; reference manual.  The reference manual in turn points you to
; gnu-emacs (the info page) for what symbols to use to write regular
; expressions. 
; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (c4-end? board)
  (let ((bs (board-string board)))
    (cond
     ((or (re-string-search-forward "XXXX" bs) 
	  (re-string-search-forward "X.......X.......X.......X" bs)
	  (re-string-search-forward "X......X......X......X" bs)
	  (re-string-search-forward "X........X........X........X" bs))
      'X)
     ((or (re-string-search-forward "OOOO" bs) 
	  (re-string-search-forward "O.......O.......O.......O" bs)
	  (re-string-search-forward "O......O......O......O" bs)
	  (re-string-search-forward "O........O........O........O" bs))
      'O)
     ((and (= 6 (car (pieces-list board)))
	   (apply =  (pieces-list board)))
      'draw)
     (else #f))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Procedures for analyzing the board
;
; These procedures look for patterns in the board.  In particular,
; they look for open sequences of pieces in columns, rows, and
; diagonals.  By "open" I mean that at least one end has an empty
; space where the sequence could be extended.
;
; The implementation of these functions takes advantage of the fact
; that MIT Scheme has built in procedures for matching regular
; expressions in strings.
;
; For a somewhat simpler example of regular expressions, see the
; c4-end? procedure.
; 
; For more information on using regular expressions in Scheme, see the
; reference manual.  The reference manual in turn points you to
; gnu-emacs (the info page) for what symbols to use to write regular
; expressions. 
; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
; (open-columns board player)
;
; given a board state, tells you how many open colums there are.  Note
; that open columns can only be open at the top.  Furthermore, any
; open column of three is recognized also an an open column of two, so
; these are subtracted out before returning the result.
;
; this function returns the list:
;
;  (twos threes)
;
(define (open-columns board player)
  (let* ((bs (board-string board))
	 (counts
	  (map (lambda (x)
		       (count-re-matches x bs))
	       (case player
		 ((X) '(" .......X.......X"  " .......X.......X.......X"))
		 ((O) '(" .......O.......O"  " .......O.......O.......O"))
		 (else (error "Invalid player!"
			      (list 'open-columns board player))))))
	 (twos (first counts))
	 (threes (second counts)))
    (list (- twos threes)
	  threes)))

;
; (open-rows board player)
;
; The situation with open rows is a little more complicated because
; rows can be open on the left or on the right or on both sides.  This
; function returns information on all of them.  Note that an open
; three on both sides (b-three) is counted also as a l-two, l-three,
; r-two, and r-three, so appropriate adjustments are made before the
; results are returned.
;
; This function returns the list:
;
;  ((l-twos l-threes) (r-twos r-threes) (b-twos b-threes))
;
(define (open-rows board player)
  (let* ((bs (board-string board))
	 (counts
	  (map (lambda (x)
		 (count-re-matches x bs))
	       (case player
		 ((X) '(" XX" " XXX" "XX " "XXX " " XX " " XXX "))
		 ((O) '(" OO" " OOO" "OO " "OOO " " OO " " OOO "))
		 (else (error "Invalid player!"
			      (list 'open-rows board player))))))
	 (l-twos (first counts))
	 (l-threes (second counts))
	 (r-twos (third counts))
	 (r-threes (fourth counts))
	 (b-twos (fifth counts))
	 (b-threes (sixth counts)))
    (list (list (- l-twos l-threes b-twos)
		(- l-threes b-threes))
	  (list (- r-twos r-threes b-twos)
		(- r-threes b-threes))
	  (list b-twos b-threes))))

;
; (open-diagonals board player)
;
; Diagonals are even more complicated.  My abbreviations for naming
; the variables are as follows:
;
; first character --- as we go up, the diagonal slants to the:
;   - l = left
;   - r = right
; second character --- the diagonal is open at the:
;   - u = "up" end
;   - d = "down" end
;   - b = "both" ends
;
; Again we have the fact that certain things are counted twice, so
; these are adjusted before returning a list.  In the end, we don't
; care whether the diagonal slants to the left or the right, so the
; list returned is:
;
; ((u-twos u-threes) (d-twos d-threes) (b-twos b-threes))
;
; The prefix on these symbols are the second characters above,
; e.g. the first element gives the number of two and three piece
; diagonals which are open at the top.
; 
(define (open-diagonals board player)
  (let* ((bs (board-string board))
	 (counts
	  (map (lambda (x)
		       (count-re-matches x bs))
	       (case player
		 ((X) '(" ........X........X" " ........X........X........X"
			"X........X........ " "X........X........X........ "
			" ........X........X........ "
			" ........X........X........X........ "
			" ......X......X" " ......X......X......X"
			"X......X...... " "X......X......X...... "
			" ......X......X...... "
			" ......X......X......X...... "))
		 ((O) '(" ........O........O" " ........O........O........O"
			"O........O........ " "O........O........O........ "
			" ........O........O........ "
			" ........O........O........O........ "
			" ......O......O" " ......O......O......O"
			"O......O...... " "O......O......O...... "
			" ......O......O...... "
			" ......O......O......O...... "))
		 (else (error "Invalid player!"
			      (list 'open-diagonals board player))))))
	 (lu-twos (list-ref counts 0))
	 (lu-threes (list-ref counts 1))
	 (ld-twos (list-ref  counts 2))
	 (ld-threes (list-ref counts 3))
	 (lb-twos (list-ref counts 4))
	 (lb-threes (list-ref counts 5))
	 (ru-twos (list-ref counts 6))
	 (ru-threes (list-ref counts 7))
	 (rd-twos (list-ref  counts 8))
	 (rd-threes (list-ref counts 9))
	 (rb-twos (list-ref counts 10))
	 (rb-threes (list-ref counts 11)))
    (list (list (+ (- lu-twos lb-twos lu-threes)
 		   (- ru-twos rb-twos ru-threes))
		(+ (- lu-threes lb-threes)
		   (- ru-threes rb-threes)))
	  (list (+ (- ld-twos lb-twos ld-threes)
 		   (- rd-twos rb-twos rd-threes))
		(+ (- ld-threes lb-threes)
		   (- rd-threes rb-threes)))
	  (list (+ lb-twos rb-twos)
		(+ lb-threes rb-threes)))))

;
; this is the procedure that does all the work.  Given a regular
; expression and a string, it determines how many times that regular
; expression matches the string
; 
(define (count-re-matches regexp string)
  (define string-end (string-length string))
  (define (crm start)
    (let ((m (re-substring-search-forward regexp string start string-end)))
      (if (not m)
	  0
	  (1+ (crm (1+ (re-match-start-index 0 m)))))))
  (crm 0))