[Toss-devel-svn] SF.net SVN: toss:[1323] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
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. |