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

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

Revision: 1411
          http://toss.svn.sourceforge.net/toss/?rev=1411&view=rev
Author:   lukaszkaiser
Date:     2011-04-15 18:34:16 +0000 (Fri, 15 Apr 2011)

Log Message:
-----------
Correcting the remaining compilation problems - everything seems to work with the new type now.

Modified Paths:
--------------
    trunk/Toss/Arena/Arena.ml
    trunk/Toss/GGP/GDL.ml
    trunk/Toss/Server/Server.ml

Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml	2011-04-14 23:57:24 UTC (rev 1410)
+++ trunk/Toss/Arena/Arena.ml	2011-04-15 18:34:16 UTC (rev 1411)
@@ -150,7 +150,6 @@
      moves? *)
   let pname = match pname with None -> "1" | Some p -> p in
   fun player_names ->
-    let player = List.assoc pname player_names in
     let zero_loc = { payoff = Formula.Const 0. ; view = (Formula.And [], []);
 		     heur = []; moves = [] } in
     let locs = List.map (fun (pl, poff) -> 
@@ -780,11 +779,18 @@
         (string_of_int (Array.length state_game.graph)))
     | SetLocPlayer (i, player) -> failwith "unsupported for now, concurrency"
     (* ((state_game, state), "LOC PLAYER SET") *)
-    | GetLocPlayer (i) -> failwith "unsupported for now, concurrency"
-    (* if i < 0 || i > Array.length state_game.graph then
+    | GetLocPlayer (i) ->
+      if i < 0 || i > Array.length state_game.graph then
         ((state_game, state), "ERR location "^string_of_int i^" not found")
-      else ((state_game, state), Aux.rev_assoc state_game.player_names
-        state_game.graph.(i).player) *)
+      else 
+	let players =
+	  Aux.array_argfind_all (fun l-> l.moves <> []) state_game.graph.(i) in
+	if List.length players <> 1 then
+          ((state_game, state), "ERR location " ^ string_of_int i ^ " allows "^
+	    (string_of_int (List.length players)) ^ " players to move")
+	else
+	  let pl = List.hd players in
+	  ((state_game, state), Aux.rev_assoc state_game.player_names pl)
     | SetLocPayoff (i, player, payoff) ->
       let (state_game, state), player =
         try (state_game, state), List.assoc player state_game.player_names

Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml	2011-04-14 23:57:24 UTC (rev 1410)
+++ trunk/Toss/GGP/GDL.ml	2011-04-15 18:34:16 UTC (rev 1411)
@@ -3437,12 +3437,13 @@
           label, (rname, rule)
         ) rules_brs in
       let labels, rules = List.split labelled_rules in
-      let location = {
-        Arena.id = loc;
-        player = find_player loc_players.(loc);
-        payoffs = payoffs;
-        moves = labels} in
-      rules, location
+      let player = find_player loc_players.(loc) in
+      let location i = {	
+        Arena.payoff = payoffs.(i);
+        moves = if i = player then labels else [];
+	view = (Formula.And [], []);
+	heur = []; } in
+      rules, Array.mapi (fun i _ -> location i) player_terms
     ) loc_toss_rules in
   let rules = Array.map fst rules_and_locations
   and locations = Array.map snd rules_and_locations in
@@ -3454,6 +3455,7 @@
   let game = {
     Arena.rules = rules;
     graph = locations;
+    patterns = [];
     num_players = players_n;
     player_names = player_names;
     data = [];
@@ -3542,7 +3544,8 @@
   let loc = (snd state).Arena.cur_loc in
   let actions = Array.of_list actions in
   let location = (fst state).Arena.graph.(loc) in
-  let player_action = actions.(location.Arena.player) in
+  let player_action = actions.(Aux.array_argfind (fun l -> l.Arena.moves <> []) 
+				 location) in
   let struc = (snd state).Arena.struc in
   (* {{{ log entry *)
   if !debug_level > 2 then (
@@ -3723,8 +3726,10 @@
 
 let our_turn gdl state =
   let loc = (snd state).Arena.cur_loc in
-  gdl.playing_as = (fst state).Arena.graph.(loc).Arena.player
+  gdl.playing_as = Aux.array_argfind (fun l -> l.Arena.moves <> []) 
+      (fst state).Arena.graph.(loc)
 
+
 let noop_move ?(force=false) gdl state =
   let loc = state.Arena.cur_loc in
   match gdl.noop_actions.(loc) with

Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml	2011-04-14 23:57:24 UTC (rev 1410)
+++ trunk/Toss/Server/Server.ml	2011-04-15 18:34:16 UTC (rev 1411)
@@ -109,6 +109,12 @@
 
 exception Found of int
 
+(* TODO; FIXME; remove the function below. *)
+let select_moving a = (* temporary func - accept just one player w/ moves *)
+  let locs = Aux.array_find_all (fun l -> l.Arena.moves <> []) a in
+  if List.length locs <> 1 then failwith "too many moves" else
+    if locs = [] then a.(0) else List.hd locs
+
 let req_handle in_ch out_ch =
   try
     let time_started = Unix.gettimeofday () in
@@ -152,9 +158,9 @@
               r.ContinuousRule.discrete.DiscreteRule.lhs_struc in
 	    let m =
               List.map (fun (l, s) -> (fn lhs l, fn struc s)) mtch in
-            let moves =
-              Move.gen_moves Move.cGRID_SIZE rules
-                (snd !state).Arena.struc graph.((snd !state).Arena.cur_loc) in
+	    let loc = select_moving graph.((snd !state).Arena.cur_loc) in
+            let moves = Move.gen_moves Move.cGRID_SIZE
+	      rules (snd !state).Arena.struc loc in
             try
               for i = 0 to Array.length moves - 1 do
                 (* FIXME: handle time and params! *)
@@ -221,9 +227,10 @@
 
           if r_name <> "" then (
 	    let {Arena.rules=rules; graph=graph} = fst !state in
+	    let mv_loc = select_moving graph.((snd !state).Arena.cur_loc) in
             let moves =
               Move.gen_moves Move.cGRID_SIZE rules
-                (snd !state).Arena.struc graph.((snd !state).Arena.cur_loc) in
+                (snd !state).Arena.struc mv_loc in
             let pos =
               (try
                  for i = 0 to Array.length moves - 1 do
@@ -349,7 +356,8 @@
 let do_play game state depth1 depth2 advr heur1 heur2 =
   let cur_state = ref state in
   while Array.length (Move.list_moves game !cur_state) > 0 do
-    let pl = game.Arena.graph.(!cur_state.Arena.cur_loc).Arena.player in
+    let pl = Aux.array_argfind (fun l -> l.Arena.moves <> []) 
+      game.Arena.graph.(!cur_state.Arena.cur_loc) in
     let depth = if pl = 0 then depth1 else if pl = 1 then depth2 else
 	failwith "only 2-player games supported in experiments for now" in
     let timeo = if pl = 0 then !exp_p1_timeout else !exp_p2_timeout in
@@ -363,7 +371,8 @@
     print_endline ("Evals: " ^ (string_of_int !Solver.eval_counter));
     Solver.eval_counter := 0;
   done;
-  let payoffs = game.Arena.graph.(!cur_state.Arena.cur_loc).Arena.payoffs in
+  let payoffs = Array.map (fun l -> l.Arena.payoff)
+    game.Arena.graph.(!cur_state.Arena.cur_loc) in
   Array.map (fun p -> Solver.M.get_real_val p (!cur_state).Arena.struc) payoffs
 ;;
 


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