Source

ocaml-minigames / mills / ai_montecarlo.ml

Full commit
open Mill

let do_turn state player =
  if can_put state then begin
    let goal = player#put state in
    put state goal;
    try
      if in_mill state goal then capture state (player#capture state)
    with _ -> () (* not capturable *)
  end
  else if can_fly state then begin
    let from, goal = player#fly state in
    fly state from goal;
    try
      if in_mill state goal then capture state (player#capture state)
    with _ -> () (* not capturable *)
  end
  else begin
    let from, goal = player#move state in
    move state from goal;
    try
      if in_mill state goal then capture state (player#capture state)
    with _ -> () (* not  movable or capturable *)
  end

let all_moves state =
  let color = get_color (get_turn state) in
  let moves a = List.map (fun b -> (a, b)) (free_neighbors state a) in
  List.flatten (List.map moves (movables state color))

let all_flies state =
  let color = get_color (get_turn state) in
  let flies a = List.map (fun b -> (a, b)) (free_dots state) in
  List.flatten (List.map flies (movables state color))

let playout state maxturn =
  while not (game_ended state) && (get_turn state) < maxturn do
    do_turn state Ai_random.player;
    end_of_turn state
  done;
  (* too many turns, points = pieces difference *)
  if get_turn state = maxturn then 
    get_count state Black - get_count state White
  (* end of game, bonus if we win *)
  else
    let black_wins = (get_turn state) mod 2 = 0 in
    if black_wins then 10 else -10

let rec estimate state score nplayouts nturns =
  if nplayouts = 0 then score
  else begin
    let maxturn = (get_turn state) + nturns in
    let result = playout (copy state) maxturn in
    estimate state (score + result) (pred nplayouts) nturns
  end

let find_best player state moves move millcheck playouts turns =
  let nplayouts = playouts / List.length moves in
  let better = if (get_turn state) mod 2 = 0 then (<) else (>) in
  let init = if (get_turn state) mod 2 = 0 then max_int else min_int in
  let rec select lst best score = match lst with
    | [] -> best
    | candidate:: rest ->
        let s = (copy state) in
        move s candidate;
        begin
          try
            if millcheck s candidate then capture s (player#capture state)
          with _ -> () (* no possible capture *)
        end;
        end_of_turn s;
        let cscore = (estimate s 0 nplayouts turns) in
        if better cscore score then select rest candidate cscore
        else select rest best score
  in
  select moves (List.hd moves) init

let player = object (self)
  val playouts = 15000
  val maxturns = 50

   method put state =
    let moves = free_dots state in
    find_best self state moves Mill.put in_mill playouts maxturns
  method move state =
    let moves = all_moves state in
    let check state move = in_mill state (snd move) in
    let action state (from, goal) = Mill.move state from goal in
    find_best self state moves action check playouts maxturns
  method fly state =
    let moves = all_flies state in
    let check state move = in_mill state (snd move) in
    let action state (from, goal) = Mill.fly state from goal in
    find_best self state moves action check playouts maxturns
  method capture state =
    let opponent = get_color ((get_turn state) + 1) in
    let moves = capturables state opponent in
    let check state move = false in
    find_best self state moves Mill.capture check (playouts/10) (maxturns/5)
end