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

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

Revision: 1373
          http://toss.svn.sourceforge.net/toss/?rev=1373&view=rev
Author:   lukstafi
Date:     2011-03-21 09:38:35 +0000 (Mon, 21 Mar 2011)

Log Message:
-----------
Test fixes.

Modified Paths:
--------------
    trunk/Toss/Arena/DiscreteRule.ml
    trunk/Toss/Play/Game.ml
    trunk/Toss/Play/GameTest.ml

Modified: trunk/Toss/Arena/DiscreteRule.ml
===================================================================
--- trunk/Toss/Arena/DiscreteRule.ml	2011-03-20 16:56:34 UTC (rev 1372)
+++ trunk/Toss/Arena/DiscreteRule.ml	2011-03-21 09:38:35 UTC (rev 1373)
@@ -176,7 +176,24 @@
 (* Find all embeddings of a rule.  Does not guarantee that rewriting
    will succeed for all of them. *)
 let find_matchings model rule_obj =
-  Solver.M.evaluate model rule_obj.lhs_form
+  (* {{{ log entry *)
+  if !debug_level > 3 then (
+    Printf.printf "find_matchings: lhs_form=\n%s\n...%!"
+      (Formula.sprint rule_obj.lhs_form);
+  );
+  if !debug_level > 4 then (
+    Printf.printf "find_matchings: model=\n%s\n...%!"
+      (Structure.sprint model);
+  );
+  (* }}} *)
+  let res = Solver.M.evaluate model rule_obj.lhs_form in
+  (* {{{ log entry *)
+  if !debug_level > 3 then (
+    Printf.printf "find_matchings: result=%s\n%!"
+      (AssignmentSet.str res)
+  );
+  (* }}} *)
+  res
 
 (* Convert assignment to an embedding of the LHS structure. *)
 let assignment_to_embedding rule_obj asgn =

Modified: trunk/Toss/Play/Game.ml
===================================================================
--- trunk/Toss/Play/Game.ml	2011-03-20 16:56:34 UTC (rev 1372)
+++ trunk/Toss/Play/Game.ml	2011-03-21 09:38:35 UTC (rev 1373)
@@ -1206,34 +1206,40 @@
   let play = match effort with
     | None -> play
     | Some effort ->
