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

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

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.




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 16)

toss-devel-svn — Toss development: svn commits