;;; Receives the size n of a row
;;; Returns a row of size n
(define (create-row n)
(if (= n 0)
'()
(cons 0 (create-row (- n 1)))))
;;; Receives the dimensions n and m of a board
;;; Returns a board of size m x n
(define (create-board m n)
(if (= n 0)
'()
(cons (create-row m) (create-board m (- n 1)))))
;;; Receives the size n of the board
;;; Returns an empty board of size n x n
(define (initial-board n)
(create-board n n))
;;;--------------------------------------------------------------------------
;;; Receives a row of the board and the current x y coordinate
;;; Returns a list with the coordinates of empty cells on the row
(define (row-moves row x y)
(cond
((null? row) '())
((= (first row) 0) (cons (list x y) (row-moves (rest row) (+ x 1) y)))
(else (row-moves (rest row) (+ x 1) y))))
;;; Receives a board and the current y coordinate (row we're in)
;;; Returns a list with the coordinates of empty cells on the board
(define (board-moves board y)
(if (null? board)
'()
(append (row-moves (first board) 0 y)
(board-moves (rest board) (+ y 1)))))
;;; Receives a board b
;;; Returns all the legal moves allowed on the board
(define (moves b)
(board-moves b 0))
;;;--------------------------------------------------------------------------
;;; Receives the current state of the board
;;; Returns the next player how is moving on the board
(define (player b)
(if (even? (- (* (length b) (length (first b))) (length (moves b))))
1
-1))
;;;--------------------------------------------------------------------------
;;; Receives a row, the x position we're replacing, and the current player
;;; Returns the row, with a piece of player p on position x
(define (put-piece-row row x p)
(if (= x 0)
(cons p (rest row))
(cons (first row) (put-piece-row (rest row) (- x 1) p))))
;;; Receives a board, an x y coordinate, and the current player
;;; Returns the board, with a piece of player p on position x y
(define (put-piece board x y p)
(if (= y 0)
(cons (put-piece-row (first board) x p) (rest board))
(cons (first board) (put-piece (rest board) x (- y 1) p))))
;;; Receives a move m to make and a board b
;;; Returns
(define (make-move m b)
(put-piece b (first m) (second m) (player b)))
;;;--------------------------------------------------------------------------
;;; Receives a pair of results a and b (domain -1, 0, 1)
;;; Returns which player has won given those results, 0 if tie
(define (merge-results a b)
(cond
((or (= a 1) (= b 1)) 1)
((or (= a -1) (= b -1)) -1)
(else 0)))
;;; Receives the sum of a line and the size n of the board
;;; Returns which player wins given that sum, 0 if tie
(define (check-winner sum n)
(cond
((= sum n) 1)
((= sum (- n)) -1)
(else 0)))
;;; Receives a row
;;; Returns which player wins on the row
(define (check-row row)
(check-winner (reduce + row 0) (length row)))
;;; Receives a board
;;; Returns which player wins by forming a line on the rows
(define (check-rows board)
(reduce merge-results (map (lambda (r) (check-row r)) board) 0))
;;; Receives a pair of columns c1 and c2
;;; Returns a new columns with the sum of the elements of c1 and c2
(define (column+ c1 c2)
(if (null? c1)
'()
(cons (+ (first c1) (first c2)) (column+ (rest c1) (rest c2)))))
;;; Receives a board
;;; Returns which player wins by forming a line in the columns
(define (check-columns board)
(reduce merge-results
(map (lambda (sum) (check-winner sum (length board)))
(reduce column+ board (create-row (length board))))
0))
;;; Receives a board and a position x
;;; Returns the piece on position x on the board
(define (select-piece-row row x)
(cond
((null? row) (panic "Cannot select element in row"))
((= x 0) (first row))
(else (select-piece-row (rest row) (- x 1)))))
;;; Receives a board, a starting position p and a direction dir (+, -)
;;; Returns which player wins by forming a line on the diagonal
(define (sum-diagonal board x dir)
(if (null? board)
0
(+ (select-piece-row (first board) x)
(sum-diagonal (rest board) (dir x 1) dir))))
;;; Receives a board
;;; Returns which player wins by forming a line on any diagonal
(define (check-diagonals board)
(merge-results
(check-winner (sum-diagonal board 0 +) (length board))
(check-winner (sum-diagonal board (- (length board) 1) -) (length board))))
;;; Receives a board b
;;; Returns who has won the board, 0 if tie
(define (win b)
(reduce merge-results
(list (check-rows b)(check-columns b) (check-diagonals b))
0))
;;;--------------------------------------------------------------------------
;;; Receives the minimum, maximum and sum in a line
;;; Returns the sum, if it corresponds to only one player; 0 otherwise
(define (estimate minim maxim sum)
(if (and (= minim -1) (= maxim 1))
0
sum))
;;; Receives a row
;;; Returns who it estimates might win the row
(define (estimate-row row)
(let ((maxim (reduce max row -1))
(minim (reduce min row 1))
(sum (reduce + row 0)))
(estimate minim maxim sum)))
;;; Receives a board
;;; Returns the estimation of who might win each row in the board
(define (estimate-rows board)
(map estimate-row board))
;;; Receives a couple of columns c1 and c2 and a function f
;;; Returns a column, with the result of applying the functin
(define (column-f c1 c2 f)
(if (null? c1)
'()
(cons (f (first c1) (first c2)) (column-f (rest c1) (rest c2) f))))
;;; Receives a list with the min, max and sum of each column
;;; Returns a list with sums, if only one player played the column; 0 otherwise
(define (column-estimate c-min c-max c-sum)
(if (null? c-min)
'()
(cons (estimate (first c-min) (first c-max) (first c-sum))
(column-estimate (rest c-min) (rest c-max) (rest c-sum)))))
;;; Receives a board
;;; Returns the estimation of who might win each column in the board
(define (estimate-columns board)
(let ((maxim (reduce (lambda (c1 c2) (column-f c1 c2 max))
board
(create-row (length board))))
(minim (reduce (lambda (c1 c2) (column-f c1 c2 min))
board
(create-row (length board))))
(sum (reduce column+ board (create-row (length board)))))
(column-estimate minim maxim sum)))
;;; Receives a board, a position x, a direction dir and a function f
;;; Returns the result of using f on the diagonal of the board
(define (diagonal-f board x dir f)
(if (null? board)
0
(f (select-piece-row (first board) x)
(diagonal-f (rest board) (dir x 1) dir f ))))
;;; Receives a board
;;; Returns the estimation of who might win each diagonal in the board
(define (estimate-diagonals board)
(list
(estimate (diagonal-f board 0 + min)
(diagonal-f board 0 + max)
(sum-diagonal board 0 +))
(estimate (diagonal-f board (- (length board) 1) - min)
(diagonal-f board (- (length board) 1) - max)
(sum-diagonal board (- (length board) 1) -))))
;;; Receives a board b
;;; Returns who it is expected to win on the board [-1, 1]
(define (win~ b)
(let* ((estimates (append (estimate-rows b)
(estimate-columns b)
(estimate-diagonals b)))
(maxim (reduce max estimates 0))
(minim (reduce min estimates 0))
(size (+ (length b) 1)))
(cond
((not (= (win b) 0)) (win b))
((null? (moves b)) 0)
((= (player b) 1) (/ (+ (+ maxim 1) minim) size))
(else (/ (+ maxim (- minim 1)) size)))))
;;;--------------------------------------------------------------------------
;;; Receives a function f a list and a limit
;;; Returns the maximum of the results of applying f on the list
(define (maximize f list limit)
(define (loop best-so-far list)
(cond
((>= best-so-far limit) limit)
((null? list) best-so-far)
(else (loop (max (f (first list) best-so-far) best-so-far) (rest list)))))
(loop -1 list))
;;; Receives a board, a depth k and a limit
;;; Returns who is estimated to win the board, after searching a depth k
(define (win~k board k limit)
(cond
((= k 0) (win~ board))
((or (not (= (win board) 0)) (null? (moves board))) (win board))
(else (let ((sign (player board)))
(* sign
(maximize (lambda (m l) (* sign (win~k (make-move m board)
(- k 1)
(* sign l))))
(moves board)
(* sign limit)))))))
;;;--------------------------------------------------------------------------
;;; Receives a list of moves, a depth k and a board
;;; Returns a list of the outcomes of each move on the list
(define (possible-outcomes move-list k board)
(if (null? move-list)
'()
(cons (list (first move-list)
(win~k (make-move (first move-list) board)
(- k 1)
(* (player board) -1)))
(possible-outcomes (rest move-list) k board))))
;;; Receives a list of outcomes and a player p
;;; Returns a list with the best outcomes for player p
(define (select-best outcomes p)
(if (null? (rest outcomes))
(list (first outcomes))
(let* ((curr-best (select-best (rest outcomes) p))
(first-score (* (second (first outcomes)) p))
(best-score (* (second (first curr-best)) p)))
(cond
((> first-score best-score) (list (first outcomes)))
((< first-score best-score) curr-best)
(else (cons (first outcomes) curr-best))))))
;;; Receives a list of outcomes
;;; Returns the list, after stripping the the estimated value
(define (clean-list list)
(if (null? list)
'()
(cons (first (first list)) (clean-list (rest list)))))
;;; Receives a depth k and a board b
;;; Returns the optimal moves for the next player, plying k times
(define (optimal-moves~ k b)
(cond
((null? (moves b)) '())
((= k 0) (moves b))
(else (clean-list
(select-best (possible-outcomes (moves b) k b) (player b))))))