[Toss-devel-svn] SF.net SVN: toss:[1530] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1530] trunk/Toss
|
From: <luk...@us...> - 2011-08-09 06:21:54
|
Revision: 1530
http://toss.svn.sourceforge.net/toss/?rev=1530&view=rev
Author: lukaszkaiser
Date: 2011-08-09 06:21:46 +0000 (Tue, 09 Aug 2011)
Log Message:
-----------
Moving move type to Arena.
Modified Paths:
--------------
trunk/Toss/Arena/Arena.ml
trunk/Toss/Arena/Arena.mli
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/Play/GameTree.ml
trunk/Toss/Play/GameTree.mli
trunk/Toss/Play/Move.ml
trunk/Toss/Play/Move.mli
trunk/Toss/Play/MoveTest.ml
trunk/Toss/Play/Play.mli
trunk/Toss/Server/ReqHandler.ml
Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Arena/Arena.ml 2011-08-09 06:21:46 UTC (rev 1530)
@@ -10,7 +10,7 @@
(* A single move consists of applying a rewrite rule for a time from the
[time_in] interval, and parameters from the interval list. *)
type label = {
- rule : string ;
+ lb_rule : string ;
time_in : float * float ;
parameters_in : (string * (float * float)) list ;
}
@@ -47,6 +47,14 @@
cur_loc : int ;
}
+type move = {
+ mv_time : float ;
+ parameters : (string * float) list ;
+ rule : string ;
+ next_loc : int ;
+ embedding : (int * int) list ;
+}
+
let zero_loc = { payoff = Formula.Const 0. ;
view = (Formula.And [], []);
heur = [];
@@ -80,7 +88,8 @@
(* Rules with which a player with given number can move. *)
let rules_for_player player_no game =
- let rules_of_loc l = List.map (fun (lab,_) -> lab.rule) l.(player_no).moves in
+ let rules_of_loc l =
+ List.map (fun (lab,_) -> lab.lb_rule) l.(player_no).moves in
List.concat (List.map rules_of_loc (Array.to_list game.graph))
(* Add a defined relation to a structure. *)
@@ -132,7 +141,7 @@
let time_in, parameters_in =
try Aux.pop_assoc "t" params
with Not_found -> (cDEFAULT_TIMESTEP, cDEFAULT_TIMESTEP), params in
- { rule = rname;
+ { lb_rule = rname;
time_in = time_in;
parameters_in = parameters_in;
}, target_loc
@@ -285,7 +294,7 @@
(* Print a label as a string. *)
let label_str
- {rule = rr; time_in = t_interval; parameters_in = param_intervals} =
+ {lb_rule = rr; time_in = t_interval; parameters_in = param_intervals} =
let fpstr (f,(fs, fe)) =
f ^ ": " ^ (string_of_float fs) ^ " -- " ^ (string_of_float fe) in
let par_str = if param_intervals = [] then " " else
@@ -304,7 +313,7 @@
if moves <> [] then
Format.fprintf f "@[<1>MOVES@ %a@]@ "
(Aux.fprint_sep_list ";" (fun f ({
- rule=r; time_in=(t_l, t_r); parameters_in=params}, target) ->
+ lb_rule=r; time_in=(t_l, t_r); parameters_in=params}, target) ->
Format.fprintf f "[@,@[<1>%s" r;
if t_l <> cDEFAULT_TIMESTEP || t_r <> cDEFAULT_TIMESTEP then
Format.fprintf f ",@ @[<1>t:@ %F@ --@ %F@]" t_l t_r;
@@ -492,13 +501,13 @@
let label, dest = List.hd dmoves1 in
Printf.sprintf
"At location %d, only the first game has label %s->%d"
- i label.rule dest));
+ i label.lb_rule dest));
let dmoves2 = Aux.list_diff loc2.moves loc1.moves in
if dmoves2 <> [] then raise (Diff_result (
let label, dest = List.hd dmoves1 in
Printf.sprintf
"At location %d, only the second game has label %s->%d"
- i label.rule dest));
+ i label.lb_rule dest));
let poff1 =
FormulaOps.map_to_formulas_expr Formula.flatten loc1.payoff in
let poff2 =
Modified: trunk/Toss/Arena/Arena.mli
===================================================================
--- trunk/Toss/Arena/Arena.mli 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Arena/Arena.mli 2011-08-09 06:21:46 UTC (rev 1530)
@@ -5,7 +5,7 @@
(** A single move consists of applying a rewrite rule for a time from the
[time_in] interval, and parameters from the interval list. *)
type label = {
- rule : string ;
+ lb_rule : string ;
time_in : float * float ;
parameters_in : (string * (float * float)) list ;
}
@@ -34,6 +34,15 @@
defined_rels : (string * (string list * Formula.formula)) list ;
}
+(** Move - complete basic action data. **)
+type move = {
+ mv_time : float ;
+ parameters : (string * float) list ;
+ rule : string ;
+ next_loc : int ;
+ embedding : (int * int) list ;
+}
+
(** State of the game. *)
type game_state = {
struc : Structure.structure ;
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-08-09 06:21:46 UTC (rev 1530)
@@ -854,7 +854,7 @@
(String.concat "_" (List.map term_to_name legal_tuple)) in
rule_names := Aux.Strings.add rname !rule_names;
let label =
- {Arena.rule = rname; time_in = 0.1, 0.1; parameters_in = []} in
+ {Arena.lb_rule = rname; time_in = 0.1, 0.1; parameters_in = []} in
let precond =
Formula.And
(synch_precond @
Modified: trunk/Toss/Play/GameTree.ml
===================================================================
--- trunk/Toss/Play/GameTree.ml 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Play/GameTree.ml 2011-08-09 06:21:46 UTC (rev 1530)
@@ -27,7 +27,7 @@
| Leaf of Arena.game_state * int * 'a
(* leaf with state, player, and info *)
| Node of Arena.game_state * int * 'a *
- (Move.move * ('a, 'b) abstract_game_tree) array
+ (Arena.move * ('a, 'b) abstract_game_tree) array
(* node with state, player, moves and info *)
(* Abstract tree printing function. *)
Modified: trunk/Toss/Play/GameTree.mli
===================================================================
--- trunk/Toss/Play/GameTree.mli 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Play/GameTree.mli 2011-08-09 06:21:46 UTC (rev 1530)
@@ -16,7 +16,7 @@
| Leaf of Arena.game_state * int * 'a
(** leaf with state, player, and info *)
| Node of Arena.game_state * int * 'a *
- (Move.move * ('a, 'b) abstract_game_tree) array
+ (Arena.move * ('a, 'b) abstract_game_tree) array
(** node with state, player, moves *)
(** Abstract tree printing function. *)
@@ -43,9 +43,9 @@
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 ->
- (Move.move * ('a, 'b) abstract_game_tree) array -> 'a) ->
+ (Arena.move * ('a, 'b) abstract_game_tree) array -> 'a) ->
choice : (int -> Arena.game -> Arena.game_state -> int -> 'a ->
- (Move.move * ('a, 'b) abstract_game_tree) array -> int) ->
+ (Arena.move * ('a, 'b) abstract_game_tree) array -> int) ->
('a, 'b) abstract_game_tree -> ('a, 'b) abstract_game_tree
@@ -84,7 +84,7 @@
(** Choose all maximizing moves given a game tree. *)
val choose_moves : Arena.game -> 'a game_tree ->
- (Move.move * Arena.game_state) list
+ (Arena.move * Arena.game_state) list
(** Game tree initialization. *)
@@ -97,8 +97,8 @@
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) ->
+ (Arena.move * 'a game_tree) array -> 'a) ->
choice : (float array option ref -> int -> Arena.game -> Arena.game_state ->
- int -> 'a node_info -> (Move.move * 'a game_tree) array -> int) ->
+ int -> 'a node_info -> (Arena.move * 'a game_tree) array -> int) ->
'a game_tree -> 'a game_tree
Modified: trunk/Toss/Play/Move.ml
===================================================================
--- trunk/Toss/Play/Move.ml 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Play/Move.ml 2011-08-09 06:21:46 UTC (rev 1530)
@@ -5,36 +5,28 @@
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 ;
-}
-
(* Make a move in a game. *)
let make_move m (game, state) =
- let req = Arena.ApplyRuleInt (m.rule, m.embedding, m.mv_time, m.parameters) in
+ let req = Arena.ApplyRuleInt
+ (m.Arena.rule, m.Arena.embedding, m.Arena.mv_time, m.Arena.parameters) in
let (new_game, new_state), _ = Arena.handle_request (game, state) req in
- (new_game, { new_state with Arena.cur_loc = m.next_loc })
+ (new_game, { new_state with Arena.cur_loc = m.Arena.next_loc })
(* 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 r = List.assoc move.Arena.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 par_str = if move.Arena.parameters = [] then " " else
+ ", " ^ (String.concat ", " (List.map fpstr move.Arena.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 emb = String.concat ", " (List.map p_name move.Arena.embedding) in
+ (move.Arena.rule) ^ "; " ^ emb ^ "; " ^ fpstr ("t", move.Arena.mv_time) ^
+ par_str ^ "; " ^ (string_of_int move.Arena.next_loc)
let move_gs_str (game, state) move =
move_str game.Arena.rules state.Arena.struc move
@@ -45,8 +37,8 @@
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 ^ "}"
+ (List.map p_name (List.sort Pervasives.compare move.Arena.embedding)) in
+ move.Arena.rule ^ "{" ^ emb ^ "}"
let move_gs_str_short state move = move_str_short state.Arena.struc move
@@ -56,7 +48,7 @@
let matchings =
Aux.concat_map
(fun (label,next_loc) ->
- let rule = List.assoc label.Arena.rule rules in
+ let rule = List.assoc label.Arena.lb_rule rules in
List.map (fun emb -> label,next_loc,emb)
(ContinuousRule.matches model rule))
loc.Arena.moves in
@@ -70,9 +62,9 @@
let t = (t_r +. t_l) /. 2. in
if label.Arena.parameters_in = [] then
[| {
- mv_time = t;
+ Arena.mv_time = t;
parameters = [];
- rule = label.Arena.rule;
+ rule = label.Arena.lb_rule;
next_loc = next_loc;
embedding = emb
} |]
@@ -90,9 +82,9 @@
) params_in in
let grid = Aux.product axes in
Aux.array_map_of_list (fun params -> {
- mv_time = t;
+ Arena.mv_time = t;
parameters = List.combine param_names params;
- rule = label.Arena.rule;
+ rule = label.Arena.lb_rule;
next_loc = next_loc;
embedding = emb}
) grid
@@ -102,12 +94,12 @@
let gen_models_list rules model time moves =
Aux.map_some (fun mv ->
- let rule = List.assoc mv.rule rules in
+ let rule = List.assoc mv.Arena.rule rules in
Aux.map_option
(fun (model, time, _) -> (* ignoring shifts, i.e. animation steps *)
- (mv, {Arena.cur_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)
+ (mv, {Arena.cur_loc = mv.Arena.next_loc; struc = model; time = time}))
+ (ContinuousRule.rewrite_single model time mv.Arena.embedding
+ rule mv.Arena.mv_time mv.Arena.parameters)) (Array.to_list moves)
let gen_models rules model time moves =
let res = gen_models_list rules model time moves in
Modified: trunk/Toss/Play/Move.mli
===================================================================
--- trunk/Toss/Play/Move.mli 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Play/Move.mli 2011-08-09 06:21:46 UTC (rev 1530)
@@ -1,24 +1,15 @@
(** 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 * Arena.game_state -> move -> string
+ Structure.structure -> Arena.move -> string
+val move_gs_str : Arena.game * Arena.game_state -> Arena.move -> string
-val move_str_short : Structure.structure -> move -> string
-val move_gs_str_short : Arena.game_state -> move -> string
+val move_str_short : Structure.structure -> Arena.move -> string
+val move_gs_str_short : Arena.game_state -> Arena.move -> string
(** Make a move in a game. *)
-val make_move : move ->
+val make_move : Arena.move ->
Arena.game * Arena.game_state -> Arena.game * Arena.game_state
@@ -28,10 +19,10 @@
(** Generate moves available from a state, as an array, in fixed order. *)
val gen_moves : int -> (string * ContinuousRule.rule) list ->
- Structure.structure -> Arena.player_loc -> move array
+ Structure.structure -> Arena.player_loc -> Arena.move array
val gen_models : (string * ContinuousRule.rule) list -> Structure.structure ->
- float -> move array -> move array * Arena.game_state array
+ float -> Arena.move array -> Arena.move array * Arena.game_state array
val list_moves : Arena.game -> Arena.game_state ->
- (int * move * Arena.game_state) array
+ (int * Arena.move * Arena.game_state) array
Modified: trunk/Toss/Play/MoveTest.ml
===================================================================
--- trunk/Toss/Play/MoveTest.ml 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Play/MoveTest.ml 2011-08-09 06:21:46 UTC (rev 1530)
@@ -4,11 +4,11 @@
"move to string" >::
(fun () ->
let mv = {
- Move.mv_time = 0.;
- Move.parameters = [];
- Move.rule = "rule";
- Move.next_loc = 1;
- Move.embedding = [(1, 1)];
+ Arena.mv_time = 0.;
+ parameters = [];
+ rule = "rule";
+ next_loc = 1;
+ embedding = [(1, 1)];
} in
let s = Structure.empty_structure () in
assert_equal ~printer:(fun x -> x) (Move.move_str_short s mv)
Modified: trunk/Toss/Play/Play.mli
===================================================================
--- trunk/Toss/Play/Play.mli 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Play/Play.mli 2011-08-09 06:21:46 UTC (rev 1530)
@@ -16,10 +16,10 @@
(** Maximax unfolding upto depth, keep previous moves for stability. *)
val unfold_maximax_upto : ?ab:bool -> int -> Arena.game ->
Formula.real_expr array array ->
- int GameTree.game_tree * (Move.move * Arena.game_state) list list ->
- int GameTree.game_tree * (Move.move * Arena.game_state) list list
+ int GameTree.game_tree * (Arena.move * Arena.game_state) list list ->
+ int GameTree.game_tree * (Arena.move * Arena.game_state) list list
(** Maximax unfold upto depth and choose move. *)
val maximax_unfold_choose : ?check_stable:int -> int -> Arena.game ->
Arena.game_state -> Formula.real_expr array array ->
- (Move.move * Arena.game_state) list
+ (Arena.move * Arena.game_state) list
Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml 2011-08-08 20:58:36 UTC (rev 1529)
+++ trunk/Toss/Server/ReqHandler.ml 2011-08-09 06:21:46 UTC (rev 1530)
@@ -64,15 +64,15 @@
try
for i = 0 to Array.length moves - 1 do
let mov = moves.(i) in
- if r_name = mov.Move.rule && List.for_all
- (fun (e, f) -> f = List.assoc e mov.Move.embedding) mtch then
+ if r_name = mov.Arena.rule && List.for_all
+ (fun (e, f) -> f = List.assoc e mov.Arena.embedding) mtch then
raise (Found i)
done;
failwith "GDL Play request: action mismatched with play state"
with Found pos -> pos) in
let req = Arena.ApplyRuleInt (r_name, mtch, 0.1, []) in
let (new_state_noloc, resp) = Arena.handle_request state req in
- let new_loc = moves.(pos).Move.next_loc in
+ let new_loc = moves.(pos).Arena.next_loc in
(fst new_state_noloc,
{snd new_state_noloc with Arena.cur_loc = new_loc})
) else state
@@ -147,7 +147,7 @@
Aux.random_elem (Play.maximax_unfold_choose 5500
(fst state) (snd state) heur) in
TranslateGame.translate_outgoing_move gdl_transl state
- move.Move.rule move.Move.embedding
+ move.Arena.rule move.Arena.embedding
) else (
Gc.compact ();
TranslateGame.noop_move gdl_transl (snd state)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
