[Toss-devel-svn] SF.net SVN: toss:[1393] trunk/Toss

[<luk...@us...>]

Revision: 1393
          http://toss.svn.sourceforge.net/toss/?rev=1393&view=rev
Author:   lukaszkaiser
Date:     2011-03-25 22:24:30 +0000 (Fri, 25 Mar 2011)

Log Message:
-----------
GameTree corrections and better loging, more exact timers in Server.

Modified Paths:
--------------
    trunk/Toss/Play/GameTree.ml
    trunk/Toss/Play/GameTree.mli
    trunk/Toss/Play/Play.ml
    trunk/Toss/Server/Server.ml
    trunk/Toss/examples/Gomoku.toss
    trunk/Toss/examples/Tic-Tac-Toe.toss

Modified: trunk/Toss/Play/GameTree.ml
===================================================================
--- trunk/Toss/Play/GameTree.ml	2011-03-25 20:12:20 UTC (rev 1392)
+++ trunk/Toss/Play/GameTree.ml	2011-03-25 22:24:30 UTC (rev 1393)
@@ -13,23 +13,26 @@
         (* node with state, player, moves and info *)
 
 (* Abstract tree printing function. *)
-let rec str_abstract ?(depth=0) str_info str_info_terminal tree =
+let rec str_abstract ?(upto=100000000) ?(struc=true) ?(depth=0) 
+    str_info str_info_terminal tree =
   let s msg state player info_s = 
-    let struc_s = Structure.str state.Arena.struc in
+    let struc_s = if struc then Structure.str state.Arena.struc else "" in
     let head_s = Printf.sprintf "Player %d loc %d time %.1f.\n" 
       player state.Arena.cur_loc state.Arena.time in
     let res = "\n" ^ msg ^ head_s ^ struc_s ^ "\n" ^ info_s in
     let prefix = if depth=0 then "" else (String.make depth '|') ^ " " in
     Str.global_replace (Str.regexp "\n") ("\n" ^ prefix) res in
-  match tree with
-    | Terminal (state, player, info) ->
-      s "Terminal. " state player (str_info_terminal info)
-    | Leaf (state, player, info) -> s "Leaf. " state player (str_info info)
-    | Node (state, player, info, children) ->
-      let next_str (_, t) =
-	str_abstract ~depth:(depth+1) str_info str_info_terminal t in
-      let child_s = Array.to_list (Array.map next_str children) in
-      String.concat "" ((s "Node. " state player (str_info info)) :: child_s)
+  if upto < 0 then " Cut;" else
+    match tree with
+      | Terminal (state, player, info) ->
+	s "Terminal. " state player (str_info_terminal info)
+      | Leaf (state, player, info) -> s "Leaf. " state player (str_info info)
+      | Node (state, player, info, children) ->
+	let next_str (_, t) =
+	  str_abstract ~upto:(upto-1) ~struc:struc ~depth:(depth+1)
+	    str_info str_info_terminal t in
+	let child_s = Array.to_list (Array.map next_str children) in
+	String.concat "" ((s "Node. " state player (str_info info)) :: child_s)
 
 (* Number of nodes in the tree. *)
 let rec size = function
@@ -88,7 +91,7 @@
 
 (* -------------- TREES WITH PAYOFF AND HEURISTIC DATA --------------- *)
 
-let cPAYOFF_AS_HEUR = ref 1000.
+let cPAYOFF_AS_HEUR = ref 10000.
 
 (* The general information in a game tree node. *)
 type 'a node_info = {
@@ -107,18 +110,18 @@
 
 
 (* Game tree printing function. *)
-let str f ?(depth=0) tree =
+let str f ?(upto=100000000) ?(struc=true) ?(depth=0) tree =
   let fas a = String.concat "; " (List.map string_of_float (Array.to_list a)) in
   let str_terminal i = "Payoffs: " ^ (fas i.payoffs) ^ 
     " heurs: " ^ (fas i.heurs_t) ^ " info: " ^ (f i.info_t) in
   let str_node i = "Heurs: " ^ (fas i.heurs) ^ " exact: " ^ 
     (string_of_bool i.heurs_are_exact) ^ " info: " ^ (f i.info) in
-  str_abstract ~depth:depth str_node str_terminal tree
+  str_abstract ~upto:upto ~struc:struc ~depth:depth str_node str_terminal tree
 
 (* Get the payoffs / heuristics array of a game tree node. *)
 let node_values = function
-  | Terminal (_, _, i) -> 
-    Array.mapi (fun k p -> !cPAYOFF_AS_HEUR *. p +. i.heurs_t.(k)) i.payoffs
+  | Terminal (_, _, i) -> Array.mapi 
+    (fun k p -> !cPAYOFF_AS_HEUR *. p +. 0.001 *. i.heurs_t.(k)) i.payoffs
   | Leaf (_, _, i) -> i.heurs
   | Node (_, _, i, _) -> i.heurs
 

Modified: trunk/Toss/Play/GameTree.mli
===================================================================
--- trunk/Toss/Play/GameTree.mli	2011-03-25 20:12:20 UTC (rev 1392)
+++ trunk/Toss/Play/GameTree.mli	2011-03-25 22:24:30 UTC (rev 1393)
@@ -14,8 +14,8 @@
         (** node with state, player, moves *)
 
 (** Abstract tree printing function. *)
