- 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 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))

- | Put of int (* index *)

- | Move of int * int (* from, goal *)

- | Fly of int * int (* from, goal *)

- | Capture of int (* optional capture index *)

-let string_of_move = function

- | Put i -> Printf.sprintf "put %d" i

- | Move (f, g) -> Printf.sprintf "move %d %d" f g

- | Fly (f, g) -> Printf.sprintf "fly %d %d" f g

- | Capture i -> Printf.sprintf "capture %d" i

-type node = Node of state * move * node list (* state, move, children *)

-let string_of_node = function

- | Node (_, move, _) -> "Node(_, " ^ (string_of_move move) ^ ", _)"

-let can_capture state move = match move with

- | Put i -> in_mill state i

- | Move (from, goal) -> in_mill state goal

- | Fly (from, goal) -> in_mill state goal

-let rec build state last_move depth =

- build s (Put i) (pred depth)

- let children = List.map aux (free_dots state) in

- Node (state, last_move, children)

- build s (Fly (from, goal)) (pred depth)

- let children = List.map aux (all_flies state) in

- Node (state, last_move, children)

- build s (Move (from, goal)) (pred depth)

- let children = List.map aux (all_moves state) in

- Node (state, last_move, children)

- build s (Capture i) (pred depth)

- let opponent = get_color (succ (get_turn state)) in

- let children = List.map aux (capturables state opponent) in

- Node (state, last_move, children)

- if depth = 0 then Node (state, last_move, [])

- else if can_capture state last_move then build_capture ()

- else if can_put state then build_put ()

- else if can_fly state then build_fly ()

- if depth > 0 then (Printf.printf "+"; indent (pred depth))

- let rec p depth = function

- Node (state, move, list) ->

- Printf.printf "%s\n" (string_of_move move);

- List.iter (p (succ depth)) list

-let rec score heuristic node =

- let scores = List.map (score heuristic) lst in

- List.fold_left max min_int scores

- let scores = List.map (score heuristic) lst in

- List.fold_left min max_int scores

- | Node (s, move, []) -> heuristic s

- | Node (s, move, children) ->

- if (get_turn s) mod 2 = 1 then max_score children

- else min_score children

- let black = (get_count state Black)

- and white = (get_count state White) in

- if can_put state then black - white

- else if black < 3 then min_int

- else if white < 3 then max_int

-let montecarlo playouts state = Ai_montecarlo.estimate state 0 playouts 15

- let find_best state lastmove depth =

- let before = Unix.gettimeofday() in

- let root = build state lastmove depth in

- let after = Unix.gettimeofday() in

- Printf.eprintf "build time %f\n%!" (after -. before);

- let children = match root with Node (_, _, c) -> c in

- let before = Unix.gettimeofday() in

- let scores = List.map (score (montecarlo 5000)) children in

- let after = Unix.gettimeofday() in

- Printf.eprintf "score time %f\n%!" (after -. before);

- let rec select nodes scores selected score =

- Printf.eprintf "select %d\n%!" (List.length nodes);

- if nodes = [] then selected

- let n, s = (List.hd nodes), (List.hd scores) in

- Printf.eprintf "%s %d\n%!" (string_of_node n) s;

- if s > score then select (List.tl nodes) (List.tl scores) n s

- else select (List.tl nodes) (List.tl scores) selected score

- select children scores (Node (state, lastmove, [])) min_int in

- val mutable last_move = Init

- let selected = find_best state Init 1 in

- | Node(_, Put i, _) -> last_move <- Put i ; i

- | _ -> failwith "no put found"

- let selected = find_best state Init 3 in

- | Node(_, Move (f, g), _) -> last_move <- Move (f, g) ; f, g

- | _ -> failwith "no move found"

- let selected = find_best state Init 1 in

- | Node(_, Fly (f, g), _) -> last_move <- Fly (f, g) ; f, g

- | _ -> failwith "no fly found"

- let selected = find_best state last_move 2 in

- | Node(_, Capture i, _) -> last_move <- Capture i ; i

- | _ -> failwith "no capture found"

+ 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 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))

+ | Put of int (* index *)

+ | Move of int * int (* from, goal *)

+ | Fly of int * int (* from, goal *)

+ | Capture of int (* optional capture index *)

+let string_of_move = function

+ | Put i -> Printf.sprintf "put %d" i

