(* Game Player Data Types and Functions *)

type piece = X | O | Empty;;

type board = (piece list) list;;

type game = NillGame | Level of (board * game list);;

type status = X_wins | O_wins | Draw | Unfinished;;

exception CannotPlacePiece;;

type move_status = Updated of board | NotAllowed;;

let table = [[Empty;Empty;Empty];[Empty;Empty;Empty];[Empty;Empty;Empty]];;

(* make_move takes a player's piece, the position that they want to put in on and the board *)
(* make_move returns an updated board with that piece in the position if possible, does nothing otherwise *)

let make_move piece (x,y) board =
let rec walk_down i board =
match board with
[]     -> raise CannotPlacePiece
| (h::t) ->
if i=1
then ([],h,t)
else
let (pre,row,rest) = walk_down (i-1) t
in (h::pre,row,rest)   in
let rec walk_acc j row =
match row with
[]     -> raise CannotPlacePiece
| (h::t) ->
if j=1
then
match h with
Empty -> ([],piece,t)
|  _     -> ([],h,t)
else
let (pre,item,rest) = walk_acc (j-1) t
in (h::pre,item,rest)    in
let (prerows,r,postrows) = walk_down x board in
let (pcol,c,postcols) = walk_acc y r in
let newrow = pcol @ (c::postcols) in
let board2 = prerows @ (newrow::postrows)
in 	if board=board2
then NotAllowed
else Updated board2;;



(* gen_moves takes a piece and a board *)
(* It returns a list of boards in which that piece has been placed *)

let gen_moves piece board =
let rec place_cols (i,j) =
if j<=3
then (make_move piece (i,j) board)::(place_cols (i,j+1))
else [] in
let rec place_rows i =
if i<=3
then (place_cols (i,1)) @ (place_rows (i+1))
else [] in
let rec filter_moves bds =
match bds with
[]                 -> []
| ((Updated b)::rst) -> b::(filter_moves rst)
| (NotAllowed::rst)  -> filter_moves rst   in
let boards = place_rows 1
in filter_moves boards;;

type status = X_wins | O_wins | Draw | Unfinished;;

(* is_EmptyPos returns true if there is an Empty position on the board *)

let is_EmptyPos board =
let rec check_row r =
match r with
[]         -> false
| (Empty::t) -> true
| (_::t)     -> check_row t  in
let rec check_rows b =
match b with
[]     -> false
| (h::t) -> (check_row h) || check_rows t
in check_rows board;;

(* is_win takes a piece and a board and returns true if that piece does indeed have three in a row *)

let is_win piece board =
let id x = x in
let add1 x = x+1 in
let sub1 x = x-1 in
let rec check_row r =
match r with
[]      -> true
| (h::t)  -> (h=piece) && check_row t  in
let rec is_row rs =
match rs with
[]      -> false
| (h::t)  -> (check_row h) || is_row t in
let rec test_row pos r =
match (pos,r) with
(p,[])      -> false
| (1,(h::t))  -> (h=piece)
| (n,(h::t))  -> test_row (n-1) t in
let rec is_column pos f b =
match b with
[]      -> true
| (h::t)  -> test_row pos h && is_column (f pos) f t in
let is_col b = (is_column 1 id b) || (is_column 2 id b) || (is_column 3 id b) in
let is_left_diag b = is_column 1 add1 b in
let is_right_diag b = is_column 3 sub1 b in
let is_diag b = is_left_diag b || is_right_diag b
in is_row board || is_col board || is_diag board;;


(* calc_status takes a board and returns the status of the board *)

let calc_status board =
if (is_win X board)
then X_wins
else (if (is_win O board)
then O_wins
else (if (is_EmptyPos board)
then Unfinished
else Draw));;

let completed bd = not ((calc_status bd) = Unfinished);;

let swap_piece p =
match p with
X -> O
| O -> X;;

(* gen_games generates all the games from the current board with piece moving first *)

let rec gen_games piece bd =
if completed bd
then
Level (bd,[])
else
let ms = gen_moves piece bd in
let gs = gen_nextlevel piece ms
in Level (bd,gs)

and gen_nextlevel piece ms =
match ms with
[]      -> []
| (b::bs) ->
let g = gen_games (swap_piece piece) b
in g::(gen_nextlevel piece bs);;

(* gen_limited_games generates all the games to the given depth *)

let rec gen_limited_games piece bd depth =
if (completed bd) || (depth=0)
then
Level (bd,[])
else
let ms = gen_moves piece bd in
let gs = gen_next_limited_level piece ms (depth-1)
in Level (bd,gs)

and gen_next_limited_level piece ms depth =
match ms with
[]      -> []
| (b::bs) ->
let g = gen_limited_games (swap_piece piece) b depth
in g::(gen_next_limited_level piece bs depth);;

let rec help game_list player =
match game_list with
[] -> false
| h::t -> can_win h player || help t player


and can_win game_tree player =
match game_tree with
Level ([],_) -> false
| Level (x,[]) -> (calc_status x = X_wins && player = X) || (calc_status x = O_wins && player = O)
| Level (board,h::t) -> can_win h player || help t player;;

let rec add_to_front v l =
match l with
[] -> []
| h::t -> if h = [] then add_to_front v t else (v::h)::add_to_front v t;;

let rec all_winning_moves_tree tree player =
match tree with
Level(board, []) -> if (can_win (Level (board,[])) player) then [[board]] else [[]]
| Level(board, x) -> add_to_front board (all_winning_moves_list x player)


and all_winning_moves_list game_list player =
match game_list with
[] -> [[]]
| h::t -> (all_winning_moves_tree h player)
@ all_winning_moves_list t player;;

let all_winning_moves board player =
all_winning_moves_tree (gen_games player board) player;;


let rec likely_help winlist player =
match winlist with
[] -> []
| (h::(h1::t1))::t2 ->
if List.length(all_winning_moves h1 player) > List.length(likely_help t2 player)
then h::(h1::t1)
else likely_help t2 player

let likely board player =
List.nth (likely_help (all_winning_moves board player) player) 1;;