[Toss-devel-svn] SF.net SVN: toss:[1389] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1389] trunk/Toss
|
From: <luk...@us...> - 2011-03-25 00:23:12
|
Revision: 1389
http://toss.svn.sourceforge.net/toss/?rev=1389&view=rev
Author: lukaszkaiser
Date: 2011-03-25 00:23:06 +0000 (Fri, 25 Mar 2011)
Log Message:
-----------
Better timeout resolution in GameTree.
Modified Paths:
--------------
trunk/Toss/Play/GameTree.ml
trunk/Toss/Play/GameTree.mli
trunk/Toss/Play/Play.ml
trunk/Toss/Server/Server.ml
Modified: trunk/Toss/Play/GameTree.ml
===================================================================
--- trunk/Toss/Play/GameTree.ml 2011-03-24 21:21:42 UTC (rev 1388)
+++ trunk/Toss/Play/GameTree.ml 2011-03-25 00:23:06 UTC (rev 1389)
@@ -58,26 +58,29 @@
(* Abstract game tree unfolding function, calls argument functions for work. *)
-let rec unfold_abstract ?(depth=0) game
+let rec unfold_abstract ?(timeout=fun () -> false) ?(depth=0) game
~info_terminal ~info_leaf ~info_node ~choice = function
| Terminal _ -> raise Not_found
| Leaf (state, player, info) ->
+ if timeout() then raise Not_found;
let moves = Move.list_moves game state in
- if moves = [||] then
+ if moves = [||] then (
Terminal (state, player, info_terminal depth game state player info)
- else
+ ) else
let leaf_of_move leaf_s =
+ if timeout() then raise Not_found;
let l_pl = game.Arena.graph.(leaf_s.Arena.cur_loc).Arena.player in
let l_info = info_leaf (depth+1) game leaf_s l_pl player in
Leaf (leaf_s, l_pl, l_info) in
let children = Array.map (fun (m, s) -> (m, leaf_of_move s)) moves in
Node (state, player,info_node depth game state player children,children)
| Node (state, player, info, children) ->
+ if timeout() then raise Not_found;
let n = choice depth game state player info children in
let (move, child) = children.(n) in
- let child_unfolded = unfold_abstract ~depth:(depth+1) game
- ~info_terminal:info_terminal ~info_leaf:info_leaf ~info_node:info_node
- ~choice:choice child in
+ let child_unfolded = unfold_abstract ~timeout:timeout ~depth:(depth+1)
+ game ~info_terminal:info_terminal ~info_leaf:info_leaf
+ ~info_node:info_node ~choice:choice child in
children.(n) <- (move, child_unfolded);
Node (state, player, info_node depth game state player children, children)
@@ -191,9 +194,10 @@
choice depth game state player info children
(* Main unfolding function. *)
-let unfold ?(ab=false) game heur ~info_leaf ~info_node ~choice =
+let unfold ?(timeout=fun () -> false) ?(ab=false) game heur
+ ~info_leaf ~info_node ~choice =
let (last_vals, stop_vals) = (ref None, ref None) in
- unfold_abstract game
+ unfold_abstract ~timeout:timeout game
~info_terminal:(info_terminal_f info_leaf)
~info_leaf:(info_leaf_f ab last_vals stop_vals info_leaf heur)
~info_node:(info_node_f info_node)
@@ -218,16 +222,17 @@
let move_s (m, n) = Move.move_gs_str_short (state n) m in
if !debug_level > 0 then print_endline
("\nBest Moves: " ^ (String.concat ", " (List.map move_s maxs)));
- if List.exists (fun x -> nonleaf (snd x)) maxs then
+ if List.exists (fun x -> nonleaf (snd x)) maxs then (
let (m, t) = Aux.random_elem maxs in (m, state t)
- else ( (* Do *not* take a shallow leaf if possible. *)
+ ) else ( (* Do *not* take a shallow leaf if possible. *)
let nonleaves = Aux.array_find_all (fun (_,c) -> nonleaf c) succ in
- if nonleaves = [] then
+ if nonleaves = [] then (
let (m, t) = Aux.random_elem maxs in (m, state t)
- else
+ ) else (
let upd_max mv (_, c) = max mv (node_values c).(p) in
let sx = (node_values (snd (List.hd nonleaves))).(p) in
let mx = List.fold_left upd_max sx nonleaves in
let mxs = List.filter (fun (_,c) -> (node_values c).(p)=mx) nonleaves in
let (m, t) = Aux.random_elem mxs in (m, state t)
+ )
)
Modified: trunk/Toss/Play/GameTree.mli
===================================================================
--- trunk/Toss/Play/GameTree.mli 2011-03-24 21:21:42 UTC (rev 1388)
+++ trunk/Toss/Play/GameTree.mli 2011-03-25 00:23:06 UTC (rev 1389)
@@ -33,7 +33,7 @@
('a, 'b) abstract_game_tree
(** Abstract game tree unfolding function, calls argument functions for work. *)
-val unfold_abstract : ?depth:int -> Arena.game ->
+val unfold_abstract : ?timeout : (unit -> bool) -> ?depth : int -> Arena.game ->
info_terminal : (int -> Arena.game -> Arena.game_state -> int -> 'a -> 'b) ->
info_leaf : (int -> Arena.game -> Arena.game_state -> int -> int -> 'a) ->
info_node : (int -> Arena.game -> Arena.game_state -> int ->
@@ -85,7 +85,8 @@
Formula.real_expr array array -> 'a game_tree
(** Game tree unfolding. *)
-val unfold : ?ab:bool -> Arena.game -> Formula.real_expr array array ->
+val unfold : ?timeout : (unit -> bool) -> ?ab:bool -> Arena.game ->
+ Formula.real_expr array array ->
info_leaf : (int -> Arena.game -> Arena.game_state -> 'a) ->
info_node : (int -> int -> float array ->
(Move.move * 'a game_tree) array -> 'a) ->
Modified: trunk/Toss/Play/Play.ml
===================================================================
--- trunk/Toss/Play/Play.ml 2011-03-24 21:21:42 UTC (rev 1388)
+++ trunk/Toss/Play/Play.ml 2011-03-25 00:23:06 UTC (rev 1389)
@@ -6,9 +6,9 @@
let set_debug_level i = debug_level := i
let timeout = ref 0.
-let set_timeout t = timeout := Unix.time() +. t
+let set_timeout t = timeout := Unix.gettimeofday() +. t
let cancel_timeout () = timeout := 0.
-let timed_out () = !timeout > 1. && Unix.time() > !timeout
+let timed_out () = !timeout > 1. && Unix.gettimeofday() +. 0.01 > !timeout
(* ------------ MAXIMAX BY DEPTH ------------- *)
@@ -42,7 +42,7 @@
(* Maximax by depth unfolding function. Throws Not_found if ready. *)
let unfold_maximax ?(ab=false) game heur =
- unfold ~ab:ab game heur ~info_leaf:(fun _ _ _ -> 0)
+ unfold ~timeout:timed_out ~ab:ab game heur ~info_leaf:(fun _ _ _ -> 0)
~info_node:(maxdepth_node) ~choice:(maximax_depth_choice ab)
(* Maximax unfolding upto depth. *)
@@ -51,11 +51,12 @@
if !debug_level > 1 && timed_out() then
print_endline "Timeout";
t
- ) else
+ ) else
try
- let u = unfold_maximax ~ab:ab game heur t in
- if !debug_level > 0 then Printf.printf "%d,%!" (size u);
- unfold_maximax_upto ~ab:ab (count-1) game heur u
+ if timed_out() then t else
+ let u = unfold_maximax ~ab:ab game heur t in
+ if !debug_level > 0 then Printf.printf "%d,%!" (size u);
+ unfold_maximax_upto ~ab:ab (count-1) game heur u
with Not_found -> t
(* Maximax unfold upto depth and choose move. *)
@@ -64,5 +65,7 @@
if !debug_level > 0 then Printf.printf "Using Alpha-Beta: %B\n%!" ab;
let t = init game state (fun _ _ _ -> 0) heur in
let u = unfold_maximax_upto ~ab count game heur t in
+ if !debug_level > 0 then Printf.printf "Timeout %f%!"
+ (Unix.gettimeofday() -. !timeout);
if !debug_level > 1 then print_endline (str string_of_int u);
choose_move game u
Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml 2011-03-24 21:21:42 UTC (rev 1388)
+++ trunk/Toss/Server/Server.ml 2011-03-25 00:23:06 UTC (rev 1389)
@@ -56,9 +56,9 @@
Unix.setsockopt sock Unix.SO_REUSEADDR true;
Unix.bind sock (Unix.ADDR_INET (get_inet_addr (addr_s), port));
Unix.listen sock 99; (* maximally 99 pending requests *)
- let timeout = ref (Unix.time () +. float (!dtimeout)) in
- while !dtimeout < 0 || Unix.time () < !timeout do
- timeout := Unix.time () +. float (!dtimeout);
+ let timeout = ref (Unix.gettimeofday () +. float (!dtimeout)) in
+ while !dtimeout < 0 || Unix.gettimeofday () < !timeout do
+ timeout := Unix.gettimeofday () +. float (!dtimeout);
let (cl_sock, _) = Unix.accept sock in
f (Unix.in_channel_of_descr cl_sock) (Unix.out_channel_of_descr cl_sock);
Unix.close cl_sock;
@@ -401,7 +401,7 @@
play, play_state
| _ -> assert false in
ignore (Unix.alarm (!playclock - (int_of_float time_used) - 1));
- Play.set_timeout (float(!playclock) -. time_used -. 1.5);
+ Play.set_timeout (float(!playclock) -. time_used -. 0.02);
if !no_gtree then
let res = Game.suggest p ps in
Game.cancel_timeout ();
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
