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

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

Revision: 1583
          http://toss.svn.sourceforge.net/toss/?rev=1583&view=rev
Author:   lukstafi
Date:     2011-09-30 18:50:42 +0000 (Fri, 30 Sep 2011)
Log Message:
-----------
GDL: refine and apply name cleaning.

Modified Paths:
--------------
    trunk/Toss/Formula/Aux.ml
    trunk/Toss/Formula/AuxTest.ml
    trunk/Toss/GGP/GDL.ml
    trunk/Toss/GGP/TranslateFormula.ml
    trunk/Toss/GGP/TranslateGame.ml
    trunk/Toss/GGP/TranslateGameTest.ml
    trunk/Toss/GGP/tests/2player_normal_form_2010-raw.toss
    trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss

Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml	2011-09-30 16:51:51 UTC (rev 1582)
+++ trunk/Toss/Formula/Aux.ml	2011-09-30 18:50:42 UTC (rev 1583)
@@ -588,13 +588,13 @@
 let is_letter c = is_uppercase c || is_lowercase c
 let is_alphanum c = is_letter c || is_digit c
 
-(* Changes a string [s] to use only alphanumeric characters and underscore
-   and to start with a lowercase letter. *)
+(* Changes a string [s] to use only alphanumeric characters and underscore. *)
 let clean_name s =
-  let res = ref "t" in
+  let res = ref "" in
   for i = 0 to (String.length s) - 1 do
-    if is_alphanum s.[i] then res := !res ^ (String.make 1 s.[i]) else
-      res := !res ^ "_" ^ (string_of_int (Char.code s.[i]))
+    if is_alphanum s.[i] || s.[i] = '_'
+    then res := !res ^ (String.make 1 s.[i])
+    else res := !res ^ "_" ^ (string_of_int (Char.code s.[i]))
   done;
   !res
 

Modified: trunk/Toss/Formula/AuxTest.ml
===================================================================
--- trunk/Toss/Formula/AuxTest.ml	2011-09-30 16:51:51 UTC (rev 1582)
+++ trunk/Toss/Formula/AuxTest.ml	2011-09-30 18:50:42 UTC (rev 1583)
@@ -469,10 +469,10 @@
 	false (Aux.is_alphanum '_');
 
       assert_equal ~printer:(fun x -> x)
-	"tala" (Aux.clean_name "ala");
+	"ala" (Aux.clean_name "ala");
 
       assert_equal ~printer:(fun x -> x)
-	"t_43_43" (Aux.clean_name "++");
+	"_43_43" (Aux.clean_name "++");
     );
 
 ]

Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml	2011-09-30 16:51:51 UTC (rev 1582)
+++ trunk/Toss/GGP/GDL.ml	2011-09-30 18:50:42 UTC (rev 1583)
@@ -74,19 +74,19 @@
     "(" ^ f ^ " " ^ 
       String.concat " " (Array.to_list (Array.map term_str args)) ^ ")"
 
-let rec term_to_name ?(nested=false) term =
-  let not_fo s = (* if strings are bad for FO vars, we add a prefix *)
-    (s = "") || (s.[0] = ':') || (s.[0] = '|') ||
-      (((Char.uppercase s.[0]) = s.[0]) && (not (Aux.is_digit s.[0]))) in
-  let s = match term with
+(* We turn the strings to alphanumeric and uncapitalize, so they are
+   valid FO variables. *)
+let term_to_name ?(nested=false) term =
+  let rec aux nested = function
     | Const c -> c
     | Var v -> v
     | Func (f, args) ->
       f ^ "_" ^ (if nested then "_S_" else "") ^
 	String.concat "_"
-	(Array.to_list (Array.map (term_to_name ~nested:true) args)) ^
+	(Array.to_list (Array.map (aux true) args)) ^
 	(if nested then "_Z_" else "") in
-  if not_fo s then "t" ^ s else s
+  let s = Aux.clean_name (aux nested term) in
+  if s.[0] = '_' then "t"^s else String.uncapitalize s
 
 let rec term_vars = function
   | Const _ -> Aux.Strings.empty
@@ -1747,12 +1747,13 @@
 (** Toss relations hold between subterms of GDL state terms: generate
     Toss relation name. *)
 let rel_on_paths rel paths_tup =
-  rel ^ "__" ^ String.concat "__" (List.map path_str paths_tup)
+  Aux.clean_name
+  (rel ^ "__" ^ String.concat "__" (List.map path_str paths_tup))
 
 (** Some Toss predicates are generated from a path and an expected
     subterm at that path. *)
 let pred_on_path_subterm path subterm =
-  path_str path ^ term_to_name subterm
+  Aux.clean_name (path_str path ^ term_to_name subterm)
 
 let counter_n = "gdl__counter"
 

Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml	2011-09-30 16:51:51 UTC (rev 1582)
+++ trunk/Toss/GGP/TranslateFormula.ml	2011-09-30 18:50:42 UTC (rev 1583)
@@ -122,7 +122,7 @@
     with Not_found -> failwith
       ("could not build arguments for relation "^rel) in
   let vtup = Array.of_list (List.map (var_of_term data) s_l) in
-  let rel_phi = Formula.Rel (rel, vtup) in
+  let rel_phi = Formula.Rel (Aux.clean_name rel, vtup) in
   if sign then rel_phi else Formula.Not rel_phi
 
 let minus a b = Formula.Plus (a, Formula.Times (Formula.Const (-1.), b))

Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml	2011-09-30 16:51:51 UTC (rev 1582)
+++ trunk/Toss/GGP/TranslateGame.ml	2011-09-30 18:50:42 UTC (rev 1583)
@@ -28,7 +28,15 @@
     clauses are only built from frame clauses, i.e. they handle only
     fluents that are preserved elsewhere.) Unfortunately it cannot be
     assumed that an element holding a non-preserved fluent is
