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

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

Revision: 1322
          http://toss.svn.sourceforge.net/toss/?rev=1322&view=rev
Author:   lukaszkaiser
Date:     2011-02-19 16:03:31 +0000 (Sat, 19 Feb 2011)

Log Message:
-----------
Moving heuristic generation from Game to Heuristic ml.

Modified Paths:
--------------
    trunk/Toss/GGP/GDL.ml
    trunk/Toss/Play/Game.ml
    trunk/Toss/Play/Game.mli
    trunk/Toss/Play/GameTest.ml
    trunk/Toss/Play/Heuristic.ml
    trunk/Toss/Play/Heuristic.mli
    trunk/Toss/Server/Server.ml

Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml	2011-02-17 21:59:46 UTC (rev 1321)
+++ trunk/Toss/GGP/GDL.ml	2011-02-19 16:03:31 UTC (rev 1322)
@@ -2671,7 +2671,7 @@
   playing_as := player;
   game_description := game_descr;
   player_name_terms := [|Const "X"; Const "O"|];
-  Game.use_monotonic := true;
+  Heuristic.use_monotonic := true;
   let effort, horizon, heur_adv_ratio =
     4, 100, 4.0 in
   effort, horizon, heur_adv_ratio
@@ -2681,7 +2681,7 @@
   playing_as := player;
   game_description := game_descr;
   player_name_terms := [|Const "WHITE"; Const "RED"|];
-  Game.use_monotonic := false;
+  Heuristic.use_monotonic := false;
   let effort, horizon, heur_adv_ratio =
     10, 100, 4.0 in
   effort, horizon, heur_adv_ratio

Modified: trunk/Toss/Play/Game.ml
===================================================================
--- trunk/Toss/Play/Game.ml	2011-02-17 21:59:46 UTC (rev 1321)
+++ trunk/Toss/Play/Game.ml	2011-02-19 16:03:31 UTC (rev 1322)
@@ -1,5 +1,3 @@
-
-(* -*- folded-file: t; -*- *)
 (* Game-related definitions. The UCTS algorithm. *)
 
 open Printf
@@ -12,7 +10,6 @@
 let set_debug_level i = (debug_level := i)
 
 let deterministic_suggest = ref false
-let use_monotonic = ref true
 
 (* A global "hurry up!" switch triggered by the timer alarm. *)
 let timeout = ref false
@@ -242,84 +239,8 @@
 
 let default_adv_ratio = 2.0
 
+let default_heuristic = Heuristic.default_heuristic
 
-let default_heuristic_old ?struc advance_ratio
-    {Arena.rules=rules; Arena.graph=graph} =
-  (* TODO: cache the default heuristic in game definition or state *)
-  let drules =
-    List.map (fun r -> (snd r).ContinuousRule.compiled) rules in
-  let fluents = Aux.concat_map DiscreteRule.fluents drules in
-  let frels = Aux.strings_of_list fluents in
-  let monotonic = !use_monotonic &&
-    List.for_all DiscreteRule.monotonic drules in
-  let signat_struc =
-    match struc with Some struc -> struc
-      | None ->
-        (snd (List.hd
-                rules)).ContinuousRule.discrete.DiscreteRule.rhs_struc in
-  let signat rel =
-    Structure.StringMap.find rel signat_struc.Structure.rel_signature in
-  let fluent_preconds =
-    if monotonic then
-      Some (DiscreteRule.fluent_preconds drules signat fluents)
-    else None in
-  Array.mapi (fun i node -> Array.map
-    (fun payoff ->
-      (* {{{ log entry *)
-      if !debug_level > (* 5 *) 1 then (
-        Printf.printf
-          "default_heuristic: Computing for loc %d of payoff %s...\n%!"
-          i (Formula.sprint_real payoff);
-      );
-      if !debug_level = 5 then (
-        Printf.printf
-          "default_heuristic: Computing for loc %d\n%!" i;
-      );
-      (* }}} *)
-      let res =
-        Heuristic.of_payoff ?struc ?fluent_preconds advance_ratio
-          frels payoff in
-      (* {{{ log entry *)
-      if !debug_level > (* 6 *) 1 then (
-        Printf.printf "default_heuristic: %s\n%!"
-          (Formula.sprint_real res)
-      );
-    (* }}} *)
-      res)
-    node.Arena.payoffs) graph
-
-let fluents_heuristic game = 
-  let (no_players, rules) = (game.Arena.num_players, game.Arena.rules) in
-  let pl_rules = Array.mapi
-    (fun i _ -> Arena.rules_for_player i game) (Array.create no_players 1) in
-  let pos_fluents_of_rule rname =
-    let drule = (List.assoc rname rules).ContinuousRule.compiled in
-    let list_upto_one s i =
-      let vx = Formula.fo_var_of_string "x" in
-      if i = 0 then Formula.Const (0.) else if i = 1 then
-	  Formula.Sum ([vx], Formula.Rel (s, [|vx|]), Formula.Const (1.))
-	else Formula.Const (0.) in
-    DiscreteRule.fluents_make ~only_pos:true list_upto_one drule in
-  let pl_fluents = Array.map (Aux.concat_map pos_fluents_of_rule) pl_rules in
-  let sums = Array.map (fun fl -> 
-    List.fold_left (fun s n-> Formula.Plus (n, s)) (Formula.Const (0.))
-      (Aux.unique_sorted fl)) pl_fluents in
-  let sum_all =
-    Array.fold_left (fun s n-> Formula.Plus (n, s)) (Formula.Const (0.)) sums in
-  let heurs = Array.map (fun f -> 
-    Formula.Plus (Formula.Times (Formula.Const (2.), f),
-		  Formula.Times (Formula.Const (-1.), sum_all))) sums in
-  Array.map (fun _ -> heurs) game.Arena.graph
-
-
-let mix_heur h1 factor h2 =
-  Array.mapi (fun i a -> Array.mapi (fun j p ->
-    Formula.Plus (p, Formula.Times (Formula.Const factor, h2.(i).(j)))) a) h1
-
-let default_heuristic ?struc advr g =
-  mix_heur (default_heuristic_old ?struc advr g) 0.2 (fluents_heuristic g)
-
-
 (* The UCB1-TUNED estimate, modified to extend to the zero- and
    one-observation cases. *)
 let ucb1_tuned ?(lower_bound=false)

