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

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

Revision: 1236
          http://toss.svn.sourceforge.net/toss/?rev=1236&view=rev
Author:   lukstafi
Date:     2010-12-08 00:23:46 +0000 (Wed, 08 Dec 2010)

Log Message:
-----------
Parsimony model in Heuristic.

Modified Paths:
--------------
    trunk/Toss/Formula/FFTNF.mli
    trunk/Toss/Play/Game.ml
    trunk/Toss/Play/GameTest.ml
    trunk/Toss/Play/Heuristic.ml
    trunk/Toss/Play/Heuristic.mli

Modified: trunk/Toss/Formula/FFTNF.mli
===================================================================
--- trunk/Toss/Formula/FFTNF.mli	2010-12-07 22:14:45 UTC (rev 1235)
+++ trunk/Toss/Formula/FFTNF.mli	2010-12-08 00:23:46 UTC (rev 1236)
@@ -14,6 +14,8 @@
 
 *)
 
+val parsimony_threshold_1 : int ref
+val parsimony_threshold_2 : int ref
 
 val debug_level : int ref
 

Modified: trunk/Toss/Play/Game.ml
===================================================================
--- trunk/Toss/Play/Game.ml	2010-12-07 22:14:45 UTC (rev 1235)
+++ trunk/Toss/Play/Game.ml	2010-12-08 00:23:46 UTC (rev 1236)
@@ -246,15 +246,18 @@
     if monotonic then
       Some (DiscreteRule.fluent_preconds drules signat fluents)
     else None in