-    different from an element where the fluent is to be added!
+    different from an element where the fluent is to be added! Extract
+    one variable under non-preserved fluent from the precondition to
+    LHS, if present, and duplicate the rewrite rule generating one
+    copy where the variable is equal to the "target" variable (head of
+    the "next" clause).
+
+    TODO-FIXME: limit translation as concurrent games to cases where
+    rules do not check fluents affected by other rules to be performed
+    concurrently.
 *)
 
 open GDL
@@ -85,7 +93,7 @@
     rule needs to match in at least one generated state to be kept). *)
 let playouts_for_rule_filtering = ref 4
 
-let env_player = Const "Environment"
+let env_player = Const "environment"
 
 type tossrule_data = {
   legal_tuple : term array;
@@ -913,7 +921,7 @@
             (* run_prolog_check_atom (rel, tup) program *)
             then (
               stable_rels := Aux.Strings.add rel !stable_rels;
-              Structure.add_rel_named_elems struc rel
+              Structure.add_rel_named_elems struc (Aux.clean_name rel)
                 (* we add the element repr. tuple if subterms, perhaps
                    several coming from a single element repr., are in
                    relation *)

Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml	2011-09-30 16:51:51 UTC (rev 1582)
+++ trunk/Toss/GGP/TranslateGameTest.ml	2011-09-30 18:50:42 UTC (rev 1583)
@@ -323,19 +323,17 @@
 
 let a () =
   set_debug_level 4;
-      game_test_case ~game_name:"connect4" ~player:"white"
-        ~own_plnum:0 ~opponent_plnum:1
-        ~loc0_rule_name:"drop_c11_noop"
-        ~loc0_emb:[
-          "cell_c11_h4__BLANK_", "cell_2_1__BLANK_";
-          "control__BLANK_", "control__BLANK_"]
-        ~loc0_move:"(drop 2)" ~loc0_noop:"noop"
-        ~loc1:1 ~loc1_rule_name:"noop_drop_c12"
-        ~loc1_emb:[
-          "cell_c12_h6__BLANK_", "cell_2_2__BLANK_";
-          "control__BLANK_", "control__BLANK_"]
-        ~loc1_noop:"noop" ~loc1_move:"(drop 2)";
-  (* failwith "tested"; *)
+      simult_test_case ~game_name:"2player_normal_form_2010" ~player:"row"
+        ~own_plnum:1 ~opp_plnum:2       (* 0 is environment! *)
+        ~own_rule_name:"m"
+        ~own_emb:["did__BLANK__m", "did__BLANK__r1";
+                  "synch_control_", "synch_control_"]
+        ~own_move:"r1"
+        ~opp_rule_name:"m2"
+        ~opp_emb:["did__BLANK__m2", "did__BLANK__c1";
+                  "synch_control_", "synch_control_"]
+        ~opp_move:"c1";
+  failwith "tested";
   ()
 
 

Modified: trunk/Toss/GGP/tests/2player_normal_form_2010-raw.toss
===================================================================
--- trunk/Toss/GGP/tests/2player_normal_form_2010-raw.toss	2011-09-30 16:51:51 UTC (rev 1582)
+++ trunk/Toss/GGP/tests/2player_normal_form_2010-raw.toss	2011-09-30 18:50:42 UTC (rev 1583)
@@ -5,7 +5,7 @@
   ex did__BLANK__m11
    (true and
     did_0row(did__BLANK__m11) and did__BLANK___BLANK_(did__BLANK__m11))
-PLAYERS Environment, row, column
+PLAYERS environment, row, column
 RULE m:
  [did__BLANK__m, synch_control_ |
     _opt_column__SYNC {did__BLANK__m; synch_control_};
@@ -55,7 +55,7 @@
   ] -> [synch_control_ |  | ]
   emb row__SYNC, column__SYNC, did_0column, did_0row
 LOC 0 {
-  PLAYER Environment { PAYOFF 0. MOVES [Environment -> 0] }
+  PLAYER environment { PAYOFF 0. MOVES [Environment -> 0] }
   PLAYER row {
   PAYOFF
    10. *

Modified: trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss
===================================================================
--- trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss	2011-09-30 16:51:51 UTC (rev 1582)
+++ trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss	2011-09-30 18:50:42 UTC (rev 1583)
@@ -3,7 +3,7 @@
   (did__BLANK___BLANK_(did__BLANK__m11) and did_0column(did__BLANK__m11)) or
   ex did__BLANK__m11
    (did__BLANK___BLANK_(did__BLANK__m11) and did_0row(did__BLANK__m11))
-PLAYERS Environment, row, column
+PLAYERS environment, row, column
 RULE m:
  [did__BLANK__m, synch_control_ |
     _opt_column__SYNC {did__BLANK__m; synch_control_};
@@ -53,7 +53,7 @@
   ] -> [synch_control_ |  | ]
   emb column__SYNC, did_0column, did_0row, row__SYNC
 LOC 0 {
-  PLAYER Environment { PAYOFF 0. MOVES [Environment -> 0] }
+  PLAYER environment { PAYOFF 0. MOVES [Environment -> 0] }
   PLAYER row {
   PAYOFF
    10. *

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