Modified: trunk/Toss/Play/Game.mli
===================================================================
--- trunk/Toss/Play/Game.mli	2011-02-17 21:59:46 UTC (rev 1321)
+++ trunk/Toss/Play/Game.mli	2011-02-19 16:03:31 UTC (rev 1322)
@@ -4,7 +4,6 @@
 (** A global "hurry up!" switch triggered by the timer alarm. *)
 val get_timeout : unit -> bool
 val cancel_timeout : unit -> unit
-val use_monotonic : bool ref
 
 (** History stored for a play, including caching of computations for
     further use. *)
@@ -213,19 +212,7 @@
 val suggest : ?effort:int ->
   play -> play_state -> (move * play_state) option
 
-(** Various constructed heuristics. *)
-val mix_heur : Formula.real_expr array array -> float -> 
-  Formula.real_expr array array -> Formula.real_expr array array
 
-val default_heuristic : ?struc:Structure.structure -> float ->
-  Arena.game -> Formula.real_expr array array
-
-val default_heuristic_old : ?struc:Structure.structure -> float ->
-  Arena.game -> Formula.real_expr array array
-
-val fluents_heuristic : Arena.game -> Formula.real_expr array array
-
-
 (* ------------------------- DEBUGGING ------------------------------------- *)
 
 (** Debugging information. At level 0 nothing is printed out.

Modified: trunk/Toss/Play/GameTest.ml
===================================================================
--- trunk/Toss/Play/GameTest.ml	2011-02-17 21:59:46 UTC (rev 1321)
+++ trunk/Toss/Play/GameTest.ml	2011-02-19 16:03:31 UTC (rev 1322)
@@ -850,10 +850,10 @@
 	P  Q  Q  +Q .  .  .  
 \" with DiagA (x, y) = ex u (R(x, u) and C(u, y)) ;
         DiagB (x, y) = ex u (R(x, u) and C(y, u))" 0 in
-      Game.use_monotonic := false;
+      Heuristic.use_monotonic := false;
       easy_case state 0 "should attack"
         (fun mov_s -> "Cross{1:a4}" = mov_s);
-      Game.use_monotonic := true;
+      Heuristic.use_monotonic := true;
 );
 
   "connect4 avoid losing" >::
@@ -874,10 +874,10 @@
 	...   Q..P  P..P  Q..
 \" with DiagA (x, y) = ex u (R(x, u) and C(u, y)) ;
         DiagB (x, y) = ex u (R(x, u) and C(y, u))" 0 in
-      Game.use_monotonic := false;
+      Heuristic.use_monotonic := false;
       hard_case state 0 "should not attack"
         (fun mov_s -> "Cross{1:f3}" <> mov_s);
-      Game.use_monotonic := true;
+      Heuristic.use_monotonic := true;
 );
 
 
