Commits

Anonymous committed 77426c9

more work on minmax, not yet playable (bug in capture ?)

Comments (0)

Files changed (2)

mills/ai_alphabeta.ml

+open Mill
+
+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))
+
+type move = 
+  | Init 
+  | 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
+    | Init -> "init move"
+      
+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
+  | Capture _ -> false
+  | Init -> false
+
+let rec build state last_move depth =
+  let build_put () =
+    let aux i = 
+      let s = copy state in
+      put s i;
+      end_of_turn s;
+      build s (Put i) (pred depth)
+    in
+    let children = List.map aux (free_dots state) in
+    Node (state, last_move, children)   
+  in
+  let build_fly () = 
+    let aux (from, goal) = 
+      let s = copy state in
+      fly s from goal;
+      end_of_turn s;
+      build s (Fly (from, goal)) (pred depth)
+    in
+    let children = List.map aux (all_flies state) in
+    Node (state, last_move, children)   
+  in    
+  let build_move () =
+    let aux (from, goal) = 
+      let s = copy state in
+      move s from goal;
+      end_of_turn s;
+      build s (Move (from, goal)) (pred depth)
+    in
+    let children = List.map aux (all_moves state) in
+    Node (state, last_move, children)   
+  in      
+  let build_capture () = 
+    let aux i = 
+      let s = copy state in
+      end_of_turn s;
+      capture s i;
+      end_of_turn s;
+      build s (Capture i) (pred depth)
+    in
+    let opponent = get_color (succ (get_turn state)) in
+    let children = List.map aux (capturables state opponent) in
+    Node (state, last_move, children)       
+  in
+  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 ()
+  else build_move ()
+  
+let print_tree root =
+  let rec indent depth = 
+    if depth > 0 then (Printf.printf "+"; indent (pred depth))
+  in  
+  let rec p depth = function
+    Node (state, move, list) -> 
+      indent depth;
+      Printf.printf "%s\n" (string_of_move move);
+      List.iter (p (succ depth)) list
+  in
+  p 0 root
+  
+let rec score heuristic node = 
+  let max_score lst = 
+    let scores = List.map (score heuristic) lst in
+    List.fold_left max min_int scores
+  in
+  let min_score lst = 
+    let scores = List.map (score heuristic) lst in
+    List.fold_left min max_int scores
+  in    
+  match node with
+  | 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 state =  
+  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
+  else black - white
+
+let montecarlo playouts state = Ai_montecarlo.estimate state 0 playouts 15
+
+let player =
+  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);
+      print_tree root;
+      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
+        else 
+          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
+      in
+      select children scores (Node (state, lastmove, [])) min_int in  
+  
+  object (self)
+    val mutable last_move = Init
+  
+    method put state = 
+      let selected = find_best state Init 1 in
+      match selected with 
+        | Node(_, Put i, _) -> last_move <- Put i ; i  
+        | _ -> failwith "no put found"        
+    method move state =
+      let selected = find_best state Init 3 in
+      match selected with 
+        | Node(_, Move (f, g), _) -> last_move <- Move (f, g) ; f, g  
+        | _ -> failwith "no move found"        
+    method fly state =
+      let selected = find_best state Init 1 in
+      match selected with 
+        | Node(_, Fly (f, g), _) -> last_move <- Fly (f, g) ; f, g  
+        | _ -> failwith "no fly found"       
+    method capture state =
+      let selected = find_best state last_move 2 in
+      match selected with 
+        | Node(_, Capture i, _) -> last_move <- Capture i ; i  
+        | _ -> failwith "no capture found"      
+  end

mills/ai_aplhabeta.ml

-open Mill
-
-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 estimate state =  
-  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
-  else black - white
-
-type move = 
-  | Init 
-  | 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
-    | Init -> "init move"
-      
-type ab_node = 
-  | Root of state * ab_node list (* state, children *)
-  | Node of state * move * ab_node list (* state, move, children *)
-  | Leaf of state
-
-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
-  | Capture _ -> false
-  | Init -> false
-
-let rec build state last_move depth =
-  Printf.printf "build %s %d\n%!" (string_of_move last_move) depth;
-  let build_put () =
-    let aux i = 
-      let s = copy state in
-      put s i;
-      end_of_turn s;
-      build s (Put i) (pred depth)
-    in
-    let children = List.map aux (free_dots state) in
-    Node (state, last_move, children)   
-  in
-  let build_fly () = 
-    let aux (from, goal) = 
-      let s = copy state in
-      fly s from goal;
-      end_of_turn s;
-      build s (Fly (from, goal)) (pred depth)
-    in
-    let children = List.map aux (all_flies state) in
-    Node (state, last_move, children)   
-  in    
-  let build_move () =
-    let aux (from, goal) = 
-      let s = copy state in
-      move s from goal;
-      end_of_turn s;
-      build s (Move (from, goal)) (pred depth)
-    in
-    let children = List.map aux (all_moves state) in
-    Node (state, last_move, children)   
-  in      
-  let build_capture () = 
-    let aux i = 
-      let s = copy state in
-      end_of_turn s;
-      capture s i;
-      end_of_turn s;
-      build s (Capture i) (pred depth)
-    in
-    let color = get_color (get_turn state) in
-    let children = List.map aux (capturables state color) in
-    Node (state, last_move, children)       
-  in
-  if depth = 0 then Leaf state
-  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 ()
-  else build_move ()
-  
-let build_tree state depth = build state Init depth
-
-let print_tree root =
-  let rec indent depth = 
-    if depth > 0 then (Printf.printf "+"; indent (pred depth))
-  in  
-  let rec p depth = function
-    | Leaf _ -> ()
-    | Root (state, list) ->
-      Printf.printf "root\n";
-      List.iter (p (succ depth)) list
-    | Node (state, move, list) -> 
-      indent depth;
-      Printf.printf "%s\n" (string_of_move move);
-      List.iter (p (succ depth)) list
-  in
-  p 0 root
-  
-let test () = 
-  let tree = build_tree (make()) 4 in
-  print_tree tree      
-
-(*
-let select node alpha beta = 
-  let state = match node with
-    | Leaf s -> s 
-    | Root (s, _) -> s
-    | Node (s, _, _) -> s
-  in
-  let children = match node with
-    | Root (_, c) -> c
-    | Node (_, _, c)  -> c
-    | _ -> []
-  in
-  let leaf = function Leaf _ -> true | _  -> false in
-  let max (a, score_a) (b, score_b) = 
-    if score_a > score_b then (a, score_a)
-    else (b, score_b)
-  and min (a, score_a) (b, score_b) =
-    if score_a < score_b then (a, score_a)
-    else (b, score_b)
-  in
-  if leaf node then node, (estimate state)    
-  else if (get_turn state) mod 2 = 1 then
-    let alpha = ref alpha in    
-    for i = 0 to (List.length children) -1 do
-      alpha := max(!alpha, 
-    done
-*)
-  (*
-function alphabeta(node, depth, alpha, beta, Player)         
-    if  depth = 0 or node is a terminal node
-        return the heuristic value of node
-    if  Player = MaxPlayer
-        for each child of node
-            alpha := max(alpha, alphabeta(child, depth-1, alpha, beta, not(Player) ))     
-            if beta <= alpha
-                break                             (* Beta cut-off *)
-        return alpha
-    else
-        for each child of node
-            beta := min(beta, alphabeta(child, depth-1, alpha, beta, not(Player) ))     
-            if beta <= alpha
-                break                             (* Alpha cut-off *)
-        return beta 
-(* Initial call *)
-alphabeta(origin, depth, -infinity, +infinity, MaxPlayer)
-*)