+ | Move (f, g) -> Printf.sprintf "move %d %d" f g

+ | Fly (f, g) -> Printf.sprintf "fly %d %d" f g

+ | Capture i -> Printf.sprintf "capture %d" i

+type node = Node of state * move * node list (* state, move, children *)

+let string_of_node = function

+ | Node (_, move, _) -> "Node(_, " ^ (string_of_move move) ^ ", _)"

+let can_capture state move = match move with

+ | Put i -> in_mill state i

+ | Move (from, goal) -> in_mill state goal

+ | Fly (from, goal) -> in_mill state goal

+let rec build state last_move depth =

+ build s (Put i) (pred depth)

+ let children = List.map aux (free_dots state) in

+ Node (state, last_move, children)

+ build s (Fly (from, goal)) (pred depth)

+ let children = List.map aux (all_flies state) in

+ Node (state, last_move, children)

+ build s (Move (from, goal)) (pred depth)

+ let children = List.map aux (all_moves state) in

+ Node (state, last_move, children)

+ build s (Capture i) (pred depth)

+ let opponent = get_color (succ (get_turn state)) in

+ let children = List.map aux (capturables state opponent) in

+ Node (state, last_move, children)

+ if can_capture state last_move then build_capture ()

+ else if depth <= 0 then Node (state, last_move, [])

+ else if can_put state then build_put ()

+ else if can_fly state then build_fly ()

+ if depth > 0 then (Printf.printf "+"; indent (pred depth))

+ let rec p depth = function

+ Node (state, move, list) ->

+ Printf.printf "%s\n" (string_of_move move);

+ List.iter (p (succ depth)) list

+let count_positions node =

+ let rec count node = match node with

+ | Node (_, _, children) ->

+ let counts = List.map count children in

+ List.fold_left (+) 0 counts

+let rec score heuristic node =

+ let scores = List.map (score heuristic) lst in

+ List.fold_left max min_int scores

+ let scores = List.map (score heuristic) lst in

+ List.fold_left min max_int scores

+ | Node (s, move, []) -> heuristic s

+ | Node (s, move, children) ->

+ if (get_turn s) mod 2 = 1 then max_score children

+ else min_score children

+let estimate_basic state =

+ let black = (get_count state Black)

+ and white = (get_count state White) in

+let estimate_mc playouts state = Ai_montecarlo.estimate state 0 playouts 50

+let estimate_hybrid playouts state =

+ let e = estimate_basic state in

+ (max 100 playouts) * e + estimate_mc playouts state

+ let find_best state lastmove depth playouts =

+ Printf.eprintf "find best: \n%s%!" (to_string state);

+ let before = Unix.gettimeofday() in

+ let root = build state lastmove depth in

+ let positions = count_positions root in

+ let nplayouts = playouts/positions in

+ let after = Unix.gettimeofday() in

+ Printf.eprintf "build time %f, %d positions, %d playouts/position\n%!"

+ (after -. before) positions nplayouts;

+ let children = match root with Node (_, _, c) -> c in

+ let before = Unix.gettimeofday() in

+ let scores = List.map (score (estimate_hybrid nplayouts)) children in

+ let after = Unix.gettimeofday() in

+ Printf.eprintf "score time %f\n%!" (after -. before);

+ let rec select nodes scores selected score =

+ if nodes = [] then selected

+ let n, s = (List.hd nodes), (List.hd scores) in

+ if s > score then select (List.tl nodes) (List.tl scores) n s

+ else select (List.tl nodes) (List.tl scores) selected score

+ select children scores (Node (state, lastmove, [])) min_int

+ val mutable last_move = Init

+ let selected = find_best state Init 2 15000 in

+ | Node(_, Put i, _) -> last_move <- Put i ; i

+ | _ -> failwith "no put found"

+ let selected = find_best state Init 4 30000 in

+ | Node(_, Move (f, g), _) -> last_move <- Move (f, g) ; f, g

+ | _ -> failwith "no move found"

+ let selected = find_best state Init 3 30000 in

+ | Node(_, Fly (f, g), _) -> last_move <- Fly (f, g) ; f, g

+ | _ -> failwith "no fly found"

+ end_of_turn state; (* unrolled later *)

+ let selected = find_best state last_move 2 10000 in

+ | Node(_, Capture i, _) -> last_move <- Capture i ; i

+ | _ -> failwith "no capture found"