toss-devel-svn Mailing List for Toss (Page 18)

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Revision: 1323
          http://toss.svn.sourceforge.net/toss/?rev=1323&view=rev
Author:   lukaszkaiser
Date:     2011-02-19 17:22:41 +0000 (Sat, 19 Feb 2011)

Log Message:
-----------
Separate small file for move handling in Play.

Modified Paths:
--------------
    trunk/Toss/Makefile
    trunk/Toss/Play/Game.ml
    trunk/Toss/Play/Game.mli
    trunk/Toss/Play/GameTest.ml
    trunk/Toss/Play/Makefile
    trunk/Toss/Server/Server.ml
    trunk/Toss/TossTest.ml

Added Paths:
-----------
    trunk/Toss/Play/Move.ml
    trunk/Toss/Play/Move.mli
    trunk/Toss/Play/MoveTest.ml

Modified: trunk/Toss/Makefile
===================================================================

--- trunk/Toss/Makefile	2011-02-19 16:03:31 UTC (rev 1322)
+++ trunk/Toss/Makefile	2011-02-19 17:22:41 UTC (rev 1323)
@@ -119,6 +119,7 @@
 # Play tests
 Play_tests: \
 	Play/HeuristicTest \
+	Play/MoveTest \
 	Play/GameTest
 
 # GGP tests

Modified: trunk/Toss/Play/Game.ml
===================================================================
--- trunk/Toss/Play/Game.ml	2011-02-19 16:03:31 UTC (rev 1322)
+++ trunk/Toss/Play/Game.ml	2011-02-19 17:22:41 UTC (rev 1323)
@@ -2,10 +2,6 @@
 
 open Printf
 
-(* TODO: Sampling grid size fixed until doing more work with
-   continuous games. *)
-let cGRID_SIZE = 5
-
 let debug_level = ref 0
 let set_debug_level i = (debug_level := i)
 
@@ -36,7 +32,6 @@
   Sys.set_signal Sys.sigalrm
     (Sys.Signal_handle (fun _ -> timeout := true))
 
-
 type f_table = float array
 
 (* Cumulative score of players for computing value estimate. *)
@@ -65,16 +60,6 @@
   Array.map (fun payoff ->
     (0.5 +. 1./.((float_of_int n) +. 2.)) *. payoff) payoffs
 
-(* Data to return a move as a suggestion rather than directly
-   following it. *)
-type move = {
-  mv_time : float ;
-  parameters : (string * float) list ;
-  rule : string ;
-  next_loc : int ;                      (* next location in the arena *)
-  embedding : (int * int) list ;
-}
-
 (* Analogous to {!Arena.game_state}, but without the game component. *)
 type game_state = {
   struc     : Structure.structure ;     (* structure state *)
@@ -82,6 +67,11 @@
   loc       : int ;                     (* positin in the game graph *)
 }
 
+let gen_models rules models time moves = 
+  let (mv, a) = Move.gen_models rules models time moves in
+  (mv, Array.map (fun (l, m, t) -> {struc=m; time=t; loc=l}) a)
+
+
 type uctree_node = {
   node_state : game_state ;
   node_stats : score ;                  (* playout statistic *)
@@ -208,25 +198,7 @@
   delta : float ;                       (* expected width of payoffs *)
 }
 
