;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Copyright (c) 1999 Wesley H. Huang.  All rights reserved.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; this global variable determines the size of the board
;
; to change the size of the board, redefine it, i.e. (define board-size 8)
;
(define board-size 8)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (othello-end? board)
;
; Returns true if the board represents the end of the game --- when neither 
; player has a valid move.  This is usually because the board is full, but
; it can occur earlier in the game.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (othello-end? board)
  (if (not (board? board))
      (begin
	(display "\nInvalid board passed to function othello-end?\n")
	(display "Argument was: ")
	(display board)
	(error "Invalid argument"))
      (or (board-full? board)
	  (and (null? (othello-valid-moves board 'x))
	       (null? (othello-valid-moves board 'o))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (othello-valid-moves board player)
;
; For a given board and player (either 'x or 'o), returns a list of valid
; moves available to that player.  The moves are represented by a list of
; two numbers, first the x and then the y coordinate of the move.
;
;; Technical notes: This could be more efficient by calling a function that
;; checks whether a move is valid without constructing the entire list of
;; pieces that would be flipped by making the given move.
;;
;; Also, there's probably a better way to do this than by searching over
;; all squares...
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (othello-valid-moves board player)
  (define (try-play play-list)
    (if (null? play-list)
	'()
	(let ((loc (car play-list)))
	  (if (equal? (piece-at board loc) 'blank)
	      (let ((fl (flip-list board loc player)))
		(if (= (length fl) 0)
		    (try-play (cdr play-list))
		    (cons loc
			  (try-play (cdr play-list)))))
	      (try-play (cdr play-list))))))
  (cond
   ((not (board? board)) (error "Invalid board given to function othello-valid-moves"))
   ((not (valid-player? player)) (error "Invalid player given to function othello-valid-moves"))
   (else (try-play (n-by-n-coords board-size)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (othello-make-move board loc player)
; 
; makes the move (by "player" at "loc") on the board, returning a new board
; player must be the symbol 'X or 'O.  This function will flip all the
; pieces that need to be flipped.
;
; if the move is invalid, returns 'invalid-move
;	
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (othello-make-move board loc player)
  (cond
   ((not (board? board)) (error "Invalid board given to function othello-make-move"))
   ((not (valid-loc? loc)) (error "Invalid loc given to function othello-make-move"))
   ((not (valid-player? player)) (error "Invalid player given to function othello-make-move "))
   (else 
    (let ((fl (flip-list board loc player)))
      (if (= (length fl) 0)
	  'invalid-move
	  (let ((next-board (new-board board)))
	    (map (lambda (flip) (play-piece! next-board flip player))
		 fl)
	    (play-piece! next-board loc player)
	    next-board))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (othello-gc board player)
;
; returns a list of the possible boards that result from a move by the 
; given player (the "child boards").  player is either 'X or 'O
;
;; Technical note: This function returns the same result as
;;
;;     (define (othello-gc board player)
;;       (map (lambda (m) (othello-make-move board m player))
;;            (othello-valid-moves board player)))
;;
;; However, the above code is inefficient (as it stands now) because the entire
;; list of pieces to flip for a given move is constructed twice, once for
;; determining whether a move is valid and once for actually making the move.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (othello-gc board player)
  (define (try-play play-list)
    (if (null? play-list)
	'()
	(let ((loc (car play-list)))
	  (if (equal? (piece-at board loc) 'blank)
	      (let ((fl (flip-list board loc player)))
		(if (= (length fl) 0)
		    (try-play (cdr play-list))
		    (let ((child (new-board board)))
		      (map (lambda (flip) (play-piece! child flip player))
			   fl)
		      (play-piece! child loc player)
		      (cons child 
			    (try-play (cdr play-list))))))
	      (try-play (cdr play-list))))))
  (cond
   ((not (board? board)) (error "Invalid board given to function othello-gc"))
   ((not (valid-player? player)) (error "Invalid player given to function othello-gc"))
   (else (try-play (n-by-n-coords board-size)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; support functions for othello-end?, othello-valid-moves, othello-make-move,
; and othello-gc 
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
; returns the directions to try if a piece from "player" is played at "loc"
;
;; uses the internal-piece-at function
;; 
(define (dir-to-try board loc player)
  (let ((op (other-player player)))
    (apply append
	   (map (lambda (dir) 
		  (if (equal? op (internal-piece-at board (map + loc dir)))
		      (list dir)
		      '()))
		'((1 0) (1 1) (0 1) (-1 1) (-1 0) (-1 -1) (0 -1) (1 -1))))))

;
; The play we are exploring is at coordinates loc.  There is an
; opponent's piece in the direction d.  We need to explore in that
; direction to make sure that there is one of our pieces at the other
; end to surround the opponent's piece.
;
; This function returns a list of the pieces that would be flipped in
; the given direction by playing at the given location.  If there are
; no pieces, it returns an empty list.
; 
;; uses the internal piece-at function --- perhaps it should just be rewritten
;;
(define (explore-dir board loc dir)
  (let* ((first-loc (map + loc dir))
	 (opponent (internal-piece-at board first-loc))
	 (my-piece (other-player opponent)))
    (define (step loc result)
      (let* ((next-loc (map + loc dir))
	     (next-piece (internal-piece-at board next-loc)))
	(cond
	 ((equal? next-piece opponent) (step next-loc (cons next-loc result)))
	 ((equal? next-piece my-piece) result)
	 (else '()))))
    (step first-loc (list first-loc))))

;
; creates a list of pieces that would have to be flipped if the given player
; plays a piece at "loc" on the given board
; 
(define (flip-list board loc player)
  (let ((dirs (dir-to-try board loc player)))
    (apply append (map (lambda (dir) (explore-dir board loc dir))
		       dirs))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Othello board representation and manipulation  
;
; These functions deal with the internal representation of the board.
; Other funnctions should access the board using these functions.
;
; For writing an evaluation function for Othello, you should only need
; the following two functions:
; 
;    (piece-at board loc)
;
;    Given a board and a location (represented as a list of two numbers,
;    the X and Y coordinates), returns either 'X, 'O, or 'blank
;
;    (tally-board board)
;
;    Returns a list of two numbers.  The first is the number of X pieces
;    on the board, the second is the number of O pieces.
;
; For writing your alpha-beta minimax search, the following function may
; be useful:
;
;    (board-difference b1 b2)
;
;    given two boards which are assumed to differ in only one position (move),
;    return the (x y) coordinate of the move
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
; create a new (blank board), but if an optional second argument is given,
; create a copy of that board instead
;
(define (new-board . input-board)
  (if (null? input-board)
      (make-string (sqr board-size) #\space)
      (if (board? (car input-board))
	  (string-copy (car input-board))
	  (error "Invalid board given to function new-board"))))

(define (convert-coord loc)
  (let* ((x (car loc))
	 (y (cadr loc)))
    (if (and (< -1 x board-size)
	     (< -1 y board-size))
	(+ (* y board-size) x)
	#f)))

(define (play-piece! board loc c)
  (let ((pos (convert-coord loc))
	(char (case c
		((X) #\X)
		((O) #\O)
		(else #f))))
    (if (and pos char)
	(string-set! board pos char))))

;
; made two versions of the piece-at function --- one which does error
; checking on the inputs for students to use, and one which doesn't
; for my code to use because my code depends on it!  when checking
; pieces in a given direction, I depend on getting a '() if the
; coordinate is off the board
;
(define (piece-at board loc)
  (cond
   ((not (board? board)) (error "Invalid board given to function piece-at"))
   ((not (valid-loc? loc)) (error "Invalid loc given to function piece-at"))
   (else
    (let ((pos (convert-coord loc)))
      (if pos
	  (case (string-ref board pos)
	    ((#\X) 'X)
	    ((#\O) 'O)
	    (else 'blank))
	  '())))))

(define (internal-piece-at board loc)
  (let ((pos (convert-coord loc)))
    (if pos
	(case (string-ref board pos)
	  ((#\X) 'X)
	  ((#\O) 'O)
	  (else 'blank))
	'())))

(define (valid-loc? loc)
  (and (list? loc)
       (= (length loc) 2)
       (integer? (car loc))
       (integer? (cadr loc))
       (< -1 (car loc) board-size)
       (< -1 (cadr loc) board-size)))

(define (valid-player? p)
  (or (equal? p 'x)
      (equal? p 'o)))

(define (string-at board loc)
  (let ((pos (convert-coord loc)))
    (if pos
	(string-ref board pos)
	'())))

;
; returns a list of two elements: number of X pieces and O pieces
;
(define (tally-board board)
  (let ((x 0)
	(o 0))
    (define (tally-mark n)
      (if (= n -1)
	  (list x o)
	  (begin
	    (case (string-ref board n)
	      ((#\X) (set! x (+ x 1)))
	      ((#\O) (set! o (+ o 1))))
	    (tally-mark (- n 1)))))
    (if (not (board? board))
	(error "Invalid board given to function othello-gc")
	(tally-mark (- (sqr board-size) 1)))))

(define (board-equal? b1 b2)
  (string-ci=? b1 b2))

(define (board-full? b)
  (equal? (substring? " " b) #f))

;
; is the argument an othello-board?
;
; (only checks whether it's a string of the proper length, not whether
; every piece is valid!)
; 
(define (board? x)
  (and (string? x)
       (= (string-length x) (sqr board-size))))

;
; given two boards which are assumed to differ in only one position (move),
; return the (x y) coordinate of the difference
;
(define (board-difference b1 b2)
  (define (bd n)
    (if (< n 0)
	'identical-boards
	(let ((b1c (string-ref b1 n))
	      (b2c (string-ref b2 n)))
	  (if (or (and (char=? b1c #\space)
		       (not (char=? b2c #\space)))
		  (and (not (char=? b1c #\space))
		       (char=? b2c #\space)))
	      (let* ((y (quotient n board-size))
		     (x (remainder n board-size)))
		(list x y))
	      (bd (- n 1))))))
  (if (or (not (board? b1))
	  (not (board? b2)))
      (error "Invalid board given to function board-difference")
      (bd (- (string-length b1) 1))))
    
	
      

    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; various auxiliary functions
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (sqr x) (* x x))

;
; creates a list of zero to (n-1)
;
(define (zero-to-n n)
  (define (ztn i r)
    (if (= i -1)
	r
	(ztn (- i 1) (cons i r))))
  (ztn (- n 1) '()))

;
; creates the outer product of (zero-to-n n) with itself
;
(define (n-by-n-coords n)
  (apply append (map (lambda (x) (map (lambda (y) (list x y))
				      (zero-to-n n)))
		     (zero-to-n n))))

;
; these functions operate on the real numbers extended to include
; 'pos-infinity and 'neg-infinity 
;
(define (infty-max a b)
  (if (number? a)
      (if (number? b)
	  (max a b)
	  (if (equal? b 'pos-infinity)
	      'pos-infinity
	      a))
      (if (equal? a 'pos-infinity)
	  'pos-infinity
	  b)))

(define (infty-min a b)
  (if (number? a)
      (if (number? b)
	  (min a b)
	  (if (equal? b 'neg-infinity)
	      'neg-infinity
	      a))
      (if (equal? a 'neg-infinity)
	  'neg-infinity
	  b)))

(define (infty->= a b)
  (cond
   ((equal? b 'neg-infinity) #t)
   ((equal? a 'pos-infinity) #t)
   ((and (number? a) (number? b)) (>= a b))
   (else #f)))

(define (infty-<= a b)
  (infty->= b a))
	      
(define (infty-= a b)
  (equal? a b))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (print-board board)
; 
; prints an ascii representation of the board to the screen
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (print-board board)
  (define (print-x-numbers x)
    (if (< x board-size)
	(begin
	  (display x)
	  (display " ")
	  (print-x-numbers (+ x 1)))))

  (define (divider)
    (display "y +")
    (display (make-string (+ (* 2 board-size) 1) #\-))
    (display "+")
    (newline))
    
  (define (print-row r)
    (define (prh x row)
      (if (< x board-size)
	  (begin
	    (display (string-at board (list x row)))
	    (display " ")
	    (prh (+ x 1) row))))
    (if (>= r 0)
	(begin
	  (display r)
	  (display " | ")
	  (prh 0 r)
	  (display "|")
	  (newline)
	  (print-row (- r 1)))))

  (if (not (board? board))
      (error "Invalid board given to function print-board")
      (begin
	(newline)
	(divider)
	(print-row (- board-size 1))
	(divider)
	(display "  x ")
	(print-x-numbers 0)
	(display "x")
	(newline))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; play a game of othello
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (play-othello x-strategy o-strategy)
  (let ((board (new-board)))

    (define (make-move player)
      (if (othello-end? board)
	  (begin  ; game is over, tally score and report who won
	    (newline)
	    (let ((tally (tally-board board)))
	      (cond
	       ((apply > tally) (display "X won with a score of ")
	                        (display (car tally))
				(display " to ")
				(display (cadr tally))
				(newline)
				(cons 'x tally))
	       ((apply < tally) (display "O won with a score of ")
	                        (display (cadr tally))
				(display " to ")
				(display (car tally))
				(newline)
				(cons 'o (reverse tally)))
	       (else (display "The game is a draw.")
		     (newline)
		     '(draw)))))
	  ;
	  ; otherwise, get the player's move and play it.  (display stuff too)
	  ;
	  (begin
	    (if (equal? player 'x)
		(player-moves! board x-strategy 'x)
		(player-moves! board o-strategy 'o))
	    (make-move (other-player player)))))

    (init-board! board)
    (print-board board)
    (make-move 'x)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (init-board! board)
;
; place the first four pieces on the board, destructively modifying
; the given board
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (init-board! board)
  (let* ((H (/ board-size 2))
	 (L (- H 1)))
    (play-piece! board (list L H) 'O)
    (play-piece! board (list H L) 'O)
    (play-piece! board (list L L) 'X)
    (play-piece! board (list H H) 'X)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (initial-board)
;
; creates a new board with the first four pieces in position
;
(define (initial-board)
  (let ((b (new-board)))
    (init-board! b)
    b))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (other-player p) 
;
; Given 'X or 'O, it returns the symbol of the other player
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (other-player c) 
  (case c
    ((x) 'O)
    ((o) 'X)
    (else (error "Invalid symbol given to function other-player"))))

;
; makes the move on the board and returns the move location (or 'invalid-move)
;	
(define (make-play! board loc player)
  (let ((fl (flip-list board loc player)))
    (if (= (length fl) 0)
	'invalid-move
	(begin
	  (map (lambda (flip) (play-piece! board flip player))
	       fl)
	  (play-piece! board loc player)
	  loc))))

;
; how many pieces would the given move flip over
;
(define (number-of-flips board loc player)
  (cond
   ((not (board? board)) (error "Invalid board given to function number-of-flips"))
   ((not (valid-loc? loc)) (error "Invalid loc given to function number-of-flips"))
   ((not (valid-player? player)) (error "Invalid player given to function number-of-flips"))
   (else (length (flip-list board loc player)))))

(define (othello-valid-move? board loc player)
  (and (equal? (piece-at board loc) 
	       'blank)
       (> (number-of-flips board loc player)
	  0)))


;
; get the player's move and report results
;
(define (player-moves! board strategy player)
  (let ((move (make-play! board (strategy board player) player)))
    (newline)
    (display "Player ")
    (display (string-upcase (symbol->string player)))
    (display " made the move ")
    (display move)
    (newline)
    (print-board board)))
	     

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; player functions
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (human-player board player)
  (newline)
  (display "You are playing ")
  (display (string-upcase (symbol->string player)))
  (newline)
  (display "Enter your move in the form (x y).  (no need to quote the list!)\nThen press return (or C-x C-e in Edwin/Emacs)")
  (newline)
  (let ((move (read)))
    (newline)
    (if (valid-loc? move)
	(if (othello-valid-move? board move player)
	    move
	    (begin
	      (display "\nINVALID MOVE --- you must play a piece so that ")
	      (display "at least one opponent's piece\nwill be flipped over.")
	      (display "  Try again...\n")
	      (human-player board player)))
	(begin
	  (display "\nINVALID MOVE --- you must enter a two element list ")
	  (display "(complete with parentheses)\nwith the coordinates of")
	  (display "your move.  For example (0 ")
	  (display (- board-size 1))
	  (display ") is the upper left\nhand corner.  Try again...\n")
	  (human-player board player)))))

(define (random-player board player)
  (let ((moves (othello-valid-moves board player)))
    (if (> (length moves) 0)
	(list-ref moves (random (length moves)))
	'(-1 -1))))
		  

;
; Here is an example of the create-minimax-player that you must write.
; This example does the following:
; 
; - calls the function make-root-node to create a root node with the
;   starting board and which player ('x or 'o) minimax will be playing
;
; - calls the function ab-minimax (which here takes 3 arguments) that
;   performs an alpha-beta minimax search
;
; - extracts the best move from the value returned by ab-minimax using the
;   get-move procedure
;
; Your version of this function will probably be similar, but your ab-minimax
; function may take more than 3 arguments; your make-root-node function will
; depend on the node representation you choose; and your get-move function
; will depend on what your ab-minimax function returns.
; 
;(define (create-minimax-player eval-fn depth-cutoff)
;  (define (minimax-player board player)
;    (let* ((root-node (make-root-node board <other information?>))
; 	    (return-value (ab-minimax root-node
;	 			      eval-fn
;				      depth-cutoff
;                                     <other-information?>)))
;      (get-move return-value)))
;  minimax-player)
;