@@ -899,10 +899,10 @@
 	P  P  P  Q  Q  .  .  
 \" with DiagA (x, y) = ex u (R(x, u) and C(u, y)) ;
         DiagB (x, y) = ex u (R(x, u) and C(y, u))" 0 in
-      Game.use_monotonic := false;
+      Heuristic.use_monotonic := false;
       hard_case state 0 "should defend"
         (fun mov_s -> "Cross{1:e2}" = mov_s);
-      Game.use_monotonic := true 
+      Heuristic.use_monotonic := true 
 );
 
 
@@ -966,7 +966,7 @@
 let a () =
   Game.set_debug_level 10
 
-let a () = Game.use_monotonic := false
+let a () = Heuristic.use_monotonic := false
 
 let a () =
   match test_filter

Modified: trunk/Toss/Play/Heuristic.ml
===================================================================
--- trunk/Toss/Play/Heuristic.ml	2011-02-17 21:59:46 UTC (rev 1321)
+++ trunk/Toss/Play/Heuristic.ml	2011-02-19 16:03:31 UTC (rev 1322)
@@ -949,3 +949,83 @@
     Printf.printf "Heuristic.of_payoff %s =\n%s\n%!"
       (real_str expr) (real_str res);
   res
+
+
+(* ------------ HEURISTICS FINAL GENERATION ------------- *)
+
+let use_monotonic = ref true
+
+let default_heuristic_old ?struc advance_ratio
+    {Arena.rules=rules; Arena.graph=graph} =
+  (* TODO: cache the default heuristic in game definition or state *)
+  let drules =
+    List.map (fun r -> (snd r).ContinuousRule.compiled) rules in
+  let fluents = Aux.concat_map DiscreteRule.fluents drules in
+  let frels = Aux.strings_of_list fluents in
+  let monotonic = !use_monotonic &&
+    List.for_all DiscreteRule.monotonic drules in
+  let signat_struc =
+    match struc with Some struc -> struc
+      | None ->
+        (snd (List.hd
+                rules)).ContinuousRule.discrete.DiscreteRule.rhs_struc in
+  let signat rel =
+    Structure.StringMap.find rel signat_struc.Structure.rel_signature in
+  let fluent_preconds =
+    if monotonic then
+      Some (DiscreteRule.fluent_preconds drules signat fluents)
+    else None in
+  Array.mapi (fun i node -> Array.map
+    (fun payoff ->
+      (* {{{ log entry *)
+      if !debug_level > (* 5 *) 1 then (
+        Printf.printf
+          "default_heuristic: Computing for loc %d of payoff %s...\n%!"
+          i (Formula.sprint_real payoff);
+      );
+      if !debug_level = 5 then (
+        Printf.printf
+          "default_heuristic: Computing for loc %d\n%!" i;
+      );
+      (* }}} *)
+      let res =
+        of_payoff ?struc ?fluent_preconds advance_ratio frels payoff in
+      (* {{{ log entry *)
+      if !debug_level > (* 6 *) 1 then (
+        Printf.printf "default_heuristic: %s\n%!"
+          (Formula.sprint_real res)
+      );
+    (* }}} *)
+      res)
+    node.Arena.payoffs) graph
+
+let fluents_heuristic game = 
+  let (no_players, rules) = (game.Arena.num_players, game.Arena.rules) in
+  let pl_rules = Array.mapi
+    (fun i _ -> Arena.rules_for_player i game) (Array.create no_players 1) in
+  let pos_fluents_of_rule rname =
+    let drule = (List.assoc rname rules).ContinuousRule.compiled in
+    let list_upto_one s i =
+      let vx = Formula.fo_var_of_string "x" in
+      if i = 0 then Formula.Const (0.) else if i = 1 then
+	  Formula.Sum ([vx], Formula.Rel (s, [|vx|]), Formula.Const (1.))
+	else Formula.Const (0.) in
+    DiscreteRule.fluents_make ~only_pos:true list_upto_one drule in
+  let pl_fluents = Array.map (Aux.concat_map pos_fluents_of_rule) pl_rules in
+  let sums = Array.map (fun fl -> 
+    List.fold_left (fun s n-> Formula.Plus (n, s)) (Formula.Const (0.))
+      (Aux.unique_sorted fl)) pl_fluents in
+  let sum_all =
+    Array.fold_left (fun s n-> Formula.Plus (n, s)) (Formula.Const (0.)) sums in
+  let heurs = Array.map (fun f -> 
+    Formula.Plus (Formula.Times (Formula.Const (2.), f),
+		  Formula.Times (Formula.Const (-1.), sum_all))) sums in
+  Array.map (fun _ -> heurs) game.Arena.graph
+
+
+let mix_heur h1 factor h2 =
+  Array.mapi (fun i a -> Array.mapi (fun j p ->
+    Formula.Plus (p, Formula.Times (Formula.Const factor, h2.(i).(j)))) a) h1
+
+let default_heuristic ?struc advr g =
+  mix_heur (default_heuristic_old ?struc advr g) 0.2 (fluents_heuristic g)