-(* Print a move as string.
 
-   TODO: perhaps find a nicer syntax? See {!TestGame.move_str}. *)
-let move_str rules struc move =
-  let r = List.assoc move.rule rules in
-  let rhs_struc = r.ContinuousRule.discrete.DiscreteRule.rhs_struc in
-  let fpstr (f, fv) =
-    f ^ ": " ^ (string_of_float fv) in
-  let par_str = if move.parameters = [] then " " else
-    ", " ^ (String.concat ", " (List.map fpstr move.parameters)) in
-  let p_name (r, e) =
-    Structure.elem_str rhs_struc r ^": "^ Structure.elem_str struc e in
-  let emb = String.concat ", " (List.map p_name move.embedding) in
-  (move.rule) ^ "; " ^ emb ^ "; " ^ fpstr ("t", move.mv_time) ^ par_str ^ 
-    "; " ^ (string_of_int move.next_loc)
-
-let move_gs_str game_state move =
-  move_str game_state.Arena.game.Arena.rules game_state.Arena.struc move
-
 let default_params = {
   cUCB = 1.0 ;
   cLCB = Some 1.0 ;
@@ -533,65 +505,6 @@
                           randbest
                     else bestsc_table, randbest
 
-let gen_moves grid_size rules model loc =
-  let matchings =
-    Aux.concat_map
-      (fun (label,next_loc) ->
-        let rule = List.assoc label.Arena.rule rules in
-        List.map (fun emb -> label,next_loc,emb)
-          (ContinuousRule.matches model rule))
-      loc.Arena.moves in
-  if matchings = [] then [| |]
-  else (
-    (* generating the grid *)
-    Array.concat
-      (List.map (fun (label,next_loc,emb) ->
-        (* not searching through time *)
-        let t_l, t_r = label.Arena.time_in in
-        let t = (t_r +. t_l) /. 2. in
-        if label.Arena.parameters_in = [] then
-          [| {
-            mv_time = t;
-            parameters = [];
-            rule = label.Arena.rule;
-            next_loc = next_loc;
-            embedding = emb
-          } |]
-        else
-          let param_names, params_in =
-            List.split label.Arena.parameters_in in
-          let axes = List.map (fun (f_l,f_r) ->
-            if grid_size < 2 then
-              [(f_r +. f_l) /. 2.]
-            else
-              let df = (f_r -. f_l) /. float_of_int (grid_size - 1) in
-              Array.to_list
-                (Array.init grid_size
-                  (fun i -> f_l +. float_of_int i *. df))
-          ) params_in in
-          let grid = Aux.product axes in
-          Aux.array_map_of_list (fun params -> {
-            mv_time = t;
-            parameters = List.combine param_names params;
-            rule = label.Arena.rule;
-            next_loc = next_loc;
-            embedding = emb}
-          ) grid
-      ) matchings))
-
-let gen_models rules defined_rels model time moves =
-  let res =
-  Aux.map_some (fun mv ->
-    let rule = List.assoc mv.rule rules in
-    Aux.map_option
-      (fun (model, time, _) ->
-        (* ignoring shifts, i.e. animation steps *)
-        mv, {loc=mv.next_loc; struc=model; time=time})
-      (ContinuousRule.rewrite_single model time mv.embedding
-         rule mv.mv_time mv.parameters)) (Array.to_list moves) in
-  let moves, models = List.split res in
-  Array.of_list moves, Array.of_list models
-
 let debug_count = ref 0
 
 (* Generate evaluation game score (the whole payoff table). *)
@@ -615,7 +528,7 @@
 and gen_scores grid_size subgames moves models loc =
   Array.mapi (fun pos mv ->
     let {struc=model; time=time} = models.(pos) in
-    play_evgame grid_size model time subgames.(mv.next_loc)
+    play_evgame grid_size model time subgames.(mv.Move.next_loc)
   ) moves
 
 
@@ -635,7 +548,7 @@
   let loc = graph.(state.loc) in
   let moves =
     if just_payoffs then [| |]
-    else gen_moves grid_size rules state.struc loc in
+    else Move.gen_moves grid_size rules state.struc loc in
   (* Don't forget to check after generating models as well --
      postconditions! *)
   if moves = [| |] then
@@ -657,14 +570,14 @@
         let nstate = ref None in
         while !nstate = None && (!pos <> init_pos || !pos < mlen) do
           let mv = moves.(!pos mod mlen) in
-          let rule = List.assoc mv.rule rules in
+          let rule = List.assoc mv.Move.rule rules in
           nstate :=
             Aux.map_option
             (fun (model, time, _) ->
               (* ignoring shifts, i.e. animation steps *)
-              {loc=mv.next_loc; struc=model; time=time})
+              {loc=mv.Move.next_loc; struc=model; time=time})
             (ContinuousRule.rewrite_single state.struc state.time
-               mv.embedding rule mv.mv_time mv.parameters);
+               mv.Move.embedding rule mv.Move.mv_time mv.Move.parameters);
           incr pos
         done;
         (match !nstate with
@@ -731,7 +644,7 @@
           ) else
             let location = graph.(loc) in
             let moves =
