tiktacktoe.ml

(* ---------- Generic Game setup  ---------- *)

module IntSet = Set.Make(Int)

type player = Even | Odd

type 'node game = {
  start : 'node;
  turn  : 'node -> player;          (* who moves at this node *)
  moves : 'node -> int list;         (* available actions ("char") *)
  trans : 'node -> int -> 'node;     (* transition *)
  win   : 'node -> bool;             (* winning condition *)
}

type 'node strategy = 'node -> int   (* choose action from a node *)

(* Simulate a game under a given strategy, returning the trace of nodes visited. *)

let simulate ?(max_steps=100) (g : 'n game) (sigma : 'n strategy) : 'n list =
  let rec loop acc n steps =
    if steps >= max_steps || g.win n || g.moves n = [] then List.rev acc
    else
      let a = sigma n in
      let n' = g.trans n a in
      loop (n' :: acc) n' (steps + 1)
  in
  loop [g.start] g.start 0

let simulate_safety ?(max_steps=100) (g : 'n game) (sigma : 'n strategy) (safe : 'n -> bool)
  : ('n list * [ `Safe | `Left_safe_set of 'n ]) =
  let rec loop acc n steps =
    if not (safe n) then (List.rev acc, `Left_safe_set n)
    else if steps >= max_steps || g.moves n = [] then (List.rev acc, `Safe)
    else
      let a = sigma n in
      let n' = g.trans n a in
      loop (n' :: acc) n' (steps + 1)
  in
  loop [g.start] g.start 0

let player_of_step i = if i mod 2 = 0 then Even else Odd

(* ---------- Tic-tac-toe-ish instance ---------- *)

type mark = E | X | O

type ttt = {
  board : mark array;      (* length 9 *)
  next  : player;          (* Even plays X, Odd plays O *)
  over  : bool;
  winner : player option;  (* None if no winner yet / draw *)
  illegal_sink : bool;     (* illegal move, game terminates and player who made move loses *)
}

let empty_state () =
  { board = Array.make 9 E; next = Even; over = false; winner = None; illegal_sink = false }

let lines =
  [|
    [|0;1;2|]; [|3;4;5|]; [|6;7;8|];
    [|0;3;6|]; [|1;4;7|]; [|2;5;8|];
    [|0;4;8|]; [|2;4;6|];
  |]

let mark_of_player = function Even -> X | Odd -> O

let other_player = function Even -> Odd | Odd -> Even

let has_three (b:mark array) (m:mark) =
  Array.exists (fun ln ->
    let a = b.(ln.(0)) and c = b.(ln.(1)) and d = b.(ln.(2)) in
    a = m && c = m && d = m
  ) lines

let board_full (b:mark array) =
  let full = ref true in
  for i = 0 to 8 do
    if b.(i) = E then full := false
  done;
  !full

let legal_moves (s:ttt) =
  if s.over || s.illegal_sink then []
  else
    let ms = ref [] in
    for i = 0 to 8 do
      if s.board.(i) = E then ms := i :: !ms
    done;
    List.rev !ms

let apply_move (s:ttt) (cell:int) : ttt =
  if s.over || s.illegal_sink then s
  else if cell < 0 || cell > 8 || s.board.(cell) <> E then
    { s with illegal_sink = true; over = true; winner = Some (other_player s.next) }
  else
    let b' = Array.copy s.board in
    b'.(cell) <- mark_of_player s.next;

    let x_wins = has_three b' X in
    let o_wins = has_three b' O in
    let over' = x_wins || o_wins || board_full b' in
    let winner' =
      if x_wins then Some Even
      else if o_wins then Some Odd
      else None
    in
    { board = b'; next = other_player s.next; over = over'; winner = winner';
      illegal_sink = false }

let ttt_game : ttt game =
  {
    start = empty_state ();
    turn = (fun s -> s.next);
    moves = legal_moves;
    trans = apply_move;
    win =
      (fun s ->
        match s.winner with
        | Some Even -> true          (* Even (X) wins *)
        | _ -> false);
  }

(* Example strategies *)

let first_legal_strategy (g:'n game) : 'n strategy =
  fun n ->
    match g.moves n with
    | a :: _ -> a
    | [] -> 0

let center_if_possible (g:ttt game) : ttt strategy =
  fun s ->
    let ms = g.moves s in
    if List.mem 4 ms then 4
    else match ms with a::_ -> a | [] -> 0
    
let safe_no_illegal (s:ttt) = not s.illegal_sink

(* Print out the output trace *)

let string_of_mark = function E -> "." | X -> "X" | O -> "O"

let print_state (s:ttt) =
  let b = s.board in
  let row i =
    Printf.printf "%s %s %s\n"
      (string_of_mark b.(i))
      (string_of_mark b.(i+1))
      (string_of_mark b.(i+2))
  in
  row 0; row 3; row 6;
  (match s.winner with
   | None -> if s.over then Printf.printf "Result: draw/over\n" else ()
   | Some Even -> Printf.printf "Winner: Even (X)\n"
   | Some Odd  -> Printf.printf "Winner: Odd (O)\n");
  if s.illegal_sink then Printf.printf "Player made illegal move. Game is over.\n";
  Printf.printf "Next: %s\n\n" (match s.next with Even -> "Even" | Odd -> "Odd")

let () =
  let sigma = center_if_possible ttt_game in
  let (trace, status) = simulate_safety ~max_steps:20 ttt_game sigma safe_no_illegal in
  List.iter print_state trace;
  match status with
  | `Safe -> Printf.printf "Player stayed safe for max_steps.\n"
  | `Left_safe_set _ -> Printf.printf "Left safety set.\n"