-  Array.map (fun node -> Array.map
+  Array.mapi (fun i node -> Array.map
     (fun payoff ->
       (* {{{ log entry *)
-
-      if !debug_level > 3 then (
-        Printf.printf "default_heuristic: Computing of payoff %s...\n%!"
-          (Formula.sprint_real payoff);
+      if !debug_level > 4 then (
+        Printf.printf
+          "default_heuristic: Computing for loc %d of payoff %s...\n%!"
+          i (Formula.sprint_real payoff);
       );
-
+      if !debug_level = 4 then (
+        Printf.printf
+          "default_heuristic: Computing for loc %d\n%!" i;
+      );
       (* }}} *)
       Heuristic.of_payoff ?struc ?fluent_preconds advance_ratio
         (Aux.strings_of_list fluents) payoff)

Modified: trunk/Toss/Play/GameTest.ml
===================================================================
--- trunk/Toss/Play/GameTest.ml	2010-12-07 22:14:45 UTC (rev 1235)
+++ trunk/Toss/Play/GameTest.ml	2010-12-08 00:23:46 UTC (rev 1236)
@@ -568,11 +568,11 @@
   
   "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;
-      FFTNF.debug_level := 4;
+      Game.set_debug_level 3;
+      (* Heuristic.debug_level := 7; *)
+      (* FFTNF.debug_level := 7; *)
       let move_opt = (let p,ps = Game.initialize_default (snd state)
                         ~heur_adv_ratio:(fst state)
                         ~loc:0 ~effort:2
@@ -1096,7 +1096,7 @@
     );
 ]
 
-let a =
+let a () =
   Aux.run_test_if_target "GameTest" tests
 
 let a () = run_test_tt ~verbose:true experiments
@@ -1109,9 +1109,9 @@
 let a () =
   Game.set_debug_level 7
 
-let a () =
+let a =
   match test_filter
-    ["Game:0:misc:2:breakthrough payoff"]
+    ["Game:0:misc:1:play: chess suggest first move"]
     tests
   with
     | Some tests -> ignore (run_test_tt ~verbose:true tests)

Modified: trunk/Toss/Play/Heuristic.ml
===================================================================
--- trunk/Toss/Play/Heuristic.ml	2010-12-07 22:14:45 UTC (rev 1235)
+++ trunk/Toss/Play/Heuristic.ml	2010-12-08 00:23:46 UTC (rev 1236)
@@ -14,6 +14,19 @@
    H(Phi) = Alg(FFTNF(promote relations F) of Phi', True)
    where Phi' = ExpandedForm(F, S, FFTNF(promote relations F) of Phi)
 
+   Since formula transformations involved in generating the heuristic
+   are costly, we use the parsimony model from FFTNF:
+
+   (1) at parsimony level 1 (PARL1), we do not compute FFTNF prior to
+   expanding the formula:
+
+   H(Phi) = Alg(FFTNF(promote relations F) of Phi', True)
+   where Phi' = ExpandedForm(F, S, Phi)
+
+   (2) at parsimony level 2 (PARL2), we do not expand the formula:
+
+   H(Phi) = Alg(FFTNF(promote relations F) of Phi, True)
+
    Monotonic case (see also the definition of FFSEP(F) in {!FFTNF}
    module):
 
@@ -800,8 +813,8 @@
   ) guards in
   sum_exprs parts
 
-let of_payoff ?(max_alt_descr=5) ?struc ?fluent_preconds adv_ratio frels expr =
-  (* FIXME: what [gds] should be doing? it's not doing anything *)
+let of_payoff ?force_parsimony
+    ?(max_alt_descr=5) ?struc ?fluent_preconds adv_ratio frels expr =
   let rec aux gds = function
     | RVar _ 
     | Const _
@@ -809,29 +822,40 @@
     | Times (a, b) -> Times (aux gds a, aux gds b)
     | Plus (a, b) -> Plus (aux gds a, aux gds b)
     | Char phi ->
+      let parsimony_level =
+        match force_parsimony with
+          | Some parl -> parl
+          | None ->
+            let size = FormulaOps.size phi in
+            if size < !FFTNF.parsimony_threshold_1 then 0
+            else if size < !FFTNF.parsimony_threshold_2 then 1
+            else 2 in
       (match fluent_preconds with
         | None ->                       (* not monotonic *)
-          let phi' = match struc with
-            | Some struc ->
-              (* guards are currently ignored *)
-              (* {{{ log entry *)
-              if !debug_level > 2 then (
-                Printf.printf
-                  "Heuristic: for expanding, get ff-tnf of %s...\n%!"
-                  (Formula.sprint phi);
-              );
-              (* }}} *)
-              let phi'' =
-                FFTNF.ff_tnf (FFTNF.promote_rels frels) phi in
-              (* {{{ log entry *)
-              if !debug_level > 2 then (
-                Printf.printf
-                  "Heuristic: computing expanded form of %s...\n%!"
-                  (Formula.sprint phi'');
-              );
-              (* }}} *)
-              expanded_form max_alt_descr frels struc phi''
-            | None -> phi in
+          let phi' =
+            if parsimony_level > 1 then phi
+            else match struc with
+              | Some struc ->
+                (* TODO: summation guards [gds] are currently ignored *)
+                (* {{{ log entry *)
+                if !debug_level > 2 then (
+                  Printf.printf
+                    "Heuristic: for expanding, get ff-tnf of %s...\n%!"
+                    (Formula.sprint phi);
+                );
+                (* }}} *)
+                let phi'' =
+                  if parsimony_level > 0 then phi
+                  else FFTNF.ff_tnf (FFTNF.promote_rels frels) phi in
+                (* {{{ log entry *)
+                if !debug_level > 2 then (
+                  Printf.printf
+                    "Heuristic: computing expanded form of %s...\n%!"
+                    (Formula.sprint phi'');
+                );
+                (* }}} *)
+                expanded_form max_alt_descr frels struc phi''
+              | None -> phi in
           (* {{{ log entry *)
           if !debug_level > 2 then (
             Printf.printf

Modified: trunk/Toss/Play/Heuristic.mli
===================================================================
--- trunk/Toss/Play/Heuristic.mli	2010-12-07 22:14:45 UTC (rev 1235)
+++ trunk/Toss/Play/Heuristic.mli	2010-12-08 00:23:46 UTC (rev 1236)
@@ -82,7 +82,8 @@
 *)
 
 (** Heuristic of payoff expression. *)
-val of_payoff : ?max_alt_descr:int -> ?struc:Structure.structure ->
+val of_payoff : ?force_parsimony:int ->
+  ?max_alt_descr:int -> ?struc:Structure.structure ->
   ?fluent_preconds:(string * (string list * Formula.formula)) list ->
   float -> Aux.Strings.t -> Formula.real_expr -> Formula.real_expr
 


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