-              gen_moves grid_size rules model location in
+              Move.gen_moves grid_size rules model location in
             if moves = [| |] then       (* terminal position *)
               let res =
                 (* *)
@@ -753,8 +666,7 @@
             else if !timeout then
               Array.map (fun _ -> 0.) graph.(loc).Arena.payoffs
             else     
-              let moves, models =
-                gen_models rules defined_rels model time moves in
+              let moves, models = gen_models rules model time moves in
               let n = Array.length models in
               if !timeout then
                 Array.map (fun _ -> 0.) graph.(loc).Arena.payoffs
@@ -835,8 +747,7 @@
                 aux alphas 0 in
         let betas = Array.make num_players infinity in
         let player = loc.Arena.player in
-        let moves, models =
-          gen_models rules defined_rels state.struc state.time moves in
+        let moves, models = gen_models rules state.struc state.time moves in
         if models = [| |] then
           let payoff =
             Array.map (fun expr ->
@@ -982,8 +893,7 @@
         (* {{{ log entry *)
         if !debug_level > 3 then printf "toss: external\n";
         (* }}} *)
-        let moves, models =
-          gen_models rules defined_rels state.struc state.time moves in
+        let moves, models = gen_models rules state.struc state.time moves in
         if models = [| |] then
           let payoff =
             Array.map (fun expr ->
@@ -1127,7 +1037,7 @@
     state ?score subgames evgame_horizon heur_effect heuristic
   horizon cooperative player =
   let location = graph.(state.loc) in
-  let moves = gen_moves grid_size rules state.struc location in
+  let moves = Move.gen_moves grid_size rules state.struc location in
   if moves = [| |] then
     let payoff =
       Array.map (fun expr ->
@@ -1137,8 +1047,7 @@
     upscore, Terminal (state, upscore, heuristic, payoff)
 
   else
-    let moves, models =
-      gen_models rules defined_rels state.struc state.time moves in
+    let moves, models = gen_models rules state.struc state.time moves in
     if models = [| |] then
       let payoff =
         Array.map (fun expr ->
@@ -1336,7 +1245,7 @@
   if !debug_level > 2 then printf "\nsuggest:\n%!";
   (* }}} *)
   (match
-    toss ~grid_size:cGRID_SIZE play play_state
+    toss ~grid_size:Move.cGRID_SIZE play play_state
   with
     | Aux.Left (bpos, moves, memory, _) ->
         (* [suggest] does not update the state, rule application

Modified: trunk/Toss/Play/Game.mli
===================================================================
--- trunk/Toss/Play/Game.mli	2011-02-19 16:03:31 UTC (rev 1322)
+++ trunk/Toss/Play/Game.mli	2011-02-19 17:22:41 UTC (rev 1323)
@@ -110,22 +110,6 @@
     {!Arena.game}. *)
 val initial_state : ?loc:int -> play -> Structure.structure -> play_state
 
-(** Data to return a move as a suggestion rather than directly
-    following it. *)
-type move = {
-  mv_time : float ;
-  parameters : (string * float) list ;
-  rule : string ;
-  next_loc : int ;                      (** next location in the arena *)
-  embedding : (int * int) list ;
-}
-
-val move_str :
-  (string * ContinuousRule.rule) list ->
-  Structure.structure -> move -> string
-
-val move_gs_str : Arena.game_state -> move -> string
-
 val default_params : uct_params
 
 (** An UCT-based agent that uses either random playouts (when
@@ -147,16 +131,6 @@
   Arena.game -> agent
 
 
-(** Default number of sample points per parameter in tree
-    search. TODO: fixed for now. *)
-val cGRID_SIZE : int
-
-(** Generate moves available from a state, as an array ordered
-    deterministically. *)
-val gen_moves :
-  int -> (string * ContinuousRule.rule) list ->
-  Structure.structure -> Arena.location -> move array
-
 (** Update "memory" assuming that the position given corresponds to a
     move selected, as generated by {!gen_moves}. With tree search,
     selects the corresponding subtree of a tree. *)
@@ -174,7 +148,7 @@
 val toss :
   grid_size:int -> ?just_payoffs:bool ->
   play -> play_state ->
-  (int * move array * memory array * play_state,
+  (int * Move.move array * memory array * play_state,
    float array) Aux.choice
 
 (** Play a play, by applying {!toss}, till the end. Return the final
@@ -210,7 +184,7 @@
     state but with accrued computation (i.e. bigger stored search
     trees). *)
 val suggest : ?effort:int ->
-  play -> play_state -> (move * play_state) option
+  play -> play_state -> (Move.move * play_state) option
 
 
 (* ------------------------- DEBUGGING ------------------------------------- *)

Modified: trunk/Toss/Play/GameTest.ml
===================================================================
--- trunk/Toss/Play/GameTest.ml	2011-02-19 16:03:31 UTC (rev 1322)
+++ trunk/Toss/Play/GameTest.ml	2011-02-19 17:22:41 UTC (rev 1323)
@@ -42,20 +42,9 @@
 module StrMap = Structure.StringMap
 module IntMap = Structure.IntMap
 
-(* Like {!Game.move_str}, but simplified (less data, shorter form). *)
-let move_str rules struc move =
-  (* let r = List.assoc move.Game.rule rules in *)
-  (* let rhs_struc = r.ContinuousRule.discrete.DiscreteRule.rhs_struc in *)
-  let p_name (r, e) =
-    (* Structure.elem_str rhs_struc r *)
-    string_of_int r ^ ":" ^ Structure.elem_str struc e in
-  let emb = String.concat ", "
-    (List.map p_name (List.sort Pervasives.compare move.Game.embedding)) in
-  move.Game.rule ^ "{" ^ emb ^ "}"
+let move_str r s m = Move.move_str_short s m
+let move_gs_str = Move.move_gs_str_short
 
-let move_gs_str state move =
-  move_str state.Arena.game.Arena.rules state.Arena.struc move
-
 let update_game ?(defs=false)
     (lazy (horizon, adv_ratio, game)) state cur_loc =
   let state =
@@ -311,7 +300,7 @@
         delta = 2.0} in           (* FIXME: give/calc delta *)
       let init_state = Game.initial_state play struc in
       (* let endstate,payoff = *)
-      ignore (Game.play ~grid_size:Game.cGRID_SIZE
+      ignore (Game.play ~grid_size:Move.cGRID_SIZE
                 ~set_timer:360 ~horizon:30 play init_state) (* in *)
       (* nothing to assert -- just check halting without exceptions *)
       (*
@@ -348,7 +337,7 @@
                         ~loc:0 ~effort:2
                         ~heuristic:breakthrough_heur
                         ~search_method:"alpha_beta_ord" () in
-                      Game.toss ~grid_size:Game.cGRID_SIZE p ps) in
+                      Game.toss ~grid_size:Move.cGRID_SIZE p ps) in
       assert_equal ~msg:"black wins: suggest" ~printer:(function
         | Aux.Left (bpos, moves, _, _) ->
           "game not over: "^move_gs_str state moves.(bpos)
@@ -409,7 +398,7 @@
                         ~heur_adv_ratio ?horizon
                         ~loc:0 ~effort:1
                         ~search_method:"alpha_beta_ord" () in
-                      Game.toss ~grid_size:Game.cGRID_SIZE p ps) in
+                      Game.toss ~grid_size:Move.cGRID_SIZE p ps) in
       assert_equal ~msg:"draw (white no move): suggest" ~printer:(function
         | Aux.Left (bpos, moves, _, _) ->
           "game not over: "^move_gs_str state moves.(bpos)
@@ -943,7 +932,7 @@
       for i = 1 to n do
         Printf.printf "Experiment: Game nr %d of %d\n%!" i n;
         let _,payoff =
-          Game.play ~grid_size:Game.cGRID_SIZE ~set_timer:3600
+          Game.play ~grid_size:Move.cGRID_SIZE ~set_timer:3600
             ?horizon play init_state in
         if payoff.(0) > 0.0 then incr winsW;
         if payoff.(1) > 0.0 then incr winsB;

Modified: trunk/Toss/Play/Makefile
===================================================================
--- trunk/Toss/Play/Makefile	2011-02-19 16:03:31 UTC (rev 1322)
+++ trunk/Toss/Play/Makefile	2011-02-19 17:22:41 UTC (rev 1323)
@@ -10,12 +10,15 @@
 	make -C .. Play/$@
 
 HeuristicTest:
+MoveTest:
 GameTest:
 
 HeuristicTestProfile:
+MoveTestProfile:
 GameTestProfile:
 
 HeuristicTestDebug:
+MoveTestDebug:
 GameTestDebug:
 
 tests:

Added: trunk/Toss/Play/Move.ml
===================================================================
--- trunk/Toss/Play/Move.ml	                        (rev 0)
+++ trunk/Toss/Play/Move.ml	2011-02-19 17:22:41 UTC (rev 1323)
@@ -0,0 +1,108 @@
+(* Move definition, generation and helper functions. *)
+
+
+(* TODO: Sampling grid size fixed until doing more with continuous games. *)
+let cGRID_SIZE = 5
+
+
+(* Data to return a move as a suggestion rather than directly. *)
+type move = {
+  mv_time : float ;
+  parameters : (string * float) list ;
+  rule : string ;
+  next_loc : int ;                      (* next location in the arena *)
+  embedding : (int * int) list ;
+}
+
+
+(* Print a move as string.
+   TODO: perhaps find a nicer syntax? See {!TestGame.move_str}. *)
+let move_str rules struc move =
+  let r = List.assoc move.rule rules in
+  let rhs_struc = r.ContinuousRule.discrete.DiscreteRule.rhs_struc in
+  let fpstr (f, fv) =
+    f ^ ": " ^ (string_of_float fv) in
+  let par_str = if move.parameters = [] then " " else
+    ", " ^ (String.concat ", " (List.map fpstr move.parameters)) in
+  let p_name (r, e) =
+    Structure.elem_str rhs_struc r ^": "^ Structure.elem_str struc e in
+  let emb = String.concat ", " (List.map p_name move.embedding) in
+  (move.rule) ^ "; " ^ emb ^ "; " ^ fpstr ("t", move.mv_time) ^ par_str ^ 
+    "; " ^ (string_of_int move.next_loc)
+
+let move_gs_str game_state move =
+  move_str game_state.Arena.game.Arena.rules game_state.Arena.struc move
+
+
+(* Like move_str but simplified (less data, shorter form). *)
+let move_str_short struc move =
+  let p_name (r, e) =
+    string_of_int r ^ ":" ^ Structure.elem_str struc e in
+  let emb = String.concat ", "
+    (List.map p_name (List.sort Pervasives.compare move.embedding)) in
+  move.rule ^ "{" ^ emb ^ "}"
+
+let move_gs_str_short state move = move_str_short state.Arena.struc move
+
+
+(* Generate moves available from a state, as an array, in fixed order. *)
+let gen_moves grid_size rules model loc =
+  let matchings =
+    Aux.concat_map
+      (fun (label,next_loc) ->
+        let rule = List.assoc label.Arena.rule rules in
+        List.map (fun emb -> label,next_loc,emb)
+          (ContinuousRule.matches model rule))
+      loc.Arena.moves in
+  if matchings = [] then [| |]
+  else (
+    (* generating the grid *)
+    Array.concat
+      (List.map (fun (label,next_loc,emb) ->
+        (* not searching through time *)
+        let t_l, t_r = label.Arena.time_in in
+        let t = (t_r +. t_l) /. 2. in
+        if label.Arena.parameters_in = [] then
+          [| {
+            mv_time = t;
+            parameters = [];
+            rule = label.Arena.rule;
+            next_loc = next_loc;
+            embedding = emb
+          } |]
+        else
+          let param_names, params_in =
+            List.split label.Arena.parameters_in in
+          let axes = List.map (fun (f_l,f_r) ->
+            if grid_size < 2 then
+              [(f_r +. f_l) /. 2.]
+            else
+              let df = (f_r -. f_l) /. float_of_int (grid_size - 1) in
+              Array.to_list
+                (Array.init grid_size
+                  (fun i -> f_l +. float_of_int i *. df))
+          ) params_in in
+          let grid = Aux.product axes in
+          Aux.array_map_of_list (fun params -> {
+            mv_time = t;
+            parameters = List.combine param_names params;
+            rule = label.Arena.rule;
+            next_loc = next_loc;
+            embedding = emb}
+          ) grid
+      ) matchings))
+
+
+
+let gen_models rules model time moves =
+  let res =
+    Aux.map_some (fun mv ->
+      let rule = List.assoc mv.rule rules in
+      Aux.map_option
+	(fun (model, time, _) -> (* ignoring shifts, i.e. animation steps *)
+          (mv, (mv.next_loc, model, time)))
+	(ContinuousRule.rewrite_single model time mv.embedding
+           rule mv.mv_time mv.parameters)) (Array.to_list moves) in
+  let moves, models = List.split res in
+  Array.of_list moves, Array.of_list models
+

Added: trunk/Toss/Play/Move.mli
===================================================================
--- trunk/Toss/Play/Move.mli	                        (rev 0)
+++ trunk/Toss/Play/Move.mli	2011-02-19 17:22:41 UTC (rev 1323)
@@ -0,0 +1,30 @@
+(** Move definition, generation and helper functions. *)
+
+(** Data to return a move as a suggestion rather than directly. *)
+type move = {
+  mv_time : float ;
+  parameters : (string * float) list ;
+  rule : string ;
+  next_loc : int ;                      (** next location in the arena *)
+  embedding : (int * int) list ;
+}
+
+val move_str : (string * ContinuousRule.rule) list ->
+  Structure.structure -> move -> string
+val move_gs_str : Arena.game_state -> move -> string
+
+val move_str_short : Structure.structure -> move -> string
+val move_gs_str_short : Arena.game_state -> move -> string
+
+
+
+(** Default number of sample points per parameter in tree search.
+    TODO: fixed for now. *)
+val cGRID_SIZE : int
+
+(** Generate moves available from a state, as an array, in fixed order. *)
+val gen_moves : int -> (string * ContinuousRule.rule) list ->
+  Structure.structure -> Arena.location -> move array
+
+val gen_models : (string * ContinuousRule.rule) list -> Structure.structure ->
+  float -> move array -> move array * (int * Structure.structure * float) array

Added: trunk/Toss/Play/MoveTest.ml
===================================================================
--- trunk/Toss/Play/MoveTest.ml	                        (rev 0)
+++ trunk/Toss/Play/MoveTest.ml	2011-02-19 17:22:41 UTC (rev 1323)
@@ -0,0 +1,21 @@
+open OUnit
+
+let tests = "Move" >::: [
+  "move to string" >::
+    (fun () ->
+      let mv = {
+	Move.mv_time = 0.;
+	Move.parameters = [];
+	Move.rule = "rule";
+	Move.next_loc = 1;
+	Move.embedding = [(1, 1)];
+      } in
+      let s = Structure.empty_structure () in
+      assert_equal ~printer:(fun x -> x) (Move.move_str_short s mv)
+	"rule{1:1}"
+    );
+] ;;
+
+let a =
+  Aux.run_test_if_target "MoveTest" tests
+;;

Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml	2011-02-19 16:03:31 UTC (rev 1322)
+++ trunk/Toss/Server/Server.ml	2011-02-19 17:22:41 UTC (rev 1323)
@@ -185,7 +185,7 @@
           match res with
             | Some (move, new_state) ->
               play_state := Some new_state;
-              Game.move_gs_str !state move
+              Move.move_gs_str !state move
             | None -> "None"
         )
 
@@ -205,23 +205,23 @@
 	    let m =
               List.map (fun (l, s) -> (fn lhs l, fn struc s)) mtch in
             let moves =
-              Game.gen_moves Game.cGRID_SIZE rules
+              Move.gen_moves Move.cGRID_SIZE rules
                 !state.Arena.struc graph.(!state.Arena.cur_loc) in
             try
               for i = 0 to Array.length moves - 1 do
                 (* FIXME: handle time and params! *)
                 let mov = moves.(i) in
                 if
-                  r_name = mov.Game.rule &&
+                  r_name = mov.Move.rule &&
                   (* t = mov.Game.time && *)
                   (* something wrong with this:
                      List.for_all (fun (pn, pv) ->
                      pv = List.assoc pn mov.Game.parameters) p && *)
                   List.for_all (fun (e, f) ->
-                    f = List.assoc e mov.Game.embedding) m
+                    f = List.assoc e mov.Move.embedding) m
                 (* TODO: handle location matching *)
                 then (
-                  expected_location := mov.Game.next_loc;
+                  expected_location := mov.Move.next_loc;
                   let _ = if !debug_level > 2 then
                       Printf.printf "expected_location = %d\n%!"
                         !expected_location in
@@ -247,10 +247,10 @@
                 | _ -> failwith "req_handle: impossible" in
               (* Rewriting doesn't handle location update. *)
               state :=
-                {new_state with Arena.cur_loc = moves.(pos).Game.next_loc};
+                {new_state with Arena.cur_loc = moves.(pos).Move.next_loc};
               let new_game_state = {
                 Game.struc = new_state.Arena.struc;
-                loc = moves.(pos).Game.next_loc;
+                loc = moves.(pos).Move.next_loc;
                 time = new_state.Arena.time;
               } in
               play_state := Some {
@@ -300,7 +300,7 @@
 	    let m =
               List.map (fun (l, s) -> (fn lhs l, fn struc s)) mtch in
             let moves =
-              Game.gen_moves Game.cGRID_SIZE rules
+              Move.gen_moves Move.cGRID_SIZE rules
                 !state.Arena.struc graph.(!state.Arena.cur_loc) in
             let pos =
               (try
@@ -310,20 +310,20 @@
                  (* {{{ log entry *)
                    if !debug_level > 3 then (
                      Printf.printf "GDL: for %s considering move %s\n%!"
-                       r_name (Game.move_gs_str !state mov)
+                       r_name (Move.move_gs_str !state mov)
                    );
                  (* }}} *)
                    if
-                     r_name = mov.Game.rule &&
+                     r_name = mov.Move.rule &&
                    (* t = mov.Game.time && *)
                    (* something wrong with this:
                       List.for_all (fun (pn, pv) ->
                       pv = List.assoc pn mov.Game.parameters) p && *)
                      List.for_all (fun (e, f) ->
-                       f = List.assoc e mov.Game.embedding) m
+                       f = List.assoc e mov.Move.embedding) m
                  (* TODO: handle location matching *)
                    then (
-                     expected_location := mov.Game.next_loc;
+                     expected_location := mov.Move.next_loc;
                      let _ = if !debug_level > 2 then
                          Printf.printf "expected_location = %d\n%!"
                            !expected_location in
@@ -348,10 +348,10 @@
               | _ -> failwith "req_handle: impossible" in
           (* Rewriting doesn't handle location update. *)
             state :=
-              {new_state with Arena.cur_loc = moves.(pos).Game.next_loc};
+              {new_state with Arena.cur_loc = moves.(pos).Move.next_loc};
             let new_game_state = {
               Game.struc = new_state.Arena.struc;
-              loc = moves.(pos).Game.next_loc;
+              loc = moves.(pos).Move.next_loc;
               time = new_state.Arena.time;
             } in
             play_state := Some {
@@ -374,7 +374,7 @@
               match res with
                 | Some (move, new_state) ->
                 (* Do not change state yet! *)
-                  GDL.translate_move move.Game.rule move.Game.embedding
+                  GDL.translate_move move.Move.rule move.Move.embedding
                     !state
                 | None -> "NOOP" in
             let msg_len = String.length mov_msg in
@@ -401,7 +401,7 @@
 	    let m =
               List.map (fun (l, s) -> (fn lhs l, fn struc s)) mtch in
             let moves =
-              Game.gen_moves Game.cGRID_SIZE rules
+              Move.gen_moves Move.cGRID_SIZE rules
                 !state.Arena.struc graph.(!state.Arena.cur_loc) in
             let pos =
               (try
@@ -411,20 +411,20 @@
                  (* {{{ log entry *)
                    if !debug_level > 3 then (
                      Printf.printf "GDL: for %s considering move %s\n%!"
-                       r_name (Game.move_gs_str !state mov)
+                       r_name (Move.move_gs_str !state mov)
                    );
                  (* }}} *)
                    if
-                     r_name = mov.Game.rule &&
+                     r_name = mov.Move.rule &&
                    (* t = mov.Game.time && *)
                    (* something wrong with this:
                       List.for_all (fun (pn, pv) ->
                       pv = List.assoc pn mov.Game.parameters) p && *)
                      List.for_all (fun (e, f) ->
-                       f = List.assoc e mov.Game.embedding) m
+                       f = List.assoc e mov.Move.embedding) m
                  (* TODO: handle location matching *)
                    then (
-                     expected_location := mov.Game.next_loc;
+                     expected_location := mov.Move.next_loc;
                      let _ = if !debug_level > 2 then
                          Printf.printf "expected_location = %d\n%!"
                            !expected_location in
@@ -449,10 +449,10 @@
               | _ -> failwith "req_handle: impossible" in
           (* Rewriting doesn't handle location update. *)
             state :=
-              {new_state with Arena.cur_loc = moves.(pos).Game.next_loc};
+              {new_state with Arena.cur_loc = moves.(pos).Move.next_loc};
             let new_game_state = {
               Game.struc = new_state.Arena.struc;
-              loc = moves.(pos).Game.next_loc;
+              loc = moves.(pos).Move.next_loc;
               time = new_state.Arena.time;
             } in
             play_state := Some {
@@ -561,7 +561,7 @@
   for i = 1 to n do (
     Random.self_init ();
     Printf.printf "Experiment: Game nr %d of %d\n%!" i n;
-    let _,payoff = Game.play ~grid_size:Game.cGRID_SIZE ~set_timer:3600
+    let _,payoff = Game.play ~grid_size:Move.cGRID_SIZE ~set_timer:3600
       ?horizon play init_state in
     Printf.printf "Game %d payoffs %f, %f\n" i payoff.(0) payoff.(1);
     aggr_payoff_w := !aggr_payoff_w +. payoff.(0);

Modified: trunk/Toss/TossTest.ml
===================================================================
--- trunk/Toss/TossTest.ml	2011-02-19 16:03:31 UTC (rev 1322)
+++ trunk/Toss/TossTest.ml	2011-02-19 17:22:41 UTC (rev 1323)
@@ -22,6 +22,7 @@
 
 let play_tests = "Play" >::: [
   HeuristicTest.tests;
+  MoveTest.tests;
   GameTest.tests;
 ]
 


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




2010	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov (25)	Dec (62)
2011	Jan (26)	Feb (38)	Mar (67)	Apr (22)	May (41)	Jun (30)	Jul (24)	Aug (32)	Sep (29)	Oct (34)	Nov (18)	Dec (2)
2012	Jan (19)	Feb (25)	Mar (16)	Apr (2)	May (18)	Jun (21)	Jul (11)	Aug	Sep	Oct	Nov	Dec

toss-devel-svn Mailing List for Toss (Page 18)

toss-devel-svn — Toss development: svn commits