;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; connect4.scm
; 
; Version 1.2.2
; 
; Copyright (c) 2000--2005 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.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Organization of this file:
;
; 1. How to get started
; 2. Board representation and accessors
; 3. Game implementation procedures
; 4. Two player procedures
; 5. Feature detectors
; 
;
(load-option 'regular-expression) ; required for various "feature detectors"


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 1. 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!
;
;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; 2. BOARD REPRESENTATION
; 
; You don't necessarily need to understand the Connect 4 board
; representation in full detail, but you will if you want to implement
; some of your own "feature detectors".  You can do this problem
; without using any of the procedures in this section if you are
; content to use the "feature detectors" that I've provided.
;
; I've written a number of "accessor procedures" that appear below;
; you can use these to access parts of the board representation
; without needing to understand its details.
; 
;
; A board is reperesented as a list of the form: (board-string pieces-list)
;
; For example, here is a board state:
; 
;   ("       |       |       |  XO   | XOXO  | OXXXO " (0 2 3 3 2 1 0))
;
; and its printed representation (printed by the "print-board" procedure)
;
;         +---------------+
;        6|               |
;        5|               |
;        4|               |
;        3|     X O       |
;        2|   X O X O     |
;        1|   O X X X O   |
;         +---------------+
;           1 2 3 4 5 6 7
;
; Note that the string contains 7 characters for each row, starting
; with the top, and rows are separated by a vertical bar.  (The
; vertical bars are actually very important because of the way the
; regular expressions are written for the provided "feature
; detectors".)  The string is then 47 characters long, and each
; character in a row is either an 'X', 'O', or a space.  The
; "pieces-list" represents the number of pieces in each column.
; 
; 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.  Keeping track
; of the number of pieces that have been played in each column
; simplify certain calculations,
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
; Accessors for the board state
;
(define board-string first)
(define pieces-list second)

;
; Accessor for cells on 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.
;
; you shouldn't need to call this procedure directly.  (It is used by
; the "piece-at" procedure.)  If you do use it, note that "characters"
; are different from "strings"; see the MIT Scheme reference manual
; for details.
;
(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 procedures 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))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 3. GAME IMPLEMENTATION PROCEDURES
;
; These procedures provide the basic functionality for the game: start
; state, getting the children of a board, and determining if the game
; is over.
; 


; the starting board state (a completely empty board)
;
(define c4-start (list "       |       |       |       |       |       "
		       '(0 0 0 0 0 0 0)))

; Find the children of a given board.
;
; 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 valid moves procedure simply returns a list of columns that are not full
; 
(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) --- I may take this procedure out of this file and put a
; more efficient version in the compiled support code.
;
; 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)
     ((apply = (cons 6 (pieces-list board)))
      'draw)
     (else #f))))

;
; return the move that led from board1 to board2
; 
(define (get-move board1 board2)
  (let ((piecelist1 (pieces-list board1))
	(piecelist2 (pieces-list board2)))
    (length (member 1 (reverse (map - piecelist2 piecelist1))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 4. TWO PLAYER PROCEDURES
;
; These procedures should be useful in testing your program.

;
; 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 "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 "\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 "That move is illegal.  Column " move " is full!\n"
	       "Try again...\n\n")
	(getmove))
       (else move))))
	
  (print "\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)))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 5. FEATURE DETECTORS
;
; 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. 
;
; These depend on the procedure "count-re-matches" which is defined at
; the end of this section.

;;;;;;;;;;;;;;;;
;
; (open-columns board player)
;
; Given a board state and which player to look for, tells you how many
; open colums are on the board.  Note that open columns can only be
; open at the top.  Furthermore, any open column of three pieces is
; recognized also an an open column of two pieces, 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.  Also, and "open two" on both sides is counted
; also as a l-two and an r-two.  Therefore, 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, this
; procedure doesn'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))
;
(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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; here's a procedure that will count the number of matches for a given
; pattern that doesn't use regular expressions, so it should be much
; faster than the regular expression based feature detectors.
; 
; the pattern is specified in the form: (char skip ... char)
;
; where char = #\X, #\O, #\space, 'XO
;       skip = the number of characters to skip ahead in the board string
;              to get to the next character to compare
;
; for example:
;
;  (#\X 1 #\space 1 #\X 1 #\X)   = "X XX" in a row
;  (#\X 9 #\space 9 #\X 9 #\X)   = "X XX" in a diagonal (down right slanting)
;
; there are some more examples/tests below
; 

(define (pattern-match pattern bs)
  (define bs-length (string-length bs))
  ; by using internal definitions, I don't have to pass "bs" (and some
  ; other arguments) to each procedure because those variables are within scope
  
  ; this helper procedure goes through each starting position in the string
  (define (pmh start-pos count)
    (if (= start-pos bs-length)
	count
	(pmh (+ start-pos 1) (if (pmh-match? pattern start-pos)
				 (+ 1 count)
				 count))))

  ; this is the procedure that does the work of checking the pattern
  ; against the board string starting at the character at index "pos"
  (define (pmh-match? pat pos)
    (let* ((p (car pat))
	   (match? (if (>= pos bs-length)
		       #f
		       (let ((c (string-ref bs pos)))
			 (if (char? p)
			     (char=? c p)
			     (or (char=? #\X c)
				 (char=? #\O c)))))))
      (cond ((not match?) #f)
	    ((null? (cdr pat)) match?)
	    (else (pmh-match? (cddr pat) 
			      (+ pos (second pat)))))))

  ; call the helper procedure with the right initial argument values
  (pmh 0 0))

;;;;;;;;;;;;;;;;
;
; if you want to write some of your own feature detectors that don't
; use regular expressions, here are procedures needed to access
; strings and compare characters:
; 
;     (string-length s)
;     (string-ref str pos)    returns a character
;     (char=? x y)            are 2 characters the same?
;
; other useful procedures
; 
;     (char? c)               returns #t if c is a character
;     (symbol? s)             returns #t if s is a symbol
;
;;;;;;;;;;;;;;;;
;
; some tests/examples for "pattern-match" using the board:
;
;     +---------------+
;    6|               |
;    5|   O X         |
;    4|   X X         |
;    3|   O O         |
;    2|   O X         |
;    1| X X O O X     |
;     +---------------+
;       1 2 3 4 5 6 7
;       
; (define b '("       | OX    | XX    | OO    | OX    |XXOOX  " 
; 	    (1 5 5 1 1 0 0)))
; (define bs "       | OX    | XX    | OO    | OX    |XXOOX  ")
;
; (pattern-match '(#\X 1 #\O 1 #\O 1 #\X) bs) => 1
; (pattern-match '(#\O 1 #\X 1 #\space) bs)   => 3
; (pattern-match '(#\O 9 #\X 9 #\space) bs)   => 1
; (pattern-match '(#\O 9 #\X 9 'XO) bs) 	    => 1
; (pattern-match '(#\O 8 #\X 8 'XO) bs) 	    => 2
; (pattern-match '(#\O 7 #\X 7 #\space) bs)   => 0
; (pattern-match '(#\space 7 #\X 7 #\X) bs)   => 2
;