;;; -*- Mode: Scheme -*-

;;; Good old Tic-Tac-Toe.
;;; For use in 6.034 at MIT EECS (by tlp@mit.edu).

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; TTT-specific functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; in TTT all i,j positions are valid

(define *BOARD-WIDTH* 3)		; TTT
(define *BOARD-SIZE* 9)

(define (BOARD-INDEX i j) (+ (* *BOARD-WIDTH* i) j))
(define (BOARD-COORDINATES i) 
  (and (>= index 0)
       (< index *board-size*)
       (list (quotient index *board-width*)
	     (remainder index *board-width*))))

;;; Just the empty board
(define (INITIAL-POSITION player)
  (let ((position (make-position player (make-board))))
    (if *WINDOW* (display-position&moves position '()))	; display it.
    position))

;;; Found at least one row, column, or diagonal with only player in it.
;;; See the definition of ttt-weight-winners below.
(define (WINNING-POSITION-FOR? position player)
  (> (ttt-weight-winners (position-board position) (list player) 1 1)
     0))

;;; not meaningful for TTT
(define (FINAL-SCORE positon player) 0)	

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; TTT-SPECIFIC FUNCTIONS - LEGAL MOVE GENERATOR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; This one is easy, find the empty spots on the board.
(define (LEGAL-MOVES position)
  (let ((board (position-board position))
	(moves '()))
    (scan-squares
     (lambda (index)
       (if (not (board-entry board index))
	   (set! moves 
		 (cons
		  (let ((mspec (make-move-spec #f index '())))
		    (make-move mspec
			       (position-after-move 
				mspec position (position-next-player position))))
		  moves))
	   )))
    moves))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; TTT-SPECIFIC FUNCTIONS - STATIC EVALUATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; This returns a score that depends of the number of rows, columns,
;;; and diagonals in which only members of players can be found.  This
;;; is useful for detecting winners as well as in computing static
;;; evaluations.  So when PLAYERS=(X), this would count how many ways
;;; the X player has won already.  When PLAYERS=(X #f), this would
;;; count (weighted) how many ways the X player might win eventually,
;;; that is, how many rows, columns and diagonals do not have an O in
;;; them.

(define *ROWS* 
  (list '(0 1 2) '(3 4 5) '(6 7 8)))

(define *COLUMNS*
  (list '(0 3 6) '(1 4 7) '(2 5 8)))

(define *DIAGONALS*
  (list '(0 4 8) '(2 4 6)))

;;; Given a board and a list of players or #f, returns a number which
;;; is the sum of a score for each row, column and diagonal.  If the
;;; row has players not listed in values, then the score is 0.  If the
;;; values include #f, then if the column, row, or diag has 1 mark,
;;; return w1, if it has two marks, return w2, if it has 3 return
;;; w2*w2.

(define (TTT-WEIGHT-WINNERS board values w1 w2)
  (let ((value1 (car values))
	(value2 (if (null? (cdr values)) 'none (cadr values))))
    
    (define (value indeces)
      (define (value-aux indeces i1 i2 i3)
	(cond ((null? indeces)
	       (cond ((> i3 0) 0)	; oponent present
		     ((= i1 1) w1)
		     ((= i1 2) w2)	; 2 in a row
		     ((= i1 3) (* w2 w2))
		     (else 0)))
	      (else
	       (let ((val (board-entry board (car indeces))))
		 (cond ((eq? val value1)
			(value-aux (cdr indeces) (+ i1 1) i2 i3))
		       ((eq? val value2)
			(value-aux (cdr indeces) i1 (+ i2 1) i3))
		       (else
			(value-aux (cdr indeces) i1 i2 (+ i3 1))))))))
      (value-aux indeces 0 0 0))

    (if (not value1)			; make sure value1 is not #f
	(let ((v value2))
	  (set! value2 value1)
	  (set! value1 v)))
    (+ (apply + (map value *rows*))
       (apply + (map value *columns*))
       (apply + (map value *diagonals*)))))

(define (TTT-STATIC-EVALUATION-FN position)
  (- (ttt-weight-winners
      (position-board position)
      ;; we're evaluating this for the next-player - whose turn this is.
      (list (position-next-player position) #f)
      1 10)
     (ttt-weight-winners
      (position-board position)
      ;; position-player produced this board, so (s)he is the oponent.
      (list (position-player position) #f)
      1 10)))

(define STATIC-EVALUATION-FN-AUX TTT-STATIC-EVALUATION-FN)