-        {play with agents=Array.map
-            (function
-              | Tree_search (subgames, sth, params, agents) ->
-                  Tree_search (
-                    subgames, sth, {params with iters=effort},
-                    agents)
-              | Maximax_evgame (
-                subgames, cooperative, depth, use_pruning) ->
-                Maximax_evgame
-                  (subgames, cooperative, effort, use_pruning)
-              | (Random_move | External _) as agent -> agent
-            ) play.agents} in
+      {play with agents=Array.map
+          (function
+            | Tree_search (subgames, sth, params, agents) ->
+              Tree_search (
+                subgames, sth, {params with iters=effort},
+                agents)
+            | Maximax_evgame (
+              subgames, cooperative, depth, use_pruning) ->
+              Maximax_evgame
+                (subgames, cooperative, effort, use_pruning)
+            | (Random_move | External _) as agent -> agent
+          ) play.agents} in
   (* {{{ log entry *)
   if !debug_level > 2 then printf "\nsuggest:\n%!";
   (* }}} *)
   (match
-    toss ~grid_size:Move.cGRID_SIZE play play_state
-  with
-    | Aux.Left (bpos, moves, memory, _) ->
-        (* [suggest] does not update the state, rule application
-           should do it *)
-        (* {{{ log entry *)
-
-        if !debug_level > 1 then
-          printf "suggest: pos %d out of %d -- %s\n%!" bpos
-            (Array.length moves)
-            (Move.move_gs_str (play.game, play_state.game_state) moves.(bpos));
+      toss ~grid_size:Move.cGRID_SIZE play play_state
+   with
+     | Aux.Left (bpos, moves, memory, _) ->
+       (* [suggest] does not update the state, rule application
+          should do it *)
+       (* {{{ log entry *)
+       if !debug_level > 1 then
+         printf "suggest: pos %d out of %d -- %s\n%!" bpos
+           (Array.length moves)
+           (Move.move_gs_str (play.game, play_state.game_state) moves.(bpos));
         (* }}} *)
-        Some (moves.(bpos), {play_state with memory=memory})
-    | Aux.Right payoffs -> None)
+       Some (moves.(bpos), {play_state with memory=memory})
+     | Aux.Right payoffs ->
+       (* {{{ log entry *)
+       if !debug_level > 2 then (
+         Printf.printf "Suggest: found payoffs = %a\n%!"
+           (Aux.array_fprint (fun ppf -> Printf.fprintf ppf "%F")) payoffs
+       );
+      (* }}} *)
+       None)
 

Modified: trunk/Toss/Play/GameTest.ml
===================================================================
--- trunk/Toss/Play/GameTest.ml	2011-03-20 16:56:34 UTC (rev 1372)
+++ trunk/Toss/Play/GameTest.ml	2011-03-21 09:38:35 UTC (rev 1373)
@@ -335,11 +335,11 @@
   "play: breakthrough suggest in GDL simplified game" >::
     (fun () ->
       let horizon, advr, state =
-        get_loc_game breakthrough_simpl_game 1 in
+        get_loc_game breakthrough_simpl_game 0 in
       (* Game.set_debug_level 5; *)
       let move_opt = (let p,ps = Game.initialize_default state
                         ~advr ?horizon
-                        ~loc:1 ~effort:1
+                        ~loc:0 ~effort:1
                         ~search_method:"alpha_beta_ord" () in
                       Game.suggest p ps) in
       assert_bool "Game is not over yet -- some move expected."
@@ -352,19 +352,19 @@
         let struc =
           Structure.del_rel struc "cellholds_x2_y2_black"
             (Array.map (Structure.find_elem struc)
-               [|"cellholds_2_7__blank_"|]) in
+               [|"cellholds_2_7_MV1"|]) in
         let struc =
           Structure.del_rel struc "cellholds_x2_y2_white"
             (Array.map (Structure.find_elem struc)
-               [|"cellholds_3_2__blank_"|]) in
+               [|"cellholds_3_2_MV1"|]) in
         let struc =
           Structure.del_rel struc "cellholds_x2_y2_white"
             (Array.map (Structure.find_elem struc)
-               [|"cellholds_4_1__blank_"|]) in
+               [|"cellholds_4_1_MV1"|]) in
         let struc =
           Structure.add_rel struc "cellholds_x2_y2_black"
             (Array.map (Structure.find_elem struc)
-               [|"cellholds_4_1__blank_"|]) in
+               [|"cellholds_4_1_MV1"|]) in
         struc in
       let horizon, advr, state =
         get_loc_game ~update_struc breakthrough_simpl_game 0 in
@@ -379,7 +379,7 @@
           "game not over: "^move_gs_str (snd state) moves.(bpos)
         | Aux.Right poffs ->
           Printf.sprintf "{W: %F; B: %F}" poffs.(0) poffs.(1))
-        (Aux.Right [| -1.0; 1.0 |]) move_opt;
+        (Aux.Right [| 0.0; 100.0 |]) move_opt;
       let payoffs = Array.to_list
         (Array.mapi (fun i v->string_of_int i,v)
            (fst state).Arena.graph.((snd state).Arena.cur_loc).Arena.payoffs)
@@ -390,7 +390,7 @@
       let answ =
         String.concat ", " (List.sort compare (List.map ev payoffs)) in
       assert_equal ~msg:"black wins: direct" ~printer:(fun x->x)
-        "0: -1., 1: 1." answ;
+        "0: 0., 1: 100." answ;
 
     );
 
@@ -1038,13 +1038,14 @@
 let a () =
   Heuristic.debug_level := 4;
   FFTNF.debug_level := 4;
+  (* DiscreteRule.debug_level := 5; *)
   Game.set_debug_level 10
 
 let a () = Heuristic.use_monotonic := false
 
-let a () =
+let a =
   match test_filter
-    ["Game:0:misc:3:play: breakthrough suggest in GDL simplified game"]
+    ["Game:0:misc:4:breakthrough payoff GDL simplified game"]
     tests
   with
     | Some tests -> ignore (run_test_tt ~verbose:true tests)


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