[Toss-devel-svn] SF.net SVN: toss:[1323] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1323] trunk/Toss
|
From: <luk...@us...> - 2011-02-19 17:22:47
|
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.
|