Modified: trunk/Toss/Play/Heuristic.mli
===================================================================
--- trunk/Toss/Play/Heuristic.mli	2011-02-17 21:59:46 UTC (rev 1321)
+++ trunk/Toss/Play/Heuristic.mli	2011-02-19 16:03:31 UTC (rev 1322)
@@ -1,3 +1,5 @@
+val use_monotonic : bool ref
+
 (** Generate a heuristic from a payoff.
 
     Input: a set of relations F whose instances can be altered duirng a
@@ -90,3 +92,16 @@
 (** Rewrite numeric constants inside an expression. *)
 val map_constants :
   (float -> float) -> Formula.real_expr -> Formula.real_expr
+
+
+(** Various constructed heuristics. *)
+val mix_heur : Formula.real_expr array array -> float -> 
+  Formula.real_expr array array -> Formula.real_expr array array
+
+val default_heuristic : ?struc:Structure.structure -> float ->
+  Arena.game -> Formula.real_expr array array
+
+val default_heuristic_old : ?struc:Structure.structure -> float ->
+  Arena.game -> Formula.real_expr array array
+
+val fluents_heuristic : Arena.game -> Formula.real_expr array array

Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml	2011-02-17 21:59:46 UTC (rev 1321)
+++ trunk/Toss/Server/Server.ml	2011-02-19 16:03:31 UTC (rev 1322)
@@ -531,22 +531,22 @@
   let game = !state.Arena.game in
   let heur1 =
     if (!heur_val_white1 = "MIX" || !heur_val_black1 = "MIX") then
-      Game.default_heuristic ~struc:!state.Arena.struc heur_adv_ratio game
+      Heuristic.default_heuristic ~struc:!state.Arena.struc heur_adv_ratio game
     else if (!heur_val_white1 = "FLUENT" || !heur_val_black1 = "FLUENT") then
-      Game.fluents_heuristic game
+      Heuristic.fluents_heuristic game
     else if (!heur_val_white1 <> "" && !heur_val_black1 <> "") then
       heur_of_vals !heur_val_white1 !heur_val_black1
     else
-      Game.default_heuristic_old ~struc:!state.Arena.struc heur_adv_ratio game in
+      Heuristic.default_heuristic_old ~struc:!state.Arena.struc heur_adv_ratio game in
   let heur2 =
     if (!heur_val_white2 = "MIX" || !heur_val_black2 = "MIX") then
-      Game.default_heuristic ~struc:!state.Arena.struc heur_adv_ratio game
+      Heuristic.default_heuristic ~struc:!state.Arena.struc heur_adv_ratio game
     else if (!heur_val_white2 = "FLUENT" || !heur_val_black2 = "FLUENT") then
-      Game.fluents_heuristic game
+      Heuristic.fluents_heuristic game
     else if (!heur_val_white2 <> "" && !heur_val_black2 <> "") then
       heur_of_vals !heur_val_white2 !heur_val_black2
     else
-      Game.default_heuristic_old ~struc:!state.Arena.struc heur_adv_ratio game in
+      Heuristic.default_heuristic_old ~struc:!state.Arena.struc heur_adv_ratio game in
   if !debug_level > 0 then (print_heur "1" heur1; print_heur "2" heur2);
   let play = {Game.game = game; agents=
       [| Game.default_maximax !state.Arena.struc ~depth:depth1
@@ -589,7 +589,7 @@
       GDL.manual_game := s; GDL.manual_translation := true),
      " GDL game for manual (i.e. hard-coded) translation (tictactoe, breakthrough, etc.)");
     ("-f", Arg.String (fun s -> set_state_from_file s), " open file");
-    ("-nm", Arg.Unit (fun () -> Game.use_monotonic := false), " turn monotonicity off");
+    ("-nm", Arg.Unit (fun () -> Heuristic.use_monotonic := false), " turn monotonicity off");
     ("-p", Arg.Int (fun i -> (port := i)), " port number (default: 8110)");
     ("-t", Arg.Int (fun i -> (dtimeout := i)), " timeout (default: none)");
     ("-heur-white-1", Arg.String (fun s -> heur_val_white1 := s), 


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