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

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

Revision: 1229
          http://toss.svn.sourceforge.net/toss/?rev=1229&view=rev
Author:   lukstafi
Date:     2010-12-06 00:46:05 +0000 (Mon, 06 Dec 2010)

Log Message:
-----------
Modified shortcut selection for board predicates (fixed single-character case). Revert to test suite in GameTest.

Modified Paths:
--------------
    trunk/Toss/Play/GameTest.ml
    trunk/Toss/Solver/Structure.ml
    trunk/Toss/Solver/StructureTest.ml

Modified: trunk/Toss/Play/GameTest.ml
===================================================================
--- trunk/Toss/Play/GameTest.ml	2010-12-06 00:34:31 UTC (rev 1228)
+++ trunk/Toss/Play/GameTest.ml	2010-12-06 00:46:05 UTC (rev 1229)
@@ -565,7 +565,7 @@
   
   "play: chess suggest first move" >::
     (fun () ->
-      (* todo "Payoff too difficult for heuristic generation."; *)
+      todo "Payoff too difficult for heuristic generation.";
       let state = chess_game in
       Game.set_debug_level 7;
       Heuristic.debug_level := 7;
@@ -1093,14 +1093,14 @@
     );
 ]
 
-let a () =
+let a =
   Aux.run_test_if_target "GameTest" tests
 
 let a () = run_test_tt ~verbose:true experiments
 
 
 (* The same content as in .toss files. *)
-let a =
+let a () =
   print_endline ("\n" ^ Arena.sprint_state (snd chess_game))
 
 let a () =

Modified: trunk/Toss/Solver/Structure.ml
===================================================================
--- trunk/Toss/Solver/Structure.ml	2010-12-06 00:34:31 UTC (rev 1228)
+++ trunk/Toss/Solver/Structure.ml	2010-12-06 00:46:05 UTC (rev 1229)
@@ -544,10 +544,13 @@
     - when there is no element in a position, the upper line is
     changed to "   " and the lower line to "*   "
 
-    - the predicates on an element are expressed using the least
-    amount of chars and the parsing/printing rules and written over
-    the default lower, then upper, line, remaining predicates are
-    stored to print separately
+    - the predicates on an element longer than one character are
+    expressed using two characters for relations with unique two
+    character prefix, and using three characters for unique three
+    character prefix (but 3 chars only for cases without
+    modifiers), and the parsing/printing rules, and written over the
+    default lower, then upper, line, remaining predicates are stored
+    to print separately
 
     - the row and column relations are determined such that they hold
     for all (existing) elements as required (they need not be
@@ -569,25 +572,17 @@
 
 (* Ignore special relations. *)
 let find_unique all_preds =
-  (* FIXME: don't force prefix-free *)
   let all_preds = List.filter (fun r -> r.[0] <> '_') all_preds in
   (* build a fixed depth trie *)
+  let uniq1, more_preds =
+    List.partition (fun r -> String.length r = 1) all_preds in
+  let uniq1 = List.map (fun p -> p,p) uniq1 in
   let trie1 = List.fold_left (fun trie pred ->
     if List.mem_assoc pred.[0] trie then
       let preds, trie = Aux.pop_assoc pred.[0] trie in
       (pred.[0], pred::preds)::trie
     else (pred.[0], [pred])::trie
-  ) [] all_preds in
-  let trie1 = List.map (fun (k,preds) ->
-    let trunc =
-      List.filter (fun r -> String.length r = 1) preds in
-    if trunc = [] then k, preds else k, trunc) trie1 in
-  let uniq1, trie1 = Aux.partition_map
-    (function (k,[pred]) -> Aux.Left (pred, Char.escaped k)
-      | subt -> Aux.Right subt) trie1 in
-  let trie1 = List.map
-    (fun (k, preds) -> k, List.filter
-      (fun pred -> String.length pred > 1) preds) trie1 in
+  ) [] more_preds in
 
   let trie2 = Aux.concat_map (fun (key, preds) ->
     let trie2 =
@@ -600,13 +595,11 @@
     List.map (fun (key2, preds) ->
       Char.escaped key ^ Char.escaped key2, preds) trie2
   ) trie1 in
-  let trie2 = List.map (fun (k,preds) ->
-    let trunc =
-      List.filter (fun r -> String.length r = 2) preds in
-    if trunc = [] then k, preds else k, trunc) trie2 in
   let uniq2, trie2 = Aux.partition_map
     (function (k,[pred]) -> Aux.Left (pred, k)
       | subt -> Aux.Right subt) trie2 in
+  (* deliberately losing two-char long predicates that are not
+     prefix-unique: they might be confusing *)
   let trie2 = List.map
     (fun (k, preds) -> k, List.filter
       (fun pred -> String.length pred > 2) preds) trie2 in

Modified: trunk/Toss/Solver/StructureTest.ml
===================================================================
--- trunk/Toss/Solver/StructureTest.ml	2010-12-06 00:34:31 UTC (rev 1228)
+++ trunk/Toss/Solver/StructureTest.ml	2010-12-06 00:46:05 UTC (rev 1229)
@@ -221,10 +221,25 @@
       test_parse ~msg:"Unique by 1 character"
 "[ | Alpha:1 {}; Beta:1 {} | ] \"
 	      
-	A  B  
+	Al Be 
+	   Al 
+	.  Be 
+\"";
+      (* "A" not in signature, because its name is recoverable from board *)
+      test_parse ~msg:"Single character + unique by 1 character"
+"[ | Alpha:1 {}; Beta:1 {} | ] \"
+	      
+	Al Be 
 	   A  
-	.  B  
+	.  Be 
 \"";
+      test_parse ~msg:"Single character + unique by 2 characters"
+"[ | Alpha:1 {}; Ampr:1 {} | ] \"
+	      
+	Al Am 
+	   A  
+	.  Am 
+\"";
       test_parse ~msg:"Unique by 3 characters"
 "[ | Aleph:1 {}; Alpha:1 {} | ] \"
 	      
@@ -240,16 +255,16 @@
       test_parse ~msg:"3 predicates"
 "[ | Alpha:1 {}; Beta:1 {}; Gamma:1 {} | ] \"
 	      
-	?  ?B 
+	?  ?Be
 	      
-	#A B? 
+	#AlBe?
 \"";
       test_parse ~msg:"2 predicates"
 "[ | Alpha:1 {}; Beta:1 {} | ] \"
 	      
-	?  ?B 
+	?  ?Be
 	      
-	#A B? 
+	#AlBe?
 \"";
     );
 


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