-val str_abstract : ?depth:int -> ('a -> string) -> ('b -> string) ->
-  ('a, 'b) abstract_game_tree -> string
+val str_abstract : ?upto:int -> ?struc:bool -> ?depth:int -> ('a -> string) ->
+  ('b -> string) -> ('a, 'b) abstract_game_tree -> string
 
 (** Number of nodes in the tree. *)
 val size : ('a, 'b) abstract_game_tree -> int
@@ -66,7 +66,8 @@
 
 
 (** Game tree printing function. *)
-val str : ('a -> string) -> ?depth:int -> 'a game_tree -> string
+val str : ('a -> string) -> ?upto:int -> ?struc:bool -> ?depth:int ->
+  'a game_tree -> string
 
 (** The values of a game tree node. *)
 val node_values : 'a game_tree -> float array

Modified: trunk/Toss/Play/Play.ml
===================================================================
--- trunk/Toss/Play/Play.ml	2011-03-25 20:12:20 UTC (rev 1392)
+++ trunk/Toss/Play/Play.ml	2011-03-25 22:24:30 UTC (rev 1393)
@@ -19,15 +19,9 @@
 
 let maximax_depth_choice ab stop_vals dp game cur_state player info children =
   let mval child = (node_values (snd child)).(player), node_info (snd child) in
-  let cmp_raw c1 c2 = 
+  let cmp c1 c2 = 
     let (v1, d1), (v2, d2) = mval c1, mval c2 in
     if v1 > v2 then 1 else if v2 > v1 then -1 else d1 - d2 in
-  let cmp c1 c2 = 
-    match snd c1, snd c2 with 
-      | Terminal _, Terminal _ -> cmp_raw c1 c2
-      | Terminal _, _ -> -1
-      | _, Terminal _ -> 1
-      | _, _ -> cmp_raw c1 c2 in
   let res = Aux.random_elem (Aux.array_argfind_all_max cmp children) in
   if !debug_level > 2 then
     print_endline (Structure.str (state (snd children.(res))).Arena.struc);
@@ -75,5 +69,6 @@
   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 > 2 then print_endline (str string_of_int u);
+  if !debug_level > 1 then 
+    print_endline (str ~upto:1 ~struc:false string_of_int u);
   choose_move game u

Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml	2011-03-25 20:12:20 UTC (rev 1392)
+++ trunk/Toss/Server/Server.ml	2011-03-25 22:24:30 UTC (rev 1393)
@@ -163,7 +163,7 @@
 
 let req_handle in_ch out_ch =
   try
-    let time_started = Sys.time () in
+    let time_started = Unix.gettimeofday () in
     let line = read_in_line in_ch in
     let req = req_of_str line in
     let resp =
@@ -396,14 +396,14 @@
           else
             let mov_msg =
               if GDL.our_turn !gdl_transl !state then (
-                let time_used = time_started -. Sys.time () in
+                let time_used = time_started -. Unix.gettimeofday () in
                 let p, ps =
                   match !play, !play_state with
                     | Some play, Some play_state ->
                       play, play_state
                     | _ -> assert false in
                 ignore (Unix.alarm (!playclock - (int_of_float time_used) - 1));
-		Play.set_timeout (float(!playclock) -. time_used -. 0.02);
+		Play.set_timeout (float(!playclock) -. time_used -. 0.03);
 		if !no_gtree then
                   let res = Game.suggest p ps in
                   Game.cancel_timeout ();
@@ -431,7 +431,7 @@
             ^ string_of_int msg_len ^ "\r\n\r\n" ^ mov_msg
     in
     if !debug_level > 0 then (
-      Printf.printf "Resp-time: %F\n%!" (Sys.time () -. time_started);
+      Printf.printf "Resp-time: %F\n%!" (Unix.gettimeofday() -. time_started);
       print_endline ("\nRepl: " ^ resp ^ "\n");
     );      
     output_string out_ch (resp ^ "\n");

Modified: trunk/Toss/examples/Gomoku.toss
===================================================================
--- trunk/Toss/examples/Gomoku.toss	2011-03-25 20:12:20 UTC (rev 1392)
+++ trunk/Toss/examples/Gomoku.toss	2011-03-25 22:24:30 UTC (rev 1393)
@@ -1,5 +1,5 @@
 PLAYERS 1, 2
-DATA r1: circle, r2: line, adv_ratio: 4, depth: 2
+DATA r1: circle, r2: line, adv_ratio: 5, depth: 2
 REL Row5 (x, y, z, v, w) = R(x, y) and R(y, z) and R(z, v) and R(v, w)
 REL Col5 (x, y, z, v, w) = C(x, y) and C(y, z) and C(z, v) and C(v, w)
 REL DiagA5 (x, y, z, v, w) =

Modified: trunk/Toss/examples/Tic-Tac-Toe.toss
===================================================================
--- trunk/Toss/examples/Tic-Tac-Toe.toss	2011-03-25 20:12:20 UTC (rev 1392)
+++ trunk/Toss/examples/Tic-Tac-Toe.toss	2011-03-25 22:24:30 UTC (rev 1393)
@@ -1,5 +1,5 @@
 PLAYERS 1, 2
-DATA r1: circle, r2: line, adv_ratio: 4, depth: 3
+DATA r1: circle, r2: line, adv_ratio: 5, depth: 3
 REL DiagA (x, y) = ex u (R(x, u) and C(u, y))
 REL DiagB (x, y) = ex u (R(x, u) and C(y, u))
 REL Row3 (x, y, z) = R(x, y) and R(y, z)


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.