Thread: [Toss-devel-svn] SF.net SVN: toss:[1544] trunk/Toss (Page 9)
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
toss-devel-svn
|
From: <luk...@us...> - 2011-08-26 14:33:43
|
Revision: 1544
http://toss.svn.sourceforge.net/toss/?rev=1544&view=rev
Author: lukstafi
Date: 2011-08-26 14:33:35 +0000 (Fri, 26 Aug 2011)
Log Message:
-----------
GDL translation: (fix) expand frame clasues for generating erasure clauses; (optimization) filter unrequired (mostly erasure) rule clauses before splitting rule candidates; various bug fixes (e.g. sign of Distinct atoms); specification-level fix for handling <negative true> literals during formula translation; related, adding blanked out <true> atoms of RHS terms to rewrite rule conditions just prior to translation. GameSimpl: minor bug fix; removing unused defined relations.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/Formula/FormulaOps.ml
trunk/Toss/Formula/FormulaOps.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/GameSimpl.ml
trunk/Toss/GGP/TranslateFormula.ml
trunk/Toss/GGP/TranslateFormula.mli
trunk/Toss/GGP/TranslateFormulaTest.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/GGP/tests/breakthrough-raw.toss
trunk/Toss/GGP/tests/breakthrough-simpl.toss
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-08-21 10:27:37 UTC (rev 1543)
+++ trunk/Toss/Formula/Aux.ml 2011-08-26 14:33:35 UTC (rev 1544)
@@ -458,6 +458,17 @@
done;
!r
+let list_find_all_max cmp l =
+ match l with
+ | [] -> []
+ | a::l -> List.fold_left
+ (fun all_max cand ->
+ let res = cmp cand (List.hd all_max) in
+ if res > 0 then [cand]
+ else if res = 0 then cand::all_max
+ else all_max)
+ [a] l
+
let array_find_all_max cmp a =
let n = Array.length a in
if n=0 then []
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-08-21 10:27:37 UTC (rev 1543)
+++ trunk/Toss/Formula/Aux.mli 2011-08-26 14:33:35 UTC (rev 1544)
@@ -249,6 +249,8 @@
arrays are of different lengths. *)
val array_for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
+(** Find all maximal elements in a list. *)
+val list_find_all_max : ('a -> 'a -> int) -> 'a list -> 'a list
(** Find all maximal elements in an array. *)
val array_find_all_max : ('a -> 'a -> int) -> 'a array -> 'a list
(** Find indices of all maximal elements in an array. *)
Modified: trunk/Toss/Formula/FormulaOps.ml
===================================================================
--- trunk/Toss/Formula/FormulaOps.ml 2011-08-21 10:27:37 UTC (rev 1543)
+++ trunk/Toss/Formula/FormulaOps.ml 2011-08-26 14:33:35 UTC (rev 1544)
@@ -1052,6 +1052,9 @@
let as_conjuncts phi =
let rec conjuncts = function
| And fl -> Aux.concat_map conjuncts fl
+ | Not (And [f]) -> conjuncts (Not f)
+ | Not (Or fl) ->
+ Aux.concat_map conjuncts (List.map (fun f->Not f) fl)
| All (vs, f) -> List.map (fun f -> All (vs, f)) (conjuncts f)
| Ex (vs, phi) ->
(match conjuncts phi with
Modified: trunk/Toss/Formula/FormulaOps.mli
===================================================================
--- trunk/Toss/Formula/FormulaOps.mli 2011-08-21 10:27:37 UTC (rev 1543)
+++ trunk/Toss/Formula/FormulaOps.mli 2011-08-26 14:33:35 UTC (rev 1544)
@@ -43,7 +43,7 @@
map_Sum : fo_var list -> formula -> real_expr -> real_expr
}
-(** Identity map to be refined using the [with] clause. *)
+(** Identity map to be refined using the [with] syntax. *)
val identity_map : formula_and_expr_map
(** Map through the structure adjusting subformulas/subexpressions. *)
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-08-21 10:27:37 UTC (rev 1543)
+++ trunk/Toss/GGP/GDL.ml 2011-08-26 14:33:35 UTC (rev 1544)
@@ -95,6 +95,8 @@
| True arg -> "true", [|arg|]
| Does (arg1, arg2) -> "does", [|arg1; arg2|]
+(** Remember that [rel_of_atom] inverts polarity of "distinct" --
+ invert back after using [atom_of_rel] if needed. *)
let atom_of_rel = function
| "distinct", args -> Distinct args
(* not a proper relation -- avoid *)
@@ -106,7 +108,7 @@
let rec bodies_of_literal = function
| Pos (Distinct args) ->
[Aux.Right ("distinct", args)] (* not negated actually! *)
- | Neg (Distinct _) -> assert false
+ | Neg (Distinct args) -> [Aux.Left ("distinct",args)]
| Pos atom -> [Aux.Left (rel_of_atom atom)]
| Neg atom -> [Aux.Right (rel_of_atom atom)]
| Disj disjs ->
@@ -201,8 +203,36 @@
not (List.mem_assoc rel1 rules))
body) branches) stratum in
stratify (stratum::strata) (more_rules @ rules)
-
+(* Topological-like sort w.r.t. the call-graph. *)
+let topsort_callgraph clauses for_rels =
+ let defs = defs_of_rules (Aux.concat_map rules_of_clause clauses) in
+ (* building incidence list *)
+ let defs = List.map
+ (fun (rel, brs) ->
+ rel,
+ Aux.concat_map (fun (_,body,neg_body) ->
+ List.map fst body @ List.map fst neg_body) brs)
+ defs in
+ let defs = List.map
+ (fun (rel, drels) ->
+ rel, Aux.strings_of_list (Aux.list_inter drels for_rels)) defs in
+ let rec aux strata defs =
+ if defs = [] then List.flatten (List.rev strata)
+ else
+ (* like in topological sort, but don't restrict to empty call set *)
+ let stratum = Aux.list_find_all_max
+ (fun (_,a) (_,b) ->
+ Aux.Strings.cardinal b - Aux.Strings.cardinal a) defs in
+ let stratum = List.map fst stratum in
+ let visited = Aux.strings_of_list stratum in
+ let defs = List.filter
+ (fun (r,_) -> not (Aux.Strings.mem r visited)) defs in
+ let defs = List.map
+ (fun (r,calls) -> r, Aux.Strings.diff calls visited) defs in
+ aux (stratum::strata) defs in
+ aux [] (List.filter (fun (r,_) -> List.mem r for_rels) defs)
+
let rec subst_one (x, term as sb) = function
| Var y when x=y -> term
| (Const _ | Var _ as t) -> t
@@ -236,7 +266,7 @@
| _ -> raise Not_found
-(** A "blank" term. *)
+(** A "blank", or "wild-card", term. *)
let blank = Const "_BLANK_"
(* Match terms on the left to ground terms on the right, ignoring
@@ -714,6 +744,7 @@
used_vars := Aux.StrMap.fold (fun _ cls acc ->
Aux.Strings.union (clauses_vars cls) acc) p Aux.Strings.empty;
used_vars := Aux.Strings.union !used_vars (clause_vars (("",[||]),g));
+ let g = preprocess_cl_body g in
let sc_init fc sb = fun m -> fc () (sb::m) in
let fc_init () = fun m -> m in
let extract res = res [] in
@@ -731,6 +762,7 @@
used_vars := Aux.StrMap.fold (fun _ cls acc ->
Aux.Strings.union (clauses_vars cls) acc) p Aux.Strings.empty;
used_vars := Aux.Strings.union !used_vars (clause_vars (("",[||]),g));
+ let g = preprocess_cl_body g in
let sc_init fc _ = true in
let fc_init () = false in
run_goal g p sc_init fc_init []
@@ -740,10 +772,10 @@
(* ************************************************************ *)
(** {3 Transformations of GDL clauses: inlining, negation.} *)
-(** Expand branches of a definition inlining the provided definitions,
- only expand positive literals. Iterate expansion to support
- nesting of definitions. *)
-let expand_positive_lits defs brs =
+(** Expand branches of a definition inlining the provided
+ definitions. Iterate expansion to support nesting of
+ definitions. *)
+let expand_definitions defs brs =
let used_vars = ref (gdl_defs_vars (("",brs)::defs)) in
let freshen_brs brs =
let br_vars = gdl_defs_vars ["",brs] in
@@ -755,7 +787,7 @@
(Aux.Strings.elements br_vars) in
let sb = List.map (fun (v,t) -> v, Var t) sb in
List.map (subst_br sb) brs in
- let expand_atom (rel, args as atom)
+ let expand_pos_atom (rel, args as atom)
(sb, (head, r_body, r_neg_body)) =
(let try def_brs = freshen_brs (List.assoc rel defs) in
let args = Array.map (subst sb) args in
@@ -766,10 +798,39 @@
sb, subst_br sb r_br
) def_brs
with Not_found ->
- [sb, (head, atom::r_body, r_neg_body)]) in
+ [sb, (head, (subst_rel sb atom)::r_body, r_neg_body)]) in
+ let pack_lits body neg_body =
+ List.map (fun a->Aux.Left a) body @
+ List.map (fun a->Aux.Right a) neg_body in
+ let expand_neg_atom (rel, args as atom)
+ (sb, (head, r_body, r_neg_body)) =
+ (let try def_brs = freshen_brs (List.assoc rel defs) in
+ let args = Array.map (subst sb) args in
+ let def_brs = Aux.map_try
+ (fun (params,body,neg_body) ->
+ let sb = unify_args ~sb params args in
+ let body = List.map (subst_rel sb) body
+ and neg_body = List.map (subst_rel sb) neg_body in
+ (* do not propagate the substitution further *)
+ pack_lits body neg_body)
+ def_brs in
+ if def_brs = [] then
+ [sb, (head, r_body, r_neg_body)]
+ else
+ (* DNF of the negation of [def_brs] disjunction --
+ [Left]/[Right] switch meaning *)
+ let dnf_of_neg = Aux.product def_brs in
+ List.map (fun dnf_br ->
+ let d_neg_body, d_body = Aux.partition_choice dnf_br in
+ sb, (head, d_body @ r_body, d_neg_body @ r_neg_body)
+ ) dnf_of_neg
+ with Not_found ->
+ [sb, (head, r_body, (subst_rel sb atom)::r_neg_body)]) in
+
let expand_br (head, body, neg_body) =
- let init = [[], (head, [], neg_body)] in
- Aux.concat_foldr expand_atom body init in
+ let init = [[], (head, [], [])] in
+ Aux.concat_foldr expand_neg_atom neg_body
+ (Aux.concat_foldr expand_pos_atom body init) in
let rec fix n_brs brs i =
let brs = Aux.concat_map expand_br brs in
let new_n_brs = List.length brs in
@@ -787,15 +848,18 @@
let placeholder = "", [] in
let clauses = List.map (fun body -> placeholder, body) conjs in
let clauses = Aux.concat_map rules_of_clause clauses in
+ let pos = function Distinct _ as a -> Neg a | a -> Pos a in
+ let neg = function Distinct _ as a -> Pos a | a -> Neg a in
let clauses = List.map (fun (_,body,neg_body) ->
- List.map (fun a -> Pos (atom_of_rel a)) body @
- List.map (fun a -> Neg (atom_of_rel a)) neg_body) clauses in
+ List.map (fun a -> pos (atom_of_rel a)) body @
+ List.map (fun a -> neg (atom_of_rel a)) neg_body) clauses in
let negated = Aux.product clauses in
(* can raise [Not_found] in case of unsatisfiable "not distinct" *)
let nclause body =
let uniterms, lits =
Aux.partition_map (function
- | Neg (Distinct terms) -> Aux.Left (Array.to_list terms)
+ (* we negate! so not (Pos Distinct) here *)
+ | Pos (Distinct terms) -> Aux.Left (Array.to_list terms)
| Neg atom -> Aux.Right (Pos atom)
| Pos atom -> Aux.Right (Neg atom)
| Disj _ -> assert false) body in
@@ -1543,3 +1607,36 @@
List.fold_left (fun clauses (p, ts) ->
expand_path_vars_by prepare_lits p ts clauses
) clauses ps_sterms
+
+
+let blank_outside_subterm arities path subterm =
+ List.fold_right
+ (fun (rel, pos) acc ->
+ let subterms = Array.make (List.assoc rel arities) blank in
+ subterms.(pos) <- acc;
+ Func (rel, subterms))
+ path subterm
+
+(** Find a path in a term and substitute, raise [Not_found] if path
+ not present. Push past blank subterms. [subst_at_path a p s blank]
+ is the same as [blank_outside_subterm a p s]. *)
+let subst_past_blank arities p s t =
+ let rec aux = function
+ | [], _ -> s
+ | (rel1, pos)::p, Func (rel2, args) when rel1 = rel2 ->
+ let args = Array.copy args in
+ args.(pos) <- aux (p, args.(pos));
+ Func (rel1, args)
+ | (rel, pos)::p, t when t = blank ->
+ let subterms = Array.make (List.assoc rel arities) blank in
+ subterms.(pos) <- aux (p, blank);
+ Func (rel, subterms)
+ | _ -> raise Not_found in
+ aux (p, t)
+
+let blank_outside_subterms arities path_subts =
+ try
+ List.fold_left (fun acc (p, s) -> subst_past_blank arities p s acc)
+ blank path_subts
+ with Not_found ->
+ invalid_arg "blank_outside_subterms: conflicting paths"
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-08-21 10:27:37 UTC (rev 1543)
+++ trunk/Toss/GGP/GDL.mli 2011-08-26 14:33:35 UTC (rev 1544)
@@ -112,11 +112,15 @@
(** {3 Transformations of GDL clauses: inlining, negation.} *)
-(** Expand branches of a definition inlining the provided definitions,
- only expand positive literals. Iterate expansion to support
- nesting of definitions. *)
-val expand_positive_lits : gdl_defs -> def_branch list -> def_branch list
+(** Expand branches of a definition inlining the provided
+ definitions. Iterate expansion to support nesting of
+ definitions. *)
+val expand_definitions : gdl_defs -> def_branch list -> def_branch list
+(** Remember that [rel_of_atom] inverts polarity of "distinct" --
+ invert back after using [atom_of_rel] if needed. *)
+val atom_of_rel : rel_atom -> atom
+
(** Form clause bodies whose disjunction is equivalent to the
negation of disjunction of given clause bodies. Keep the
substitution so that the heads of corresponding clauses can be
@@ -154,6 +158,8 @@
val literal_str : literal -> string
val clause_str : clause -> string
+val topsort_callgraph : clause list -> string list -> string list
+
(** {3 GDL whole-game operations.}
Aggregate and random playout, player-denoting variable elimination. *)
@@ -235,10 +241,17 @@
val path_str : path -> string
-(* [ground_vars_at_paths prepare_lits ps_sterms clauses] expands
- variables that have occurrences at paths in [ps_sterms] in some
- state term of a clause (from which pre-processed literals are
- extracted by [prepare_lits]), by terms provided in [ps_sterms]. *)
+(** [ground_vars_at_paths prepare_lits ps_sterms clauses] expands
+ variables that have occurrences at paths in [ps_sterms] in some
+ state term of a clause (from which pre-processed literals are
+ extracted by [prepare_lits]), by terms provided in [ps_sterms]. *)
val ground_vars_at_paths :
(clause -> literal list) ->
(path * term list) list -> clause list -> clause list
+
+
+val blank_outside_subterm :
+ (string * int) list -> path -> term -> term
+
+val blank_outside_subterms :
+ (string * int) list -> (path * term) list -> term
Modified: trunk/Toss/GGP/GameSimpl.ml
===================================================================
--- trunk/Toss/GGP/GameSimpl.ml 2011-08-21 10:27:37 UTC (rev 1543)
+++ trunk/Toss/GGP/GameSimpl.ml 2011-08-26 14:33:35 UTC (rev 1544)
@@ -99,10 +99,13 @@
used; if [keep_nonempty_predicates] is true, do not remove
predicates.
+ Remove unused defined relations. Note that recursion loops are not
+ handled (i.e. mutually recursive relations are not removed).
+
FIXME: why some unused (non-empty) predicates end up being empty?
TODO: require an explicit set of relations to keep instead of
- [keep_nonempty_predicates].
+ [keep_nonempty_predicates]. ???
(5) TODO: Glue redundant rules (equal and having the same roles in
the game graph).
@@ -479,13 +482,14 @@
Structure.add_rels struc grel tuples in
(* preparing (3a-d) *)
- let add_rel rel acc =
+ let add_rel excl rel acc =
match rel with
- | Rel (rel,_) -> Aux.Strings.add rel acc
+ | Rel (rel,_) when rel <> excl -> Aux.Strings.add rel acc
| _ -> acc in
+ let add_rels excl = FormulaOps.fold_over_atoms (add_rel excl) in
let used_rels =
Arena.fold_over_formulas ~include_defined_rels:false
- (FormulaOps.fold_over_atoms add_rel)
+ (add_rels "")
game Aux.Strings.empty in
let used_rels = ref used_rels in
let struc = ref state.Arena.struc in
@@ -829,22 +833,39 @@
(* 4 *)
(* since relations relevant for LHS structures occur in the
"embedding formula", we can freely remove from all structures
- static relations that do not occur in any formula *)
+ the relations that do not occur in any formula *)
let used_rels =
Arena.fold_over_formulas ~include_defined_rels:false
- (FormulaOps.fold_over_atoms add_rel)
+ (FormulaOps.fold_over_atoms (add_rels ""))
game Aux.Strings.empty in
+ let used_in_def =
+ List.fold_right (fun (drel, (_, def)) -> add_rels drel def)
+ game.Arena.defined_rels Aux.Strings.empty in
+ let used_in_def, defined_rels =
+ let rec aux (used_in_def, defined_rels) =
+ let defined_rels = List.filter
+ (fun (r, _) -> Aux.Strings.mem r used_rels ||
+ Aux.Strings.mem r used_in_def)
+ defined_rels in
+ let now_used_in_def =
+ List.fold_right (fun (drel, (_, def)) -> add_rels drel def)
+ defined_rels Aux.Strings.empty in
+ if Aux.Strings.subset used_in_def now_used_in_def
+ then now_used_in_def, defined_rels
+ else aux (now_used_in_def, defined_rels) in
+ aux (used_in_def, game.Arena.defined_rels) in
+ let used_rels = Aux.Strings.union used_in_def used_rels in
+ let game = {game with Arena.defined_rels = defined_rels} in
let clear_rel rel =
let rel =
if DiscreteRule.special_rel_of rel = None then rel
else DiscreteRule.orig_rel_of rel in
let res =
(not keep_nonempty_predicates ||
- List.assoc rel signat > 1 ||
+ (try List.assoc rel signat > 1 with Not_found -> false) ||
Structure.rel_size !struc rel = 0
) &&
not (Aux.Strings.mem rel fluents) &&
- not (List.mem_assoc rel game.Arena.defined_rels) &&
not (Aux.Strings.mem rel used_rels) in
(* {{{ log entry *)
if !debug_level > 2 && res then (
Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml 2011-08-21 10:27:37 UTC (rev 1543)
+++ trunk/Toss/GGP/TranslateFormula.ml 2011-08-26 14:33:35 UTC (rev 1544)
@@ -56,9 +56,7 @@
) state_terms in
other, pos_terms, neg_terms) disj
-(* Whether $i$th argument is a $\mathrm{DefSide}$ or a
- $\mathrm{CallSide}$, and the $p_{R,i}$ path for a relation $R$. *)
-type defrel_arg_mode = (bool * path) array
+type defrel_argpaths = (GDL.path * int) list list
type transl_data = {
f_paths : path_set; (* fluent paths *)
@@ -66,7 +64,7 @@
all_paths : path_set; (* sum of f_paths and m_paths *)
mask_reps : term list; (* mask terms *)
defined_rels : string list;
- defrel_arg_mode : (string * defrel_arg_mode) list ref;
+ mutable defrel_argpaths : (string * defrel_argpaths) list;
(* late binding to store $ArgMode# data *)
term_arities : (string * int) list;
rel_default_path : (string * path option array) list;
@@ -78,7 +76,7 @@
all_paths = empty_path_set;
mask_reps = [];
defined_rels = [];
- defrel_arg_mode = ref [];
+ defrel_argpaths = [];
term_arities = [];
rel_default_path = [];
}
@@ -89,25 +87,34 @@
let var_of_term data t =
Formula.fo_var_of_string (term_to_name (blank_out data t))
-let blank_outside_subterm data path subterm =
- let arities = data.term_arities in
- List.fold_right
- (fun (rel, pos) acc ->
- let subterms = Array.make (List.assoc rel arities) blank in
- subterms.(pos) <- acc;
- Func (rel, subterms))
- path subterm
-
let var_of_subterm data path subt =
Formula.fo_var_of_string
- (term_to_name (blank_outside_subterm data path subt))
+ (term_to_name (blank_outside_subterm data.term_arities path subt))
-(* placeholder *)
-let translate_defrel =
- ref (fun data sterms_all sterms_in s_subterms sign rel args ->
- assert false)
+let var_of_subterms data path_subts =
+ Formula.fo_var_of_string
+ (term_to_name (blank_outside_subterms data.term_arities path_subts))
-let transl_rels data rels_phi sterms_all sterms_in =
+
+let find_defrel_arg sterms args apset =
+ List.find
+ (fun s -> List.for_all (fun (p,i) -> at_path s p = args.(i)) apset)
+ sterms
+
+let translate_defrel data sterms sign rel args =
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf "translate_defrel: phi=%s, sign=%b\n"
+ (rel_atom_str (rel, args)) sign
+ );
+ (* }}} *)
+ let partition = List.assoc rel data.defrel_argpaths in
+ let s_l = List.map (find_defrel_arg sterms args) partition in
+ let vtup = Array.of_list (List.map (var_of_term data) s_l) in
+ let defrel_phi = Formula.Rel (rel, vtup) in
+ if sign then defrel_phi else Formula.Not defrel_phi
+
+let transl_rels data rels_phi sterms_all vterms_in =
(* within-mask subterms to locate paths on which to generate relations *)
let s_subterms = Aux.concat_map
(fun sterm ->
@@ -132,7 +139,8 @@
let stuples = Aux.product stuples in
let stuples = List.filter
(fun stup ->
- List.exists (fun (sterm,_) -> List.mem sterm sterms_in) stup)
+ List.exists (fun (sterm,_) ->
+ List.mem (var_of_term data sterm) vterms_in) stup)
stuples in
let atoms = Aux.map_some
(fun stup ->
@@ -151,8 +159,7 @@
let transl_posdefrel sign rel args =
if List.mem rel data.defined_rels
then
- [!translate_defrel data sterms_all sterms_in
- s_subterms sign rel args]
+ [translate_defrel data sterms_all sign rel args]
else transl_rel sign rel args in
let rec aux = function
| Pos (Rel (rel, args)) -> transl_posdefrel true rel args
@@ -263,7 +270,7 @@
neg_ext @
[
(* positive because they form a "premise" *)
- transl_rels data rels_eqs all_terms neg_terms;
+ transl_rels data rels_eqs all_terms neg_vars;
(* the universal "conclusion" *)
negated_neg_state_transl]) in
let universal_part =
@@ -275,7 +282,7 @@
let base_part =
Formula.And (
pos_ext @
- [ transl_rels data rels_eqs pos_terms pos_terms;
+ [ transl_rels data rels_eqs pos_terms pos_vars;
transl_state data pos_state_phi] @
universal_part) in
if pos_vars = [] then base_part
@@ -294,187 +301,173 @@
(* **************************************** *)
(* {3 Build and use defined relations.} *)
-let select_defrel_argpaths data all_branches =
- (* TODO: code-review this and [build_defrel] functions *)
- let select_for_defrel rel =
- (* searching for ArgMode = DefSide,S,p *)
- let branches = Aux.assoc_all rel all_branches in
- (* {{{ log entry *)
- if !debug_level > 2 then (
- Printf.printf "select_defrel_argpaths: rel=%s, no of brs=%d\n%!"
- rel (List.length branches)
- );
- (* }}} *)
- (* first find the common paths, we will find the state terms later *)
- let branch_paths =
- List.map (fun (args, (_, sterms_pos, sterms_neg)) ->
- let sterms = state_terms (sterms_pos @ sterms_neg) in
- Array.map (fun arg ->
- Aux.concat_map (fun sterm ->
- Aux.map_some (fun x->x)
- (map_paths (fun p subt ->
- if subt = arg then Some p else None) data.m_paths sterm)
- ) sterms) args
- ) branches in
- let p_defside = List.fold_left
- (Aux.array_map2 Aux.list_inter)
- (List.hd branch_paths) (List.tl branch_paths) in
- let p_defside = Array.map
- (function path::_ -> Some path | [] -> None) p_defside in
- (* now find the mapping $\calS_i$ for the DefSide result *)
- let branch_sterms (args, (_, sterms_pos, sterms_neg)) =
- let sterms = state_terms (sterms_pos @ sterms_neg) in
- Aux.array_map2
- (fun arg -> function None -> None
- | Some path ->
- Some (List.find (fun sterm ->
- List.mem (Some path)
- (map_paths (fun p subt ->
- if subt = arg then Some p else None) data.m_paths sterm)
- ) sterms))
- args p_defside in
- let s_defside = List.map branch_sterms branches in
- (* now computing the ArgMode(R,i) = CallSide,p variant *)
- let call_branches = Aux.concat_map
- (fun (_,(_, (phi, _, _ as body))) ->
- let calls = Aux.assoc_all rel (rel_atoms phi) in
- List.map (fun args -> args, body) calls
- ) all_branches in
- let callside_for_arg i =
- let call_paths = Aux.concat_map
- (fun (args, (_, sterms_pos, sterms_neg)) ->
- let sterms = state_terms (sterms_pos @ sterms_neg)
- and arg = args.(i) in
- let paths = Aux.concat_map (fun sterm ->
- Aux.map_some (fun x->x)
- (map_paths (fun p subt ->
- if subt = arg then Some p else None) data.m_paths sterm)
- ) sterms in
- List.map (fun p -> p, ()) paths
- ) call_branches in
- let call_paths = List.map
- (fun (p, ns) -> List.length ns, p)
- (Aux.collect call_paths) in
- (* decreasing order *)
- match List.sort (fun (x,_) (y,_) -> y-x) call_paths with
- | [] -> None
- | (_,p)::_ -> Some p in
- let p_callside = Array.mapi
- (fun i ->
- function Some _ -> None | None -> callside_for_arg i)
- p_defside in
- let arg_paths = Array.mapi
- (fun i defside ->
- let callside = p_callside.(i) in
- match defside, callside with
- | Some p, _ | None, Some p -> p
- | None, None ->
- (* the ArgMode(R,i) = NoSide,p variant is precomputed *)
- try
- match (List.assoc rel data.rel_default_path).(i) with
- | Some p -> p
- | None -> raise Not_found
- with Not_found ->
- failwith
- (Printf.sprintf
- "TranslateFormula.build_defrels: could not \
- determine path for relation %s argument %d" rel i)
- ) p_defside in
- let defrel_arg_mode = Aux.array_map2
- (fun defside path -> defside <> None, path)
- p_defside arg_paths in
- data.defrel_arg_mode :=
- (rel, defrel_arg_mode) :: !(data.defrel_arg_mode);
- rel, (p_defside, s_defside, arg_paths) in
- List.map select_for_defrel data.defined_rels
-
-
-let build_defrels data clauses =
- let all_branches = Aux.concat_map
- (fun ((rel,args),body) ->
- List.map (fun phi -> rel, (args, phi)) (separate_disj [body]))
+let select_defrel_argpaths drel data clauses =
+ let atoms_sterms = List.map
+ (fun ((rel,args), body) ->
+ let r_atoms = if rel = drel then [args] else [] in
+ let r_atoms = r_atoms @ Aux.map_some
+ (function Rel (rel, args) when rel = drel -> Some args
+ | _ -> None)
+ (atoms_of_body body) in
+ r_atoms, state_terms body
+ (* we take all state terms to have more compact partition *)
+ (*Aux.map_some
+ (function Pos (True s) -> Some s | _ -> None) body*))
clauses in
- let sel_argpaths = select_defrel_argpaths data all_branches in
- let build_defrel rel =
- (* now building the translation *)
- let (p_defside, s_defside, arg_paths) =
- List.assoc rel sel_argpaths in
- let defvars =
- Array.mapi (fun i _ -> "v"^string_of_int i) arg_paths in
- let defbody (args,(rels_phi,pos_state,neg_state)) s_defside =
- let arg_eqs = Array.mapi (* $E_{j,l}$ *)
- (fun i v ->
- let v = Formula.fo_var_of_string v in
- let in_I = p_defside.(i) <> None in
- if in_I
- then
- let s_i = match s_defside.(i) with
- | Some s -> var_of_term data s
- | None -> assert false in
- Formula.Eq (v, s_i)
- else Formula.Eq (v, var_of_subterm data arg_paths.(i) args.(i)))
- defvars in
- let arg_eqs = Array.to_list arg_eqs in
- let callside_sterms = (* $S_{j,l}$ *)
- Aux.array_mapi_some
- (fun i path ->
- if p_defside.(i) <> None then None (* only for not in I *)
- else Some (blank_outside_subterm data path args.(i)))
- arg_paths in
- (* packing sterms back as a formula *)
- let callside_sterms = Array.to_list
- (Array.map (fun sterm -> Pos (True sterm)) callside_sterms) in
- transl_disjunct data rels_phi
- (callside_sterms @ pos_state) neg_state arg_eqs in
- let branches = Aux.assoc_all rel all_branches in
- let def_disjuncts = List.map2 defbody branches s_defside in
- rel, (Array.to_list defvars, Formula.Or def_disjuncts) in
- List.map build_defrel data.defined_rels
+ let check_path args p s_p =
+ let inds = Aux.array_argfind_all (fun r -> r=s_p) args in
+ List.map (fun i->p,i) inds in
+ let sterm_path_sets args s =
+ let ptups = Aux.product
+ (map_paths (check_path args) data.m_paths s) in
+ (* distinct [p] in a tuple is already ensured *)
+ List.filter (fun tup ->
+ not (Aux.not_unique (List.map snd tup))) ptups in
+ let argpath_sets = Aux.concat_map
+ (fun (atoms, sterms) -> Aux.concat_map
+ (fun args -> Aux.concat_map (sterm_path_sets args) sterms)
+ atoms)
+ atoms_sterms in
+ let argpath_sets =
+ Aux.map_reduce (fun pset -> pset, 1) (+) 0 argpath_sets in
+ let argpath_sets = List.sort Pervasives.compare
+ (List.map (* lexicographic comparison *)
+ (fun (pset,count) -> List.length pset, count, pset)
+ argpath_sets) in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf
+ "select_defrel_argpaths: drel=%s; argpath_sets=\n%!" drel;
+ List.iter (fun (len, count, pset) ->
+ Printf.printf "len=%d; count=%d; pset=%s\n%!" len count
+ (String.concat ", "
+ (List.map (fun (p,i)->path_str p^": "^string_of_int i) pset)))
+ argpath_sets
+ );
+ (* }}} *)
+ let argpath_sets = List.map Aux.trd3 (List.rev argpath_sets) in
+ (* now greedily -- by traversing the ordering -- select covering *)
+ let apsets_cover = List.fold_left
+ (fun cover apset ->
+ if List.exists
+ (fun (_,i) -> not (List.exists (fun cov_apset ->
+ List.exists (fun (_,j)->i=j) cov_apset) cover)) apset
+ then apset::cover else cover)
+ [] argpath_sets in
+ (* eliminating multiple points --...
[truncated message content] |
|
From: <luk...@us...> - 2011-08-28 21:08:40
|
Revision: 1546
http://toss.svn.sourceforge.net/toss/?rev=1546&view=rev
Author: lukstafi
Date: 2011-08-28 21:08:34 +0000 (Sun, 28 Aug 2011)
Log Message:
-----------
GDL translation: translate definition from command-line provided file; semantic definition of fluent paths and frame clauses, approximated on random playout states, refining the syntactic definition whenever sensible.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGame.mli
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-08-27 09:44:45 UTC (rev 1545)
+++ trunk/Toss/Formula/Aux.ml 2011-08-28 21:08:34 UTC (rev 1546)
@@ -288,11 +288,12 @@
aux [] l
-let maximal cmp l =
+let maximal leq l =
+ let less x y = leq x y && not (leq y x) in
let rec aux acc = function
| hd::tl when
- not (List.exists (fun x-> cmp hd x) acc) &&
- not (List.exists (fun x-> cmp hd x) tl) ->
+ not (List.exists (fun x-> less hd x) acc) &&
+ not (List.exists (fun x-> less hd x) tl) ->
aux (hd::acc) tl
| hd::tl -> aux acc tl
| [] -> acc in
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-08-27 09:44:45 UTC (rev 1545)
+++ trunk/Toss/Formula/Aux.mli 2011-08-28 21:08:34 UTC (rev 1546)
@@ -176,9 +176,8 @@
(** Find an element satisfying the predicate and separate it from the list. *)
val pop_find : ('a -> bool) -> 'a list -> 'a * 'a list
-(** Return the list of maximal elements, under the given less-or-equal
- comparison (the input does not need to be sorted). (Currently, of
- equal elements only the last one is preserved.) *)
+(** Return the list of all maximal elements, under the given less-or-equal
+ comparison. (Maximal elements can be equivalent or incomparable.) *)
val maximal : ('a -> 'a -> bool) -> 'a list -> 'a list
(** Assuming that [l2] already has only maximal elements,
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-08-27 09:44:45 UTC (rev 1545)
+++ trunk/Toss/GGP/GDL.ml 2011-08-28 21:08:34 UTC (rev 1546)
@@ -1445,6 +1445,29 @@
in
aux (p, ps)
+let paths_intersect ps1 ps2 =
+ let rec aux = function
+ | Empty, p | p, Empty -> Empty
+ | Here, Here
+ | Here, Here_and_below _
+ | Here_and_below _, Here -> Here
+ | Here, Below _ | Below _, Here -> Empty
+ | Below ps1, Here_and_below ps2
+ | Here_and_below ps2, Below ps1
+ | Below ps1, Below ps2 -> Below (join (ps1, ps2))
+ | Here_and_below ps1, Here_and_below ps2
+ -> Here_and_below (join (ps1, ps2))
+ and join = function
+ | [], _ | _, [] -> []
+ | ((rel1, args1)::ps1), ((rel2, args2)::ps2) when rel1 = rel2 ->
+ let args = Aux.array_map2 (fun x y->aux (x,y)) args1 args2 in
+ (rel1, args)::join (ps1, ps2)
+ | ((rel1, _)::ps1), ((rel2, _)::_ as ps2) when rel1 < rel2 ->
+ join (ps1, ps2)
+ | ((rel1, _)::_ as ps1), ((rel2, _)::ps2) ->
+ join (ps1, ps2) in
+ aux (ps1, ps2)
+
(** Find a path in a term and substitute, raise [Not_found] if path
not present. [subst_at_path p s t] is $t[p \ot s]$. *)
let subst_at_path p s t =
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-08-27 09:44:45 UTC (rev 1545)
+++ trunk/Toss/GGP/GDL.mli 2011-08-28 21:08:34 UTC (rev 1546)
@@ -235,6 +235,7 @@
(** Add path to a set. First argument gives term arities. *)
val add_path : (string -> int) -> path -> path_set -> path_set
val paths_union : path_set -> path_set -> path_set
+val paths_intersect : path_set -> path_set -> path_set
(** List the paths in a set. *)
val paths_to_list : path_set -> path list
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-08-27 09:44:45 UTC (rev 1545)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-08-28 21:08:34 UTC (rev 1546)
@@ -26,13 +26,6 @@
let debug_level = ref 0
let generate_test_case = ref None
-(** Treat "next" clauses which introduce a fluent position for a
- variable-variable mismatch, as non-erasing frame clauses (to be
- ignored). ("Wave" refers to the process of "propagating the frame
- condition" that these clauses are assumed to do, if
- [nonerasing_frame_wave] is set to [true].) *)
-let nonerasing_frame_wave = ref true
-
(** two heuristics for selecting defined relations: select relations
with arity smaller than three; or, select relations that have ground
defining clauses (i.e. defining clauses with empty bodies). *)
@@ -119,36 +112,99 @@
the set of paths that merges the found term and [c]; as in the
definition of $s_\calC$ and $t_\calC$ for a clause $\calC \in
\mathrm{Next}_{e}$. Among the most similar terms finds one that is
- not a "frame wave", if not possible and if {!nonerasing_frame_wave}
- is [true] -- raises [Not_found]. *)
+ not a "wave", if possible; returns the list of best candidates. *)
let most_similar c ts =
let gens = List.map (fun t -> t, merge_terms c t) ts in
(* worse-or-equal as "leq" *)
let cmp (_, (_, pn1, siz1)) (_, (_, pn2, siz2)) =
- not (siz1 > siz2) && pn2 >= pn1 in
+ siz1 < siz2 || siz1 = siz2 && pn1 >= pn2 in
let best = Aux.maximal cmp gens in
- (* avoid "frame wave" if possible *)
- (* FIXME: TODO: handle frame waves as in updated reference spec *)
- let t, (ps, _, _) =
- if !nonerasing_frame_wave
- then
- List.find (fun (t, (ps, _, _)) ->
- c = t ||
- List.for_all
- (fun fluent -> Aux.Strings.is_empty (term_vars fluent))
- (at_paths ps t)) best
- else List.hd best in
- t, ps
+ (* avoid "wave" if possible *)
+ let nonwave_best, wave_best = Aux.partition_map
+ (fun (t, (ps, _, _)) ->
+ if List.for_all
+ (fun fluent -> Aux.Strings.is_empty (term_vars fluent))
+ (at_paths ps t)
+ then Aux.Left (ps, t)
+ else Aux.Right (ps, t))
+ best in
+ if nonwave_best = [] then true, wave_best
+ else false, nonwave_best
-
+(* Find semantically the fluent paths of a clause -- works only for
+ clauses that are not "negative true". Find paths that merge with
+ nearest terms in prior state, better are paths that have less of
+ different subterms (at them) among prior state terms. Return fluent
+ paths, an empty path set if the clause is a frame clause. Return
+ [None] when the clause does not generate any state terms for any
+ provided playout state. *)
+let semantic_fluent_paths program playout_states cl =
+ let head, body = match cl with
+ | ("next", [|head|]), body -> head, body
+ | _ -> assert false in
+ let old_run_aggregate = !run_prolog_aggregate in
+ run_prolog_aggregate := true;
+ let state_fpaths state =
+ let new_sterms =
+ run_prolog_goal body
+ (replace_rel_in_program "true" (state_cls state) program) in
+ if new_sterms = []
+ then None
+ else
+ let new_sterms = List.map (fun sb->subst sb head) new_sterms in
+ let term_paths s =
+ if List.mem s state then empty_path_set
+ else
+ let _, best = most_similar s state in
+ let best = List.map
+ (fun (ps,_) -> ps,
+ List.length (Aux.unique_sorted
+ (Aux.concat_map (at_paths ps) state)))
+ best in
+ let ps, _ = List.hd
+ (List.sort (fun (_,nts1) (_,nts2) -> nts1 - nts2) best) in
+ (* {{{ log entry *)
+ if !debug_level > 4 then (
+ Printf.printf "semantic_fluent_paths: for %s paths = %s\n%!"
+ (term_str s)
+ (String.concat ", " (List.map path_str (paths_to_list ps)));
+ if List.length (paths_to_list ps) > 1 then
+ Printf.printf "state: %s\n\n%!"
+ (String.concat ", " (List.map term_str state))
+ );
+ (* }}} *)
+ ps in
+ Some (List.fold_left paths_union empty_path_set
+ (List.map term_paths new_sterms)) in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf "semantic_fluent_paths: computing for body=%s...\n%!"
+ (String.concat " " (List.map literal_str body))
+ );
+ (* }}} *)
+ let fpaths_if_matched = Aux.map_some state_fpaths playout_states in
+ if fpaths_if_matched = [] then None
+ else
+ let res =
+ List.fold_left paths_union empty_path_set
+ fpaths_if_matched in
+ run_prolog_aggregate := old_run_aggregate;
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf "semantic_fluent_paths: f_paths=%s\n%!"
+ (String.concat "; "(List.map path_str (paths_to_list res)))
+ );
+ (* }}} *)
+ Some res
(* Find $s_\calC$ and $t_\calC$ for a clause $\calC \in
\mathrm{Next}_{e}$, i.e. in expanded "next" clauses. Determine
which original clauses are frame clauses, and which have to
be dropped (under assumption of being "frame waves"). Return the
proper frame clauses, the non-frame clauses, and the fluent paths
- (as in definition of $\calP_f$). *)
-let fluent_paths_and_frames clauses =
+ (as in definition of $\calP_f$). Augment the syntactic check with
+ semantic exploration whenever sensible. *)
+let fluent_paths_and_frames program playout_states clauses =
let defs =
defs_of_rules (Aux.concat_map rules_of_clause clauses) in
let static, nonstatic = static_rels defs in
@@ -164,10 +220,8 @@
let inline_defs =
("does", List.assoc "legal" defs)::inline_defs in
(* To determine whether a clause is a frame, we need to know its
- expansion, so we expand clauses separately. A proper frame clause
- must have *all* expansions being proper frame clauses. But a
- clause is dropped as "frame wave" if any of its expansions is
- regarded as "frame wave". *)
+ expansion, so we expand clauses separately. A frame clause
+ must have *all* expansions being frame clauses. *)
let next_clauses =
List.filter (fun ((rel,_),_) -> rel="next") clauses in
(* {{{ log entry *)
@@ -200,33 +254,52 @@
(Aux.assoc_all "true" body) in
let p_ts = true_args body in
let n_ts = true_args neg_body in
- let t_C, ps = most_similar s_C (p_ts @ n_ts) in
+ let wave, best = most_similar s_C (p_ts @ n_ts) in
+ let ps, t_C =
+ try List.find (fun (_,t) -> not (List.mem t n_ts)) best
+ with Not_found -> List.hd best in
(* "negative true" check *)
- t_C, ps, List.mem t_C n_ts in
- let is_frame s_C (t_C, _, neg_true) =
+ wave, t_C, ps, List.mem t_C n_ts in
+ let is_frame s_C (_, t_C, _, neg_true) =
not neg_true && s_C = t_C in
let find_fluents (c, c_e) =
let s_C = (snd (fst c)).(0) in
- (* discarding frame waves *)
- (* FIXME: TODO: handle frame waves as in updated reference spec *)
- let res = Aux.map_try (find_br_fluents s_C) c_e in
+ let res = List.map (find_br_fluents s_C) c_e in
(* {{{ log entry *)
if !debug_level > 3 then (
Printf.printf
"find_fluents: most_similar for s_C=%s expansions t_C=%s\n"
(term_str s_C) (String.concat ", "
- (List.map (fun (t,_,_)->term_str t) res))
+ (List.map (fun (_,t,_,_)->term_str t) res))
);
(* }}} *)
if List.for_all (is_frame s_C) res
then Aux.Left c
+ else if List.for_all
+ (fun (wave,_,_,neg_true)-> not wave && not neg_true) res
+ then
+ let f_paths =
+ List.map (fun (_, _, ps, _) -> ps) res in
+ Aux.Right (c, List.fold_left paths_union empty_path_set f_paths)
else
+ let sem_f_paths =
+ semantic_fluent_paths program playout_states c in
+ if sem_f_paths = Some empty_path_set (* frame clause *)
+ then Aux.Left c
+ else
let f_paths =
- List.map (fun (t_C, ps, neg_true) ->
- if neg_true
- then
- term_paths (function Const _ -> true | _ -> false) t_C
- else ps) res in
+ List.map (fun (wave, t_C, ps, neg_true) ->
+ let ps =
+ if neg_true
+ then
+ term_paths (function Const _ -> true | _ -> false) t_C
+ else ps in
+ if wave || neg_true then
+ match sem_f_paths with
+ | Some sem_ps -> paths_intersect sem_ps ps
+ | None -> ps
+ else ps
+ ) res in
Aux.Right (c, List.fold_left paths_union empty_path_set f_paths) in
let res = List.map find_fluents next_e in
let frames, fluents = Aux.partition_choice res in
@@ -244,7 +317,7 @@
(* Expand role variables, find fluent and mask paths, generate the
initial structure. Encode frame clauses by using the unique
relation name "frame next". *)
-let create_init_struc clauses =
+let create_init_struc program ~playout_states clauses =
let players =
Aux.map_some (function
| ("role", [|player|]), _ -> Some player
@@ -275,7 +348,7 @@
);
(* }}} *)
let frame_clauses, move_clauses, f_paths =
- fluent_paths_and_frames clauses in
+ fluent_paths_and_frames program playout_states clauses in
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf
@@ -435,7 +508,7 @@
let frame_clauses = List.map
(fun ((_,args),body) -> ("frame next", args), body) frame_clauses in
- players, rules,
+ rules,
frame_clauses @ move_clauses @ clauses,
f_paths, m_paths, mask_reps, defined_rels,
Aux.Strings.elements !stable_rels, Aux.Strings.elements !fluents,
@@ -740,10 +813,6 @@
TODO: unrequired clauses with disjunctions may avoid being
excluded. If this poses problems we might need to expand
disjunctions containing potentially case-split atoms.
-
- TODO: (important) filter-out case-split atoms based on conjoining
- them with deterministic literals of required clauses (and checking
- on the suite of random playout states).
*)
let rule_cases program playout_states rule_cls =
let required_cls = Aux.map_some
@@ -1538,11 +1607,19 @@
let translate_game ~playing_as clauses =
let clauses = expand_players clauses in
let used_vars, clauses = rename_clauses clauses in
- let players, rules,
+ let players =
+ Aux.map_some (function
+ | ("role", [|player|]), _ -> Some player
+ | _ -> None
+ ) clauses in
+ let players = Array.of_list players in
+ let program = preprocess_program clauses in
+ let playout_states = generate_playout_states program players in
+ let rules,
clauses, f_paths, m_paths,
mask_reps, defined_rels, stable_rels, fluents,
(*static_base,*) init_state, struc, ground_state_terms, elem_term_map =
- create_init_struc clauses in
+ create_init_struc program ~playout_states clauses in
let ground_at paths = List.map
(fun p ->
p, Aux.unique_sorted
@@ -1572,7 +1649,6 @@
(List.map (fun ((rel,args),body as cl)->
if rel = "frame next" then ("next", args), body
else cl) clauses) in
- let playout_states = generate_playout_states program players in
let turn_data =
try Some (check_turn_based players program)
with Not_turn_based -> None in
Modified: trunk/Toss/GGP/TranslateGame.mli
===================================================================
--- trunk/Toss/GGP/TranslateGame.mli 2011-08-27 09:44:45 UTC (rev 1545)
+++ trunk/Toss/GGP/TranslateGame.mli 2011-08-28 21:08:34 UTC (rev 1546)
@@ -64,17 +64,18 @@
purposes. Encode frame clauses by using the unique
relation name "frame next".
- [players, rules, frame_cls, move_cls, f_paths, m_paths, mask_reps,
- defined_rels, stable_rels, fluents, init_state,
- struc, ground_state_terms, elem_term_map = create_init_struc clauses] *)
+ [rules, clauses, f_paths, m_paths, mask_reps,
+ defined_rels, stable_rels, fluents,
+ init_state, struc, ground_state_terms, elem_term_map =
+ create_init_struc program ~playout_states clauses] *)
val create_init_struc :
+ GDL.prolog_program ->
+ playout_states:GDL.term list list ->
GDL.clause list ->
- GDL.term array * GDL.gdl_rule list *
- GDL.clause list * GDL.path_set *
- GDL.path_set * GDL.term list * string list * string list *
- string list * GDL.term list *
- Structure.structure * GDL.term list *
- GDL.term Aux.IntMap.t
+ GDL.gdl_rule list * GDL.clause list *
+ GDL.path_set * GDL.path_set * GDL.term list * string list *
+ string list * string list * GDL.term list * Structure.structure *
+ GDL.term list * GDL.term Aux.IntMap.t
(* [playing_as] is only used for building move translation data, the
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-08-27 09:44:45 UTC (rev 1545)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-08-28 21:08:34 UTC (rev 1546)
@@ -116,11 +116,12 @@
(fun () ->
let descr = load_rules ("./GGP/examples/connect5.gdl") in
let clauses = GDL.expand_players descr in
- let players, rules,
+ let program = preprocess_program clauses in
+ let rules,
clauses, f_paths, m_paths, mask_reps, defined_rels,
stable_rels, fluents,
init_state, struc, ground_state_terms, elem_term_map =
- TranslateGame.create_init_struc clauses in
+ TranslateGame.create_init_struc program ~playout_states:[] clauses in
assert_equal ~msg:"f_paths" ~printer:(fun x->x)
"cell_2; control_0"
@@ -209,16 +210,17 @@
]
-let a () =
- (* GDL.debug_level := 4; *)
- TranslateGame.debug_level := 4;
- TranslateFormula.debug_level := 4;
- GameSimpl.debug_level := 4;
- DiscreteRule.debug_level := 4;
+let set_debug_level i =
+ (* GDL.debug_level := i; *)
+ TranslateGame.debug_level := i;
+ TranslateFormula.debug_level := i;
+ GameSimpl.debug_level := i;
+ DiscreteRule.debug_level := i;
()
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"
@@ -278,3 +280,20 @@
Aux.run_test_if_target "TranslateGameTest"
("TranslateGame" >::: [tests; bigtests])
+
+let main () =
+ Aux.set_optimized_gc ();
+ let (file) = (ref "") in
+ let opts = [
+ ("-v", Arg.Unit (fun () -> set_debug_level 1), "be verbose");
+ ("-d", Arg.Int (fun i -> set_debug_level i), "set debug level");
+ ("-f", Arg.String (fun s -> file := s), "process file");
+ ] in
+ Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
+ if !file = "" then exec () else
+ let descr = load_rules !file in
+ let gdl_data, result =
+ TranslateGame.translate_game ~playing_as:(GDL.Const "") descr in
+ print_endline (Arena.state_str result)
+
+let _ = Aux.run_if_target "TranslateGameTest" main
Modified: trunk/Toss/www/reference/reference.tex
===================================================================
--- trunk/Toss/www/reference/reference.tex 2011-08-27 09:44:45 UTC (rev 1545)
+++ trunk/Toss/www/reference/reference.tex 2011-08-28 21:08:34 UTC (rev 1546)
@@ -1335,7 +1335,7 @@
To construct the elements of the structure from state terms,
and to make that structure a good representation of the game in Toss,
-we first determine which state terms always have common subtrees.
+we first determine which state terms have common subtrees.
\begin{definition} \label{def-merge}
For two terms $s$ and $t$ we say that a set of paths $P$ \emph{merges}
@@ -1361,10 +1361,10 @@
$s_\calC$)}. The term $t_\calC$ is the argument of \texttt{true} in
the body of $\calC$ which is most similar to $s$ in the sense of
Definition~\ref{def-merge}, and of equally similar has smallest
-$d\calP(s,t)$ (if there are several, we pick one arbitrarily).
+$d\calP(s,t)$.
-\paragraph{Wave Clauses}
+\paragraph{Wave Clauses and Fluent Paths}
Let \emph{wave clauses} $\mathrm{Next}_{W}$ be defined as follows:
$\calC \in \mathrm{Next}_{W}$ if there is $\calC' \in
@@ -1375,19 +1375,32 @@
\emptyset \}$. Wave clauses propagate information across terms rather
than describing a change of a term.
-\paragraph{Fluent Paths and Structure Elements}
+We often use the word \emph{fluent} for changing objects, and so we
+define the set of \emph{fluent paths}, $\calP_f$, based on two
+intuitions. Semantically, the intuition is that fluent paths are all
+the $d\calP(s,t)$ paths where $s$ is any new state term and $t$ is its
+closest state term from the prior state, for any reachable prior
+state. Let us represent such paths, summed over $s$ generated by a
+clause $\calC$, as $d\calP(s^{sem}_\calC,t^{sem}_\calC)$. The other
+intuition applies to some games that start with a small set of state
+terms, and we do not want to consider the whole gradually introduced
+state terms as fluent, rather we determine syntactically which
+subterms would change no matter what state terms were already
+introduced. We approximate the sets
+$d\calP(s^{sem}_\calC,t^{sem}_\calC)$ from below by computing them on
+states from a small number of random playouts.
-We often use the word \emph{fluent} for changing objects, and so we
-define the set of \emph{fluent paths}, $\calP_f$, in the following way.
-We say that a term $t$ is a \emph{negative true} in a clause $\calC$ if
-it is the argument of a negative occurrence of \texttt{true} in $\calC$.
-We write $\calL(t)$ for the set of paths to all constant leaves in $t$.
-The set
-\[ \calP_f \ = \
- \bigcup_{\calC \in \mathrm{Next}_{f}} d\calP(s_\calC, t_\calC) \ \cup \
- \bigcup_{\calC \in \mathrm{Next}_{f},\
- t_\calC \text{ negative true in } \calC} \calL(t_\calC).
- \]
+We say that a term $t$ is a \emph{negative true} in a
+clause $\calC$ if it is the argument of a negative occurrence of
+\texttt{true} in $\calC$. We write $\calL(t)$ for the set of paths to
+all constant leaves in $t$. The set
+\begin{align*}
+ \calP_f \ = \ &
+ \bigcup_{\calC \in \mathrm{Next}_{W}} d\calP(s^{sem}_\calC,t^{sem}_\calC) \ \cup \\
+ & \bigcup_{\calC \in \mathrm{Next}_{f}} d\calP(s_\calC, t_\calC) \ \cup \\
+ & \bigcup_{\calC \in \mathrm{Next}_{f},\
+ t_\calC \text{ negative true in } \calC} \calL(t_\calC) \cap d\calP(s^{sem}_\calC,t^{sem}_\calC).
+ \end{align*}
Note that $\calP_f$ contains all merge sets for the selected terms in
$\mathrm{Next}_e$ clauses, and additionally, when $t_\calC$ is a negative true,
we add the paths to all constant leaves in $t_\calC$.
@@ -1434,6 +1447,8 @@
$\calP_f = \{(\mathtt{cell},3), (\mathtt{control},1)\}$.
\end{example}
+\paragraph{Structure Elements}
+
The fluent paths define the partition of GDL state terms into elements
of the Toss structures in the following way.
@@ -1796,32 +1811,22 @@
So far, we have not accounted for the fact that rewrite rules of Toss
only affect the matched part of the structure, while the GDL game
definition explicitly describes the construction of the whole
-successive structure. We will say that a \texttt{next} clause is a
-\emph{frame clause} if and only if it contains a \texttt{true}
-relation applied to a term equal to the \texttt{next} argument. (TODO:
-a clause is a frame clause if it does not add a state term not
-present in the current state -- we will check empirically). Negating
-the frame clauses from the tuple $\ol{\calN}$ and transforming them
-into \emph{erasure clauses} will keep track of the elements that
-possibly lose fluents and ensure correct translation.
+successive structure. We say that a \texttt{next} clause $\calC$ is a
+\emph{frame clause} when $d\calP(s^{sem}_\calC,t^{sem}_\calC) =
+\setempty$ (if possible, \ie when the clause is not a wave clause,
+approximated by checking whether it contains a \texttt{true} relation
+applied to a term equal to the \texttt{next} argument). Negating the
+frame clauses from the tuple $\ol{\calN}$ and transforming them into
+\emph{erasure clauses} will keep track of the elements that possibly
+lose fluents and ensure correct translation.
We determine which clauses are frame clauses prior to partitioning
into the rule clauses and computing the substitution
$\sigma_{\ol{\calC},\ol{\calN}}$ -- at the point where fluent paths
-are computed. It is difficult to establish which wave clauses should
-be considered frame clauses. In the current implementation, we
-optimistically assume that all wave clauses not depending on player
-actions (\ie not containing \texttt{does}) are frame clauses (and
-currently we ignore frame-wave clauses as they do not provide useful
-erasure clauses). In the future, we might perform deeper checking as
-to which wave clauses are frame clauses. (TODO: redo this whole
-paragraph -- there will be no ``wave clauses'', we'll just detect
-frame clauses from random playouts.)
+are computed. We transform frame clauses by expanding relations that
+would otherwise be translated as defined relations: so as to eliminate
+local variables whenever possible.
-We transform frame clauses by expanding relations that would otherwise
-be translated as defined relations: so as to eliminate local variables
-whenever possible.
-
From the frame clauses in $\sigma_{\ol{\calC}, \ol{\calN}}(\calN_1), \dots,
\sigma_{\ol{\calC}, \ol{\calN}}(\calN_m)$, we select subsets $J$
such that, clauses in $J$ having the form $\mathtt{(<= (next\ s_i)\ b_i)}$,
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-08-31 13:56:14
|
Revision: 1550
http://toss.svn.sourceforge.net/toss/?rev=1550&view=rev
Author: lukstafi
Date: 2011-08-31 13:56:07 +0000 (Wed, 31 Aug 2011)
Log Message:
-----------
GDL translation specification-level: optionally forcing fluent and within-mask paths to point to leaves of relevant terms. GDL translation major fixes: wrong algo for eliminating variables at fluent position subterms; do not consider terminal states for building rewrite rules; wrong algo for computing within-mask paths. Concurrent moves games: bug fixes in GDL translation; new translation test; small fixes (work remains) in ReqHandler.
Modified Paths:
--------------
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/GDLTest.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGame.mli
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/Server/ReqHandler.ml
trunk/Toss/Server/ReqHandler.mli
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-08-29 21:08:20 UTC (rev 1549)
+++ trunk/Toss/GGP/GDL.ml 2011-08-31 13:56:07 UTC (rev 1550)
@@ -1130,13 +1130,15 @@
if step < horizon then
loop (actions::actions_accu) (state::state_accu) (step+1) next
else
- let states = List.rev (next::state::state_accu) in
+ let states = List.rev (state::state_accu) in
List.rev (actions::actions_accu),
- List.map (fun ts->state_of_tups ts) states
+ List.map (fun ts->state_of_tups ts) states,
+ state_of_tups next
with Playout_over ->
List.rev actions_accu,
List.map (fun ts->state_of_tups ts)
- (List.rev (state::state_accu))) in
+ (List.rev state_accu),
+ state_of_tups state) in
(* FIXME: this is identity, right? remove *)
let init_base = saturate static_base state_rules in
let init_state = Aux.StrMap.find "init" init_base in
@@ -1227,8 +1229,8 @@
| _ -> false in
List.map (fun (h, b) -> h, List.filter (Aux.neg neg_lit) b) cls
-(* Note that the list of playout states is
- one longer than that of playout actions.
+(* Return the terminal state separately. The list of playout states is
+ same length as that of playout actions.
To keep monotonicity, besides removing negative literals from
"legal" clauses, we also add old terms to the state. (Only when
@@ -1267,9 +1269,9 @@
loop (actions::actions_accu) (state::state_accu) (step+1) next
else
List.rev (actions::actions_accu),
- List.rev (next::state::state_accu)
+ List.rev (state::state_accu), next
with Playout_over ->
- List.rev actions_accu, List.rev (state::state_accu)) in
+ List.rev actions_accu, List.rev state_accu, state) in
let init_state = List.map (fun (_,args) -> args.(0))
(run_prolog_atom ("init", [|Var "x"|]) program) in
(* {{{ log entry *)
@@ -1307,7 +1309,8 @@
let trav = x::trav in
let cycle = List.rev trav in
loop cycle trav [] cycle tail in
- loop [] [] [] [] cands
+ if cands = [] then []
+ else loop [] [] [] [] cands
let player_vars_of rels =
@@ -1392,10 +1395,14 @@
(* Subtries are in sorted order. *)
let empty_path_set = Empty
+let eps_path = []
+let eps_path_set = Here
let path_str p =
- String.concat "_" (List.map (fun (rel, arg) ->
- rel ^ "_" ^ string_of_int arg) p)
+ if p = [] then "eps_path"
+ else
+ String.concat "_" (List.map (fun (rel, arg) ->
+ rel ^ "_" ^ string_of_int arg) p)
let paths_union ps1 ps2 =
let rec aux = function
@@ -1607,21 +1614,30 @@
path_str path ^ term_to_name subterm
-(* [expand_path_vars_by prepare_lits p ts clauses] expands variables
+(* [expand_path_vars_by prepare_lits p ts clauses] expands subterms
that have occurrences at path [p] in some state term of a clause
(from which pre-processed literals are extracted by
- [prepare_lits]), by terms [ts]. *)
+ [prepare_lits]), by substituting their variables with corresponding
+ subterms of terms [ts]. *)
let expand_path_vars_by prepare_lits p ts clauses =
let exp_clause clause =
- (* determine variables standing for players *)
let pstates = state_terms (prepare_lits clause) in
- let pvars = Aux.map_try
- (fun s -> term_vars (at_path s p)) pstates in
- let pvars = Aux.Strings.elements
- (List.fold_left Aux.Strings.union Aux.Strings.empty pvars) in
- if pvars = [] then [clause]
+ let pterms = Aux.map_try
+ (fun s -> at_path s p) pstates in
+ let multi_sb = Aux.concat_map
+ (fun gterm -> Aux.concat_map
+ (fun pterm ->
+ try match_nonblank [] [pterm] [gterm] with Not_found -> [])
+ pterms)
+ ts in
+ let multi_sb = Aux.collect multi_sb in
+ let multi_sb =
+ List.map (fun (v, ts) -> v, Aux.unique_sorted ts) multi_sb in
+ if multi_sb = [] then [clause]
else
- let sbs = Aux.power pvars ts in
+ let sb_vars, sb_terms = List.split multi_sb in
+ let sb_terms = Aux.product sb_terms in
+ let sbs = List.map (List.combine sb_vars) sb_terms in
List.map (fun sb -> subst_clause sb clause) sbs in
Aux.concat_map exp_clause clauses
@@ -1663,3 +1679,124 @@
blank path_subts
with Not_found ->
invalid_arg "blank_outside_subterms: conflicting paths"
+
+
+(* If some path points only to bigger than one (i.e. non-leaf)
+ subterms in the given set of terms, then expand/split it to longer
+ paths that together cover all leafs the original path covered. *)
+let refine_leaf_paths paths terms =
+ let rec aux terms = function
+ | Empty -> Empty
+ | Here ->
+ if terms=[] ||
+ List.exists (function Func _ -> false | _ -> true) terms
+ then Here
+ else
+ let subterms = Aux.collect
+ (List.map (function Func (rel,args) -> rel,args
+ | _ -> assert false) terms) in
+ Below (List.map (fun (rel, args_set) ->
+ let arity =
+ Array.length (List.hd args_set) in
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "refine_leaf_paths: aux rel=%s, no terms=%d\n%!"
+ rel (List.length args_set)
+ );
+ (* }}} *)
+ rel, aux2 (Array.make arity Here) args_set) subterms)
+ | Below subpaths as path ->
+ let subterms = Aux.collect
+ (Aux.map_some (function Func (rel,args) -> Some (rel,args)
+ | _ -> None) terms) in
+ if subterms = []
+ then path
+ else
+ Below (List.map (fun (rel, arg_paths as r_subpaths) ->
+ try
+ rel, aux2 arg_paths (List.assoc rel subterms)
+ with Not_found -> r_subpaths) subpaths)
+ | Here_and_below subpaths as path ->
+ if terms=[] ||
+ List.exists (function Func _ -> false | _ -> true) terms
+ then path
+ else
+ let subterms = Aux.collect
+ (List.map (function Func (rel,args) -> rel,args
+ | _ -> assert false) terms) in
+ (* so far as [Here], from now as [Below] *)
+ Below (List.map (fun (rel, arg_paths as r_subpaths) ->
+ try
+ rel, aux2 arg_paths (List.assoc rel subterms)
+ with Not_found -> r_subpaths) subpaths)
+ and aux2 arg_paths args_set = Array.mapi
+ (fun i path ->
+ aux (List.map (fun a->a.(i)) args_set) path)
+ arg_paths in
+ (* {{{ log entry *)
+ if !debug_level > 1 then (
+ Printf.printf "refine_leaf_paths:\npaths=%s\nterms=%s\n%!"
+ (String.concat "; " (List.map path_str (paths_to_list paths)))
+ (String.concat ", " (List.map term_str terms))
+ );
+ (* }}} *)
+ let res = aux terms paths in
+ res
+
+(* Split paths in the set until, if possible, none of subterms at the
+ paths meets the predicate. Also remove paths not present in terms. *)
+let refine_paths_avoiding paths avoid terms =
+ let rec aux terms = function
+ | Empty -> Empty
+ | Here ->
+ if terms=[] then Empty
+ else if not (List.exists avoid terms)
+ then Here
+ else
+ let subterms =
+ Aux.map_some (function
+ | Func (rel,args) as t when not (avoid t) -> Some (rel,args)
+ | _ -> None) terms in
+ if subterms = [] then Empty
+ else
+ let subterms = Aux.collect subterms in
+ Below (List.map (fun (rel, args_set) ->
+ let arity =
+ Array.length (List.hd args_set) in
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "refine_paths_avoiding: aux rel=%s, no terms=%d\n%!"
+ rel (List.length args_set)
+ );
+ (* }}} *)
+ rel, aux2 (Array.make arity Here) args_set) subterms)
+ | (Here_and_below subpaths | Below subpaths) as path ->
+ if terms=[] then Empty
+ else if not (List.exists avoid terms)
+ then path
+ else
+ let subterms =
+ Aux.map_some (function
+ | Func (rel,args) as t when not (avoid t) -> Some (rel,args)
+ | _ -> None) terms in
+ if subterms = [] then Empty
+ else
+ let subterms = Aux.collect subterms in
+ let subpaths =
+ Aux.map_try (fun (rel, args_subpaths) ->
+ let args_subterms = List.assoc rel subterms in
+ rel, aux2 args_subpaths args_subterms) subpaths in
+ Below subpaths
+ and aux2 arg_paths args_set = Array.mapi
+ (fun i path ->
+ aux (List.map (fun a->a.(i)) args_set) path)
+ arg_paths in
+ (* {{{ log entry *)
+ if !debug_level > 1 then (
+ Printf.printf "refine_paths_avoiding:\npaths=%s\nterms=%s\n%!"
+ (String.concat "; " (List.map path_str (paths_to_list paths)))
+ (String.concat ", " (List.map term_str terms))
+ );
+ (* }}} *)
+ let res = aux terms paths in
+ res
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-08-29 21:08:20 UTC (rev 1549)
+++ trunk/Toss/GGP/GDL.mli 2011-08-31 13:56:07 UTC (rev 1550)
@@ -185,11 +185,11 @@
aggregate:bool -> term array -> int -> gdl_rule list ->
gdl_rule list * gdl_rule list *
graph * term list *
- (term array list list * term list list)
+ (term array list list * term list list * term list)
val playout_prolog :
aggregate:bool -> term array -> int -> prolog_program ->
- term array list list * term list list
+ term array list list * term list list * term list
val find_cycle : term option list -> term option list
@@ -232,6 +232,7 @@
val at_paths : ?fail_at_missing:bool -> path_set -> term -> term list
val empty_path_set : path_set
+val eps_path_set : path_set
(** Add path to a set. First argument gives term arities. *)
val add_path : (string -> int) -> path -> path_set -> path_set
val paths_union : path_set -> path_set -> path_set
@@ -243,9 +244,10 @@
val path_str : path -> string
(** [ground_vars_at_paths prepare_lits ps_sterms clauses] expands
- variables that have occurrences at paths in [ps_sterms] in some
+ subterms that have occurrences at paths in [ps_sterms] in some
state term of a clause (from which pre-processed literals are
- extracted by [prepare_lits]), by terms provided in [ps_sterms]. *)
+ extracted by [prepare_lits]), by substituting their variables with
+ corresponding subterms of terms provided in [ps_sterms]. *)
val ground_vars_at_paths :
(clause -> literal list) ->
(path * term list) list -> clause list -> clause list
@@ -256,3 +258,14 @@
val blank_outside_subterms :
(string * int) list -> (path * term) list -> term
+
+(** If some path points only to bigger than one (i.e. non-leaf)
+ subterms in the given set of terms, then expand/split it to longer
+ paths that together cover all leafs the original path covered. *)
+val refine_leaf_paths : path_set -> term list -> path_set
+
+(** Split paths in the set until, if possible, none of subterms at the
+ paths meets the predicate. Also remove paths not present in
+ terms. *)
+val refine_paths_avoiding :
+ path_set -> (term -> bool) -> term list -> path_set
Modified: trunk/Toss/GGP/GDLTest.ml
===================================================================
--- trunk/Toss/GGP/GDLTest.ml 2011-08-29 21:08:20 UTC (rev 1549)
+++ trunk/Toss/GGP/GDLTest.ml 2011-08-31 13:56:07 UTC (rev 1550)
@@ -198,7 +198,7 @@
(not (true (control ?r))))
" in
- let _, _, _, _, (agg_actions, _) =
+ let _, _, _, _, (agg_actions, _, _) =
GDL.playout_satur ~aggregate:true [|GDL.Const "x"; GDL.Const "o"|]
10 (Aux.concat_map GDL.rules_of_clause descr) in
let actions = List.map (List.map (fun a->"does", a)) agg_actions in
@@ -208,7 +208,7 @@
(String.concat ";\n" (List.map (fun step -> String.concat " "
(List.map GDL.rel_atom_str step)) actions));
- let _, _, _, _, (rand_actions, _) =
+ let _, _, _, _, (rand_actions, _, _) =
GDL.playout_satur ~aggregate:false [|GDL.Const "x"; GDL.Const "o"|]
10 (Aux.concat_map GDL.rules_of_clause descr) in
let actions = List.map (List.map (fun a->"does", a)) rand_actions in
@@ -251,7 +251,7 @@
" in
let program = GDL.preprocess_program descr in
- let agg_actions, _ =
+ let agg_actions, _, _ =
GDL.playout_prolog ~aggregate:true [|GDL.Const "x"; GDL.Const "o"|]
10 program in
let actions = List.map (List.map (fun a->"does", a)) agg_actions in
@@ -261,7 +261,7 @@
(String.concat ";\n" (List.map (fun step -> String.concat " "
(List.map GDL.rel_atom_str step)) actions));
- let rand_actions, _ =
+ let rand_actions, _, _ =
GDL.playout_prolog ~aggregate:false [|GDL.Const "x"; GDL.Const "o"|]
10 program in
let actions = List.map (List.map (fun a->"does", a)) rand_actions in
@@ -404,7 +404,7 @@
GDL.playout_satur ~aggregate:false [|GDL.Const "x"; GDL.Const "o"|]
10 (Aux.concat_map GDL.rules_of_clause clauses) in
*)
- let rand_actions, _ =
+ let rand_actions, _, _ =
GDL.playout_prolog ~aggregate:false [|GDL.Const "x"; GDL.Const "o"|]
10 (GDL.preprocess_program clauses) in
let noop_actions = Aux.take_n 9
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-08-29 21:08:20 UTC (rev 1549)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-08-31 13:56:07 UTC (rev 1550)
@@ -26,6 +26,20 @@
let debug_level = ref 0
let generate_test_case = ref None
+(** Refine fluent paths to always point to some leaf, keeping the same
+ coverage of leafs on all ground state terms. *)
+let refine_leaf_f_paths = ref false
+
+(** Refine within-mask paths to always point to some leaf, keeping the same
+ coverage of leafs on all ground state terms. *)
+let refine_leaf_m_paths = ref true
+
+(** Refine fluent paths generated for a "next" clause to always point
+ to some leaf, with respect to the right-hand-side state
+ term. (Makes [refine_leaf_f_paths] redundant but generates
+ less fluent paths.) *)
+let propose_leaf_f_paths = ref true
+
(** two heuristics for selecting defined relations: select relations
with arity smaller than three; or, select relations that have ground
defining clauses (i.e. defining clauses with empty bodies). *)
@@ -46,7 +60,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;
@@ -103,11 +117,7 @@
fluents = [];
}
-let our_turn gdl state = true
-let noop_move gdl state = "NOOP"
-
-
(* [most_similar c ts] finds a term from [ts] most similar to [c], and
the set of paths that merges the found term and [c]; as in the
definition of $s_\calC$ and $t_\calC$ for a clause $\calC \in
@@ -115,6 +125,15 @@
not a "wave", if possible; returns the list of best candidates. *)
let most_similar c ts =
let gens = List.map (fun t -> t, merge_terms c t) ts in
+ (* {{{ log entry *)
+ if !debug_level > 4 then (
+ Printf.printf "most_similar: %s -->%!"(term_str c);
+ List.iter (fun (t, (ps, card, size)) ->
+ Printf.printf ", %s (at %d,%d: %s)" (term_str t) card size
+ (String.concat "; " (List.map path_str (paths_to_list ps)))) gens;
+ Printf.printf "\n%!";
+ );
+ (* }}} *)
(* worse-or-equal as "leq" *)
let cmp (_, (_, pn1, siz1)) (_, (_, pn2, siz2)) =
siz1 < siz2 || siz1 = siz2 && pn1 >= pn2 in
@@ -137,7 +156,8 @@
different subterms (at them) among prior state terms. Return fluent
paths, an empty path set if the clause is a frame clause. Return
[None] when the clause does not generate any state terms for any
- provided playout state. *)
+ provided playout state. Refine the fluent paths with just the RHS
+ state term of the clause if [propose_leaf_f_paths] is true. *)
let semantic_fluent_paths program playout_states cl =
let head, body = match cl with
| ("next", [|head|]), body -> head, body
@@ -163,7 +183,7 @@
best in
let ps, _ = List.hd
(List.sort (fun (_,nts1) (_,nts2) -> nts1 - nts2) best) in
- (* {{{ log entry *)
+ (* {{{ log entry *)
if !debug_level > 4 then (
Printf.printf "semantic_fluent_paths: for %s paths = %s\n%!"
(term_str s)
@@ -172,7 +192,7 @@
Printf.printf "state: %s\n\n%!"
(String.concat ", " (List.map term_str state))
);
- (* }}} *)
+ (* }}} *)
ps in
Some (List.fold_left paths_union empty_path_set
(List.map term_paths new_sterms)) in
@@ -188,6 +208,9 @@
let res =
List.fold_left paths_union empty_path_set
fpaths_if_matched in
+ let res =
+ if !propose_leaf_f_paths then refine_leaf_paths res [head]
+ else res in
run_prolog_aggregate := old_run_aggregate;
(* {{{ log entry *)
if !debug_level > 2 then (
@@ -199,11 +222,11 @@
(* Find $s_\calC$ and $t_\calC$ for a clause $\calC \in
\mathrm{Next}_{e}$, i.e. in expanded "next" clauses. Determine
- which original clauses are frame clauses, and which have to
- be dropped (under assumption of being "frame waves"). Return the
- proper frame clauses, the non-frame clauses, and the fluent paths
- (as in definition of $\calP_f$). Augment the syntactic check with
- semantic exploration whenever sensible. *)
+ which original clauses are frame clauses. Return the frame clauses,
+ the non-frame clauses, and the fluent paths (as in definition of
+ $\calP_f$). If [propose_leaf_f_paths] is true, refine fluent paths
+ of a clause with respect to the clause head state term. Augment the
+ syntactic check with semantic exploration whenever sensible. *)
let fluent_paths_and_frames program playout_states clauses =
let defs =
defs_of_rules (Aux.concat_map rules_of_clause clauses) in
@@ -248,38 +271,40 @@
(GDL.def_str ("next", next_exp))
);
(* }}} *)
- let find_br_fluents s_C (_,body,neg_body) =
+ let find_br_fluents (* s_C *) (head,body,neg_body) =
+ let s_Ce = head.(0) in
let true_args body = List.map
(function [|t|] -> t | _ -> assert false)
(Aux.assoc_all "true" body) in
let p_ts = true_args body in
let n_ts = true_args neg_body in
- let wave, best = most_similar s_C (p_ts @ n_ts) in
+ let wave, best = most_similar s_Ce (p_ts @ n_ts) in
let ps, t_C =
try List.find (fun (_,t) -> not (List.mem t n_ts)) best
with Not_found -> List.hd best in
(* "negative true" check *)
- wave, t_C, ps, List.mem t_C n_ts in
- let is_frame s_C (_, t_C, _, neg_true) =
- not neg_true && s_C = t_C in
+ wave, s_Ce, t_C, ps, List.mem t_C n_ts in
+ let is_frame (* s_C *) (_, s_Ce, t_C, _, neg_true) =
+ not neg_true && s_Ce = t_C in
let find_fluents (c, c_e) =
let s_C = (snd (fst c)).(0) in
- let res = List.map (find_br_fluents s_C) c_e in
+ let res = List.map find_br_fluents (*s_C*) c_e in
(* {{{ log entry *)
if !debug_level > 3 then (
Printf.printf
- "find_fluents: most_similar for s_C=%s expansions t_C=%s\n"
+ "find_fluents: most_similar for s_C=%s expansions s_Ce-t_C=%s\n"
(term_str s_C) (String.concat ", "
- (List.map (fun (_,t,_,_)->term_str t) res))
+ (List.map (fun (_,s,t,_,_)->
+ term_str s^"-"^term_str t) res))
);
(* }}} *)
- if List.for_all (is_frame s_C) res
+ if List.for_all is_frame (*s_C*) res
then Aux.Left c
else if List.for_all
- (fun (wave,_,_,neg_true)-> not wave && not neg_true) res
+ (fun (wave,_,_,_,neg_true)-> not wave && not neg_true) res
then
let f_paths =
- List.map (fun (_, _, ps, _) -> ps) res in
+ List.map (fun (_, _, _, ps, _) -> ps) res in
Aux.Right (c, List.fold_left paths_union empty_path_set f_paths)
else
let sem_f_paths =
@@ -288,24 +313,32 @@
then Aux.Left c
else
let f_paths =
- List.map (fun (wave, t_C, ps, neg_true) ->
+ List.map (fun (wave, s_Ce, t_C, ps, neg_true) ->
let ps =
if neg_true
then
term_paths (function Const _ -> true | _ -> false) t_C
else ps in
+ let ps =
+ if !propose_leaf_f_paths then refine_leaf_paths ps [s_Ce]
+ else ps in
if wave || neg_true then
match sem_f_paths with
| Some sem_ps -> paths_intersect sem_ps ps
| None -> ps
else ps
) res in
- Aux.Right (c, List.fold_left paths_union empty_path_set f_paths) in
+ let f_paths =
+ List.fold_left paths_union empty_path_set f_paths in
+ Aux.Right (c, f_paths) in
let res = List.map find_fluents next_e in
let frames, fluents = Aux.partition_choice res in
let move_clauses, f_paths = List.split fluents in
- frames, move_clauses,
- List.fold_left paths_union empty_path_set f_paths
+ let f_paths = List.fold_left paths_union empty_path_set f_paths in
+ if f_paths = empty_path_set then
+ failwith "fluent_path_and_frames: no fluent paths found";
+ frames, move_clauses, f_paths
+
let rec contains_blank = function
@@ -329,12 +362,12 @@
performing aggregate playout, which is very much
saturation-like. *)
let static_rel_defs, nonstatic_rel_defs,
- static_base, init_state, (agg_actions, agg_states) =
+ static_base, init_state, (agg_actions, agg_states, terminal_state) =
playout_satur ~aggregate:true players !playout_horizon rules in
(* *)
(*
- let program = preprocess_program clauses in
- let agg_actions, agg_states =
+ let program = preprocess_program clauses in
+ let agg_actions, agg_states =
playout_prolog ~aggregate:true players !playout_horizon program in
*)
let init_state = List.hd agg_states in
@@ -362,9 +395,24 @@
Aux.unique_sorted
(List.map (fun ((rel, args),_) -> rel, Array.length args)
clauses) in
- let ground_state_terms =
- List.fold_left (fun acc st -> Aux.unique_sorted (st @ acc)) []
- agg_states in
+ let ground_state_terms = List.fold_left
+ (fun acc st ->
+ Aux.sorted_merge (Aux.unique_sorted st) acc) []
+ (terminal_state::agg_states) in
+ let f_paths =
+ if !refine_leaf_f_paths
+ then (
+ let res = refine_leaf_paths f_paths ground_state_terms in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf
+ "create_init_struc: refined f_paths=%s\n%!"
+ (String.concat "; "
+ (List.map GDL.path_str (GDL.paths_to_list res)))
+ );
+ (* }}} *)
+ res
+ ) else f_paths in
let element_reps =
Aux.unique_sorted (List.map (fun t ->
simult_subst f_paths blank t) ground_state_terms) in
@@ -375,10 +423,8 @@
(String.concat ", " (List.map term_str element_reps))
);
(* }}} *)
- let m_paths = List.map
- (term_paths ~prefix_only:true (Aux.neg contains_blank)) element_reps in
let m_paths =
- List.fold_left paths_union empty_path_set m_paths in
+ refine_paths_avoiding eps_path_set contains_blank element_reps in
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf
@@ -387,6 +433,20 @@
(List.map GDL.path_str (GDL.paths_to_list m_paths)))
);
(* }}} *)
+ let m_paths =
+ if !refine_leaf_m_paths
+ then (
+ let res = refine_leaf_paths m_paths ground_state_terms in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf
+ "create_init_struc: refined m_paths=%s\n%!"
+ (String.concat "; "
+ (List.map GDL.path_str (GDL.paths_to_list res)))
+ );
+ (* }}} *)
+ res
+ ) else m_paths in
let mask_reps =
Aux.unique_sorted (List.map (fun t ->
simult_subst m_paths blank t) element_reps) in
@@ -445,7 +505,7 @@
let tup = Array.of_list (List.map2 at_path etup ptup) in
if rel = "EQ_" && arity = 2 && tup.(0) = tup.(1) ||
rel <> "EQ_" && graph_mem rel tup static_base
- (* rel <> "EQ_" && run_prolog_check_atom (rel, tup) program *)
+ (* rel <> "EQ_" && run_prolog_check_atom (rel, tup) program *)
then (
stable_rels := Aux.Strings.add fact_rel !stable_rels;
Structure.add_rel_named_elems struc fact_rel
@@ -1154,8 +1214,9 @@
let _, _, _, _, (playout_actions, playout_states) =
playout_satur ~aggregate:false players !playout_horizon rules in
*)
- let playout_actions, playout_states =
+ let playout_actions, playout_states, terminal_state =
playout_prolog ~aggregate:false players !playout_horizon program in
+ if playout_actions = [] then raise Not_turn_based;
(* {{{ log entry *)
if !debug_level > 3 then (
let actions = List.map
@@ -1164,7 +1225,7 @@
String.concat ";\n" (List.map (fun step -> String.concat " "
(List.map GDL.rel_atom_str step)) actions) in
Printf.printf
- "check_turn_based: no of states: %d, playout actions:\n%s\n%!"
+ "check_turn_based: no of in-game states: %d, playout actions:\n%s\n%!"
(List.length playout_states) res
);
(* }}} *)
@@ -1259,10 +1320,13 @@
let build_toss_rule transl_data rule_names struc fluents
- synch_precond synch_postcond (legal_tuple, case_rhs, case_cond) =
+ synch_elems synch_precond synch_postcond
+ (legal_tuple, case_rhs, case_cond) =
let rname =
- Aux.not_conflicting_name !rule_names
- (String.concat "_" (List.map term_to_name legal_tuple)) in
+ if legal_tuple = [] then "Environment"
+ else String.concat "_" (List.map term_to_name legal_tuple) in
+ let rname =
+ Aux.not_conflicting_name !rule_names rname in
rule_names := Aux.Strings.add rname !rule_names;
let label =
{Arena.lb_rule = rname; time_in = 0.1, 0.1; parameters_in = []} in
@@ -1295,14 +1359,24 @@
let rhs_add = synch_postcond @ rhs_add in
let signat = Structure.rel_signature struc in
let struc_elems = List.map
- (fun sterm -> term_to_name (blank_out transl_data sterm))
- case_rhs in
+ (fun sterm -> term_to_name (blank_out transl_data sterm)) case_rhs in
let rulevar_terms = Aux.strmap_of_assoc
(List.combine struc_elems case_rhs) in
- let struc_elems = Aux.unique_sorted struc_elems in
+ let struc_elems = Aux.unique_sorted (synch_elems @ struc_elems) in
let precond = FormulaOps.del_vars_quant
(List.map Formula.fo_var_of_string struc_elems :> Formula.var list)
precond in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ let add_str (rel, args) =
+ rel^"("^String.concat ", " (Array.to_list args)^")" in
+ Printf.printf
+ "build_toss_rule: rhs_add=%s; struc_elems=%s; total precond=\n%s\n\n%!"
+ (String.concat ", "(List.map add_str rhs_add))
+ (String.concat ", " struc_elems)
+ (Formula.str precond)
+ );
+ (* }}} *)
let discrete =
DiscreteRule.translate_from_precond ~precond
~add:rhs_add ~emb_rels:fluents ~signat ~struc_elems in
@@ -1373,7 +1447,6 @@
let loc_graph_concurrent players
player_payoffs struc build_rule fluents rule_cands =
(* finding or creating the control predicate *)
- let num_players = Array.length players in
let control_pred, control_e, struc =
try
let control_pred, _ =
@@ -1408,17 +1481,19 @@
let rules = ref [] in
let tossr_data = ref [] in
let players_with_env = Array.of_list
- (Array.to_list players @ [env_player]) in
+ (env_player :: Array.to_list players) in
let player_moves = List.map
(fun (pl, p_rules) ->
let pl_num =
Aux.array_argfind (fun x -> x = pl) players_with_env in
let p_rules = List.map
(fun rcand ->
- if pl_num = num_players then (* environment *)
- build_rule struc fluents all_players_precond [] rcand
+ if pl_num = 0 then (* environment *)
+ build_rule struc fluents [control_vn]
+ all_players_precond [] rcand
else
- build_rule struc fluents [] (player_marker_rhs pl) rcand)
+ build_rule struc fluents [control_vn]
+ [] (player_marker_rhs pl) rcand)
p_rules in
(* we need to build first before adding [player_cond] because
of how formula translation works *)
@@ -1466,7 +1541,8 @@
let score =
match score with
| Const pay ->
- (try float_of_string pay with _ -> assert false)
+ (try float_of_string pay with _ -> failwith
+ "TranslateGame.compute_payoffs: non-numeric goal value")
| _ -> failwith
("TranslateGame.compute_payoffs: non-constant " ^
"goal values not implemented yet") in
@@ -1515,34 +1591,35 @@
let transl_arg_type_no_side defined_rels init_state program
ground_at_m_paths =
- ass...
[truncated message content] |
|
From: <luk...@us...> - 2011-08-31 23:11:19
|
Revision: 1554
http://toss.svn.sourceforge.net/toss/?rev=1554&view=rev
Author: lukaszkaiser
Date: 2011-08-31 23:11:10 +0000 (Wed, 31 Aug 2011)
Log Message:
-----------
Splitting FormulaOps - creating FormulaMap and FormulaSubst to handle let-in before other FormulaOps parts.
Modified Paths:
--------------
trunk/Toss/Arena/Arena.ml
trunk/Toss/Arena/ContinuousRule.ml
trunk/Toss/Arena/DiscreteRule.ml
trunk/Toss/Formula/FFTNF.ml
trunk/Toss/Formula/FormulaOps.ml
trunk/Toss/Formula/FormulaOps.mli
trunk/Toss/Formula/FormulaOpsTest.ml
trunk/Toss/Formula/FormulaParser.mly
trunk/Toss/GGP/GameSimpl.ml
trunk/Toss/GGP/Makefile
trunk/Toss/GGP/TranslateFormula.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/Play/Heuristic.ml
trunk/Toss/Server/Picture.ml
trunk/Toss/Server/Tests.ml
trunk/Toss/Solver/Class.ml
trunk/Toss/Solver/Solver.ml
Added Paths:
-----------
trunk/Toss/Formula/FormulaMap.ml
trunk/Toss/Formula/FormulaMap.mli
trunk/Toss/Formula/FormulaMapTest.ml
trunk/Toss/Formula/FormulaSubst.ml
trunk/Toss/Formula/FormulaSubst.mli
trunk/Toss/Formula/FormulaSubstTest.ml
Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml 2011-08-31 22:51:22 UTC (rev 1553)
+++ trunk/Toss/Arena/Arena.ml 2011-08-31 23:11:10 UTC (rev 1554)
@@ -263,7 +263,7 @@
List.map add_more old_locs in
let add_def_rel loc =
let sub_p l =
- { l with payoff = FormulaOps.subst_rels_expr def_rels_pure l.payoff } in
+ { l with payoff = FormulaSubst.subst_rels_expr def_rels_pure l.payoff } in
Array.map sub_p loc in
(* {{{ log entry *)
if !debug_level > 2 then (
@@ -279,7 +279,7 @@
(* }}} *)
let graph = Array.of_list (List.rev locations) in
(* TODO; FIXME; JUST THIS List.rev ABOVE WILL NOT ALWAYS BE GOOD, OR?!! *)
- let pats = List.rev_map (FormulaOps.subst_rels_expr def_rels_pure) patterns in
+ let pats=List.rev_map (FormulaSubst.subst_rels_expr def_rels_pure) patterns in
{
rules = rules;
patterns = pats;
@@ -417,7 +417,7 @@
rn, ContinuousRule.map_to_formulas f r
) game.rules;
graph = Array.map (fun la -> Array.map (fun loc ->
- {loc with payoff = FormulaOps.map_to_formulas_expr f loc.payoff;
+ {loc with payoff = FormulaMap.map_to_formulas_expr f loc.payoff;
}) la) game.graph;
defined_rels = List.map (fun (drel, (args, def)) ->
drel, (args, f def)) game.defined_rels;
@@ -430,7 +430,7 @@
) game.rules acc in
let acc =
Array.fold_right (fun la -> Array.fold_right
- (fun loc -> FormulaOps.fold_over_formulas_expr f loc.payoff) la)
+ (fun loc -> FormulaMap.fold_over_formulas_expr f loc.payoff) la)
game.graph acc in
let acc =
if include_defined_rels then
@@ -517,9 +517,9 @@
"At location %d, only the second game has label %s->%d"
i label.lb_rule dest));
let poff1 =
- FormulaOps.map_to_formulas_expr Formula.flatten loc1.payoff in
+ FormulaMap.map_to_formulas_expr Formula.flatten loc1.payoff in
let poff2 =
- FormulaOps.map_to_formulas_expr Formula.flatten loc2.payoff in
+ FormulaMap.map_to_formulas_expr Formula.flatten loc2.payoff in
if poff1 <> poff2 then raise (Diff_result (
Printf.sprintf
"At location %d, payffs for player %d differ:\n%s\nvs.\n%s"
Modified: trunk/Toss/Arena/ContinuousRule.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRule.ml 2011-08-31 22:51:22 UTC (rev 1553)
+++ trunk/Toss/Arena/ContinuousRule.ml 2011-08-31 23:11:10 UTC (rev 1554)
@@ -24,9 +24,9 @@
let make_rule signat defs discr dynamics update ?(pre=Formula.And [])
?(inv=Formula.And []) ?(post=Formula.And []) () =
(* note that replacing not required for [pre]: [compile_rule] does it *)
- let cpre = FormulaOps.subst_rels defs pre in
- let cinv = FormulaOps.subst_rels defs inv in
- let cpost = FormulaOps.subst_rels defs post in
+ let cpre = FormulaSubst.subst_rels defs pre in
+ let cinv = FormulaSubst.subst_rels defs inv in
+ let cpost = FormulaSubst.subst_rels defs post in
let discrete = { discr with DiscreteRule.pre = cpre } in
(* we use [discrete] instead of [discr] because parser does not
insert precondition into discr! *)
Modified: trunk/Toss/Arena/DiscreteRule.ml
===================================================================
--- trunk/Toss/Arena/DiscreteRule.ml 2011-08-31 22:51:22 UTC (rev 1553)
+++ trunk/Toss/Arena/DiscreteRule.ml 2011-08-31 23:11:10 UTC (rev 1554)
@@ -116,12 +116,12 @@
all added and deleted tuples be removed? *)
let fluent_preconds rules signature posi_frels nega_frels indef_frels =
let indef_vars_fold =
- {FormulaOps.make_fold Aux.unique_append [] with
- FormulaOps.fold_Rel = (fun rel args ->
+ {FormulaMap.make_fold Aux.unique_append [] with
+ FormulaMap.fold_Rel = (fun rel args ->
if Aux.Strings.mem rel indef_frels
then Array.to_list args else [])} in
let collect_indef_vars phi =
- FormulaOps.fold_formula indef_vars_fold phi in
+ FormulaMap.fold_formula indef_vars_fold phi in
let rem_closed indef_vars = function
| Formula.Eq (x, y) ->
List.mem x indef_vars || List.mem y indef_vars
@@ -130,7 +130,7 @@
Aux.Strings.mem rel indef_frels ||
( !prune_indef_vars &&
Aux.array_existsi (fun _ v -> List.mem v indef_vars) args)
- | phi -> FormulaOps.free_vars phi = [] in
+ | phi -> FormulaSubst.free_vars phi = [] in
let fluent_precond is_posi rel =
(* rules that produce a fluent, together with its args *)
let rel_prods =
@@ -168,13 +168,13 @@
(* }}} *)
(* remove potential condition for absence/presence of the
fluent being just added / deleted *)
- let body = FormulaOps.map_formula
- {FormulaOps.identity_map with
+ let body = FormulaMap.map_formula
+ {FormulaMap.identity_map with
(* remove the absence/presence condition of added/deleted
tuple (TODO: see header comment); we know by [rel \in
nega_frels/posi_frels] that the occurrence is
positive/negative *)
- FormulaOps.map_Rel = (fun b_rel b_args ->
+ FormulaMap.map_Rel = (fun b_rel b_args ->
let b = rel = b_rel && lhs_args =
Array.map Formula.var_str b_args in
if b && Aux.Strings.mem rel nega_frels then Formula.And []
@@ -202,7 +202,7 @@
| None -> (* LHS and RHS vars are the same *)
let numap = List.combine args nu_args in
(* TODO: (?) could capture if someone uses av__N in precond *)
- FormulaOps.subst_vars numap body,
+ FormulaSubst.subst_vars numap body,
List.filter
(fun v->not (List.mem v args)) r.lhs_elem_vars, []
| Some rlmap ->
@@ -814,7 +814,7 @@
let subst =
List.map (fun (re,le) ->
lhs_name_of le, rhs_name_of re) rule_src.rule_s in
- FormulaOps.subst_vars subst rule_src.pre
+ FormulaSubst.subst_vars subst rule_src.pre
else rule_src.pre in
(* now we are ready to forget LHS names if optimizing *)
let lhs_name_of =
@@ -920,14 +920,14 @@
| atom -> atom in
let defined_new_rels =
List.map (fun (drel, (args,body)) ->
- "_new_"^drel, (args, FormulaOps.map_to_atoms transform_new_rel body))
+ "_new_"^drel, (args, FormulaMap.map_to_atoms transform_new_rel body))
defined_rels in
let defined_del_rels =
List.map (fun (drel, (args,body)) ->
- "_del_"^drel, (args, FormulaOps.map_to_atoms transform_del_rel body))
+ "_del_"^drel, (args, FormulaMap.map_to_atoms transform_del_rel body))
defined_rels in
let defs = defined_rels @ defined_new_rels @ defined_del_rels in
- let emb = FormulaOps.subst_rels defs emb in
+ let emb = FormulaSubst.subst_rels defs emb in
(* RHS *)
let rhs_rels =
@@ -1076,7 +1076,7 @@
);
(* }}} *)
let precond = Formula.And conjs in
- let fvars = FormulaOps.free_vars precond in
+ let fvars = FormulaSubst.free_vars precond in
let local_vars =
List.filter (fun v->
not (List.mem (Formula.var_str v) struc_elems)) fvars in
Modified: trunk/Toss/Formula/FFTNF.ml
===================================================================
--- trunk/Toss/Formula/FFTNF.ml 2011-08-31 22:51:22 UTC (rev 1553)
+++ trunk/Toss/Formula/FFTNF.ml 2011-08-31 23:11:10 UTC (rev 1554)
@@ -204,22 +204,22 @@
| And (flist) -> And (List.map (nnf ~neg:false) flist)
| Or (flist) when neg -> And (List.map (nnf ~neg:true) flist)
| Or (flist) -> Or (List.map (nnf ~neg:false) flist)
- | Ex (x, _) as phi when neg && FormulaOps.free_vars phi = [] ->
+ | Ex (x, _) as phi when neg && FormulaSubst.free_vars phi = [] ->
Not (pn_nnf phi)
| Ex (x, phi) when neg -> All (x, nnf ~neg:true phi)
| Ex (x, phi) -> Ex (x, nnf ~neg:false phi)
| All (x, phi) when neg -> Ex (x, nnf ~neg:true phi)
- | All (x, phi) as sbt when not neg && FormulaOps.free_vars sbt = [] ->
+ | All (x, phi) as sbt when not neg && FormulaSubst.free_vars sbt = [] ->
Not (pn_nnf (Ex (x, nnf ~neg:true phi)))
| All (x, phi) -> All (x, nnf ~neg:false phi)
and pn_nnf phi =
let rec pnf ex vars sb = function
| Rel _ | Eq _ | In _ | SO _ | RealExpr _ | Lfp _ | Gfp _ as psi ->
- [], vars, FormulaOps.subst_vars sb psi
+ [], vars, FormulaSubst.subst_vars sb psi
| Not (Ex _) as phi -> [], vars, phi (* already processed recursively *)
| Not psi as phi -> (* already reduced to NNF *)
- [], vars, FormulaOps.subst_vars sb phi
+ [], vars, FormulaSubst.subst_vars sb phi
| And conjs ->
let (prefs, vars, conjs) =
List.fold_right (fun conj (prefs, vars, conjs) ->
@@ -559,16 +559,16 @@
prefix Top (p_pn_nnf ~do_pnf phi) in
let phi = Formula.flatten phi in
let protected lit qvs =
- let lit_vs = FormulaOps.all_vars lit in
+ let lit_vs = FormulaSubst.all_vars lit in
List.for_all (fun v->List.mem v lit_vs) qvs in
let rec to_tree last_qvs = function
| Not (Ex _ as phi) -> (* assumes [phi] is ground! *)
{fvs=Vars.empty; t=TNot_subtask phi}
| (Rel _ | Eq _ | In _ | SO _ | RealExpr _ | Not _ | Lfp _ | Gfp _) as lit
when not do_pnf && protected lit last_qvs ->
- {fvs=vars_of_list (FormulaOps.all_vars lit); t=TProc (0,lit)}
+ {fvs=vars_of_list (FormulaSubst.all_vars lit); t=TProc (0,lit)}
| (Rel _ | Eq _ | In _ | SO _ | RealExpr _ | Not _ | Lfp _ | Gfp _) as lit->
- {fvs=vars_of_list (FormulaOps.all_vars lit); t=TLit lit}
+ {fvs=vars_of_list (FormulaSubst.all_vars lit); t=TLit lit}
| And conjs ->
List.fold_right (fun conj -> function {fvs=vs; t=TAnd conjs} ->
let conj = to_tree last_qvs conj in
@@ -1099,7 +1099,7 @@
flatten formula, build the tree while pushing negation inside
(flatten if possible) if the subformula contains active atoms. *)
let ffsep_init posi_frels nega_frels phi =
- let fvs = FormulaOps.free_vars phi in
+ let fvs = FormulaSubst.free_vars phi in
let rec aux neg evs = function
| Ex (vs, phi) when not neg ->
aux neg (add_vars vs evs) phi
@@ -1125,13 +1125,13 @@
| Eq _ | In _ | RealExpr _ | SO _ -> false in
let rec build neg phi =
if not (has_active neg phi) then
- {fvs=vars_of_list (FormulaOps.free_vars phi);
+ {fvs=vars_of_list (FormulaSubst.free_vars phi);
t=TProc (0, if neg then Not phi else phi)}
else
match phi with
| Rel _ as atom ->
(* the atom is actually a literal, negative if [rel \in NF] *)
- {fvs=vars_of_list (FormulaOps.free_vars atom); t=TLit atom}
+ {fvs=vars_of_list (FormulaSubst.free_vars atom); t=TLit atom}
| Not phi -> build (not neg) phi
| Ex (vs, phi) ->
let ({fvs=fvs} as subt) = build neg phi in
@@ -1286,7 +1286,7 @@
| _ -> assert false in
let forest = loop [] [[], tree] in
(* step 6 *)
- let all_avs = FormulaOps.free_vars (And (concat_map fst forest)) in
+ let all_avs = FormulaSubst.free_vars (And (concat_map fst forest)) in
let all_avs = List.filter (fun v->not (List.mem v fvs)) all_avs in
(* does not descend alternations, only erases "real" [evs] *)
let rec erase_qs neg = function
@@ -1304,7 +1304,7 @@
| phi -> phi in
List.map (fun (atoms, tree) ->
let atoms = List.rev atoms in
- let avs = FormulaOps.free_vars (And atoms) in
+ let avs = FormulaSubst.free_vars (And atoms) in
let avs = List.map Formula.to_fo
(List.filter (fun v->not (List.mem v fvs)) avs) in
avs, unique (=) atoms, Formula.flatten
Added: trunk/Toss/Formula/FormulaMap.ml
===================================================================
--- trunk/Toss/Formula/FormulaMap.ml (rev 0)
+++ trunk/Toss/Formula/FormulaMap.ml 2011-08-31 23:11:10 UTC (rev 1554)
@@ -0,0 +1,273 @@
+open Formula
+
+(* ----- Most basic literals / atoms map. --- *)
+
+(* Map [f] to all literals (i.e. atoms or not(atom)'s) in the given
+ formula. Preserves order of subformulas. *)
+let rec map_to_literals f g = function
+ | Rel _ | Eq _ | In _ | SO _ as x -> f x
+ | RealExpr (r, s) -> RealExpr (map_to_literals_expr f g r, s)
+ | Not (Rel _) | Not (Eq _) | Not (In _) as x -> f x
+ | Not (RealExpr (r, s)) -> Not (RealExpr (map_to_literals_expr f g r, s))
+ | Not phi -> Not (map_to_literals f g phi)
+ | Or flist -> Or (List.map (map_to_literals f g) flist)
+ | And flist -> And (List.map (map_to_literals f g) flist)
+ | Ex (vs, phi) -> Ex (vs, map_to_literals f g phi)
+ | All (vs, phi) -> All (vs, map_to_literals f g phi)
+ | Lfp (v, vs, phi) -> Lfp (v, vs, map_to_literals f g phi)
+ | Gfp (v, vs, phi) -> Gfp (v, vs, map_to_literals f g phi)
+
+and map_to_literals_expr f g = function
+ | RVar _ | Const _ | Fun _ as x -> g x
+ | Times (r1, r2) ->
+ Times (map_to_literals_expr f g r1, map_to_literals_expr f g r2)
+ | Plus (r1, r2) ->
+ Plus (map_to_literals_expr f g r1, map_to_literals_expr f g r2)
+ | Char (phi) -> Char (map_to_literals f g phi)
+ | Sum (vs, phi, r) ->
+ Sum (vs, map_to_literals f g phi, map_to_literals_expr f g r)
+
+(* Map [f] to all atoms in the given formula. *)
+let map_to_atoms_full f g phi =
+ map_to_literals (function Not (x) -> Not (f x) | x -> f x) g phi
+
+let map_to_atoms_full_re f g re =
+ map_to_literals_expr (function Not (x) -> Not (f x) | x -> f x) g re
+
+let map_to_atoms f phi =
+ map_to_literals (function Not (x) -> Not (f x) | x -> f x) (fun x -> x) phi
+
+let map_to_atoms_expr f r =
+ map_to_literals_expr (function Not (x) -> Not (f x) | x -> f x) (fun x -> x) r
+
+let get_atoms phi =
+ let atoms = ref [] in
+ let add_atom x = atoms := x :: !atoms; x in
+ ignore (map_to_atoms add_atom phi);
+ Aux.unique_sorted !atoms
+
+
+(* ---- Generalized maps --- *)
+
+(* Generalized map over formula and real expression types. *)
+type formula_and_expr_map = {
+ map_Rel : string -> fo_var array -> formula;
+ map_Eq : fo_var -> fo_var -> formula;
+ map_In : fo_var -> mso_var -> formula;
+ map_SO : so_var -> fo_var array -> formula;
+ map_RealExpr : real_expr -> sign_op -> formula;
+ map_Not : formula -> formula;
+ map_And : formula list -> formula;
+ map_Or : formula list -> formula;
+ map_Ex : var list -> formula -> formula;
+ map_All : var list -> formula -> formula;
+ map_Lfp : [ mso_var | so_var ] -> fo_var array -> formula -> formula;
+ map_Gfp : [ mso_var | so_var ] -> fo_var array -> formula -> formula;
+
+ map_RVar : string -> real_expr;
+ map_Const : float -> real_expr;
+ map_Times : real_expr -> real_expr -> real_expr;
+ map_Plus : real_expr -> real_expr -> real_expr;
+ map_Fun : string -> fo_var -> real_expr;
+ map_Char : formula -> real_expr;
+ map_Sum : fo_var list -> formula -> real_expr -> real_expr
+}
+
+let identity_map = {
+ map_Rel = (fun rel args -> Rel (rel, args));
+ map_Eq = (fun x y -> Eq (x, y));
+ map_In = (fun x ys -> In (x, ys));
+ map_SO = (fun v vs -> SO (v, vs));
+ map_RealExpr = (fun expr sign -> RealExpr (expr, sign));
+ map_Not = (fun phi -> Not phi);
+ map_And = (fun conjs -> And conjs);
+ map_Or = (fun disjs -> Or disjs);
+ map_Ex = (fun vs phi -> Ex (vs, phi));
+ map_All = (fun vs phi -> All (vs, phi));
+ map_Lfp = (fun v vs phi -> Lfp (v, vs, phi));
+ map_Gfp = (fun v vs phi -> Gfp (v, vs, phi));
+
+ map_RVar = (fun v -> RVar v);
+ map_Const = (fun c -> Const c);
+ map_Times = (fun expr1 expr2 -> Times (expr1, expr2));
+ map_Plus = (fun expr1 expr2 -> Plus (expr1, expr2));
+ map_Fun = (fun f v -> Fun (f, v));
+ map_Char = (fun phi -> Char phi);
+ map_Sum = (fun vs guard expr -> Sum (vs, guard, expr))
+}
+
+let rec map_formula gmap = function
+ | Rel (rel, args) -> gmap.map_Rel rel args
+ | Eq (x, y) -> gmap.map_Eq x y
+ | In (x, ys) -> gmap.map_In x ys
+ | SO (v, vs) -> gmap.map_SO v vs
+ | RealExpr (expr, sign) ->
+ gmap.map_RealExpr (map_real_expr gmap expr) sign
+ | Not phi -> gmap.map_Not (map_formula gmap phi)
+ | And conjs -> gmap.map_And (List.map (map_formula gmap) conjs)
+ | Or disjs -> gmap.map_Or (List.map (map_formula gmap) disjs)
+ | Ex (vs, phi) -> gmap.map_Ex vs (map_formula gmap phi)
+ | All (vs, phi) -> gmap.map_All vs (map_formula gmap phi)
+ | Lfp (v, vs, phi) -> gmap.map_Lfp v vs (map_formula gmap phi)
+ | Gfp (v, vs, phi) -> gmap.map_Gfp v vs (map_formula gmap phi)
+
+and map_real_expr gmap = function
+ | RVar v -> gmap.map_RVar v
+ | Const c -> gmap.map_Const c
+ | Times (expr1, expr2) ->
+ gmap.map_Times (map_real_expr gmap expr1) (map_real_expr gmap expr2)
+ | Plus (expr1, expr2) ->
+ gmap.map_Plus (map_real_expr gmap expr1) (map_real_expr gmap expr2)
+ | Fun (f, v) -> gmap.map_Fun f v
+ | Char phi -> gmap.map_Char (map_formula gmap phi)
+ | Sum (vs, guard, expr) ->
+ gmap.map_Sum vs (map_formula gmap guard) (map_real_expr gmap expr)
+
+
+(* Generalized fold over formula and real expression types. *)
+type 'a formula_and_expr_fold = {
+ fold_Rel : string -> fo_var array -> 'a;
+ fold_Eq : fo_var -> fo_var -> 'a;
+ fold_In : fo_var -> mso_var -> 'a;
+ fold_SO : so_var -> fo_var array -> 'a;
+ fold_RealExpr : 'a -> sign_op -> 'a;
+ fold_Not : 'a -> 'a;
+ fold_And : 'a -> 'a -> 'a;
+ fold_Or : 'a -> 'a -> 'a;
+ fold_Ex : var list -> 'a -> 'a;
+ fold_All : var list -> 'a -> 'a;
+ fold_Lfp : [ mso_var | so_var ] -> fo_var array -> 'a -> 'a;
+ fold_Gfp : [ mso_var | so_var ] -> fo_var array -> 'a -> 'a;
+
+ fold_RVar : string -> 'a;
+ fold_Const : float -> 'a;
+ fold_Times : 'a -> 'a -> 'a;
+ fold_Plus : 'a -> 'a -> 'a;
+ fold_Fun : string -> fo_var -> 'a;
+ fold_Char : 'a -> 'a;
+ fold_Sum : fo_var list -> 'a -> 'a -> 'a
+}
+
+let make_fold union empty = {
+ fold_Rel = (fun _ _ -> empty);
+ fold_Eq = (fun _ _ -> empty);
+ fold_In = (fun _ _ -> empty);
+ fold_SO = (fun _ _ -> empty);
+ fold_RealExpr = (fun expr _ -> expr);
+ fold_Not = (fun phi -> phi);
+ fold_And = union;
+ fold_Or = union;
+ fold_Ex = (fun _ phi -> phi);
+ fold_All = (fun _ phi -> phi);
+ fold_Lfp = (fun _ _ phi -> phi);
+ fold_Gfp = (fun _ _ phi -> phi);
+
+ fold_RVar = (fun _ -> empty);
+ fold_Const = (fun _ -> empty);
+ fold_Times = union;
+ fold_Plus = union;
+ fold_Fun = (fun _ _ -> empty);
+ fold_Char = (fun phi -> phi);
+ fold_Sum = (fun _ guard expr -> union guard expr)
+}
+
+open Aux.BasicOperators
+
+let rec fold_formula gfold = function
+ | Rel (rel, args) -> gfold.fold_Rel rel args
+ | Eq (x, y) -> gfold.fold_Eq x y
+ | In (x, ys) -> gfold.fold_In x ys
+ | SO (v, vs) -> gfold.fold_SO v vs
+ | RealExpr (expr, sign) ->
+ gfold.fold_RealExpr (fold_real_expr gfold expr) sign
+ | Not phi -> gfold.fold_Not (fold_formula gfold phi)
+ | And [] ->
+ gfold.fold_RealExpr (fold_real_expr gfold (Const 1.)) GZero
+ | And [conj] -> fold_formula gfold conj
+ | And (conj::conjs) ->
+ List.fold_right (gfold.fold_And -| fold_formula gfold) conjs
+ (fold_formula gfold conj)
+ | Or [] ->
+ gfold.fold_RealExpr (fold_real_expr gfold (Const 1.)) LZero
+ | Or [disj] -> fold_formula gfold disj
+ | Or (disj::disjs) ->
+ List.fold_right (gfold.fold_Or -| fold_formula gfold) disjs
+ (fold_formula gfold disj)
+ | Ex (vs, phi) -> gfold.fold_Ex vs (fold_formula gfold phi)
+ | All (vs, phi) -> gfold.fold_All vs (fold_formula gfold phi)
+ | Lfp (v, vs, phi) -> gfold.fold_Lfp v vs (fold_formula gfold phi)
+ | Gfp (v, vs, phi) -> gfold.fold_Gfp v vs (fold_formula gfold phi)
+
+and fold_real_expr gfold = function
+ | RVar v -> gfold.fold_RVar v
+ | Const c -> gfold.fold_Const c
+ | Times (expr1, expr2) ->
+ gfold.fold_Times (fold_real_expr gfold expr1) (fold_real_expr gfold expr2)
+ | Plus (expr1, expr2) ->
+ gfold.fold_Plus (fold_real_expr gfold expr1) (fold_real_expr gfold expr2)
+ | Fun (f, v) -> gfold.fold_Fun f v
+ | Char phi -> gfold.fold_Char (fold_formula gfold phi)
+ | Sum (vs, guard, expr) ->
+ gfold.fold_Sum vs (fold_formula gfold guard) (fold_real_expr gfold expr)
+
+(* Map [f] to top-level formulas in the real expression ([Char]s and
+ [Sum] guards). *)
+let rec map_to_formulas_expr f = function
+ | RVar _ | Const _ | Fun _ as x -> x
+ | Times (r1, r2) ->
+ Times (map_to_formulas_expr f r1, map_to_formulas_expr f r2)
+ | Plus (r1, r2) ->
+ Plus (map_to_formulas_expr f r1, map_to_formulas_expr f r2)
+ | Char (phi) -> Char (f phi)
+ | Sum (vs, phi, r) ->
+ Sum (vs, f phi, map_to_formulas_expr f r)
+
+let rec fold_over_formulas_expr f r acc =
+ match r with
+ | RVar _ | Const _ | Fun _ -> acc
+ | Times (r1, r2)
+ | Plus (r1, r2) ->
+ fold_over_formulas_expr f r1 (fold_over_formulas_expr f r2 acc)
+ | Char (phi) -> f phi acc
+ | Sum (vs, phi, r) ->
+ fold_over_formulas_expr f r (f phi acc)
+
+let rec fold_over_literals f phi acc =
+ match phi with
+ | Rel _ | Eq _ | In _ | SO _ as x -> f x acc
+ | RealExpr (r, _) -> fold_over_literals_expr f r acc
+ | Not (Rel _) | Not (Eq _) | Not (In _) as x -> f x acc
+ | Not phi -> fold_over_literals f phi acc
+ | Or flist
+ | And flist -> List.fold_right (fold_over_literals f) flist acc
+ | Ex (_, phi) | All (_, phi) -> fold_over_literals f phi acc
+ | Lfp (_, _, phi) | Gfp (_, _, phi) -> fold_over_literals f phi acc
+
+and fold_over_literals_expr f =
+ fold_over_formulas_expr (fold_over_literals f)
+
+let fold_over_atoms f phi =
+ fold_over_literals
+ (function Not x -> f x | x -> f x) phi
+
+(* Map [f] to all variables occurring in the formula. Preserves order
+ of subformulas. *)
+let rec map_to_all_vars (f : var -> var) phi =
+ let foaf va = Array.map (fun x -> to_fo (f (x :> var))) va in
+ match phi with
+ | Rel (rn, vl) -> Rel (rn, foaf vl)
+ | Eq (x, y) -> Eq (to_fo (f (x :> var)), to_fo (f (y :> var)))
+ | In (x, y) -> In (to_fo (f (x :> var)), to_mso (f (y :> var)))
+ | SO (v, vs) -> SO (to_so (f (v :> var)), foaf vs)
+ | RealExpr _ -> failwith "re"(* TODO: implement var map for realexprs. *)
+ | Not phi -> Not (map_to_all_vars f phi)
+ | Or flist -> Or (List.map (map_to_all_vars f) flist)
+ | And flist -> And (List.map (map_to_all_vars f) flist)
+ | Ex (vs, phi) -> Ex (List.map f vs, map_to_all_vars f phi)
+ | All (vs, phi) -> All (List.map f vs, map_to_all_vars f phi)
+ | Lfp (v, vs, phi) ->
+ Lfp (to_mso_or_so (f (v :> var)), foaf vs, map_to_all_vars f phi)
+ | Gfp (v, vs, phi) ->
+ Gfp (to_mso_or_so (f (v :> var)), foaf vs, map_to_all_vars f phi)
+
+
Added: trunk/Toss/Formula/FormulaMap.mli
===================================================================
--- trunk/Toss/Formula/FormulaMap.mli (rev 0)
+++ trunk/Toss/Formula/FormulaMap.mli 2011-08-31 23:11:10 UTC (rev 1554)
@@ -0,0 +1,99 @@
+open Formula
+
+(** {2 Basic maps - to literals and atoms.} *)
+
+val get_atoms : formula -> formula list
+
+(** Map [f] to all literals (i.e. atoms or not(atom)'s) in the given
+ formula. Preserves order of subformulas. *)
+val map_to_literals : (formula -> formula) -> (real_expr -> real_expr) ->
+ formula -> formula
+val map_to_literals_expr : (formula -> formula) -> (real_expr -> real_expr) ->
+ real_expr -> real_expr
+
+(** Map [f] to all atoms in the given formula. *)
+val map_to_atoms_full : (formula -> formula) -> (real_expr -> real_expr) ->
+ formula -> formula
+val map_to_atoms_full_re : (formula -> formula) -> (real_expr -> real_expr) ->
+ real_expr -> real_expr
+val map_to_atoms : (formula -> formula) -> formula -> formula
+val map_to_atoms_expr : (formula -> formula) -> real_expr -> real_expr
+
+(** {2 Generalized maps} *)
+
+(** Generalized map over formula and real expression types. *)
+type formula_and_expr_map = {
+ map_Rel : string -> fo_var array -> formula;
+ map_Eq : fo_var -> fo_var -> formula;
+ map_In : fo_var -> mso_var -> formula;
+ map_SO : so_var -> fo_var array -> formula;
+ map_RealExpr : real_expr -> sign_op -> formula;
+ map_Not : formula -> formula;
+ map_And : formula list -> formula;
+ map_Or : formula list -> formula;
+ map_Ex : var list -> formula -> formula;
+ map_All : var list -> formula -> formula;
+ map_Lfp : [ mso_var | so_var ] -> fo_var array -> formula -> formula;
+ map_Gfp : [ mso_var | so_var ] -> fo_var array -> formula -> formula;
+
+ map_RVar : string -> real_expr;
+ map_Const : float -> real_expr;
+ map_Times : real_expr -> real_expr -> real_expr;
+ map_Plus : real_expr -> real_expr -> real_expr;
+ map_Fun : string -> fo_var -> real_expr;
+ map_Char : formula -> real_expr;
+ map_Sum : fo_var list -> formula -> real_expr -> real_expr
+}
+
+(** Identity map to be refined using the [with] syntax. *)
+val identity_map : formula_and_expr_map
+
+(** Map through the structure adjusting subformulas/subexpressions. *)
+val map_formula : formula_and_expr_map -> formula -> formula
+val map_real_expr : formula_and_expr_map -> real_expr -> real_expr
+
+(** Generalized fold over formula and real expression types. *)
+type 'a formula_and_expr_fold = {
+ fold_Rel : string -> fo_var array -> 'a;
+ fold_Eq : fo_var -> fo_var -> 'a;
+ fold_In : fo_var -> mso_var -> 'a;
+ fold_SO : so_var -> fo_var array -> 'a;
+ fold_RealExpr : 'a -> sign_op -> 'a;
+ fold_Not : 'a -> 'a;
+ fold_And : 'a -> 'a -> 'a;
+ fold_Or : 'a -> 'a -> 'a;
+ fold_Ex : var list -> 'a -> 'a;
+ fold_All : var list -> 'a -> 'a;
+ fold_Lfp : [ mso_var | so_var ] -> fo_var array -> 'a -> 'a;
+ fold_Gfp : [ mso_var | so_var ] -> fo_var array -> 'a -> 'a;
+
+ fold_RVar : string -> 'a;
+ fold_Const : float -> 'a;
+ fold_Times : 'a -> 'a -> 'a;
+ fold_Plus : 'a -> 'a -> 'a;
+ fold_Fun : string -> fo_var -> 'a;
+ fold_Char : 'a -> 'a;
+ fold_Sum : fo_var list -> 'a -> 'a -> 'a
+}
+
+val make_fold : ('a -> 'a -> 'a) -> 'a -> 'a formula_and_expr_fold
+
+(** Fold the structure using the operations. (Not tail-recursive.) *)
+val fold_formula : 'a formula_and_expr_fold -> formula -> 'a
+val fold_real_expr : 'a formula_and_expr_fold -> real_expr -> 'a
+
+(** Map [f] to top-level formulas in the real expression ([Char]s and
+ [Sum] guards). *)
+val map_to_formulas_expr : (formula -> formula) -> real_expr -> real_expr
+
+val fold_over_formulas_expr :
+ (formula -> 'a -> 'a) -> real_expr -> 'a -> 'a
+
+val fold_over_literals :
+ (formula -> 'a -> 'a) -> formula -> 'a -> 'a
+val fold_over_atoms :
+ (formula -> 'a -> 'a) -> formula -> 'a -> 'a
+
+(** Map @param f to all variables occurring in the formula.
+ Preserves order of subformulas. @param phi The formula to substitute in. *)
+val map_to_all_vars : (var -> var) -> formula -> formula
Added: trunk/Toss/Formula/FormulaMapTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaMapTest.ml (rev 0)
+++ trunk/Toss/Formula/FormulaMapTest.ml 2011-08-31 23:11:10 UTC (rev 1554)
@@ -0,0 +1,45 @@
+open OUnit
+open Formula
+
+FormulaOps.set_debug_level 0
+
+let formula_of_string s =
+ FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
+
+let real_expr_of_string s =
+ FormulaParser.parse_real_expr Lexer.lex (Lexing.from_string s)
+
+
+let formula_eq ?(flatten=true) f1 phi1 f2 phi2 =
+ if flatten then
+ assert_equal ~printer:(fun x -> Formula.sprint x)
+ (Formula.flatten (f1 (formula_of_string phi1)))
+ (Formula.flatten (f2 (formula_of_string phi2)))
+ else
+ assert_equal ~printer:(fun x -> Formula.sprint x)
+ (f1 (formula_of_string phi1)) (f2 (formula_of_string phi2))
+
+let id x = x
+
+let tests = "FormulaMap" >::: [
+ "subst all" >::
+ (fun () ->
+ let var_subst subst v =
+ let subst_str s = try List.assoc s subst with Not_found -> s in
+ match v with
+ | `FO s -> `FO (subst_str s)
+ | `MSO s -> `MSO (subst_str s)
+ | `SO s -> `SO (subst_str s)
+ | `Real s -> `Real (subst_str s) in
+ let fo_var_subst subst (v : fo_var) = to_fo (var_subst subst v) in
+ let subst_atom subst = function
+ | Rel (rn, vs) -> Rel (rn, Array.map (fo_var_subst subst) vs)
+ | _ -> failwith "not atom" in
+ let subst_all_eq ?(sub=[("x", "a"); ("y", "b")]) phi1 phi2 =
+ formula_eq id phi2 (FormulaMap.map_to_atoms (subst_atom sub)) phi1 in
+ subst_all_eq "ex x (P(x) and (not R(x, y)))"
+ "ex x (P(a) and (not R(a, b)))";
+ );
+]
+
+let exec = Aux.run_test_if_target "FormulaMapTest" tests
Modified: trunk/Toss/Formula/FormulaOps.ml
===================================================================
--- trunk/Toss/Formula/FormulaOps.ml 2011-08-31 22:51:22 UTC (rev 1553)
+++ trunk/Toss/Formula/FormulaOps.ml 2011-08-31 23:11:10 UTC (rev 1554)
@@ -1,6 +1,8 @@
(* Operations on formulas.*)
open Formula
+open FormulaMap
+open FormulaSubst
let debug_level = ref 0
let debug_level_cnf = ref 0
@@ -14,6 +16,7 @@
(* Sat.set_debug_level (i-1);*)
Sat.set_debug_level ((i land 48) lsr 4);
(debug_level := i);
+ (FormulaSubst.set_debug_level i);
(debug_level_cnf :...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-02 13:37:22
|
Revision: 1555
http://toss.svn.sourceforge.net/toss/?rev=1555&view=rev
Author: lukstafi
Date: 2011-09-02 13:37:14 +0000 (Fri, 02 Sep 2011)
Log Message:
-----------
FormulaMap: adapting to let-in expressions. GDL translation fixing: bugs (generating stable paths; finding paths for defined relation arguments). GameSimpl minor bug. Bugs in move translation for concurrent games. Fixing TranslateGame regression tests.
Modified Paths:
--------------
trunk/Toss/Formula/FormulaMap.ml
trunk/Toss/Formula/FormulaMap.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/GameSimpl.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
trunk/Toss/GGP/tests/connect5-raw.toss
trunk/Toss/GGP/tests/connect5-simpl.toss
trunk/Toss/GGP/tests/tictactoe-raw.toss
trunk/Toss/GGP/tests/tictactoe-simpl.toss
Modified: trunk/Toss/Formula/FormulaMap.ml
===================================================================
--- trunk/Toss/Formula/FormulaMap.ml 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/Formula/FormulaMap.ml 2011-09-02 13:37:14 UTC (rev 1555)
@@ -16,6 +16,8 @@
| All (vs, phi) -> All (vs, map_to_literals f g phi)
| Lfp (v, vs, phi) -> Lfp (v, vs, map_to_literals f g phi)
| Gfp (v, vs, phi) -> Gfp (v, vs, map_to_literals f g phi)
+ | Let (rel, args, body, scope) ->
+ Let (rel, args, map_to_literals f g body, map_to_literals f g scope)
and map_to_literals_expr f g = function
| RVar _ | Const _ | Fun _ as x -> g x
@@ -26,6 +28,8 @@
| Char (phi) -> Char (map_to_literals f g phi)
| Sum (vs, phi, r) ->
Sum (vs, map_to_literals f g phi, map_to_literals_expr f g r)
+ | RLet (func, body, scope) ->
+ RLet (func, map_to_literals_expr f g body, map_to_literals_expr f g scope)
(* Map [f] to all atoms in the given formula. *)
let map_to_atoms_full f g phi =
@@ -63,6 +67,7 @@
map_All : var list -> formula -> formula;
map_Lfp : [ mso_var | so_var ] -> fo_var array -> formula -> formula;
map_Gfp : [ mso_var | so_var ] -> fo_var array -> formula -> formula;
+ map_Let : string -> string list -> formula -> formula -> formula;
map_RVar : string -> real_expr;
map_Const : float -> real_expr;
@@ -70,7 +75,8 @@
map_Plus : real_expr -> real_expr -> real_expr;
map_Fun : string -> fo_var -> real_expr;
map_Char : formula -> real_expr;
- map_Sum : fo_var list -> formula -> real_expr -> real_expr
+ map_Sum : fo_var list -> formula -> real_expr -> real_expr;
+ map_RLet : string -> real_expr -> real_expr -> real_expr
}
let identity_map = {
@@ -86,6 +92,7 @@
map_All = (fun vs phi -> All (vs, phi));
map_Lfp = (fun v vs phi -> Lfp (v, vs, phi));
map_Gfp = (fun v vs phi -> Gfp (v, vs, phi));
+ map_Let = (fun rel args body scope -> Let (rel, args, body, scope));
map_RVar = (fun v -> RVar v);
map_Const = (fun c -> Const c);
@@ -93,7 +100,8 @@
map_Plus = (fun expr1 expr2 -> Plus (expr1, expr2));
map_Fun = (fun f v -> Fun (f, v));
map_Char = (fun phi -> Char phi);
- map_Sum = (fun vs guard expr -> Sum (vs, guard, expr))
+ map_Sum = (fun vs guard expr -> Sum (vs, guard, expr));
+ map_RLet = (fun f body scope -> RLet (f, body, scope));
}
let rec map_formula gmap = function
@@ -110,6 +118,8 @@
| All (vs, phi) -> gmap.map_All vs (map_formula gmap phi)
| Lfp (v, vs, phi) -> gmap.map_Lfp v vs (map_formula gmap phi)
| Gfp (v, vs, phi) -> gmap.map_Gfp v vs (map_formula gmap phi)
+ | Let (rel, args, body, scope) ->
+ gmap.map_Let rel args (map_formula gmap body) (map_formula gmap scope)
and map_real_expr gmap = function
| RVar v -> gmap.map_RVar v
@@ -122,6 +132,8 @@
| Char phi -> gmap.map_Char (map_formula gmap phi)
| Sum (vs, guard, expr) ->
gmap.map_Sum vs (map_formula gmap guard) (map_real_expr gmap expr)
+ | RLet (f, body, scope) ->
+ gmap.map_RLet f (map_real_expr gmap body) (map_real_expr gmap scope)
(* Generalized fold over formula and real expression types. *)
@@ -138,6 +150,7 @@
fold_All : var list -> 'a -> 'a;
fold_Lfp : [ mso_var | so_var ] -> fo_var array -> 'a -> 'a;
fold_Gfp : [ mso_var | so_var ] -> fo_var array -> 'a -> 'a;
+ fold_Let : string -> string list -> 'a -> 'a -> 'a;
fold_RVar : string -> 'a;
fold_Const : float -> 'a;
@@ -145,7 +158,8 @@
fold_Plus : 'a -> 'a -> 'a;
fold_Fun : string -> fo_var -> 'a;
fold_Char : 'a -> 'a;
- fold_Sum : fo_var list -> 'a -> 'a -> 'a
+ fold_Sum : fo_var list -> 'a -> 'a -> 'a;
+ fold_RLet : string -> 'a -> 'a -> 'a
}
let make_fold union empty = {
@@ -161,6 +175,7 @@
fold_All = (fun _ phi -> phi);
fold_Lfp = (fun _ _ phi -> phi);
fold_Gfp = (fun _ _ phi -> phi);
+ fold_Let = (fun _ _ -> union);
fold_RVar = (fun _ -> empty);
fold_Const = (fun _ -> empty);
@@ -168,7 +183,8 @@
fold_Plus = union;
fold_Fun = (fun _ _ -> empty);
fold_Char = (fun phi -> phi);
- fold_Sum = (fun _ guard expr -> union guard expr)
+ fold_Sum = (fun _ guard expr -> union guard expr);
+ fold_RLet = (fun _ -> union)
}
open Aux.BasicOperators
@@ -197,6 +213,8 @@
| All (vs, phi) -> gfold.fold_All vs (fold_formula gfold phi)
| Lfp (v, vs, phi) -> gfold.fold_Lfp v vs (fold_formula gfold phi)
| Gfp (v, vs, phi) -> gfold.fold_Gfp v vs (fold_formula gfold phi)
+ | Let (rel, args, body, scope) ->
+ gfold.fold_Let rel args (fold_formula gfold body) (fold_formula gfold scope)
and fold_real_expr gfold = function
| RVar v -> gfold.fold_RVar v
@@ -209,6 +227,8 @@
| Char phi -> gfold.fold_Char (fold_formula gfold phi)
| Sum (vs, guard, expr) ->
gfold.fold_Sum vs (fold_formula gfold guard) (fold_real_expr gfold expr)
+ | RLet (f, body, scope) ->
+ gfold.fold_RLet f (fold_real_expr gfold body) (fold_real_expr gfold scope)
(* Map [f] to top-level formulas in the real expression ([Char]s and
[Sum] guards). *)
@@ -221,6 +241,8 @@
| Char (phi) -> Char (f phi)
| Sum (vs, phi, r) ->
Sum (vs, f phi, map_to_formulas_expr f r)
+ | RLet (func, body, scope) ->
+ RLet (func, map_to_formulas_expr f body, map_to_formulas_expr f scope)
let rec fold_over_formulas_expr f r acc =
match r with
@@ -231,6 +253,8 @@
| Char (phi) -> f phi acc
| Sum (vs, phi, r) ->
fold_over_formulas_expr f r (f phi acc)
+ | RLet (func, r1, r2) ->
+ fold_over_formulas_expr f r1 (fold_over_formulas_expr f r2 acc)
let rec fold_over_literals f phi acc =
match phi with
@@ -242,6 +266,8 @@
| And flist -> List.fold_right (fold_over_literals f) flist acc
| Ex (_, phi) | All (_, phi) -> fold_over_literals f phi acc
| Lfp (_, _, phi) | Gfp (_, _, phi) -> fold_over_literals f phi acc
+ | Let (_, _, body, scope) ->
+ fold_over_literals f body (fold_over_literals f scope acc)
and fold_over_literals_expr f =
fold_over_formulas_expr (fold_over_literals f)
@@ -252,6 +278,25 @@
(* Map [f] to all variables occurring in the formula. Preserves order
of subformulas. *)
+let map_to_all_vars (f : var -> var) phi =
+ let foaf va = Array.map (fun x -> to_fo (f (x :> var))) va in
+ let safs va = List.map (fun x -> var_str (f (var_of_string x))) va in
+ map_formula
+ {identity_map with
+ map_Rel = (fun rn vl -> Rel (rn, foaf vl));
+ map_Eq = (fun x y -> Eq (to_fo (f (x :> var)), to_fo (f (y :> var))));
+ map_In = (fun x y -> In (to_fo (f (x :> var)), to_mso (f (y :> var))));
+ map_SO = (fun v vs -> SO (to_so (f (v :> var)), foaf vs));
+ map_Ex = (fun vs phi -> Ex (List.map f vs, phi));
+ map_All = (fun vs phi -> All (List.map f vs, phi));
+ map_Lfp = (fun v vs phi ->
+ Lfp (to_mso_or_so (f (v :> var)), foaf vs, phi));
+ map_Gfp = (fun v vs phi ->
+ Gfp (to_mso_or_so (f (v :> var)), foaf vs, phi));
+ map_Let = (fun rel args body scope ->
+ Let (rel, safs args, body, scope))
+ } phi
+(* alternative direct definition
let rec map_to_all_vars (f : var -> var) phi =
let foaf va = Array.map (fun x -> to_fo (f (x :> var))) va in
match phi with
@@ -269,5 +314,7 @@
Lfp (to_mso_or_so (f (v :> var)), foaf vs, map_to_all_vars f phi)
| Gfp (v, vs, phi) ->
Gfp (to_mso_or_so (f (v :> var)), foaf vs, map_to_all_vars f phi)
+ | Let (rel, args, body, scope) ->
+ Let (rel, args, map_to_all_vars f body, map_to_all_vars f scope)
+*)
-
Modified: trunk/Toss/Formula/FormulaMap.mli
===================================================================
--- trunk/Toss/Formula/FormulaMap.mli 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/Formula/FormulaMap.mli 2011-09-02 13:37:14 UTC (rev 1555)
@@ -35,6 +35,7 @@
map_All : var list -> formula -> formula;
map_Lfp : [ mso_var | so_var ] -> fo_var array -> formula -> formula;
map_Gfp : [ mso_var | so_var ] -> fo_var array -> formula -> formula;
+ map_Let : string -> string list -> formula -> formula -> formula;
map_RVar : string -> real_expr;
map_Const : float -> real_expr;
@@ -42,7 +43,8 @@
map_Plus : real_expr -> real_expr -> real_expr;
map_Fun : string -> fo_var -> real_expr;
map_Char : formula -> real_expr;
- map_Sum : fo_var list -> formula -> real_expr -> real_expr
+ map_Sum : fo_var list -> formula -> real_expr -> real_expr;
+ map_RLet : string -> real_expr -> real_expr -> real_expr
}
(** Identity map to be refined using the [with] syntax. *)
@@ -66,6 +68,7 @@
fold_All : var list -> 'a -> 'a;
fold_Lfp : [ mso_var | so_var ] -> fo_var array -> 'a -> 'a;
fold_Gfp : [ mso_var | so_var ] -> fo_var array -> 'a -> 'a;
+ fold_Let : string -> string list -> 'a -> 'a -> 'a;
fold_RVar : string -> 'a;
fold_Const : float -> 'a;
@@ -73,7 +76,8 @@
fold_Plus : 'a -> 'a -> 'a;
fold_Fun : string -> fo_var -> 'a;
fold_Char : 'a -> 'a;
- fold_Sum : fo_var list -> 'a -> 'a -> 'a
+ fold_Sum : fo_var list -> 'a -> 'a -> 'a;
+ fold_RLet : string -> 'a -> 'a -> 'a
}
val make_fold : ('a -> 'a -> 'a) -> 'a -> 'a formula_and_expr_fold
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/GGP/GDL.ml 2011-09-02 13:37:14 UTC (rev 1555)
@@ -1745,17 +1745,17 @@
(* Split paths in the set until, if possible, none of subterms at the
paths meets the predicate. Also remove paths not present in terms. *)
-let refine_paths_avoiding paths avoid terms =
+let refine_paths_avoiding paths avoid_later avoid_now terms =
let rec aux terms = function
| Empty -> Empty
| Here ->
if terms=[] then Empty
- else if not (List.exists avoid terms)
+ else if not (List.exists avoid_later terms)
then Here
else
let subterms =
Aux.map_some (function
- | Func (rel,args) as t when not (avoid t) -> Some (rel,args)
+ | Func (rel,args) as t when not (avoid_now t) -> Some (rel,args)
| _ -> None) terms in
if subterms = [] then Empty
else
@@ -1764,7 +1764,7 @@
let arity =
Array.length (List.hd args_set) in
(* {{{ log entry *)
- if !debug_level > 3 then (
+ if !debug_level > 1 then (
Printf.printf "refine_paths_avoiding: aux rel=%s, no terms=%d\n%!"
rel (List.length args_set)
);
@@ -1772,12 +1772,12 @@
rel, aux2 (Array.make arity Here) args_set) subterms)
| (Here_and_below subpaths | Below subpaths) as path ->
if terms=[] then Empty
- else if not (List.exists avoid terms)
+ else if not (List.exists avoid_later terms)
then path
else
let subterms =
Aux.map_some (function
- | Func (rel,args) as t when not (avoid t) -> Some (rel,args)
+ | Func (rel,args) as t when not (avoid_now t) -> Some (rel,args)
| _ -> None) terms in
if subterms = [] then Empty
else
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/GGP/GDL.mli 2011-09-02 13:37:14 UTC (rev 1555)
@@ -264,8 +264,10 @@
paths that together cover all leafs the original path covered. *)
val refine_leaf_paths : path_set -> term list -> path_set
-(** Split paths in the set until, if possible, none of subterms at the
- paths meets the predicate. Also remove paths not present in
- terms. *)
+(** [refine_paths_avoiding paths avoid_later avoid_now terms] splits
+ paths in the set until, if possible, none of subterms at the paths
+ meets the predicate [avoid_later]; it does not descend subterms
+ for which [avoid_now] holds. Also removes paths not present
+ in terms. *)
val refine_paths_avoiding :
- path_set -> (term -> bool) -> term list -> path_set
+ path_set -> (term -> bool) -> (term -> bool) -> term list -> path_set
Modified: trunk/Toss/GGP/GameSimpl.ml
===================================================================
--- trunk/Toss/GGP/GameSimpl.ml 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/GGP/GameSimpl.ml 2011-09-02 13:37:14 UTC (rev 1555)
@@ -313,7 +313,7 @@
| None -> rel
| Some spec -> DiscreteRule.orig_rel_of rel in
(* {{{ log entry *)
- if !debug_level > 3 then (
+ if !debug_level > 4 then (
Printf.printf "removable: %s...%!" rel
);
(* }}} *)
@@ -326,7 +326,7 @@
List.mem_assoc (fst (List.assoc rel equivalent))
game.Arena.defined_rels) in
(* {{{ log entry *)
- if !debug_level > 3 then (
+ if !debug_level > 4 then (
Printf.printf "%B\n%!" res;
);
(* }}} *)
@@ -926,6 +926,7 @@
) &&
not (Aux.Strings.mem rel fluents) &&
(not (Aux.Strings.mem rel used_rels) ||
+ not (List.mem_assoc rel defined_rels) &&
Structure.rel_size !struc rel = 0) in
(* {{{ log entry *)
if !debug_level > 2 && res then (
Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/GGP/TranslateFormula.ml 2011-09-02 13:37:14 UTC (rev 1555)
@@ -310,16 +310,32 @@
| _ -> None)
(atoms_of_body body) in
r_atoms, state_terms body
- (* we take all state terms to have more compact partition *)
- (*Aux.map_some
- (function Pos (True s) -> Some s | _ -> None) body*))
+ (* we take all state terms to have more compact partition *)
+ (*Aux.map_some
+ (function Pos (True s) -> Some s | _ -> None) body*))
clauses in
let check_path args p s_p =
let inds = Aux.array_argfind_all (fun r -> r=s_p) args in
List.map (fun i->p,i) inds in
let sterm_path_sets args s =
- let ptups = Aux.product
- (map_paths (check_path args) data.m_paths s) in
+ (* {{{ log entry *)
+ if !debug_level > 4 then (
+ Printf.printf "sterm_path_sets: rel=%s args={%s} sterm=%s\n%!"
+ drel
+ (String.concat ", " (Array.to_list (Array.map term_str args)))
+ (term_str s)
+ );
+ (* }}} *)
+ let psets = map_paths (check_path args) data.m_paths s in
+ (* {{{ log entry *)
+ if !debug_level > 4 then (
+ Printf.printf "sterm_path_sets: psets=%s\n%!"
+ (String.concat "; "(List.map (fun pset->"["^
+ String.concat ", " (List.map (fun (p,i)->
+ path_str p^":"^string_of_int i) pset)^"]") psets))
+ );
+ (* }}} *)
+ let ptups = Aux.product (Aux.list_remove [] psets) in
(* distinct [p] in a tuple is already ensured *)
List.filter (fun tup ->
not (Aux.not_unique (List.map snd tup))) ptups in
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-09-02 13:37:14 UTC (rev 1555)
@@ -424,7 +424,8 @@
);
(* }}} *)
let m_paths =
- refine_paths_avoiding eps_path_set contains_blank element_reps in
+ refine_paths_avoiding eps_path_set
+ contains_blank (fun t->t=blank) element_reps in
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf
@@ -1336,7 +1337,10 @@
(* a defined relation for checking game termination *)
let nonterminal = Formula.Not (Formula.Rel ("terminal", [||])) in
let precond =
- Formula.And (nonterminal :: synch_precond @ [case_precond]) in
+ if legal_tuple = [] then (* Environment rule *)
+ Formula.And (synch_precond @ [case_precond])
+ else
+ Formula.And (nonterminal :: synch_precond @ [case_precond]) in
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf "build_toss_rule: synch precond = %s; main precond = %s\n%!"
@@ -1591,7 +1595,7 @@
payoffs
-let transl_arg_type_no_side defined_rels init_state program
+let transl_argpath_no_side defined_rels init_state program
ground_at_m_paths =
if ground_at_m_paths = [] then []
else
@@ -1774,6 +1778,18 @@
let args = List.assoc rel (List.map fst clauses) in
rel, Array.length args)
defined_rels in
+ let argpath_no_side =
+ transl_argpath_no_side defined_rel_arities init_state program
+ (ground_at m_paths) in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf "argpath_no_side:\n%!";
+ List.iter (fun (rel, argps) ->
+ Printf.printf "default paths for %s: %s\n%!" rel
+ (String.concat "; "(List.map (function None -> "None"
+ | Some p -> path_str p) (Array.to_list argps)))) argpath_no_side;
+ );
+ (* }}} *)
let transl_data = {
TranslateFormula.f_paths = f_paths;
m_paths = m_paths;
@@ -1782,9 +1798,7 @@
defined_rels = defined_rels;
defrel_argpaths = []; (* built in TranslateFormula *)
term_arities = term_arities;
- rel_default_path =
- transl_arg_type_no_side defined_rel_arities init_state program
- (ground_at m_paths);
+ rel_default_path = argpath_no_side;
} in
(* Building defined rels needs to happen between creating rule
candidates and rule translation, so that transformed clauses don't
@@ -1793,6 +1807,13 @@
(* Transform the rule conditions as well so they can be translated. *)
let rule_cands, clauses =
encode_rule_cands_in_clauses rule_cands clauses in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf
+ "traslate_game: all clauses prior to building defined rels\n%s\n\n%!"
+ (String.concat "\n"(List.map clause_str clauses));
+ );
+ (* }}} *)
let clauses, defined_rels =
TranslateFormula.build_defrels transl_data clauses in
let rule_cands, clauses =
@@ -2031,9 +2052,13 @@
(fun player move ->
let tossrules =
Aux.strmap_filter (fun _ rdata ->
- try ignore (unify [] [move]
- [rdata.legal_tuple.(player)]); true
- with Not_found -> false
+ rdata.legal_tuple <> [||] && (* not Environment rule *)
+ let legal_term =
+ if Array.length rdata.legal_tuple > 1
+ then rdata.legal_tuple.(player)
+ else rdata.legal_tuple.(0) in
+ try ignore (unify [] [move] [legal_term]); true
+ with Not_found -> false
) gdl.tossrule_data in
let candidates = Aux.map_some (fun (rname, rdata) ->
translate_incoming_single_action gdl.fluents gdl.transl_data
@@ -2046,30 +2071,30 @@
" for player " ^ string_of_int player)
| [rname, emb, lhs_struc] ->
(* {{{ log entry *)
- if !debug_level > 0 then (
- Printf.printf "GDL.translate_incoming_move: rname=%s; emb=%s\n...%!"
- rname
- (String.concat ", " (List.map (fun (v,e) ->
- Structure.elem_str lhs_struc v ^ ": " ^
- Structure.elem_str struc e) emb))
- );
- (* }}} *)
- player, (rname, emb)
+ if !debug_level > 0 then (
+ Printf.printf "GDL.translate_incoming_move: rname=%s; emb=%s\n...%!"
+ rname
+ (String.concat ", " (List.map (fun (v,e) ->
+ Structure.elem_str lhs_struc v ^ ": " ^
+ Structure.elem_str struc e) emb))
+ );
+ (* }}} *)
+ player, (rname, emb)
| _ ->
(* {{{ log entry *)
- if !debug_level > 0 then (
- Printf.printf "GDL.translate_incoming_move: ambiguity\n%!";
- List.iter (fun (rname, emb, lhs_struc) ->
- Printf.printf "rname=%s; emb=%s\n%!"
- rname
- (String.concat ", " (List.map (fun (v,e) ->
- Structure.elem_str lhs_struc v ^ ": " ^
- Structure.elem_str struc e) emb))) candidates
- );
- (* }}} *)
- failwith
- ("GDL.translate_incoming_move: ambiguity among rules "^
- String.concat ", " (List.map Aux.fst3 candidates))
+ if !debug_level > 0 then (
+ Printf.printf "GDL.translate_incoming_move: ambiguity\n%!";
+ List.iter (fun (rname, emb, lhs_struc) ->
+ Printf.printf "rname=%s; emb=%s\n%!"
+ rname
+ (String.concat ", " (List.map (fun (v,e) ->
+ Structure.elem_str lhs_struc v ^ ": " ^
+ Structure.elem_str struc e) emb))) candidates
+ );
+ (* }}} *)
+ failwith
+ ("GDL.translate_incoming_move: ambiguity among rules "^
+ String.concat ", " (List.map Aux.fst3 candidates))
)
actions in
Array.to_list candidates
@@ -2116,12 +2141,26 @@
);
(* }}} *)
(* 10d *)
- let emb = List.map (fun (lhs_e, struc_e) ->
+ (* only the synchronization element should raise [Not_found] *)
+ let emb = Aux.map_try (fun (lhs_e, struc_e) ->
let v = DiscreteRule.elemvar_of_elem
rule.ContinuousRule.compiled.DiscreteRule.lhs_elem_inv_names
lhs_e in
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf
+ "translate_outgoing_move: emb lhs_e=%d, v=%s, struc_e=%d\n%!"
+ lhs_e v struc_e;
+ Printf.printf
+ "translate_outgoing_move: emb lhs term=%s\n%!"
+ (term_str (Aux.StrMap.find v tossrule.rulevar_terms));
+ Printf.printf
+ "translate_outgoing_move: emb struc term=%s\n%!"
+ (term_str (Aux.IntMap.find struc_e gdl.elem_term_map));
+ );
+ (* }}} *)
Aux.StrMap.find v tossrule.rulevar_terms,
- Aux.IntMap.find struc_e gdl.elem_term_map) emb in
+ Aux.IntMap.find struc_e gdl.elem_term_map) emb in
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf "outgoing-emb={%s}\n%!"
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-02 13:37:14 UTC (rev 1555)
@@ -93,17 +93,13 @@
(norm_move (rname, emb)) (norm_move move)
(* COPIED FROM ReqHandler. *)
-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
exception Found of int
(* The player applying the rewrite seems not to be used. *)
-(* FIXME: adapt to simultaneous moves. *)
+(* Problem: are players indexed from 0 or from 1 in graph? *)
let apply_rewrite state (player, (r_name, mtch)) =
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 mv_loc = graph.((snd state).Arena.cur_loc).(player) in
let moves =
Move.gen_moves Move.cGRID_SIZE rules
(snd state).Arena.struc mv_loc in
@@ -184,11 +180,13 @@
(fun () ->
simult_test_case ~game_name:"2player_normal_form_2010" ~player:"row"
~own_plnum:0 ~opp_plnum:1
- ~own_rule_name:"row"
- ~own_emb:["_BLANK_", "_BLANK_"]
+ ~own_rule_name:"r1"
+ ~own_emb:["did__BLANK___BLANK_", "did__BLANK___BLANK_";
+ "reward_r1_c1_90_90", "reward_r1_c1_90_90"]
~own_move:"r1"
- ~opp_rule_name:"column"
- ~opp_emb:["_BLANK_", "_BLANK_"]
+ ~opp_rule_name:"c1"
+ ~opp_emb:["did__BLANK___BLANK_", "did__BLANK___BLANK_";
+ "reward_r1_c1_90_90", "reward_r1_c1_90_90"]
~opp_move:"c1"
);
@@ -225,7 +223,7 @@
(* adjacent_cell is a defined relation only because it has
large arity: see {!TranslateGame.defined_arity_above}. *)
assert_equal ~msg:"defined_rels" ~printer:(fun x->x)
- "adjacent_cell, col, conn5, diag1, diag2, exists_empty_cell, exists_line_of_five, goal, legal, next, row, terminal"
+ "adjacent, adjacent_cell, col, conn5, diag1, diag2, exists_empty_cell, exists_line_of_five, goal, legal, next, row, terminal"
(String.concat ", " (List.sort String.compare defined_rels));
assert_equal ~msg:"fluents" ~printer:(fun x->x)
@@ -233,7 +231,7 @@
(String.concat ", " fluents);
assert_equal ~msg:"stable_rels" ~printer:(fun x->x)
- "EQ___cell_0__cell_0, EQ___cell_0__cell_1, EQ___cell_1__cell_0, EQ___cell_1__cell_1, adjacent__cell_0__cell_0, adjacent__cell_0__cell_1, adjacent__cell_1__cell_0, adjacent__cell_1__cell_1, cell_0a, cell_0b, cell_0c, cell_0d, cell_0e, cell_0f, cell_0g, cell_0h, cell_1a, cell_1b, cell_1c, cell_1d, cell_1e, cell_1f, cell_1g, cell_1h, cell__BLANK___BLANK___BLANK_, control__BLANK_, coordinate__cell_0, coordinate__cell_1, nextcol__cell_0__cell_0, nextcol__cell_0__cell_1, nextcol__cell_1__cell_0, nextcol__cell_1__cell_1"
+ "EQ___cell_0__cell_0, EQ___cell_0__cell_1, EQ___cell_1__cell_0, EQ___cell_1__cell_1, cell_0a, cell_0b, cell_0c, cell_0d, cell_0e, cell_0f, cell_0g, cell_0h, cell_1a, cell_1b, cell_1c, cell_1d, cell_1e, cell_1f, cell_1g, cell_1h, cell__BLANK___BLANK___BLANK_, control__BLANK_, coordinate__cell_0, coordinate__cell_1, nextcol__cell_0__cell_0, nextcol__cell_0__cell_1, nextcol__cell_1__cell_0, nextcol__cell_1__cell_1"
(String.concat ", " stable_rels);
assert_equal ~msg:"structure elements" ~printer:(fun x->x)
@@ -246,15 +244,15 @@
(fun () ->
game_test_case ~game_name:"connect5" ~player:"x"
~own_plnum:0 ~opponent_plnum:1
- ~loc0_rule_name:"mark_x161_y162_0"
+ ~loc0_rule_name:"mark_x5_y5_noop"
~loc0_emb:[
- "cell_x161_y162__blank_", "cell_e_f_MV1";
- "control__blank_", "control_MV1"]
+ "cell_x5_y5__BLANK_", "cell_e_f__BLANK_";
+ "control__BLANK_", "control__BLANK_"]
~loc0_move:"(mark e f)" ~loc0_noop:"noop"
- ~loc1:1 ~loc1_rule_name:"mark_x175_y176_1"
+ ~loc1:1 ~loc1_rule_name:"noop_mark_x6_y6"
~loc1_emb:[
- "cell_x175_y176__blank_", "cell_f_g_MV1";
- "control__blank_", "control_MV1"]
+ "cell_x6_y6__BLANK_", "cell_f_g__BLANK_";
+ "control__BLANK_", "control__BLANK_"]
~loc1_noop:"noop" ~loc1_move:"(mark f g)"
);
@@ -270,8 +268,8 @@
~loc0_move:"(move 2 2 1 3)" ~loc0_noop:"noop" ~loc1:1
~loc1_rule_name:"noop_move_x7_y9_x8_y10"
~loc1_emb:[
- "cellholds_x7_y9__blank_", "cellholds_7_7__BLANK_";
- "cellholds_x8_y10__blank_", "cellholds_6_6__BLANK_";
+ "cellholds_x7_y9__BLANK_", "cellholds_7_7__BLANK_";
+ "cellholds_x8_y10__BLANK_", "cellholds_6_6__BLANK_";
"control__BLANK_", "control__BLANK_"]
~loc1_noop:"noop" ~loc1_move:"(move 7 7 6 6)"
);
@@ -307,11 +305,13 @@
set_debug_level 4;
simult_test_case ~game_name:"2player_normal_form_2010" ~player:"row"
~own_plnum:0 ~opp_plnum:1
- ~own_rule_name:"row"
- ~own_emb:["_BLANK_", "_BLANK_"]
+ ~own_rule_name:"r1"
+ ~own_emb:["did__BLANK___BLANK_", "did__BLANK___BLANK_";
+ "reward_r1_c1_90_90", "reward_r1_c1_90_90"]
~own_move:"r1"
- ~opp_rule_name:"column"
- ~opp_emb:["_BLANK_", "_BLANK_"]
+ ~opp_rule_name:"c1"
+ ~opp_emb:["did__BLANK___BLANK_", "did__BLANK___BLANK_";
+ "reward_r1_c1_90_90", "reward_r1_c1_90_90"]
~opp_move:"c1"
@@ -354,7 +354,7 @@
(* regenerate ~debug:true ~game_name:"pawn_whopping" ~player:"x"; *)
(* regenerate ~debug:false ~game_name:"connect4" ~player:"white"; *)
regenerate ~debug:false ~game_name:"2player_normal_form_2010" ~player:"row";
- failwith "generated";
+ (* failwith "generated"; *)
()
let exec () =
Modified: trunk/Toss/GGP/tests/2player_normal_form_2010-raw.toss
===================================================================
--- trunk/Toss/GGP/tests/2player_normal_form_2010-raw.toss 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/GGP/tests/2player_normal_form_2010-raw.toss 2011-09-02 13:37:14 UTC (rev 1555)
@@ -228,7 +228,6 @@
] -> [reward_r1_c1_90_90 | | ]
emb row__SYNC, column__SYNC, did_0column, did_0row, did_1c1, did_1c2,
did_1c3, did_1r1, did_1r2, did_1r3
- pre not terminal()
LOC 0 {
PLAYER Environment { PAYOFF 0. MOVES [Environment -> 0] }
PLAYER row {
Modified: trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss
===================================================================
--- trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss 2011-08-31 23:11:10 UTC (rev 1554)
+++ trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss 2011-09-02 13:37:14 UTC (rev 1555)
@@ -108,9 +108,10 @@
emb column__SYNC, did_0column, did_0row, did_1c1, did_1c2, did_1c3,
did_1r1, did_1r2, did_1r3, row__SYNC
pre
- ex reward_r3_m0_r_r0
- (reward_0r3(reward_r3_m0_r_r0) and
- not did__BLANK___BLANK_(reward_r3_m0_r_r0))
+ (not terminal() and
+ ex reward_r3_m0_r_r0
+ (reward_0r3(reward_r3_m0_r_r0) and
+ not did__BLANK___BLANK_(reward_r3_m0_r_r0)))
RULE r2:
...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-03 00:16:30
|
Revision: 1556
http://toss.svn.sourceforge.net/toss/?rev=1556&view=rev
Author: lukaszkaiser
Date: 2011-09-03 00:16:24 +0000 (Sat, 03 Sep 2011)
Log Message:
-----------
Formula and real expr (Let and RLet) expansion, correcting compilation warnings.
Modified Paths:
--------------
trunk/Toss/Formula/FormulaOps.ml
trunk/Toss/Formula/FormulaOpsTest.ml
trunk/Toss/Formula/FormulaSubst.ml
trunk/Toss/Formula/FormulaSubst.mli
trunk/Toss/GGP/GameSimpl.ml
trunk/Toss/Play/Heuristic.ml
trunk/Toss/Solver/Solver.ml
Modified: trunk/Toss/Formula/FormulaOps.ml
===================================================================
--- trunk/Toss/Formula/FormulaOps.ml 2011-09-02 13:37:14 UTC (rev 1555)
+++ trunk/Toss/Formula/FormulaOps.ml 2011-09-03 00:16:24 UTC (rev 1556)
@@ -50,8 +50,7 @@
| Gfp (r, vs, phi) when neg ->
Lfp (r, vs, nnf ~neg:true ~rev:((var_str r) :: rev) phi)
| Gfp (r, vs, phi) -> Gfp (r, vs, nnf ~neg:false ~rev phi)
- | Let (r, args, body, phi) -> (* subst_rels [(rel, (args, body))] phi *)
- Let (r, args, nnf body, nnf phi)
+ | Let _ -> nnf ~neg ~rev (expand_formula psi)
(* -- Delete quantified variables. --- *)
@@ -64,6 +63,7 @@
match compare_vars v1 v2 with
0 -> remove_dup_vars acc (v2::vs)
| _ -> remove_dup_vars (v1::acc) (v2::vs)
+
(* Delete all quantification over [vs] in the formula. *)
let rec del_vars_quant vs = function
| Eq _ | Rel _ | In _ | SO _ | RealExpr _ as f -> f
@@ -81,6 +81,7 @@
else All (vr, del_vars_quant vs phi)
| Lfp (r, xs, phi) -> Lfp (r, xs, del_vars_quant vs phi)
| Gfp (r, xs, phi) -> Gfp (r, xs, del_vars_quant vs phi)
+ | Let _ as phi -> del_vars_quant vs (expand_formula phi)
(* --- Signs of rels --- *)
@@ -262,6 +263,7 @@
| All (xs, phi) -> All (xs, prenex phi)
| Lfp (v, vs, phi) -> Lfp (v, vs, prenex phi)
| Gfp (v, vs, phi) -> Gfp (v, vs, prenex phi)
+ | Let _ as phi -> prenex (expand_formula phi)
let pnf fm = prenex(nnf(fm))
@@ -315,6 +317,7 @@
with Not_found -> atom
)
| Not phi -> Not (propagate_univ acc_atoms acc_formulas phi)
+ | Let _ as phi -> propagate_univ acc_atoms acc_formulas (expand_formula phi)
| Ex (vs, phi) -> Ex (vs, propagate_univ acc_atoms acc_formulas phi)
| All (vs, phi) -> All (vs, propagate_univ acc_atoms acc_formulas phi)
| Lfp (v, vs, phi) -> Lfp (v, vs, propagate_univ acc_atoms acc_formulas phi)
@@ -367,7 +370,8 @@
| Ex (x, psi) -> Ex (x, do_simplify (simplify_subformulas psi))
| All (x, psi) -> All (x, do_simplify (simplify_subformulas psi))
| Lfp (x, xs, psi) -> Lfp (x, xs, do_simplify (simplify_subformulas psi))
- | Gfp (x, xs, psi) -> Gfp (x, xs, do_simplify (simplify_subformulas psi)) in
+ | Gfp (x, xs, psi) -> Gfp (x, xs, do_simplify (simplify_subformulas psi))
+ | Let _ as psi -> simplify_subformulas (expand_formula psi) in
let check_for_variants phi =
let vars = List.map var_str (all_vars phi) in
List.exists (fun var -> var.[((String.length var)-1)]='_') vars in
@@ -460,6 +464,7 @@
let simp_q = simplify_re ~do_pnf ~do_formula ~ni q in
if simp_p = p && simp_q = q then Times (p, q) else
simplify_re ~do_pnf ~do_formula ~ni (Times (simp_p, simp_q))
+ | RLet _ as re -> simplify_re ~do_pnf ~do_formula ~ni (expand_real_expr re)
(* Formula as a list of conjuncts, with one level of distributing
@@ -496,7 +501,8 @@
| Ex (vs, phi) -> Ex (vs, map_formula phi)
| All (vs, phi) -> All (vs, map_formula phi)
| Lfp (v, vs, phi) -> Lfp (v, vs, map_formula phi)
- | Gfp (v, vs, phi) -> Gfp (v, vs, map_formula phi) in
+ | Gfp (v, vs, phi) -> Gfp (v, vs, map_formula phi)
+ | Let _ as phi -> map_formula (expand_formula phi) in
try Formula.flatten (map_formula phi) with Not_found -> And []
let unused_quants_map = {identity_map with
@@ -825,6 +831,7 @@
tnf_fun (All ([x], All (xs, phi)))
| Lfp (v, vs, phi) -> Lfp (v, vs, tnf_fun phi)
| Gfp (v, vs, phi) -> Gfp (v, vs, tnf_fun phi)
+ | Let _ as phi -> tnf_fun (expand_formula phi)
and tnf_re_fun = function
| RVar _ | Const _ | Fun _ as x -> x
@@ -832,6 +839,7 @@
| Plus (re1, re2) -> Plus (tnf_re_fun re1, tnf_re_fun re2)
| Char (phi) -> Char (flatten_sort (tnf_fun (flatten_sort phi)))
| Sum (vl, f, r) -> Sum (vl, tnf_fun f, tnf_re_fun r)
+ | RLet _ as re -> tnf_re_fun (expand_real_expr re)
and append_quant vs ~universal flist =
let (have_v, no_v) = List.partition (has_free vs) flist in
@@ -894,6 +902,7 @@
let subst = List.map (subst_name_avoiding avs) avoidv in
let nv = fp_var_subst subst v in
Gfp (nv, vs, rename_quant_avoiding ((nv :> var) :: avs) phi)
+ | Let _ as phi -> rename_quant_avoiding avs (expand_formula phi)
let rec has_mso = function
@@ -902,6 +911,7 @@
| Not phi | Ex (_, phi) | All (_, phi) | Lfp (_,_, phi) | Gfp (_,_, phi) ->
has_mso phi
| And flist | Or flist -> List.exists has_mso flist
+ | Let _ as phi -> has_mso (expand_formula phi)
let rec has_fo = function
| In _ -> false
@@ -909,6 +919,7 @@
| Not phi | Ex (_, phi) | All (_, phi) | Lfp (_,_, phi) | Gfp (_,_, phi) ->
has_fo phi
| And flist | Or flist -> List.exists has_fo flist
+ | Let _ as phi -> has_fo (expand_formula phi)
let rec mso_last = function
| Rel _ | Eq _ | In _ | SO _ | RealExpr _ as phi -> phi
@@ -997,6 +1008,7 @@
| All (vs, f) -> All (vs, push_in_quant f)
| Lfp (v, vs, f) -> Lfp (v, vs, push_in_quant f)
| Gfp (v, vs, f) -> Gfp (v, vs, push_in_quant f)
+ | Let _ -> push_in_quant (expand_formula phi)
let rec push_quant f = push_in_quant (flatten_sort (f))
Modified: trunk/Toss/Formula/FormulaOpsTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaOpsTest.ml 2011-09-02 13:37:14 UTC (rev 1555)
+++ trunk/Toss/Formula/FormulaOpsTest.ml 2011-09-03 00:16:24 UTC (rev 1556)
@@ -42,7 +42,7 @@
nnf_eq "ex x :(all y (R (x, y))) > 0"
"ex x :(all y (R (x, y))) > 0";
nnf_eq "let R(x) = not ex y C(x, y) in not (P(x) or R(x))"
- "let R(x) = all y not C(x, y) in not P(x) and not R(x)";
+ "not P(x) and ex y C(x, y)";
nnf_eq "not lfp T(x) = (P(x) or ex y (E(x, y) and y in T))"
"gfp T(x) = (not P(x) and all y (not E(x, y) or y in T))";
nnf_eq "not lfp |R(x, y) = (P(x, y) or ex z (E(x, z) and |R(y, z)))"
Modified: trunk/Toss/Formula/FormulaSubst.ml
===================================================================
--- trunk/Toss/Formula/FormulaSubst.ml 2011-09-02 13:37:14 UTC (rev 1555)
+++ trunk/Toss/Formula/FormulaSubst.ml 2011-09-03 00:16:24 UTC (rev 1556)
@@ -91,6 +91,7 @@
let (_, bad_subst) = newnames new_subst bad_vs in
Gfp (fp_var_subst bad_subst v, subvs,
subst_vars (bad_subst @ new_subst) phi)
+ | Let _ -> failwith "FormulaSubst:subst_vars: let substitution"
and subst_vars_expr subst = function
| Const _ as x -> x
@@ -104,9 +105,9 @@
let new_vs = List.filter (fun x -> not (in_vs x)) subst in
if new_vs = [] then Sum(vs, phi, r) else
Sum(vs, subst_vars new_vs phi, subst_vars_expr new_vs r)
+ | RLet _ -> failwith "FormulaSubst:subst_vars_expr: rlet substitution"
-
(* --------- SUBSTITUTE DEFINED RELATIONS ------------ *)
(* Substitute in relations defined in [defs] by their definitions. *)
@@ -208,6 +209,7 @@
| Plus (r1, r2) -> Plus (subst_rels_expr defs r1, subst_rels_expr defs r2)
| Char (phi) -> Char (subst_rels defs phi)
| Sum (vs, phi, r) -> Sum (vs, subst_rels defs phi, subst_rels_expr defs r)
+ | RLet _ -> failwith "FormulaSubst:subst_rels_expr: rlet substitution"
(* Assign emptyset to the MSO-variable v by replacing "x in X" with "false". *)
let assign_emptyset v phi =
@@ -216,7 +218,30 @@
| phi -> phi in
flatten (FormulaMap.map_to_atoms (replace_by_emptyset v) phi)
+(* Expand Let's and RLet's in formula. TODO!! FIXME!! add RLet expand
+ and allow recursively defined relations in let-series. *)
+let rec expand_formula = function
+ | Rel _ | Eq _ | In _ | SO _ as phi -> phi
+ | RealExpr (r, sgn) -> RealExpr (expand_real_expr r, sgn)
+ | Not phi -> Not (expand_formula phi)
+ | Or flist -> Or (List.map expand_formula flist)
+ | And flist -> And (List.map expand_formula flist)
+ | Ex (vs, phi) -> Ex (vs, expand_formula phi)
+ | All (vs, phi) -> All (vs, expand_formula phi)
+ | Lfp (v, vs, phi) -> Lfp (v, vs, expand_formula phi)
+ | Gfp (v, vs, phi) -> Gfp (v, vs, expand_formula phi)
+ | Let (rel, args, def, phi) ->
+ let exp = expand_formula phi in subst_rels [(rel, (args, def))] exp
+and expand_real_expr = function
+ | RVar _ | Const _ | Fun _ as x -> x
+ | Times (r1, r2) -> Times (expand_real_expr r1, expand_real_expr r2)
+ | Plus (r1, r2) -> Plus (expand_real_expr r1, expand_real_expr r2)
+ | Char (phi) -> Char (expand_formula phi)
+ | Sum (vs, phi, r) -> Sum (vs, expand_formula phi, expand_real_expr r)
+ | RLet _ -> failwith "FormulaSubst:expand real_expr RLet not implemented yet"
+
+
(* -------------------------- FREE VARIABLES -------------------------------- *)
(* Helper function: remove duplicates from sorted list of variables. *)
@@ -244,6 +269,7 @@
| Lfp (r, vs, phi) | Gfp (r, vs, phi) ->
all_vars_acc
((r :> var):: (List.rev_append ((Array.to_list vs) :> var list) acc)) phi
+ | Let (_, _, def, phi) -> all_vars_acc (all_vars_acc acc def) phi
and all_vars_real = function
| RVar s -> [s]
@@ -254,6 +280,7 @@
| Char phi -> List.rev_map var_str (all_vars_acc [] phi)
| Sum (_, f, r) ->
List.rev_append (List.rev_map var_str (all_vars_acc [] f)) (all_vars_real r)
+ | RLet (_, def, re) -> List.rev_append (all_vars_real def) (all_vars_real re)
let all_vars phi =
remove_dup_vars [] (List.sort compare_vars (all_vars_acc [] phi))
@@ -277,6 +304,7 @@
let fv_phi = free_vars_acc [] phi in
List.rev_append ((Array.to_list xs) :> var list) (List.rev_append (
List.filter (fun v -> not (List.mem v vs)) fv_phi) acc)
+ | Let _ as phi -> free_vars_acc acc (expand_formula phi)
and free_vars_real = function
| RVar s -> [s]
@@ -288,6 +316,7 @@
| Sum (vl, _, r) ->
let vs = List.map var_str vl in
List.filter (fun w -> not (List.mem w vs)) (free_vars_real r)
+ | RLet _ as r -> free_vars_real (expand_real_expr r)
let free_vars phi =
remove_dup_vars [] (List.sort compare_vars (free_vars_acc [] phi))
Modified: trunk/Toss/Formula/FormulaSubst.mli
===================================================================
--- trunk/Toss/Formula/FormulaSubst.mli 2011-09-02 13:37:14 UTC (rev 1555)
+++ trunk/Toss/Formula/FormulaSubst.mli 2011-09-03 00:16:24 UTC (rev 1556)
@@ -28,7 +28,11 @@
val subst_rels_expr :
(string * (string list * formula)) list -> real_expr -> real_expr
+(** Expand Let's and RLet's in formula. **)
+val expand_formula : formula -> formula
+val expand_real_expr : real_expr -> real_expr
+
(** {2 MSO empty set assignment} *)
(** Assign emptyset to an MSO-variable. *)
Modified: trunk/Toss/GGP/GameSimpl.ml
===================================================================
--- trunk/Toss/GGP/GameSimpl.ml 2011-09-02 13:37:14 UTC (rev 1555)
+++ trunk/Toss/GGP/GameSimpl.ml 2011-09-03 00:16:24 UTC (rev 1556)
@@ -152,6 +152,7 @@
| Ex (_, phi) ->
if not neg then aux neg phi else 0, [phi]
| Not phi -> aux (not neg) phi
+ | Let _ as phi -> aux neg (FormulaSubst.expand_formula phi)
| Rel _ | Eq _ | In _ | SO _ | RealExpr _ | Lfp _ | Gfp _ -> 1, [] in
aux false phi
Modified: trunk/Toss/Play/Heuristic.ml
===================================================================
--- trunk/Toss/Play/Heuristic.ml 2011-09-02 13:37:14 UTC (rev 1555)
+++ trunk/Toss/Play/Heuristic.ml 2011-09-03 00:16:24 UTC (rev 1556)
@@ -285,6 +285,7 @@
| Ex (_,phi) | All (_,phi) | Not phi | Lfp (_, _, phi) | Gfp (_, _, phi) ->
has_rels frels phi
| Eq _ | In _ | RealExpr _ | SO _ -> false
+ | Let _ as phi -> has_rels frels (FormulaSubst.expand_formula phi)
let add_tuples nts ts =
List.fold_left (fun ts nt -> Structure.Tuples.add nt ts) ts nts
@@ -797,11 +798,14 @@
[[if neg then Not phi else phi]]
| All (vs, psi) as phi ->
[[if neg then Ex (vs, Not psi) else phi]]
+ | Let _ as phi -> limited_dnf neg (FormulaSubst.expand_formula phi)
let rec has_pos_existential ?(neg=false) = function
| Not phi -> has_pos_existential ~neg:(not neg) phi
| And phs | Or phs -> List.exists (has_pos_existential ~neg) phs
- | Ex _ -> not neg | All _ -> neg | _ -> false
+ | Ex _ -> not neg | All _ -> neg
+ | Let _ as phi -> has_pos_existential ~neg (FormulaSubst.expand_formula phi)
+ | _ -> false
let rec map_constants f = function
@@ -813,6 +817,7 @@
| Sum (vs, phi, es) ->
Sum (vs, phi, map_constants f es)
| RVar _ | Fun _ | Char _ as expr -> expr
+ | RLet _ as re -> map_constants f (FormulaSubst.expand_real_expr re)
let normalized_mult coefs =
let n = List.length coefs in
@@ -941,6 +946,7 @@
| RVar _
| Const _
| Fun _ as expr -> expr
+ | RLet _ as re -> aux gds (FormulaSubst.expand_real_expr re)
| Times (a, b) -> Times (aux gds a, aux gds b)
| Plus (a, b) -> Plus (aux gds a, aux gds b)
| Char phi ->
Modified: trunk/Toss/Solver/Solver.ml
===================================================================
--- trunk/Toss/Solver/Solver.ml 2011-09-02 13:37:14 UTC (rev 1555)
+++ trunk/Toss/Solver/Solver.ml 2011-09-03 00:16:24 UTC (rev 1556)
@@ -204,21 +204,23 @@
let a0 = eval ((v, alltps)::fp) model elems asg0 phi in
let fp_res = if a0 = Any then Any else fixpnt v vll phi a0 in
report (simp (join aset fp_res))
+ | Let _ -> eval fp model elems aset (FormulaSubst.expand_formula phi)
and assignment_of_real_expr fp ?(check=true) model elems (p, sgn) =
let rec fo_vars_r_rec = function
- RVar s -> []
+ | RVar s -> []
| Const _ -> []
| Times (r1, r2) -> List.rev_append (fo_vars_r_rec r1) (fo_vars_r_rec r2)
| Plus (r1, r2) -> List.rev_append (fo_vars_r_rec r1) (fo_vars_r_rec r2)
| Fun (s, v) -> [v]
| Char phi ->
- let fv = FormulaSubst.free_vars phi in
- if List.exists (function `FO _ -> false | _ -> true) fv then
- failwith "non first-order free vars in real_expr not yet supported"
- else List.rev_map to_fo fv
+ let fv = FormulaSubst.free_vars phi in
+ if List.exists (function `FO _ -> false | _ -> true) fv then
+ failwith "non first-order free vars in real_expr not yet supported"
+ else List.rev_map to_fo fv
| Sum (vl, _, r) ->
- List.filter (fun w -> not (List.mem w vl)) (fo_vars_r_rec r) in
+ List.filter (fun w -> not (List.mem w vl)) (fo_vars_r_rec r)
+ | RLet _ as re -> fo_vars_r_rec (FormulaSubst.expand_real_expr re) in
let fo_vars_real re =
remove_dup_vars [] (List.sort compare_vars (fo_vars_r_rec re)) in
let rec sum_polys = function
@@ -231,7 +233,7 @@
| Real [[(poly, _)]] -> poly
| Real _ -> failwith "too many polynomials in assignement to sum over" in
let rec poly_of assgn = function
- RVar s -> Poly.Var s
+ | RVar s -> Poly.Var s
| Const f -> Poly.Const f
| Times (r1, r2) -> Poly.Times (poly_of assgn r1, poly_of assgn r2)
| Plus (r1, r2) -> Poly.Plus (poly_of assgn r1, poly_of assgn r2)
@@ -250,7 +252,8 @@
let fo_aset = List.fold_left make_fo_asg Any assgn in
let r_a = assignment_of_real_expr fp ~check:false model elems (r,sgn) in
let asg = join (eval fp model elems fo_aset guard) r_a in
- sum_polys asg (* Note: above "sgn" is irrelevant! *) in
+ sum_polys asg (* Note: above "sgn" is irrelevant! *)
+ | RLet _ as re -> poly_of assgn (FormulaSubst.expand_real_expr re) in
let rec process_vars assgn = function
| [] ->
let poly = poly_of assgn p in
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-09-03 08:52:13
|
Revision: 1557
http://toss.svn.sourceforge.net/toss/?rev=1557&view=rev
Author: lukstafi
Date: 2011-09-03 08:52:07 +0000 (Sat, 03 Sep 2011)
Log Message:
-----------
Minor commit (specifying new approach to fluent paths).
Modified Paths:
--------------
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-03 00:16:24 UTC (rev 1556)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-03 08:52:07 UTC (rev 1557)
@@ -332,7 +332,7 @@
and discreterule_dl = !DiscreteRule.debug_level in
if debug then (
GameSimpl.debug_level := 4;
- GDL.debug_level := 4;
+ GDL.debug_level := 2;
TranslateFormula.debug_level := 4;
TranslateGame.debug_level := 4;
DiscreteRule.debug_level := 4);
@@ -353,8 +353,9 @@
(* regenerate ~debug:false ~game_name:"breakthrough" ~player:"white"; *)
(* regenerate ~debug:true ~game_name:"pawn_whopping" ~player:"x"; *)
(* regenerate ~debug:false ~game_name:"connect4" ~player:"white"; *)
- regenerate ~debug:false ~game_name:"2player_normal_form_2010" ~player:"row";
- (* failwith "generated"; *)
+ (* regenerate ~debug:false ~game_name:"2player_normal_form_2010" ~player:"row"; *)
+ regenerate ~debug:true ~game_name:"pacman3p" ~player:"pacman";
+ failwith "generated";
()
let exec () =
Modified: trunk/Toss/www/reference/reference.tex
===================================================================
--- trunk/Toss/www/reference/reference.tex 2011-09-03 00:16:24 UTC (rev 1556)
+++ trunk/Toss/www/reference/reference.tex 2011-09-03 08:52:07 UTC (rev 1557)
@@ -1364,8 +1364,34 @@
$d\calP(s,t)$.
-\paragraph{Wave Clauses and Fluent Paths}
+\paragraph{Fluent Paths}
+We need to decide which parts of the state description will provide
+the fixed ``coordinate system'', and which will provide labels over
+coordinates (predicates ranging over the points spanned by the
+coordinates). The labels-predicates will be the only means accounting
+for game state changes, directly translating into Toss fluents, we
+will therefore call the state term paths containing them the
+\emph{fluent paths}. We need to have at least one fluent for each
+\texttt{next} clause that leads to state change, but first we need to
+determine which \texttt{next} clauses change state.
+
+We say that a \texttt{next} clause $\calC$ is a \emph{frame clause}
+when, for each state transition, each state term it generates is
+already present in the prior state. If possible (\ie when the clause
+is not a wave clause) we find a frame clause by checking whether it
+contains a \texttt{true} relation applied to a term equal to the
+\texttt{next} argument. Otherwies, we approximate by checking on
+states generated by a few random playouts.
+
+For each non-frame \texttt{next} clause \texttt{(<= (next $s_\calC$)
+ $\ldots$)}, a fluent path is a path $s_\calC\tpos_p$ such that the
+set $\{t\ |\ t=s\tpos_p, s\in\calS \}$ is clearly the smallest, where
+$\calS$ is the set of all state terms. When the next-smallest set
+$\{t\ |\ t=s\tpos_{p'}, s\in\calS \}$ is less than twice as big as
+$\{t\ |\ t=s\tpos_p, s\in\calS \}$, we resort to changeability in the
+GDL state transitions to determine the fluent path for $\calC$.
+
Let \emph{wave clauses} $\mathrm{Next}_{W}$ be defined as follows:
$\calC \in \mathrm{Next}_{W}$ if there is $\calC' \in
\mathrm{Next}_{e}$ derived from $\calC$ such that the set of subterms
@@ -1820,14 +1846,10 @@
So far, we have not accounted for the fact that rewrite rules of Toss
only affect the matched part of the structure, while the GDL game
definition explicitly describes the construction of the whole
-successive structure. We say that a \texttt{next} clause $\calC$ is a
-\emph{frame clause} when $d\calP(s^{sem}_\calC,t^{sem}_\calC) =
-\emptyset$ (if possible, \ie when the clause is not a wave clause,
-approximated by checking whether it contains a \texttt{true} relation
-applied to a term equal to the \texttt{next} argument). Negating the
-frame clauses from the tuple $\ol{\calN}$ and transforming them into
-\emph{erasure clauses} will keep track of the elements that possibly
-lose fluents and ensure correct translation.
+successive structure. Negating the frame clauses from the tuple
+$\ol{\calN}$ and transforming them into \emph{erasure clauses} will
+keep track of the elements that possibly lose fluents and ensure
+correct translation.
We determine which clauses are frame clauses prior to partitioning
into the rule clauses and computing the substitution
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-09-06 12:10:53
|
Revision: 1559
http://toss.svn.sourceforge.net/toss/?rev=1559&view=rev
Author: lukstafi
Date: 2011-09-06 12:10:45 +0000 (Tue, 06 Sep 2011)
Log Message:
-----------
GDL translation: Major specification change - new definition of fluents. Great renaming - within-mask paths into coordinate paths, anchor predicates into coordinate predicates, mask predicates into root predicates. GDL: bug in adding a path to a set of paths. TranslateGame: simplified code for finding fluents; checking static part for early pruning when building and filtering rule candidates; synchronization missing not-moved precondition. Structure: rel_find renamed into rel_graph and not raising [Not_found]. GameSimpl: deep bug regarding semantics of EQ; removing stable relations that are inverses of others; related fixes.
Modified Paths:
--------------
trunk/Toss/Arena/Arena.ml
trunk/Toss/Arena/ContinuousRule.ml
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GameSimpl.ml
trunk/Toss/GGP/TranslateFormula.ml
trunk/Toss/GGP/TranslateFormula.mli
trunk/Toss/GGP/TranslateFormulaTest.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGame.mli
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
trunk/Toss/GGP/tests/connect5-raw.toss
trunk/Toss/GGP/tests/tictactoe-raw.toss
trunk/Toss/GGP/tests/tictactoe-simpl.toss
trunk/Toss/Solver/Solver.ml
trunk/Toss/Solver/Structure.ml
trunk/Toss/Solver/Structure.mli
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml 2011-09-05 19:36:50 UTC (rev 1558)
+++ trunk/Toss/Arena/Arena.ml 2011-09-06 12:10:45 UTC (rev 1559)
@@ -722,7 +722,7 @@
get_from_loc fun_signature loc (state_game, state) "get signature")
| GetAllTuples (loc, rel) ->
let tuples struc =
- let tps = Structure.rel_find rel struc in
+ let tps = Structure.rel_graph rel struc in
Structure.rel_str struc rel tps in
((state_game, state),
get_from_loc tuples loc (state_game, state) "get all tuples")
Modified: trunk/Toss/Arena/ContinuousRule.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRule.ml 2011-09-05 19:36:50 UTC (rev 1558)
+++ trunk/Toss/Arena/ContinuousRule.ml 2011-09-06 12:10:45 UTC (rev 1559)
@@ -172,7 +172,7 @@
let set_val struc ((f, e), v) =
let e_rel =
(* DiscreteRule adds RHS element names to rewritten result *)
- Structure.rel_find ("_right_" ^ e) struc in
+ Structure.rel_graph ("_right_" ^ e) struc in
let elem = (Structure.Tuples.choose e_rel).(0) in
Structure.add_fun struc f (elem, v) in
let upd_struc = List.fold_left set_val ns upd_vals in
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-09-05 19:36:50 UTC (rev 1558)
+++ trunk/Toss/Formula/Aux.ml 2011-09-06 12:10:45 UTC (rev 1559)
@@ -169,6 +169,10 @@
[] -> raise Not_found
| (a,b)::l -> if b = x then a else rev_assoc l x
+let rec mem_rev_assoc l x = match l with
+ | [] -> false
+ | (a, b) :: l -> compare b x = 0 || mem_rev_assoc l x
+
let rev_assoc_all l x =
let rec aux acc = function
| [] -> acc
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-09-05 19:36:50 UTC (rev 1558)
+++ trunk/Toss/Formula/Aux.mli 2011-09-06 12:10:45 UTC (rev 1559)
@@ -105,6 +105,10 @@
using structural equality. *)
val rev_assoc : ('a * 'b) list -> 'b -> 'a
+(** Check if the value is associated with a key in the key-value pairs,
+ using structural equality. *)
+val mem_rev_assoc : ('a * 'b) list -> 'b -> bool
+
(** Inverse image of an association: return all keys with a given
value (using structural equality). Returns elements in reverse order. *)
val rev_assoc_all : ('a * 'b) list -> 'b -> 'a list
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-05 19:36:50 UTC (rev 1558)
+++ trunk/Toss/GGP/GDL.ml 2011-09-06 12:10:45 UTC (rev 1559)
@@ -1444,11 +1444,12 @@
(* Keeping functional... *)
let args = Array.copy args in
args.(pos) <- aux (p, args.(pos));
- (rel, args)::ps
+ (* keep it sorted! *)
+ List.sort (fun (s1,_) (s2,_)->String.compare s1 s2) ((rel, args)::ps)
with Not_found ->
let args = Array.make (arities rel) Empty in
args.(pos) <- aux (p, args.(pos));
- (rel, args)::ps)
+ List.sort (fun (s1,_) (s2,_)->String.compare s1 s2) ((rel, args)::ps))
in
aux (p, ps)
@@ -1695,6 +1696,7 @@
let subterms = Aux.collect
(List.map (function Func (rel,args) -> rel,args
| _ -> assert false) terms) in
+ (* [collect] returns list sorted wrt. keys *)
Below (List.map (fun (rel, args_set) ->
let arity =
Array.length (List.hd args_set) in
@@ -1760,6 +1762,7 @@
if subterms = [] then Empty
else
let subterms = Aux.collect subterms in
+ (* [collect] returns list sorted wrt. keys *)
Below (List.map (fun (rel, args_set) ->
let arity =
Array.length (List.hd args_set) in
Modified: trunk/Toss/GGP/GameSimpl.ml
===================================================================
--- trunk/Toss/GGP/GameSimpl.ml 2011-09-05 19:36:50 UTC (rev 1558)
+++ trunk/Toss/GGP/GameSimpl.ml 2011-09-06 12:10:45 UTC (rev 1559)
@@ -7,8 +7,10 @@
rules is specified by transformations described below. Rules can
be refined or new simplification rules added to each stage.
- Assuming that relations beginning with EQ__ are equivalences,
- eliminate redundant occurrences.
+ Assuming that relations beginning with EQ__ are such that for [x~y
+ = Ex z EQ__R(x, z) and EQ__R(x, z) or EQ__R(z, x) and EQ__R(z,
+ y)], the relation [~] is an equivalence, eliminate redundant
+ occurrences.
TODO: use [DiscreteRule.special_rel_of rel = Some "opt"]
instead of [DiscreteRule.special_rel_of rel <> None]? (To protect
@@ -19,20 +21,20 @@
(0a) Replace relations missing from the structure and defined
relations list, with "false", i.e. [Or []].
- (1) Reduce equivalent or complement relations.
+ (1) Reduce equivalent, complement, or inverse relations.
(1a) If [introduce_complement] is on, for each (unary) predicate
that does not have its complement in the structure, introduce the
complement.
(1b) Identify relations in the structure that are not fluents nor
- defined relations and that are equal to or are complements of
- other relations in the structure. Select a single relation / a
- predicate (called "the original" below), that is smaller than its
- complement (if the complement is in the signature, but see (1a)),
- and replace all selected relations with it (or its negation), in
- all formulas of the definition. Remove the other relations from
- the structure.
+ defined relations and that are equal to, or are complements of, or
+ are inverses of, other relations in the structure. Select a single
+ relation / a predicate (called "the original" below), that is
+ smaller than its complement (if the complement is in the
+ signature, but see (1a)), and replace all selected relations with
+ it (or its negation), in all formulas of the definition. Remove
+ the other relations from the structure.
(1c) We need to update LHS structures of rules (for presentation
and game modification purposes, since the simple transformation
@@ -42,9 +44,10 @@
that occur positively in the LHS and are complements of their
original. Derive all the tuples of embedded relations that are
required to be absent for a match (not present, even optionally,
- in the LHS). (1c1) Rename relations equivalent to their
- originals. (1c2) Remove the non-optional tuples for relations that
- are complements of their originals and (1c3) add tuples of
+ in the LHS). (1c1) Rename relations equivalent to their originals,
+ or (1c2) rename relations with inverting arguments for inverses of
+ their original. (1c3) Remove the non-optional tuples for relations
+ that are complements of their originals and (1c4) add tuples of
originals that are complements of relations that are required to
be absent.
@@ -67,17 +70,15 @@
(3b) For binary static relations, collect pairs such that one
relation is applied to arguments in reverse order than the other
one, and introduce a new relation for intersection of one with the
- inverse of the other, but only if neither of them is an
- equivalence relation beginning with "EQ__" -- in the latter case,
- use a relation introduced in (3a) (introduce if not present), only
- with arguments in order reverse to the order of non-EQ relation.
+ inverse of the other.
(3c) Filter out relations beginning with "EQ__" by: (3c1)
collecting equivalent elements in families of sets indexed by EQ
- relations; (3c2) keeping an EQ relation, outside of glueing group,
- only if its arguments are not yet in the same partition wrt. the
- relation. Do it after glueing not to preclude intersections, take
- into account the glueing reductions.
+ relations (separate set for the first arguments and for the second
+ arguments); (3c2) keeping an EQ relation, outside of glueing
+ group, only if its arguments are not yet in the same partition
+ wrt. the relation. Do it after glueing not to preclude
+ intersections, take into account the glueing reductions.
(3d) Repeat till no more atoms can be glued in this way.
@@ -134,8 +135,6 @@
let debug_level = ref 0
let introduce_complement = ref true
-(** If [true] include equivalences in "both directions" when glueing. *)
-let reflexivity_equiv = ref true
let final_simplify =
ref (FormulaOps.remove_redundant ?implies:None)
@@ -201,6 +200,8 @@
let more_formulas, game =
map_all_formulas remove_absent more_formulas game in
(* 1 *)
+ (* TODO: clean up this part, i.e. how complement/equivalent/inverse
+ relations are handled *)
let add_rel rel acc =
match rel with
| Rel (rel,_) -> Aux.Strings.add rel acc
@@ -218,7 +219,7 @@
let used_rels = ref used_rels in
let complements =
List.fold_left (fun table (rel,arity) ->
- let rel_tups = Structure.rel_find rel !struc in
+ let rel_tups = Structure.rel_graph rel !struc in
let ntups = tcard rel_tups in
let crel =
Structure.StringMap.fold (fun rel2 rel2_tups crel ->
@@ -268,11 +269,11 @@
(* prepare for (1bc) and (2) *)
let subset_table =
List.fold_left (fun table (rel,arity) ->
- let rel_tups = Structure.rel_find rel struc in
+ let rel_tups = Structure.rel_graph rel struc in
let row =
List.fold_left (fun row (rel2,arity2) ->
if arity2 = arity &&
- Tups.subset rel_tups (Structure.rel_find rel2 struc)
+ Tups.subset rel_tups (Structure.rel_graph rel2 struc)
then Aux.Strings.add rel2 row
else row
) Aux.Strings.empty signat in
@@ -288,6 +289,35 @@
(* }}} *)
let included_in rel1 rel2 =
Aux.Strings.mem rel2 (Aux.StrMap.find rel1 subset_table) in
+ let is_inverse = List.fold_left
+ (fun table -> function
+ | (rel,2) when not (Aux.mem_rev_assoc table rel) ->
+ let graph = Structure.rel_graph rel struc in
+ let inv_graph = Structure.tuples_of_list
+ (List.map (fun args->[|args.(1);args.(0)|])
+ (Tups.elements graph)) in
+ let ntups = tcard graph in
+ let crel =
+ Structure.StringMap.fold (fun rel2 graph2 crel ->
+ if crel <> None || rel2 = rel || List.assoc rel2 signat <> 2 ||
+ Aux.Strings.mem rel2 fluents ||
+ ntups <> tcard graph2 then crel
+ else
+ if
+ not (Aux.Strings.mem rel2 fluents) &&
+ Tups.subset inv_graph graph2
+ then (
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "is_inverse: rel=%s; inv_rel=%s\n%!" rel rel2
+ );
+ (* }}} *)
+ Some rel2
+ ) else None
+ ) (Structure.relations struc) None in
+ (match crel with None -> table | Some rel2 -> (rel, rel2)::table)
+ | _ -> table)
+ [] signat in
(* 1b *)
let equivalent =
List.map (fun (rel1, arity) ->
@@ -322,7 +352,12 @@
rel <> "" &&
not (Aux.Strings.mem rel fluents) &&
not (List.mem_assoc rel game.Arena.defined_rels) &&
- not (List.exists (fun (_,(rel2,_)) -> rel2=rel) equivalent) &&
+ not (List.exists
+ (fun (rel2,(rel3,_)) ->
+ (not (List.mem_assoc rel is_inverse) || rel2<>rel3) &&
+ rel3=rel)
+ equivalent) &&
+ not (Aux.mem_rev_assoc is_inverse rel) &&
not (Aux.Strings.mem (fst (List.assoc rel equivalent)) fluents ||
List.mem_assoc (fst (List.assoc rel equivalent))
game.Arena.defined_rels) in
@@ -342,15 +377,18 @@
(if neg then "C " else "")^rel2) equivalent))
);
(* }}} *)
- let repl_equiv = function
+ let repl_equiv_and_inv = function
| Rel (rel, args) as phi ->
- if removable rel then
- let orig, neg = List.assoc rel equivalent in
- if neg then Not (Rel (orig, args)) else Rel (orig, args)
- else phi
+ if removable rel then (
+ if List.mem_assoc rel is_inverse
+ then Rel (List.assoc rel is_inverse, [|args.(1); args.(0)|])
+ else
+ let orig, neg = List.assoc rel equivalent in
+ if neg then Not (Rel (orig, args)) else Rel (orig, args)
+ ) else phi
| phi -> phi in
let more_formulas, game =
- map_all_formulas (FormulaMap.map_to_atoms repl_equiv)
+ map_all_formulas (FormulaMap.map_to_atoms repl_equiv_and_inv)
more_formulas game in
let state =
{state with Arena.struc = Structure.clear_rels struc removable} in
@@ -369,15 +407,15 @@
Aux.unique_sorted (
List.map (fun rel ->
if removable rel then
- fst (List.assoc rel equivalent)
+ if List.mem_assoc rel is_inverse
+ then List.assoc rel is_inverse
+ else fst (List.assoc rel equivalent)
else rel
) rule_src.DiscreteRule.emb_rels) in
let added_emb_rels =
Aux.unique_sorted (
List.fold_left (fun emb_rels rel ->
- let tups =
- try Structure.rel_find rel lhs_struc
- with Not_found -> Tups.empty in
+ let tups = Structure.rel_graph rel lhs_struc in
if removable rel &&
not (Tups.is_empty tups) &&
snd (List.assoc rel equivalent) (* is complement *)
@@ -398,6 +436,8 @@
let new_emb_rels =
Aux.list_diff added_emb_rels kept_emb_rels in
let ltups = Tups.elements in
+ let invert_tups tups = List.map
+ (fun tup -> [|tup.(1); tup.(0)|]) (ltups tups) in
let lhs_neg_tups =
r.ContinuousRule.compiled.DiscreteRule.lhs_neg_tups in
(* 1c1: renaming removable relations to their originals *)
@@ -410,18 +450,23 @@
| Some spec -> DiscreteRule.orig_rel_of rel in
if not (removable rel) then lhs_struc
else
- let orig, neg = List.assoc rel equivalent in
+ let is_inv = List.mem_assoc rel is_inverse in
+ let orig, neg =
+ if is_inv then List.assoc rel is_inverse, false
+ else List.assoc rel equivalent in
let orig =
match spec with
| None -> orig
| Some spec -> "_"^spec^"_"^orig in
if not neg (* 1c1 *)
- || (neg && spec = Some "opt") (* not-1c2 *)
+ || (neg && spec = Some "opt") (* not-1c3 *)
then
- Structure.add_rels lhs_struc orig (ltups tups)
+ Structure.add_rels lhs_struc orig
+ (if is_inv then invert_tups tups
+ else ltups tups)
else if List.mem_assoc rel lhs_neg_tups
&& spec <> Some "opt"
- then (* 1c3 *)
+ then (* 1c4 *)
Structure.add_rels lhs_struc orig
(List.assoc rel lhs_neg_tups)
else lhs_struc
@@ -447,8 +492,7 @@
if not (removable rel1) ||
not neg || rel2 <> emb_rel then []
else (* neg *)
- (try ltups (Structure.rel_find rel1 lhs_struc)
- with Not_found -> [])
+ ltups (Structure.rel_graph rel1 lhs_struc)
) equivalent in
(* {{{ log entry *)
let str_tups tups =
@@ -490,8 +534,14 @@
(* 3 *)
let intersect_rels struc grel rels =
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "Generating: %s = %s\n%!"
+ grel (String.concat "_AND_" rels)
+ );
+ (* }}} *)
let rel_graphs =
- List.map (fun rel -> Structure.rel_find rel struc) rels in
+ List.map (fun rel -> Structure.rel_graph rel struc) rels in
let graph =
match rel_graphs with
| [] -> assert false
@@ -501,21 +551,21 @@
let tuples = Tups.elements graph in
Structure.add_rels struc grel tuples in
let intersect_with_inv struc grel rel1 rel2 =
- let graph1 = Structure.rel_find rel1 struc in
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "Generating-inv: %s = %s_INV_%s\n%!"
+ grel rel1 rel2
+ );
+ (* }}} *)
+ let graph1 = Structure.rel_graph rel1 struc in
let tuples2 =
- Tups.elements (Structure.rel_find rel2 struc) in
+ Tups.elements (Structure.rel_graph rel2 struc) in
let inv_graph =
Structure.tuples_of_list (List.map (function
| [|e1; e2|] -> [|e2; e1|]
| _ -> assert false) tuples2) in
let tuples = Tups.elements
(Tups.inter graph1 inv_graph) in
- (* {{{ log entry *)
- if !debug_level > 3 then (
- Printf.printf "Generating-inv: %s_INV_%s -- tuple: %s\n%!"
- rel1 rel2 (Structure.tuple_str struc (List.hd tuples))
- );
- (* }}} *)
Structure.add_rels struc grel tuples in
(* preparing (3a-d) *)
@@ -535,6 +585,17 @@
let glued_inv = ref [] in (* bingings introduced by [glue_inv] *)
let is_equiv rel =
String.length rel >= 4 && String.sub rel 0 4 = "EQ__" in
+ let is_symm_memo = ref [] in
+ let is_symm rel =
+ try List.assoc rel !is_symm_memo
+ with Not_found ->
+ let graph = Structure.rel_graph rel !struc in
+ let inv_graph = Structure.tuples_of_list
+ (List.map (fun args->[|args.(1);args.(0)|])
+ (Tups.elements graph)) in
+ let res = Tups.subset inv_graph graph in
+ is_symm_memo := (rel, res):: !is_symm_memo;
+ res in
(* 3a *)
(* remove relations that are already parts of participating glueings *)
let prune_defined (args, rels) =
@@ -560,10 +621,7 @@
grel, args) in
let glue rels =
let args_rels =
- Aux.collect (Aux.concat_map (fun (rel,args)->
- if !reflexivity_equiv && is_equiv rel
- then [args,rel; [|args.(1); args.(0)|],rel]
- else [args,rel]) rels) in
+ Aux.collect (List.map (fun (rel,args)-> args,rel) rels) in
let args_rels =
List.map prune_defined args_rels in
Aux.map_some (function
@@ -583,8 +641,6 @@
then
let rel2, more = Aux.pop_assoc args2 more in
if is_equiv rel1 || is_equiv rel2
- (* equivalences are considered with reverse order of
- arguments during the earlier [glue] phase *)
then (rel1, args1)::loop ((args2, rel2)::more)
else
let rels =
@@ -608,6 +664,9 @@
| [] -> [] in
loop rels in
(* 3c *)
+ let symmetrize bipart = Aux.map_rev_prepend bipart
+ (function Aux.Left a -> Aux.Right a | Aux.Right a -> Aux.Left a)
+ bipart in
let glue_equiv rels =
(* only partition, process later, add the original grels to
filtered rels *)
@@ -619,40 +678,49 @@
else if List.mem_assoc rel !glued_inv
then
let rel1, rel2 = List.assoc rel !glued_inv in
- [rel1, args; rel2, args]
+ [rel1, args; rel2, [|args.(1); args.(0)|]]
else assert false) grels in
(* 3c1 *)
+ let eq_rels, other_rels = List.partition (is_equiv -| fst) rels in
let eq_sets =
Aux.collect (List.filter (is_equiv -| fst) eq_sets) in
- let build_sets tups =
+ (* The "equivalence class" is a connected component of a
+ bipartite graph: we label the first/second argument of a graph
+ with [Left/Right] labels. *)
+ let build_sets rel tups =
List.fold_left (fun sets args ->
- let args = Array.to_list args in
+ let dir_args = [Aux.Left args.(0); Aux.Right args.(1)] in
+ let dir_args =
+ if is_symm rel then symmetrize dir_args else dir_args in
(let try set, sets =
Aux.pop_find (fun set ->
- List.exists (fun a->List.mem a set) args) sets in
- Aux.unique_sorted (args @ set) :: sets
- with Not_found -> args::sets)
+ List.exists (fun arg -> List.mem arg set) dir_args) sets in
+ Aux.unique_sorted (dir_args @ set) :: sets
+ with Not_found -> dir_args::sets)
) [] tups in
- let eq_sets =
- List.map (fun (rel, tups) -> rel, build_sets tups) eq_sets in
+ let eq_sets = List.map
+ (fun (rel, tups) -> rel, build_sets rel tups)
+ eq_sets in
(* 3c2 *)
- let _, rels = List.fold_left (fun (eq_sets, rels as old)
+ let _, eq_rels = List.fold_left (fun (eq_sets, rels as old)
(rel, args as atom) ->
+ let dir_args = [Aux.Left args.(0); Aux.Right args.(1)] in
+ let dir_args =
+ if is_symm rel then symmetrize dir_args else dir_args in
let sets, eq_sets =
try Aux.pop_assoc rel eq_sets
with Not_found -> [], eq_sets in
- let argset = Array.to_list args in
(let try set, sets =
Aux.pop_find (fun set ->
- List.exists (fun a->List.mem a set) argset) sets in
- if List.for_all (fun a->List.mem a set) argset
+ List.exists (fun arg -> List.mem arg set) dir_args) sets in
+ if List.for_all (fun arg -> List.mem arg set) dir_args
then old
else
- (rel, Aux.unique_sorted (argset @ set) :: sets)::eq_sets,
+ (rel, Aux.unique_sorted (dir_args @ set) :: sets)::eq_sets,
atom::rels
- with Not_found -> (rel, argset::sets)::eq_sets, atom::rels)
- ) (eq_sets, []) rels in
- grels @ rels in
+ with Not_found -> (rel, dir_args::sets)::eq_sets, atom::rels)
+ ) (eq_sets, []) eq_rels in
+ grels @ eq_rels @ other_rels in
(* the step of 3d *)
let gluable rel =
@@ -740,28 +808,31 @@
if List.mem_assoc args2 more
then
let rel2, more = Aux.pop_assoc args2 more in
- if is_equiv rel1 || is_equiv rel2 then
- let eq_rel, eq_args, inv_rel, inv_args =
+ if is_equiv rel1 || is_equiv rel2
+ then loop ((args2, rel2)::more)
+ else
+ (*if is_equiv rel1 || is_equiv rel2 then
+ let eq_rel, eq_args, inv_rel, inv_args =
if is_equiv rel1 then rel1, args1, rel2, args2
else rel2, args2, rel1, args1 in
- let rels = [rel1; rel2] in
- let rels = List.sort String.compare rels in
+ let rels = [rel1; rel2] in
+ let rels = List.sort String.compare rels in
(* pretend the equivalence is the inverted one *)
- (let try result =
- Aux.rev_assoc !glued rels,
+ (let try result =
+ Aux.rev_assoc !glued rels,
(inv_rel, eq_rel), inv_args, eq_args in
- result::loop more
- with Not_found ->
- (* it is possible that in the compiled matching condition,
- due to ohter glueing, the relations were not glued *)
- (* {{{ log entry *)
- if !debug_level > 0 then (
- Printf.printf "glue_inv_lhs: not glueing rels=%s\n%!"
- (String.concat "," rels);
- );
- (* }}} *)
- loop more)
- else
+ result::loop more
+ with Not_found ->
+ (* it is possible that in the compiled matching condition,
+ due to ohter glueing, the relations were not glued *)
+ (* {{{ log entry *)
+ if !debug_level > 0 then (
+ Printf.printf "glue_inv_lhs: not glueing rels=%s\n%!"
+ (String.concat "," rels);
+ );
+ (* }}} *)
+ loop more)
+ else*)
let rels =
if rel1 < rel2 then rel1, rel2 else rel2, rel1 in
let rel, args, inv_rel, inv_args =
@@ -785,6 +856,7 @@
| [] -> [] in
loop rels in
+ (* TODO: code duplication is annoying... *)
(* 3f-3c *)
let glue_equiv_lhs rels =
let grels, rels = List.partition (fun (rel,_) ->
@@ -795,38 +867,44 @@
else if List.mem_assoc rel !glued_inv
then
let rel1, rel2 = List.assoc rel !glued_inv in
- [rel1, args; rel2, args]
+ [rel1, args; rel2, [|args.(1); args.(0)|]]
else assert false) grels in
(* 3c1 *)
let eq_sets =
Aux.collect (List.filter (is_equiv -| fst) eq_sets) in
- let build_sets tups =
+ let eq_rels, other_rels = List.partition (is_equiv -| fst) rels in
+ let build_sets rel tups =
List.fold_left (fun sets args ->
- let args = Array.to_list args in
+ let dir_args = [Aux.Left args.(0); Aux.Right args.(1)] in
+ let dir_args =
+ if is_symm rel then symmetrize dir_args else dir_args in
(let try set, sets =
Aux.pop_find (fun set ->
- List.exists (fun a->List.mem a set) args) sets in
- Aux.unique_sorted (args @ set) :: sets
- with Not_found -> args::sets)
+ List.exists (fun arg -> List.mem arg set) dir_args) sets in
+ Aux.unique_sorted (dir_args @ set) :: sets
+ with Not_found -> dir_args::sets)
) [] tups in
let eq_sets =
- List.map (fun (rel, tups) -> rel, build_sets tups) eq_sets in
+ List.map (fun (rel, tups) -> rel, build_sets rel tups) eq_sets in
(* 3c2 *)
+ (* this time we build tuples that are redundant, to be deleted! *)
let _, drels = List.fold_left (fun (eq_sets, drels)
(rel, args as atom) ->
+ let dir_args = [Aux.Left args.(0); Aux.Right args.(1)] in
+ let dir_args =
+ if is_symm rel then symmetrize dir_args else dir_args in
let sets, eq_sets =
try Aux.pop_assoc rel eq_sets
with Not_found -> [], eq_sets in
- let argset = Array.to_list args in
(let try set, sets =
Aux.pop_find (fun set ->
- List.exists (fun a->List.mem a set) argset) sets in
- if List.for_all (fun a->List.mem a set) argset
+ List.exists (fun arg -> List.mem arg set) dir_args) sets in
+ if List.for_all (fun arg -> List.mem arg set) dir_args
then (rel, set::sets)::eq_sets, atom::drels
- else (rel, Aux.unique_sorted (argset @ set) :: sets)
+ else (rel, Aux.unique_sorted (dir_args @ set) :: sets)
:: eq_sets, drels
- with Not_found -> (rel, argset::sets)::eq_sets, drels)
- ) (eq_sets, []) rels in
+ with Not_found -> (rel, dir_args::sets)::eq_sets, drels)
+ ) (eq_sets, []) eq_rels in
drels in
(* 3f *)
Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml 2011-09-05 19:36:50 UTC (rev 1558)
+++ trunk/Toss/GGP/TranslateFormula.ml 2011-09-06 12:10:45 UTC (rev 1559)
@@ -60,9 +60,9 @@
type transl_data = {
f_paths : path_set; (* fluent paths *)
- m_paths : path_set; (* within-mask paths *)
- all_paths : path_set; (* sum of f_paths and m_paths *)
- mask_reps : term list; (* mask terms *)
+ c_paths : path_set; (* coordinate paths *)
+ all_paths : path_set; (* sum of f_paths and c_paths *)
+ root_reps : term list; (* coordinate root terms *)
defined_rels : string list;
mutable defrel_argpaths : (string * defrel_argpaths) list;
(* late binding to store $ArgMode# data *)
@@ -72,9 +72,9 @@
let empty_transl_data = {
f_paths = empty_path_set;
- m_paths = empty_path_set;
+ c_paths = empty_path_set;
all_paths = empty_path_set;
- mask_reps = [];
+ root_reps = [];
defined_rels = [];
defrel_argpaths = [];
term_arities = [];
@@ -115,10 +115,10 @@
if sign then defrel_phi else Formula.Not defrel_phi
let transl_rels data rels_phi sterms_all vterms_in =
- (* within-mask subterms to locate paths on which to generate relations *)
+ (* coordinate subterms to locate paths on which to generate relations *)
let s_subterms = Aux.concat_map
(fun sterm ->
- map_paths (fun path subt -> subt, (sterm, path)) data.m_paths sterm)
+ map_paths (fun path subt -> subt, (sterm, path)) da...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-09 11:12:29
|
Revision: 1561
http://toss.svn.sourceforge.net/toss/?rev=1561&view=rev
Author: lukstafi
Date: 2011-09-09 11:12:21 +0000 (Fri, 09 Sep 2011)
Log Message:
-----------
GDL translation: handling counters updated by arbitrary numeric functions, both specification and implementation; small related fixes in reference.tex. ContinuousRule and Formula: switching dynamics updates (but not evolution) from Term.term to Formula.real_expr. FormulaOps: generating piecewise linear expressions from function graphs. TranslateGame[Test]: small fixes to concurrent games.
Modified Paths:
--------------
trunk/Toss/Arena/Arena.ml
trunk/Toss/Arena/Arena.mli
trunk/Toss/Arena/ArenaParser.mly
trunk/Toss/Arena/ContinuousRule.ml
trunk/Toss/Arena/ContinuousRule.mli
trunk/Toss/Arena/ContinuousRuleParser.mly
trunk/Toss/Formula/Formula.ml
trunk/Toss/Formula/Formula.mli
trunk/Toss/Formula/FormulaOps.ml
trunk/Toss/Formula/FormulaOps.mli
trunk/Toss/Formula/FormulaParser.mly
trunk/Toss/Formula/FormulaSubst.ml
trunk/Toss/Formula/FormulaSubst.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Arena/Arena.ml 2011-09-09 11:12:21 UTC (rev 1561)
@@ -582,7 +582,8 @@
ContinuousRule.rule)
(* Set a rule as given *)
| GetRule of string (* Get a rule as string *)
- | SetRuleUpd of string*string *string *Term.term (* Set a rule update eq *)
+ | SetRuleUpd of string * string * string * Formula.real_expr
+ (* Set a rule update eq *)
| GetRuleUpd of string * string * string (* Get a rule update eq *)
| SetRuleDyn of string*string *string *Term.term (* Set a rule dynamics eq *)
| GetRuleDyn of string * string * string (* Get a rule dynamics eq *)
@@ -862,17 +863,17 @@
| GetRule (r_name) ->
let msg = get_from_rule ContinuousRule.str r_name state_game "get rule" in
((state_game, state), msg)
- | SetRuleUpd (r_name, f, elem_name, term) ->
+ | SetRuleUpd (r_name, f, elem_name, expr) ->
let set_upd r =
let new_upd =
- Aux.replace_assoc (f,elem_name) term r.ContinuousRule.update in
+ Aux.replace_assoc (f,elem_name) expr r.ContinuousRule.update in
{ r with ContinuousRule.update = new_upd }, "UPDATE SET" in
apply_to_rule set_upd r_name (state_game, state) "set rule upd"
| GetRuleUpd (r_name, f, elem_name) ->
let get_upd r =
try
let upd = List.assoc (f,elem_name) r.ContinuousRule.update in
- Term.str upd
+ Formula.real_str upd
with Not_found -> "0.0" in
((state_game, state),
get_from_rule get_upd r_name state_game "get rule upd")
Modified: trunk/Toss/Arena/Arena.mli
===================================================================
--- trunk/Toss/Arena/Arena.mli 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Arena/Arena.mli 2011-09-09 11:12:21 UTC (rev 1561)
@@ -209,7 +209,8 @@
ContinuousRule.rule)
(** Set a rule as given *)
| GetRule of string (** Get a rule as string *)
- | SetRuleUpd of string*string *string *Term.term (** Set a rule update eq *)
+ | SetRuleUpd of string * string * string * Formula.real_expr
+ (** Set a rule update eq *)
| GetRuleUpd of string * string * string (** Get a rule update eq *)
| SetRuleDyn of string*string *string *Term.term (** Set a rule dynamics eq *)
| GetRuleDyn of string * string * string (** Get a rule dynamics eq *)
Modified: trunk/Toss/Arena/ArenaParser.mly
===================================================================
--- trunk/Toss/Arena/ArenaParser.mly 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Arena/ArenaParser.mly 2011-09-09 11:12:21 UTC (rev 1561)
@@ -222,7 +222,7 @@
time = FLOAT
params = separated_list (COMMA, separated_pair (ID, COLON, FLOAT))
{ ApplyRule (r, mtch, time, params) }
- | SET_CMD RULE_SPEC UPDATE r=id_int fn=ID elem=id_int upd=term_expr
+ | SET_CMD RULE_SPEC UPDATE r=id_int fn=ID elem=id_int upd=real_expr
{ SetRuleUpd (r, fn, elem, upd) }
| GET_CMD RULE_SPEC UPDATE r=id_int fn=ID elem=id_int
{ GetRuleUpd (r, fn, elem) }
Modified: trunk/Toss/Arena/ContinuousRule.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRule.ml 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Arena/ContinuousRule.ml 2011-09-09 11:12:21 UTC (rev 1561)
@@ -14,7 +14,8 @@
discrete : DiscreteRule.rule; (* The discrete part *)
compiled : DiscreteRule.rule_obj ; (* Compiled discrete part *)
dynamics : ((string * string) * Term.term) list; (* Equation system calD *)
- update : ((string * string) * Term.term) list; (* Update equations calT *)
+ update : ((string * string) * Formula.real_expr) list;
+ (* Update equations calT *)
(* Note that, for efficiency, the precondition is part of DiscreteRule. *)
inv : Formula.formula; (* Invariant for the evolution *)
post : Formula.formula; (* Postcondition for application *)
@@ -101,12 +102,15 @@
if !debug_level > 1 then print_endline ("ct: " ^ (string_of_float !time));
let left_elname le =
Structure.elem_str r.discrete.DiscreteRule.lhs_struc le in
+ let p_vars, p_vals = List.split params in
let subst_params tm =
- let (p_vars, p_vals) = List.split params in
List.hd
(Term.subst_simp p_vars (List.map (fun f -> Term.Const f) p_vals) [tm]) in
+ let re_sb = List.map
+ (fun (p,v) -> p, Formula.Const v) params in
let dyn = List.map (fun (lhs, rhs) -> (lhs, subst_params rhs)) r.dynamics in
- let upd = List.map (fun (lhs, rhs) -> (lhs, subst_params rhs)) r.update in
+ let upd = List.map (fun (lhs, rhs) ->
+ (lhs, FormulaSubst.subst_real re_sb rhs)) r.update in
let init_vals =
let get_val f a =
(* LHS is embedded in the model *)
@@ -160,11 +164,20 @@
f, Structure.elem_str struc i in
let all_vals_assoc =
select_pos (List.map lhs_to_model_str dyn) (List.rev !all_vals) in
+ (*
let val_map =
if !cur_vals = [] then List.combine (List.map fst dyn) init_vals
else List.combine (List.map fst dyn) !cur_vals in
- let upd_vals = Term.eq_vals (Term.subst_simp_eq
- [("t", Term.Const !time)] val_map upd) in
+ let upd_vals = Term.eq_vals
+ (Term.subst_simp_eq [("t", Term.Const !time)] val_map upd) in
+ *)
+ let upd = List.map (fun (lhs, rhs) ->
+ (lhs, FormulaSubst.subst_real ["t", Formula.Const !time] rhs)) upd in
+ (* we don't need to use val_map because !last_struc contains the
+ evolved values *)
+ let upd_vals = List.map
+ (fun (lhs,expr) -> lhs, Solver.M.get_real_val expr !last_struc)
+ upd in
(* we pass the evolved structure to discrete rewriting, so that
function values can be copied to new elements in case they are
not updated later *)
@@ -209,10 +222,10 @@
let str r =
let dyn_str =
if r.dynamics = [] then "" else "\ndynamics\n" ^
- Term.eq_str ~diff:true r.dynamics in
+ Term.eq_str ~diff:true r.dynamics in
let upd_str =
if r.update = [] then "" else "\nupdate\n" ^ (
- Term.eq_str r.update
+ Formula.eq_str r.update
) ^ "\n" in
let pre_str = " pre " ^ (Formula.str r.discrete.DiscreteRule.pre) in
let inv_str = " inv " ^ (Formula.str r.inv) in
@@ -234,7 +247,7 @@
(Term.fprint_eqs ~diff:true) r.dynamics;
if has_update r then
Format.fprintf f "@ @[<hv>update@ %a@]"
- (Term.fprint_eqs ~diff:false) r.update;
+ (Formula.fprint_eqs ~diff:false) r.update;
if print_compiled then
Format.fprintf f "@ @[<1>compiled@ %a@]"
DiscreteRule.fprint_rule_obj r.compiled;
Modified: trunk/Toss/Arena/ContinuousRule.mli
===================================================================
--- trunk/Toss/Arena/ContinuousRule.mli 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Arena/ContinuousRule.mli 2011-09-09 11:12:21 UTC (rev 1561)
@@ -9,15 +9,13 @@
(** Specification of a continuous rewriting rule, as in modelling document.
Function named foo on element i is, in a term, given by variable foo_i. *)
type rule = {
- discrete : DiscreteRule.rule; (** The discrete part *)
- compiled : DiscreteRule.rule_obj ; (** Compiled discrete part *)
- dynamics : ((string * string) * Term.term) list; (** Equation system calD *)
- update : ((string * string) * Term.term) list; (** Update equations calT *)
+ discrete : DiscreteRule.rule; (** The discrete part *)
+ compiled : DiscreteRule.rule_obj ; (** Compiled discrete part *)
+ dynamics : Term.eq_sys; (** Equation system calD *)
+ update : Formula.eq_sys; (** Update equations calT *)
(** Note that, for efficiency, the precondition is part of DiscreteRule. *)
- inv : Formula.formula; (** Invariant for the evolution *)
- (** Optimized invariant *)
- post : Formula.formula; (** Postcondition for application *)
- (** Optimized postcondition *)
+ inv : Formula.formula; (** Invariant for the evolution *)
+ post : Formula.formula; (** Postcondition for application *)
}
(** Create a continuous rule given a named discrete rule and other params. *)
@@ -25,7 +23,7 @@
(string * int) list -> (** signature *)
(string * (string list * Formula.formula)) list -> (** defined rels *)
(DiscreteRule.rule) ->
- Term.eq_sys -> Term.eq_sys ->
+ Term.eq_sys -> Formula.eq_sys ->
?pre:Formula.formula -> ?inv:Formula.formula ->
?post:Formula.formula -> unit -> rule
Modified: trunk/Toss/Arena/ContinuousRuleParser.mly
===================================================================
--- trunk/Toss/Arena/ContinuousRuleParser.mly 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Arena/ContinuousRuleParser.mly 2011-09-09 11:12:21 UTC (rev 1561)
@@ -18,7 +18,7 @@
%public rule_expr:
| discr = discrete_rule_expr
dyn = loption (preceded (DYNAMICS, eq_sys))
- upd = loption (preceded (UPDATE, eq_sys))
+ upd = loption (preceded (UPDATE, expr_eq_sys))
pre = option (preceded (PRE, formula_expr))
inv = option (preceded (INV, formula_expr))
post = option (preceded (POST, formula_expr))
Modified: trunk/Toss/Formula/Formula.ml
===================================================================
--- trunk/Toss/Formula/Formula.ml 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Formula/Formula.ml 2011-09-09 11:12:21 UTC (rev 1561)
@@ -259,6 +259,25 @@
let str = sprint
let real_str = sprint_real
+type eq_sys = ((string * string) * real_expr) list
+
+(* Print an equation system. *)
+let fprint_eqs ?(diff=false) ppf eqs =
+ let sing ppf ((f, a), t) =
+ let mid_str = if diff then "'" else "" in
+ Format.fprintf ppf "@[<1>%s(%s)%s@ =@ @[<1>%a@]@]"
+ f a mid_str fprint_real t in
+ Format.fprintf ppf "@[<hv>%a@]" (Aux.fprint_sep_list ";" sing) eqs
+
+(* Print an equation system as a string. *)
+let eq_str ?(diff=false) eqs =
+ let sing_str ((f, a), t) =
+ let mid_str = if diff then "' = " else " = " in
+ let l_str = real_str (Fun (f, `FO a)) in
+ let r_str = real_str t in
+ l_str ^ mid_str ^ r_str in
+ " " ^ (String.concat ";\n " (List.map sing_str eqs))
+
(* ------------------------ ORDER ON FORMULAS ------------------------------- *)
(* Compare two variables. We assume that FO < MSO < SO < Real. *)
Modified: trunk/Toss/Formula/Formula.mli
===================================================================
--- trunk/Toss/Formula/Formula.mli 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Formula/Formula.mli 2011-09-09 11:12:21 UTC (rev 1561)
@@ -82,6 +82,10 @@
val is_atom : formula -> bool
+(** Equation system: a left-hand-side [f,a] actually represents
+ [Fun (f, `FO a)] *)
+type eq_sys = ((string * string) * real_expr) list
+
(** {2 Printing Functions} *)
(** Print a variable as a string. *)
@@ -106,6 +110,9 @@
val fprint_prec : int -> Format.formatter -> formula -> unit
val fprint_real_prec : int -> Format.formatter -> real_expr -> unit
+(** Print an equation system. *)
+val fprint_eqs : ?diff : bool -> Format.formatter -> eq_sys -> unit
+val eq_str : ?diff:bool -> eq_sys -> string
(** {2 Formula syntax check} *)
Modified: trunk/Toss/Formula/FormulaOps.ml
===================================================================
--- trunk/Toss/Formula/FormulaOps.ml 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Formula/FormulaOps.ml 2011-09-09 11:12:21 UTC (rev 1561)
@@ -1024,3 +1024,49 @@
let tnf_lfp fprel fpvs fpdef = Lfp (fprel, fpvs, tnf_fv_nofp ?sizes fpdef) in
let psi = map_formula { identity_map with map_Lfp = tnf_lfp } phi in
tnf_fv_nofp ?sizes psi
+
+
+(* ------------------------------- Reals ----------------------------------- *)
+
+let l_then x y e =
+ Times (Char (RealExpr (Plus (x, Times (Const (-1.), y)),
+ LZero)), e)
+let geq_then x y e =
+ Times (Char (RealExpr (Plus (x, Times (Const (-1.), y)),
+ GEQZero)), e)
+let diff a b = Plus (a, Times (Const (-1.), b))
+
+(* Generate a piecewise-linear function of a given argument from a
+ graph. Raise [Failure "piecewise_linear"] if first elements of
+ the graph are not unique or graph is empty. *)
+let piecewise_linear arg graph =
+ let domain = List.sort Pervasives.compare (List.map fst graph) in
+ let slope begp endp =
+ (List.assoc endp graph -. List.assoc begp graph) /.
+ (endp -. begp) in
+ let affine begp endp =
+ Plus (Times (Const (slope begp endp), diff arg (Const begp)),
+ Const (List.assoc begp graph)) in
+ let rec step old_begp old_slope = function
+ | [] | [_] -> assert false
+ | [begp; endp] when begp = endp -> failwith "piecewise_linear"
+ | [begp; endp] when old_slope = slope begp endp -> affine begp endp
+ | [begp; endp] ->
+ Plus (l_then arg (Const begp) (affine old_begp begp),
+ geq_then arg (Const begp) (affine begp endp))
+ | begp::endp::_ when begp = endp -> failwith "piecewise_linear"
+ | begp::endp::more when old_slope = slope begp endp ->
+ step old_begp old_slope (endp::more)
+ | begp::endp::more ->
+ Plus (l_then arg (Const begp) (affine old_begp begp),
+ geq_then arg (Const endp)
+ (step begp (slope begp endp) (endp::more))) in
+ match domain with
+ | [] -> failwith "piecewise_linear"
+ | [endp] -> Const endp
+ | [begp; endp] when begp = endp -> failwith "piecewise_linear"
+ | [begp; endp] -> affine begp endp
+ | begp::endp::_ when begp = endp -> failwith "piecewise_linear"
+ | begp::endp::more -> step begp (slope begp endp) (endp::more)
+
+
Modified: trunk/Toss/Formula/FormulaOps.mli
===================================================================
--- trunk/Toss/Formula/FormulaOps.mli 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Formula/FormulaOps.mli 2011-09-09 11:12:21 UTC (rev 1561)
@@ -85,6 +85,13 @@
val to_cnf : formula -> formula list
+(** {2 Reals} *)
+
+(** Generate a piecewise-linear function of a given argument from a
+ graph. Raise [Failure "piecewise_linear"] if first elements of
+ the graph are not unique or graph is empty. *)
+val piecewise_linear : real_expr -> (float * float) list -> real_expr
+
(** {2 Debugging} *)
(** Debugging information. At level 0 nothing is printed out. *)
Modified: trunk/Toss/Formula/FormulaParser.mly
===================================================================
--- trunk/Toss/Formula/FormulaParser.mly 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Formula/FormulaParser.mly 2011-09-09 11:12:21 UTC (rev 1561)
@@ -14,12 +14,13 @@
try so_var_of_string s with Failure s -> raise (Parsing_error s)
%}
-%start parse_formula parse_real_expr
+%start parse_formula parse_real_expr parse_expr_eqs
%type <Formula.formula> parse_formula formula_expr
%type <Formula.var list> var_list
%type <Formula.fo_var list> fo_var_list
%type <Formula.real_expr> parse_real_expr real_expr
%type <Formula.real_expr * Formula.sign_op> real_ineq
+%type <Formula.eq_sys> parse_expr_eqs expr_eq_sys
%%
@@ -122,6 +123,19 @@
{ Let (rel, args, body, phi) }
+expr_eq_expr: /* we do not distinguish standard and differential equations here */
+ | ID OPEN ID CLOSE EQ real_expr { (($1, $3), $6) }
+ | ID OPEN INT CLOSE EQ real_expr { (($1, string_of_int $3), $6) }
+ | ID OPEN ID CLOSE APOSTROPHE EQ real_expr { (($1, $3), $7) }
+ | ID OPEN INT CLOSE APOSTROPHE EQ real_expr { (($1, string_of_int $3), $7) }
+
+%public expr_eq_sys:
+ | expr_eq_expr { [$1] }
+ | expr_eq_expr SEMICOLON expr_eq_sys { $1 :: $3 }
+
+parse_expr_eqs:
+ expr_eq_sys EOF { $1 };
+
parse_formula:
formula_expr EOF
{ if Formula.syntax_ok $1 then $1 else
Modified: trunk/Toss/Formula/FormulaSubst.ml
===================================================================
--- trunk/Toss/Formula/FormulaSubst.ml 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Formula/FormulaSubst.ml 2011-09-09 11:12:21 UTC (rev 1561)
@@ -107,7 +107,11 @@
Sum(vs, subst_vars new_vs phi, subst_vars_expr new_vs r)
| RLet _ -> failwith "FormulaSubst:subst_vars_expr: rlet substitution"
+let subst_real subst = FormulaMap.map_real_expr
+ {FormulaMap.identity_map with FormulaMap.map_RVar =
+ (fun v -> try List.assoc v subst with Not_found -> RVar v)}
+
(* --------- SUBSTITUTE DEFINED RELATIONS ------------ *)
(* Substitute in relations defined in [defs] by their definitions. *)
Modified: trunk/Toss/Formula/FormulaSubst.mli
===================================================================
--- trunk/Toss/Formula/FormulaSubst.mli 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/Formula/FormulaSubst.mli 2011-09-09 11:12:21 UTC (rev 1561)
@@ -16,6 +16,9 @@
val subst_vars : (string * string) list -> formula -> formula
val subst_vars_expr : (string * string) list -> real_expr -> real_expr
+(** Substitute a real variable with a subexpression. *)
+val subst_real : (string * real_expr) list -> real_expr -> real_expr
+
(** Substitute once relations in [defs] by corresponding subformulas
(with instantiated parameters). *)
val subst_once_rels :
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/GGP/GDL.ml 2011-09-09 11:12:21 UTC (rev 1561)
@@ -152,6 +152,9 @@
List.fold_left Aux.Strings.union Aux.Strings.empty
(List.map clause_vars cls)
+let literals_vars lits =
+ clause_vars (("",[| |]), lits)
+
let defs_of_rules rules =
Aux.map_reduce (fun ((rel, args), body, neg_body) ->
rel, (args, body, neg_body)) (fun y x->x::y) [] rules
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/GGP/GDL.mli 2011-09-09 11:12:21 UTC (rev 1561)
@@ -53,6 +53,7 @@
val terms_vars : term array -> Aux.Strings.t
val clause_vars : clause -> Aux.Strings.t
val clauses_vars : clause list -> Aux.Strings.t
+val literals_vars : literal list -> Aux.Strings.t
val defs_of_rules : gdl_rule list -> gdl_defs
val rules_of_clause : clause -> gdl_rule list
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-09-08 19:05:23 UTC (rev 1560)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-09-09 11:12:21 UTC (rev 1561)
@@ -710,14 +710,88 @@
in
List.filter keep literals
+
+let counter_path_partition num_functors counter_cands (arg, body) =
+ (* search backwards *)
+ let roots = Aux.map_some
+ (function
+ | Pos (True (Func (f, [|r|]))) as a
+ when List.mem f counter_cands -> Some (r, a)
+ | _ -> None)
+ body in
+ let rec find_path acc point =
+ if List.mem_assoc point roots
+ then List.assoc point roots::acc
+ else
+ let revcands = Aux.map_some
+ (function
+ | Pos (Rel (rel, [|x; y|])) as a
+ when y=point && List.mem rel num_functors ->
+ Some (x, a)
+ | _ -> None)
+ body in
+ match revcands with
+ | [next, edge] ->
+ find_path (edge::acc) next
+ | _ -> raise Not_found in
+ match arg with
+ | Const c when
+ (try ignore (float_of_string c); true
+ with Failure "float_of_string" -> false) ->
+ [Pos (True arg)], body
+ | Var _ as v ->
+ let path = find_path [] v in
+ path, Aux.list_diff body path
+ | _ -> raise Not_found
+
+
+let split_counter_rule_cls counters num_functors rule_cls =
+ let counter_cls, rule_cls = Aux.partition_map
+ (function
+ | Func (f, [|h|]), _, body when List.mem f counters ->
+ Aux.Left (f, h, body)
+ | cl -> Aux.Right cl)
+ rule_cls in
+ let counter_cls = Array.mapi
+ (fun i (f, h, body) ->
+ let update, cond =
+ counter_path_partition num_functors counters (h, body) in
+ (i, update),
+ (Func ("_COUNTER_CL_", [|Const (string_of_int i); Const f|]),
+ false, cond))
+ (Array.of_list counter_cls) in
+ let counter_upds, counter_cls =
+ List.split (Array.to_list counter_cls) in
+ counter_upds, counter_cls @ rule_cls
+
+
+let counter_updates_and_preconds counters counter_upds case_cls =
+ let counter_cls, case_cls = Aux.partition_map
+ (function
+ | Func ("_COUNTER_CL_", [|Const i; Const f|]), body ->
+ Aux.Left (int_of_string i, f, body)
+ | cl -> Aux.Right cl)
+ case_cls in
+ let updates, counter_cls = List.split
+ (List.map
+ (fun (i, f, body) -> (f, List.assoc i counter_upds),
+ (ignore_rhs, body)) counter_cls) in
+ updates, counter_cls @ case_cls
+
+
(* Assign rule clauses to rule cases, i.e. candidates for Toss
- rules. Collect the conditions and RHS state terms together. Frame
+ rules. Collect the conditions and RHS state terms together. Frame
clauses are already processed into erasure clauses. Rule clauses
should contain the "legal" clauses with heads replaced by
"_IGNORE_RHS_" terms which will be discarded later; "legal" clauses
and "next" clauses that contained "does" atoms should be marked as
required.
+ We preprocess the clauses by splitting the counter clauses into
+ update calculation and remaining clause condition, remembering the
+ association between the two, and adding back the counter clauses
+ (condintions) as unrequired.
+
We call atoms or literals "deterministic" if they are not under
disjunction. First we collect deterministic literals of required
clauses, and remove unrequired clauses that have deterministic
@@ -734,11 +808,20 @@
unrequired clauses that have no literals disagreeing with the sign
assignment.
+ After the "partitioned" candidates are produced, we collect the
+ "RHSes" from clause heads removing "_IGNORE_RHS_" and removing
+ heads marking counter clauses, but putting in the update
+ calculations corresponding to counter clauses that made it into the
+ candidate case.
+
TODO: unrequired clauses with disjunctions may avoid being
excluded. If this poses problems we might need to expand
disjunctions containing potentially case-split atoms.
*)
-let rule_cases static_rels program playout_states rule_cls =
+let rule_cases counters num_functors static_rels program
+ playout_states rule_cls =
+ let counter_upds, rule_cls =
+ split_counter_rule_cls counters num_functors rule_cls in
let required_cls = Aux.map_some
(fun (h, required, body) ->
if required then Some (h, body) else None) rule_cls in
@@ -795,6 +878,10 @@
| _ -> None) body) unrequired_cls) in
let split_atoms = Aux.list_diff unreq_atoms req_atoms in
if split_atoms = [] then (* single partition *)
+ let updates, unrequired_cls =
+ (* also replace counter cl heads with [ignore_rhs] *)
+ counter_updates_and_preconds counters
+ counter_upds unrequired_cls in
let rule_cls = required_cls @ unrequired_cls in
let case_rhs, case_conds = List.split rule_cls in
let case_rhs = Aux.list_remove ignore_rhs case_rhs in
@@ -803,7 +890,7 @@
Printf.printf "rule_cases: single partition\n%!";
);
(* }}} *)
- [Aux.unique_sorted case_rhs,
+ [Aux.unique_sorted case_rhs, updates,
Aux.unique_sorted (List.concat case_conds)]
else
let patterns =
@@ -850,6 +937,10 @@
not (List.mem (Pos a) body)
) choice
) unrequired_cls in
+ let updates, case_cls =
+ (* also replace counter cl heads with [ignore_rhs] *)
+ counter_updates_and_preconds counters
+ counter_upds case_cls in
let case_cls = case_cls @ required_cls in
let case_rhs, case_conds = List.split case_cls in
let case_rhs =
@@ -858,21 +949,30 @@
Aux.unique_sorted (List.concat case_conds) in
(* {{{ log entry *)
if !debug_level > 3 then (
- Printf.printf "\nRCAND:\nsep_cond: %s\nRHS: %s\ncase_conds: %s\n\n%!"
+ let update_str (counter, update) =
+ counter^": "^
+ String.concat " " (List.map literal_str update) in
+ Printf.printf
+ "\nRCAND:\nsep_cond: %s\nRHS: %s\nUPDATEs: %s\ncase_conds: %s\n\n%!"
(String.concat " " (List.map literal_str separation_cond))
(String.concat " " (List.map term_str case_rhs))
+ (String.concat "; " (List.map update_str updates))
(String.concat " " (List.map literal_str case_conds))
);
(* }}} *)
- case_rhs,
+ case_rhs, updates,
Aux.unique_sorted (separation_cond @ case_conds) in
let res = List.map rule_case choices in
(* {{{ log entry *)
if !debug_level > 2 then (
+ let update_str (counter, update) =
+ counter^": "^
+ String.concat " " (List.map literal_str update) in
Printf.printf "rule_cases: next clauses partitioned into rules\n%!";
- let print_case i (case_rhs, case_cond) =
- Printf.printf "\nRCAND: #%d\nRHS: %s\nLHS: %s\n%!" i
+ let print_case i (case_rhs, updates, case_cond) =
+ Printf.printf "\nRCAND: #%d\nRHS: %s\nUPDATEs: %s\nLHS: %s\n%!" i
(String.concat " " (List.map term_str case_rhs))
+ (String.concat "; " (List.map update_str updates))
(String.concat " " (List.map literal_str case_cond)) in
Array.iteri print_case (Array.of_list res)
);
@@ -906,18 +1006,20 @@
List.map (add_erasure_clauses f_paths) move_tups
-let add_legal_cond static_rels program playout_states (legal_tup, next_cls) =
+let add_legal_cond counters num_functors static_rels program playout_states
+ (legal_tup, next_cls) =
let legal_tup, legal_conds = List.split legal_tup in
let legal_cls = List.map (* required clauses *)
(fun body -> ignore_rhs, true, body) legal_conds in
List.map
- (fun (case_rhs, case_cond) -> legal_tup, case_rhs, case_cond)
- (rule_cases static_rels program playout_states (legal_cls @ next_cls))
+ (fun (case_rhs, updates, case_cond) ->
+ legal_tup, case_rhs, updates, case_cond)
+ (rule_cases counters num_functors static_rels program playout_states
+ (legal_cls @ next_cls))
-let turnbased_rule_cases static_rels loc_noops used_vars f_paths
- program playout_states next_cls
- players legal_by_player =
+let turnbased_rule_cases counters num_functors static_rels loc_noops used_vars f_paths
+ program playout_states next_cls players legal_by_player =
let legal_tuples = Aux.product legal_by_player in
(* remove tuples with multiple players making moves
TODO: could be enhanced by only excluding a noop of a player for
@@ -944,15 +1046,16 @@
process_rule_cands
used_vars f_paths next_cls `General players legal_tuples in
let rules = Aux.concat_map
- (add_legal_cond static_rels program playout_states) move_tups in
+ (add_legal_cond counters num_functors static_rels
+ program playout_states) move_tups in
(* we do not look for the players -- for turn-based case, it's done
while building game graph *)
Aux.Left rules
(* If "Concurrent Moves" case, divide rule clauses among players. *)
-let concurrent_rule_cases static_rels used_vars f_paths program playout_states
- next_cls players legal_by_player =
+let concurrent_rule_cases counters num_functors static_rels used_vars f_paths
+ program playout_states next_cls players legal_by_player =
let env_pl_tups =
env_player,
process_rule_cands used_vars f_paths next_cls `Environment [] [[]] in
@@ -968,27 +1071,29 @@
let player_rules = List.map
(fun (player, move_tups) ->
player, Aux.concat_map
- (add_legal_cond static_rels program playout_states) move_tups)
+ (add_legal_cond counters num_functors static_rels
+ program playout_states) move_tups)
(player_rules @ [env_pl_tups]) in
Aux.Right player_rules
-let general_int_rule_cases static_rels used_vars f_paths program
- playout_states next_cls players legal_by_player =
+let general_int_rule_cases counters num_functors static_rels used_vars f_paths
+ program playout_states next_cls players legal_by_player =
failwith "General Interaction Games not implemented yet"
(* Generate rule candidates (they need to be filtered before finishing
the translation of Toss rules): returns the "legal" terms tuple
- (ordered by players), the right-hand-sides, and the conditions
- (concatenated bodies of the selected "legal" and "next" clauses).
+ (ordered by players), the right-hand-sides, the counter updates (if
+ any), and the conditions (concatenated bodies of the selected
+ "legal" and "next" clauses).
The "concurrent games" case is handled specifically. Instead of
rules for tu...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-11 18:47:13
|
Revision: 1563
http://toss.svn.sourceforge.net/toss/?rev=1563&view=rev
Author: lukstafi
Date: 2011-09-11 18:47:06 +0000 (Sun, 11 Sep 2011)
Log Message:
-----------
GDL translation: translating goal values (i.e. payoffs) computed from counters; bug fix: update conditions now processed with other clauses. (Uses of counters other than counter updates and goal values not implemented yet, coming soon.)
Modified Paths:
--------------
trunk/Toss/GGP/TranslateFormula.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml 2011-09-10 13:02:00 UTC (rev 1562)
+++ trunk/Toss/GGP/TranslateFormula.ml 2011-09-11 18:47:06 UTC (rev 1563)
@@ -98,7 +98,8 @@
let find_defrel_arg sterms args apset =
List.find
- (fun s -> List.for_all (fun (p,i) -> at_path s p = args.(i)) apset)
+ (fun s -> List.for_all (fun (p,i) ->
+ try at_path s p = args.(i) with Not_found -> false) apset)
sterms
let translate_defrel data sterms sign rel args =
@@ -109,7 +110,10 @@
);
(* }}} *)
let partition = List.assoc rel data.defrel_argpaths in
- let s_l = List.map (find_defrel_arg sterms args) partition in
+ let s_l =
+ try List.map (find_defrel_arg sterms args) partition
+ with Not_found -> failwith
+ ("could not build arguments for defined relation "^rel) in
let vtup = Array.of_list (List.map (var_of_term data) s_l) in
let defrel_phi = Formula.Rel (rel, vtup) in
if sign then defrel_phi else Formula.Not defrel_phi
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-09-10 13:02:00 UTC (rev 1562)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-09-11 18:47:06 UTC (rev 1563)
@@ -754,32 +754,17 @@
Aux.Left (f, h, body)
| cl -> Aux.Right cl)
rule_cls in
- let counter_cls = Array.mapi
- (fun i (f, h, body) ->
+ let counter_cls = List.map
+ (fun (f, h, body) ->
let update, cond =
counter_path_partition num_functors counters (h, body) in
- (i, update),
- (Func ("_COUNTER_CL_", [|Const (string_of_int i); Const f|]),
- false, cond))
- (Array.of_list counter_cls) in
- let counter_upds, counter_cls =
- List.split (Array.to_list counter_cls) in
- counter_upds, counter_cls @ rule_cls
+ f, (cond, update))
+ counter_cls in
+ Aux.collect counter_cls, rule_cls
-let counter_updates_and_preconds counters counter_upds case_cls =
- let counter_cls, case_cls = Aux.partition_map
- (function
- | Func ("_COUNTER_CL_", [|Const i; Const f|]), body ->
- Aux.Left (int_of_string i, f, body)
- | cl -> Aux.Right cl)
- case_cls in
- let updates, counter_cls = List.split
- (List.map
- (fun (i, f, body) -> (f, List.assoc i counter_upds),
- (ignore_rhs, body)) counter_cls) in
- updates, counter_cls @ case_cls
-
+let remove_local_vars gvars lits =
+ List.filter (fun l -> Aux.Strings.subset (literals_vars [l]) gvars) lits
(* Assign rule clauses to rule cases, i.e. candidates for Toss
rules. Collect the conditions and RHS state terms together. Frame
@@ -789,10 +774,13 @@
and "next" clauses that contained "does" atoms should be marked as
required.
- We preprocess the clauses by splitting the counter clauses into
- update calculation and remaining clause condition, remembering the
- association between the two, and adding back the counter clauses
- (condintions) as unrequired.
+ We preprocess the clauses by filtering out the counter clauses,
+ splitting them into update calculation and remaining clause
+ condition. (For each counter, the counter clauses will later be
+ merged into a single update by turning clause conditions into
+ characteristic functions multiplied by update calculations, and
+ summing up.) At the end, we add the update clauses to each rule
+ case.
We call atoms or literals "deterministic" if they are not under
disjunction. First we collect deterministic literals of required
@@ -811,10 +799,7 @@
assignment.
After the "partitioned" candidates are produced, we collect the
- "RHSes" from clause heads removing "_IGNORE_RHS_" and removing
- heads marking counter clauses, but putting in the update
- calculations corresponding to counter clauses that made it into the
- candidate case.
+ "RHSes" from clause heads removing "_IGNORE_RHS_".
TODO: unrequired clauses with disjunctions may avoid being
excluded. If this poses problems we might need to expand
@@ -822,7 +807,7 @@
*)
let rule_cases counters num_functors static_rels testground program
playout_states rule_cls =
- let counter_upds, rule_cls =
+ let counter_cls, rule_cls =
split_counter_rule_cls counters num_functors rule_cls in
let required_cls = Aux.map_some
(fun (h, required, body) ->
@@ -890,10 +875,6 @@
| _ -> None) body) unrequired_cls) in
let split_atoms = Aux.list_diff unreq_atoms req_atoms in
if split_atoms = [] then (* single partition *)
- let updates, unrequired_cls =
- (* also replace counter cl heads with [ignore_rhs] *)
- counter_updates_and_preconds counters
- counter_upds unrequired_cls in
let rule_cls = required_cls @ unrequired_cls in
let case_rhs, case_conds = List.split rule_cls in
let case_rhs = Aux.list_remove ignore_rhs case_rhs in
@@ -902,7 +883,7 @@
Printf.printf "rule_cases: single partition\n%!";
);
(* }}} *)
- [Aux.unique_sorted case_rhs, updates,
+ [Aux.unique_sorted case_rhs, counter_cls,
Aux.unique_sorted (List.concat case_conds)]
else
let patterns =
@@ -949,42 +930,46 @@
not (List.mem (Pos a) body)
) choice
) unrequired_cls in
- let updates, case_cls =
- (* also replace counter cl heads with [ignore_rhs] *)
- counter_updates_and_preconds counters
- counter_upds case_cls in
let case_cls = case_cls @ required_cls in
let case_rhs, case_conds = List.split case_cls in
let case_rhs =
Aux.list_remove ignore_rhs (Aux.unique_sorted case_rhs) in
let case_conds =
Aux.unique_sorted (List.concat case_conds) in
+ let separation_cond =
+ remove_local_vars (literals_vars case_conds) separation_cond in
(* {{{ log entry *)
if !debug_level > 3 then (
- let update_str (counter, update) =
- counter^": "^
+ let cond_upd_str (cond, update) =
+ ":(and "^String.concat " " (List.map literal_str cond)^")*{"^
String.concat " " (List.map literal_str update) in
+ let counters_str (counter, cond_updates) =
+ counter^": "^String.concat ", "
+ (List.map cond_upd_str cond_updates) in
Printf.printf
- "\nRCAND:\nsep_cond: %s\nRHS: %s\nUPDATEs: %s\ncase_conds: %s\n\n%!"
+ "\nRCAND:\nsep_cond: %s\nRHS: %s\nCOUNTER_CLs: %s\ncase_conds: %s\n\n%!"
(String.concat " " (List.map literal_str separation_cond))
(String.concat " " (List.map term_str case_rhs))
- (String.concat "; " (List.map update_str updates))
+ (String.concat "; " (List.map counters_str counter_cls))
(String.concat " " (List.map literal_str case_conds))
);
(* }}} *)
- case_rhs, updates,
+ case_rhs, counter_cls,
Aux.unique_sorted (separation_cond @ case_conds) in
let res = List.map rule_case choices in
(* {{{ log entry *)
if !debug_level > 2 then (
- let update_str (counter, update) =
- counter^": "^
+ let cond_upd_str (cond, update) =
+ ":(and "^String.concat " " (List.map literal_str cond)^")*{"^
String.concat " " (List.map literal_str update) in
+ let counters_str (counter, cond_updates) =
+ counter^": "^String.concat ", "
+ (List.map cond_upd_str cond_updates) in
Printf.printf "rule_cases: next clauses partitioned into rules\n%!";
- let print_case i (case_rhs, updates, case_cond) =
- Printf.printf "\nRCAND: #%d\nRHS: %s\nUPDATEs: %s\nLHS: %s\n%!" i
+ let print_case i (case_rhs, counter_cls, case_cond) =
+ Printf.printf "\nRCAND: #%d\nRHS: %s\nCOUNTER_CLs: %s\nLHS: %s\n%!" i
(String.concat " " (List.map term_str case_rhs))
- (String.concat "; " (List.map update_str updates))
+ (String.concat "; " (List.map counters_str counter_cls))
(String.concat " " (List.map literal_str case_cond)) in
Array.iteri print_case (Array.of_list res)
);
@@ -1158,13 +1143,16 @@
let pl_rulecands = match result with
| Aux.Left rcands -> [Const "All Players", rcands]
| Aux.Right pl_rcands -> pl_rcands in
- let update_str (counter, update) =
- counter^": "^
+ let cond_upd_str (cond, update) =
+ ":(and "^String.concat " " (List.map literal_str cond)^")*{"^
String.concat " " (List.map literal_str update) in
- let print_rcand i (_, case_rhs, updates, case_cond) =
- Printf.printf "\nRCAND: #%d\nRHS: %s\nUPDATEs: %s\nLHS: %s\n%!" i
+ let counters_str (counter, cond_updates) =
+ counter^": "^String.concat ", "
+ (List.map cond_upd_str cond_updates) in
+ let print_rcand i (_, case_rhs, counter_cls, case_cond) =
+ Printf.printf "\nRCAND: #%d\nRHS: %s\nCOUNTER_CLs: %s\nLHS: %s\n%!" i
(String.concat " " (List.map term_str case_rhs))
- (String.concat "; " (List.map update_str updates))
+ (String.concat "; " (List.map counters_str counter_cls))
(String.concat " " (List.map literal_str case_cond)) in
let print_rcands (player, rcands) =
Printf.printf "create_rule_cands: player %s --\n%!"
@@ -1353,9 +1341,22 @@
List.fold_left comp_f xvar path
| _ -> assert false
+let transl_cond_updates transl_data num_functions cond_updates =
+ let cond_update (cond, update) =
+ let update = transl_update_path num_functions update in
+ let cond = TranslateFormula.translate transl_data [cond] in
+ Formula.Times (Formula.Char cond, update) in
+ match cond_updates with
+ | [] -> assert false
+ | [c_upd] -> cond_update c_upd
+ | c_upd::c_upds ->
+ List.fold_left
+ (fun acc c_upd -> Formula.Plus (acc, cond_update c_upd))
+ (cond_update c_upd) c_upds
+
let build_toss_rule num_functions transl_data rule_names struc fluents
synch_elems synch_precond synch_postcond
- (legal_tuple, case_rhs, updates, case_cond) =
+ (legal_tuple, case_rhs, counter_cls, case_cond) =
let rname =
if legal_tuple = [] then "Environment"
else String.concat "_" (List.map term_to_name legal_tuple) in
@@ -1374,7 +1375,7 @@
if legal_tuple = [] then precond (* Environment rule *)
else nonterminal :: precond in
let precond =
- if updates = [] then precond
+ if counter_cls = [] then precond
else Formula.Rel (counter_n, [|`FO counter_n|]) :: precond in
(* {{{ log entry *)
if !debug_level > 2 then (
@@ -1396,7 +1397,7 @@
s_subterms)
case_rhs in
let rhs_add = synch_postcond @ rhs_add in
- (* let rhs_add = if updates = [] then rhs_add else *)
+ (* let rhs_add = if counter_cls = [] then rhs_add else *)
let signat = Structure.rel_signature struc in
let struc_elems = List.map
(fun sterm -> term_to_name (blank_out transl_data sterm)) case_rhs in
@@ -1404,7 +1405,7 @@
(List.combine struc_elems case_rhs) in
let struc_elems = Aux.unique_sorted (synch_elems @ struc_elems) in
let struc_elems =
- if updates = [] then struc_elems else counter_n::struc_elems in
+ if counter_cls = [] then struc_elems else counter_n::struc_elems in
let precond = FormulaOps.del_vars_quant
(List.map Formula.fo_var_of_string struc_elems :> Formula.var list)
(Formula.And precond) in
@@ -1423,9 +1424,9 @@
DiscreteRule.translate_from_precond ~precond
~add:rhs_add ~emb_rels:fluents ~signat ~struc_elems in
let updates = List.map
- (fun (f, update) -> (f, counter_n),
- transl_update_path num_functions update)
- updates in
+ (fun (f, cond_updates) -> (f, counter_n),
+ transl_cond_updates transl_data num_functions cond_updates)
+ counter_cls in
let rule =
ContinuousRule.make_rule signat [] discrete
[] updates ~pre:discrete.DiscreteRule.pre () in
@@ -1568,24 +1569,42 @@
(* We assume that clauses for different goal values are disjoint, for
non-disjoint we sum each component. *)
-let compute_payoffs transl_data players clauses =
- (* TODO: we should expand non-constant value expressions... *)
+let compute_payoffs transl_data num_functors num_functions counters
+ players clauses =
let goal_cls = Aux.map_some
(function (("goal",[|player; value|]), body) ->
Some (player,(value,body)) | _ -> None) clauses in
+ let goal_w_counters_cls, goal_cls = Aux.partition_map
+ (function
+ | p, (Var _ as arg,body) as g_cl ->
+ (let try path, rem_body =
+ counter_path_partition num_functors counters (arg, body) in
+ if Aux.Strings.is_empty (Aux.Strings.inter (literals_vars path)
+ (literals_vars rem_body))
+ then Aux.Left (p, (rem_body, path))
+ else Aux.Right g_cl
+ with Not_found -> Aux.Right g_cl)
+ | g_cl -> Aux.Right g_cl)
+ goal_cls in
let goal_cls =
List.map (fun (player, goal_brs) -> player, Aux.collect goal_brs)
(Aux.collect goal_cls) in
+ let goal_w_counters_cls = Aux.collect goal_w_counters_cls in
let player_goals = Array.map
(fun player ->
- try List.assoc player goal_cls
- with Not_found -> failwith
- ("TranslateGame.compute_payoffs: no goal provided for player "
- ^ term_to_name player))
+ let num_goal_cls =
+ try List.assoc player goal_cls with Not_found -> [] in
+ let counter_goal_cls =
+ try List.assoc player goal_w_counters_cls with Not_found -> [] in
+ if num_goal_cls = [] && counter_goal_cls = [] then
+ failwith
+ ("TranslateGame.compute_payoffs: no goal provided for player "
+ ^ term_to_name player)
+ else num_goal_cls, counter_goal_cls)
players in
(* Translate the goal conditions. *)
- let payoffs = Array.map
- (fun goals -> List.map
+ let transl_payoffs (num_goal_cls, counter_goal_cls) =
+ let num_payoff = List.map
(fun (score, disjs) ->
let score =
match score with
@@ -1600,42 +1619,50 @@
score,
if phi_vars = [] then goal_phi
else Formula.Ex (phi_vars, goal_phi))
- goals)
- player_goals in
- (* Offset the values to remove the most inconvenient goal
- condition. *)
- let payoffs = Array.map
- (fun payoff ->
- let sized =
- List.map (fun (score,phi) -> GameSimpl.niceness phi, score)
- payoff in
+ num_goal_cls in
+ (* Offset the values to remove the most inconvenient goal
+ condition. *)
+ let sized =
+ List.map (fun (score,phi) -> GameSimpl.niceness phi, score)
+ num_payoff in
(* Sort in increasing niceness -- to remove the least nice. *)
- let base_score =
- match List.sort Pervasives.compare sized with [] -> 0.
- | (_, score)::_ -> score in
- match payoff with
- | [score, guard] ->
- Formula.Times (
- Formula.Const score, Formula.Char guard)
- | scores ->
- List.fold_left (fun sum (score, guard) ->
- if score = base_score then (
+ let base_score =
+ match List.sort Pervasives.compare sized with [] -> 0.
+ | (_, score)::_ -> score in
+ let num_payoff =
+ match num_payoff with
+ | [] -> Formula.Const 0.
+ | [score, guard] ->
+ Formula.Times (
+ Formula.Const score, Formula.Char guard)
+ | scores ->
+ List.fold_left (fun sum (score, guard) ->
+ if score = base_score then (
(* {{{ log entry *)
- if !debug_level > 2 then (
- Printf.printf
- "translate_game: (8) dropping score %f guard:\n%s\n\n%!"
- score (Formula.sprint guard)
- );
+ if !debug_level > 2 then (
+ Printf.printf
+ "translate_game: (8) dropping score %f guard:\n%s\n\n%!"
+ score (Formula.sprint guard)
+ );
(* }}} *)
- sum)
- else
- let guarded = Formula.Times (
- Formula.Const (score -. base_score), Formula.Char guard) in
- if sum = Formula.Const 0. then guarded
- else Formula.Plus (sum, guarded))
- (Formula.Const base_score) scores
- ) payoffs in
- payoffs
+ sum)
+ else
+ let guarded = Formula.Times (
+ Formula.Const (score -. base_score), Formula.Char guard) in
+ if sum = Formula.Const 0. then guarded
+ else Formula.Plus (sum, guarded))
+ (Formula.Const base_score) scores in
+ let counter_payoff =
+ match counter_goal_cls with
+ | [] -> Formula.Const 0.
+ | cond_upds ->
+ transl_cond_updates transl_data num_functions cond_upds in
+ if num_payoff = Formula.Const 0.
+ then counter_payoff
+ else if counter_payoff = Formula.Const 0.
+ then num_payoff
+ else Formula.Plus (counter_payoff, num_payoff) in
+ Array.map transl_payoffs player_goals
let transl_argpath_no_side defined_rels init_state program
@@ -1673,10 +1700,22 @@
(* Representing rule candidates as (rule) clauses. *)
let encode_rule_cands_in_clauses rule_cands clauses =
let rule_cl_i = ref 0 in
+ let rule_upd_j = ref 0 in
let more_cls = ref [] in
+ let proc_update i (cond, update) =
+ let j = !rule_upd_j in
+ incr rule_upd_j;
+ more_cls := (("update clause", [|Const (string_of_int i);
+ Const (string_of_int j)|]), cond)::
+ !more_cls;
+ update, j in
+ let proc_counter_upds i (counter, updates) =
+ let updates = List.map (proc_update i) updates in
+ counter, updates in
let proc_cand (legal_tup, rhs_tup, updates, cond) =
let i = !rule_cl_i in
- incr rule_cl_i;
+ incr rule_cl_i; rule_upd_j := 0;
+ let updates = List.map (proc_counter_upds i) updates in
more_cls := (("rule clause", [|Const (string_of_int i)|]), cond)::
!more_cls;
legal_tup, rhs_tup, updates, i in
@@ -1696,8 +1735,20 @@
Aux.Left (int_of_string i, cond)
| cl -> Aux.Right cl)
clauses in
- let proc_cand (legal_tup, rhs_tup, updates, cond_i) =
- legal_tup, rhs_tup, updates, List.assoc cond_i rule_cls in
+ let update_cls, clauses = Aux.partition_map
+ (function
+ | ("update clause", [|Const i; Const j|]), cond ->
+ Aux.Left ((int_of_string i, int_of_string j), cond)
+ | cl -> Aux.Right cl)
+ clauses in
+ let proc_update i (update, j) =
+ List.assoc (i,j) update_cls, update in
+ let proc_counter_upds i (counter, updates) =
+ let updates = List.map (proc_update i) updates in
+ counter, updates in
+ let proc_cand (legal_tup, rhs_tup, updates, i) =
+ legal_tup, rhs_tup, List.map (proc_counter_upds i) updates,
+ List.assoc i rule_cls in
let rule_cands =
match rule_cands with
| Aux.Left cands -> Aux.Left (List.map proc_cand cands)
@@ -2022,7 +2073,9 @@
decode_rule_cands_of_clauses rule_cands clauses in
(* possibly update the structure with a control element and predicate *)
let rule_names = ref Aux.Strings.empty in
- let payoffs = compute_payoffs transl_data players clauses in
+ let payoffs =
+ compute_payoffs transl_data num_functors num_functions counters
+ players clauses in
let player_names = Array.to_list
(Array.mapi (fun i p -> term_to_name p, i)
(if turn_data = None then Array.append [|env_player|] players
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-10 13:02:00 UTC (rev 1562)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-11 18:47:06 UTC (rev 1563)
@@ -361,7 +361,7 @@
(* regenerate ~debug:false ~game_name:"connect4" ~player:"white"; *)
(* regenerate ~debug:false ~game_name:"2player_normal_form_2010" ~player:"row"; *)
regenerate ~debug:true ~game_name:"pacman3p" ~player:"pacman";
- failwith "generated";
+ (* failwith "generated"; *)
()
let exec () =
Modified: trunk/Toss/www/reference/reference.tex
===================================================================
--- trunk/Toss/www/reference/reference.tex 2011-09-10 13:02:00 UTC (rev 1562)
+++ trunk/Toss/www/reference/reference.tex 2011-09-11 18:47:06 UTC (rev 1563)
@@ -1927,7 +1927,10 @@
according to the partition, form the separation condition. Currently,
we do not consider atoms under disjunction (mostly for simplicity
considerations; would this cause problems, the definition can be
-extended to include disjunctions in making the partition).
+extended to include disjunctions in making the partition). We remove
+from the separation condition negations of atoms that contain ``local
+variables'': variables not appearing in positive atoms of the whole
+condition.
We filter the rule candidates by checking for satisfiability (in the
same GDL model as used for building the initial Toss structure) of the
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-09-12 14:56:09
|
Revision: 1564
http://toss.svn.sourceforge.net/toss/?rev=1564&view=rev
Author: lukstafi
Date: 2011-09-12 14:56:02 +0000 (Mon, 12 Sep 2011)
Log Message:
-----------
GDL translation: uses of counters in formulas specified and implemented; new ideas required for nice translation of pacman3p.gdl.
Modified Paths:
--------------
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/GameSimpl.ml
trunk/Toss/GGP/TranslateFormula.ml
trunk/Toss/GGP/TranslateFormula.mli
trunk/Toss/GGP/TranslateFormulaTest.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/GGP/GDL.ml 2011-09-12 14:56:02 UTC (rev 1564)
@@ -1675,7 +1675,9 @@
let pred_on_path_subterm path subterm =
path_str path ^ term_to_name subterm
+let counter_n = "gdl__counter"
+
(* [expand_path_vars_by prepare_lits p ts clauses] expands subterms
that have occurrences at path [p] in some state term of a clause
(from which pre-processed literals are extracted by
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/GGP/GDL.mli 2011-09-12 14:56:02 UTC (rev 1564)
@@ -151,6 +151,8 @@
val blank : term
+val counter_n : string
+
val term_str : term -> string
val term_to_name : ?nested:bool -> term -> string
Modified: trunk/Toss/GGP/GameSimpl.ml
===================================================================
--- trunk/Toss/GGP/GameSimpl.ml 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/GGP/GameSimpl.ml 2011-09-12 14:56:02 UTC (rev 1564)
@@ -124,9 +124,16 @@
(for example with {!FormulaOps.simplify} or
{!FormulaOps.remove_redundant} without the [implies] argument).
- (5) TODO: Glue redundant rules (equal and having the same roles in
- the game graph).
+ (5) TODO: Remove redundant existential quantifiers in formulas of
+ the form "ex x. x = v and ...".
+ (6) TODO: Remove redundant stable predicate literals, where the
+ literal is implied by its argument appearing as an argument to a
+ relation: when the relation projected on the argument is a subset
+ of the predicate (or outside the predicate for negative
+ literal). Compute the relation-argument-position, predicate
+ implications including relations produced by gluing.
+
*)
open Formula
Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/GGP/TranslateFormula.ml 2011-09-12 14:56:02 UTC (rev 1564)
@@ -15,23 +15,27 @@
(* [separate_disj] is $\mathrm{TrDistr}$. Separate each disjunct,
splitting disjuncts if necessary, into "positive state terms",
- "negative state terms" and "reminder". *)
-let separate_disj disj =
- (* FIXME see tests *)
+ "negative state terms" (excluding counters) and "reminder". *)
+let separate_disj counters disj =
+ let is_c = function
+ | Func (f, _) when List.mem f counters -> true | _ -> false in
let aux conj =
List.fold_right (fun lit acc -> match lit with
- | (Pos (True _) | Neg (True _)) as lit ->
+ | (Pos (True t) | Neg (True t)) as lit when not (is_c t) ->
List.map (fun conj -> Aux.Left lit::conj) acc
| Disj ls as lit ->
- if List.for_all (function Pos (True _) -> true | _ -> false) ls
- || List.for_all (function Neg (True _) -> true | _ -> false) ls
+ if List.for_all
+ (function Pos (True t) when not (is_c t) -> true | _ -> false) ls
+ || List.for_all
+ (function Neg (True t) when not (is_c t) -> true | _ -> false) ls
then
List.map (fun conj -> Aux.Left lit::conj) acc
else if List.exists
- (function Pos (True _) | Neg (True _) -> true | _ -> false) ls
+ (function (Pos (True t) | Neg (True t))
+ when not (is_c t) -> true | _ -> false) ls
then
Aux.concat_map (function
- | (Pos (True _) | Neg (True _)) as lit ->
+ | (Pos (True t) | Neg (True t)) as lit when not (is_c t) ->
List.map (fun conj -> Aux.Left lit::conj) acc
| lit -> List.map (fun conj -> Aux.Right lit::conj) acc
) ls
@@ -47,10 +51,12 @@
| Pos _ as lit -> Aux.Left lit
| Neg _ as lit -> Aux.Right lit
| Disj ls as lit
- when List.for_all (function Pos (True _) -> true | _ -> false) ls
+ when List.for_all
+ (function Pos (True t) when not (is_c t) -> true | _ -> false) ls
-> Aux.Left lit
| Disj ls as lit
- when List.for_all (function Neg (True _) -> true | _ -> false) ls
+ when List.for_all
+ (function Neg (True t) when not (is_c t) -> true | _ -> false) ls
-> Aux.Right lit
| _ -> assert false
) state_terms in
@@ -63,6 +69,8 @@
c_paths : path_set; (* coordinate paths *)
all_paths : path_set; (* sum of f_paths and c_paths *)
root_reps : term list; (* coordinate root terms *)
+ counters : string list;
+ num_functions : (string * Formula.real_expr) list;
defined_rels : string list;
mutable defrel_argpaths : (string * defrel_argpaths) list;
(* late binding to store $ArgMode# data *)
@@ -75,6 +83,8 @@
c_paths = empty_path_set;
all_paths = empty_path_set;
root_reps = [];
+ num_functions = [];
+ counters = [];
defined_rels = [];
defrel_argpaths = [];
term_arities = [];
@@ -118,7 +128,10 @@
let defrel_phi = Formula.Rel (rel, vtup) in
if sign then defrel_phi else Formula.Not defrel_phi
-let transl_rels data rels_phi sterms_all vterms_in =
+let minus a b = Formula.Plus (a, Formula.Times (Formula.Const (-1.), b))
+let counter_v = `FO counter_n
+
+let transl_rels data cv_map counter_vars rels_phi sterms_all vterms_in =
(* coordinate subterms to locate paths on which to generate relations *)
let s_subterms = Aux.concat_map
(fun sterm ->
@@ -165,7 +178,46 @@
then
[translate_defrel data sterms_all sign rel args]
else transl_rel sign rel args in
+ let transl_c = function
+ | Const v when
+ (try ignore (float_of_string v); true with _ -> false) ->
+ Formula.Const (float_of_string v)
+ | Var x when List.mem_assoc x cv_map ->
+ Formula.Fun (List.assoc x cv_map, counter_v)
+ | _ -> raise Not_found in
+ let transl_counter_term sign c t =
+ let sign_op =
+ if sign then Formula.EQZero else Formula.NEQZero in
+ let cc = Formula.Fun (c, counter_v) and ct = transl_c t in
+ if cc = ct then []
+ else [Formula.RealExpr (minus cc ct, sign_op)] in
+ let transl_numfun_rel sign rel t1 t2 =
+ let sign_op =
+ if sign then Formula.EQZero else Formula.NEQZero in
+ let f_result =
+ FormulaSubst.subst_real [":x", transl_c t1]
+ (List.assoc rel data.num_functions) in
+ [Formula.RealExpr
+ (minus f_result (transl_c t2), sign_op)] in
let rec aux = function
+ | Pos (True (Func (c, [|t|])))
+ when List.mem c data.counters &&
+ (try ignore (transl_c t); true with Not_found -> false) ->
+ transl_counter_term true c t
+ | Neg (True (Func (c, [|t|])))
+ when List.mem c data.counters &&
+ (try ignore (transl_c t); true with Not_found -> false) ->
+ transl_counter_term false c t
+ | Pos (Rel (rel, [|t1; t2|]))
+ when List.mem_assoc rel data.num_functions &&
+ (try ignore [transl_c t1; transl_c t2]; true
+ with Not_found -> false) ->
+ transl_numfun_rel true rel t1 t2
+ | Neg (Rel (rel, [|t1; t2|]))
+ when List.mem_assoc rel data.num_functions &&
+ (try ignore [transl_c t1; transl_c t2]; true
+ with Not_found -> false) ->
+ transl_numfun_rel false rel t1 t2
| Pos (Rel (rel, args)) -> transl_posdefrel true rel args
| Neg (Rel (rel, args)) -> transl_posdefrel false rel args
| Pos (Does _ | Role _) | Neg (Does _ | Role _) ->
@@ -239,6 +291,15 @@
$G_i$, [pos_state_phi] is $ST^{+}_i$, [neg_state_phi] is
$ST^{-}_i$, [ext_phi] is $E$. *)
let transl_disjunct data rels_phi pos_state_phi neg_state_phi ext_phi =
+ let is_c = function
+ | Func (f, _) when List.mem f data.counters -> true
+ | _ -> false in
+ let cv_map = Aux.map_some
+ (function
+ | Pos (True (Func (f, [|Var x|]))) when List.mem f data.counters ->
+ Some (x, f) | _ -> None) rels_phi in
+ let counter_vars =
+ terms_vars (Array.of_list (List.filter is_c (state_terms rels_phi))) in
let pos_terms = state_terms pos_state_phi in
let pos_vars = List.map (var_of_term data) pos_terms in
let neg_terms = state_terms neg_state_phi in
@@ -255,7 +316,7 @@
rels_phi @ pos_state_phi @ neg_state_phi) in
let eqs =
List.map (fun v -> Pos (Rel ("EQ_", [|Var v; Var v|])))
- (Aux.Strings.elements phi_vars) in
+ (Aux.Strings.elements (Aux.Strings.diff phi_vars counter_vars)) in
let rels_eqs = rels_phi @ eqs in
(* {{{ log entry *)
if !debug_level > 2 then (
@@ -275,7 +336,7 @@
neg_ext @
[
(* positive because they form a "premise" *)
- transl_rels data rels_eqs all_terms neg_vars;
+ transl_rels data cv_map counter_vars rels_eqs all_terms neg_vars;
(* the universal "conclusion" *)
negated_neg_state_transl]) in
let universal_part =
@@ -287,22 +348,29 @@
let base_part =
Formula.And (
pos_ext @
- [ transl_rels data rels_eqs pos_terms pos_vars;
+ [ transl_rels data cv_map counter_vars rels_eqs pos_terms pos_vars;
transl_state data pos_state_phi] @
universal_part) in
if pos_vars = [] then base_part
else Formula.Ex ((pos_vars :> Formula.var list), base_part)
-
+let has_counter t =
+ FormulaMap.fold_formula
+ {FormulaMap.make_fold ( || ) false with
+ FormulaMap.fold_Fun = (fun _ v -> v = counter_v)} t
(* Translate a disjunction of conjunctions of literals (and disjs of lits). *)
let translate data disj =
- let disj = separate_disj disj in
- Formula.Or (List.map (fun (rels_phi, pos_state, neg_state) ->
- transl_disjunct data rels_phi pos_state neg_state []
- ) disj)
+ let disj = separate_disj data.counters disj in
+ let res =
+ Formula.Or (List.map (fun (rels_phi, pos_state, neg_state) ->
+ transl_disjunct data rels_phi pos_state neg_state []
+ ) disj) in
+ if has_counter res
+ then Formula.Ex
+ ([counter_v], Formula.And [Formula.Rel (counter_n, [|counter_v|]); res])
+ else res
-
(* **************************************** *)
(* {3 Build and use defined relations.} *)
Modified: trunk/Toss/GGP/TranslateFormula.mli
===================================================================
--- trunk/Toss/GGP/TranslateFormula.mli 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/GGP/TranslateFormula.mli 2011-09-12 14:56:02 UTC (rev 1564)
@@ -7,6 +7,8 @@
c_paths : GDL.path_set; (** coordinate paths *)
all_paths : GDL.path_set; (** sum of f_paths and c_paths *)
root_reps : GDL.term list; (** root terms *)
+ counters : string list;
+ num_functions : (string * Formula.real_expr) list;
defined_rels : string list;
mutable defrel_argpaths : (string * defrel_argpaths) list;
(** late binding to store argument paths data *)
@@ -21,7 +23,7 @@
(** Exposed for testing purposes only. *)
val separate_disj :
- GDL.literal list list ->
+ string list -> GDL.literal list list ->
(GDL.literal list * GDL.literal list * GDL.literal list) list
val translate :
Modified: trunk/Toss/GGP/TranslateFormulaTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormulaTest.ml 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/GGP/TranslateFormulaTest.ml 2011-09-12 14:56:02 UTC (rev 1564)
@@ -65,6 +65,8 @@
c_paths = c_paths;
all_paths = all_paths;
root_reps = root_reps;
+ counters = [];
+ num_functions = [];
defined_rels = defined_rels;
defrel_argpaths = [];
term_arities = term_arities;
@@ -85,7 +87,7 @@
let phi = "(or (col ?r) (row ?r) (diag1 ?r) (diag2 ?r))" in
let conj = parse_literal_list phi in
- let disj = separate_disj [conj] in
+ let disj = separate_disj [] [conj] in
assert_equal ~msg:phi ~printer:(fun x->x)
"(<= (rels#0 )
(or (col ?r) (row ?r) (diag1 ?r) (diag2 ?r)))
@@ -98,7 +100,7 @@
let phi = "(or (arel x) (true s1)) (brel y)" in
let conj = parse_literal_list phi in
- let disj = separate_disj [conj] in
+ let disj = separate_disj [] [conj] in
assert_equal ~msg:phi ~printer:(fun x->x)
"(<= (rels#0 )
(arel x)
@@ -119,7 +121,7 @@
let phi = "(or (arel x) (true s1)) (not (true s2))" in
let conj = parse_literal_list phi in
- let disj = separate_disj [conj] in
+ let disj = separate_disj [] [conj] in
assert_equal ~msg:phi ~printer:(fun x->x)
"(<= (rels#0 )
(arel x))
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-09-12 14:56:02 UTC (rev 1564)
@@ -18,6 +18,19 @@
occur in the structure)
TODO: filter out legal tuples that are not statically satisfiable
+
+ TODO: after detecting that some state terms do not have any fluent
+ paths in them, eliminate these state terms by performing a GDL
+ source-level transformation into relations (i.e. erase the "init"
+ and "true" wrappers, and their "next" clauses, which are frame
+ clauses)
+
+ TODO: perform the argument-path analysis for all GDL relations,
+ not only future defined relations; if fact-only GDL relations have
+ no conflicting paths (i.e. each argument is only used with a
+ specific path), translate them using the mechanism of defined
+ relations, but as stable (structure) relations, called
+ "materialized defined relations".
*)
open GDL
@@ -1325,8 +1338,6 @@
else raise Not_turn_based
-let counter_n = "gdl__counter"
-
let transl_update_path num_functions update =
let comp_f acc = function
| Pos (Rel (f, _)) when List.mem_assoc f num_functions ->
@@ -2048,6 +2059,8 @@
c_paths = c_paths;
all_paths = paths_union f_paths c_paths;
root_reps = root_reps;
+ counters = counters;
+ num_functions = num_functions;
defined_rels = defined_rels;
defrel_argpaths = []; (* built in TranslateFormula *)
term_arities = term_arities;
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-12 14:56:02 UTC (rev 1564)
@@ -307,18 +307,20 @@
let a () =
set_debug_level 4;
- game_test_case ~game_name:"tictactoe" ~player:"xplayer"
+ game_test_case ~game_name:"breakthrough" ~player:"white"
~own_plnum:0 ~opponent_plnum:1
- ~loc0_rule_name:"mark_x6_y_noop"
+ ~loc0_rule_name:"move_x2_y3_x3_y4_noop"
~loc0_emb:[
- "cell_x6_y__BLANK_", "cell_2_2__BLANK_";
+ "cellholds_x2_y3__BLANK_", "cellholds_2_2__BLANK_";
+ "cellholds_x3_y4__BLANK_", "cellholds_1_3__BLANK_";
"control__BLANK_", "control__BLANK_"]
- ~loc0_move:"(mark 2 2)" ~loc0_noop:"noop"
- ~loc1:1 ~loc1_rule_name:"noop_mark_x7_y0"
+ ~loc0_move:"(move 2 2 1 3)" ~loc0_noop:"noop" ~loc1:1
+ ~loc1_rule_name:"noop_move_x7_y9_x8_y10"
~loc1_emb:[
- "cell_x7_y0__BLANK_", "cell_1_1__BLANK_";
+ "cellholds_x7_y9__BLANK_", "cellholds_7_7__BLANK_";
+ "cellholds_x8_y10__BLANK_", "cellholds_6_6__BLANK_";
"control__BLANK_", "control__BLANK_"]
- ~loc1_noop:"noop" ~loc1_move:"(mark 1 1)"
+ ~loc1_noop:"noop" ~loc1_move:"(move 7 7 6 6)"
let a () =
@@ -360,7 +362,7 @@
(* regenerate ~debug:true ~game_name:"pawn_whopping" ~player:"x"; *)
(* regenerate ~debug:false ~game_name:"connect4" ~player:"white"; *)
(* regenerate ~debug:false ~game_name:"2player_normal_form_2010" ~player:"row"; *)
- regenerate ~debug:true ~game_name:"pacman3p" ~player:"pacman";
+ (* regenerate ~debug:true ~game_name:"pacman3p" ~player:"pacman"; *)
(* failwith "generated"; *)
()
Modified: trunk/Toss/www/reference/reference.tex
===================================================================
--- trunk/Toss/www/reference/reference.tex 2011-09-11 18:47:06 UTC (rev 1563)
+++ trunk/Toss/www/reference/reference.tex 2011-09-12 14:56:02 UTC (rev 1564)
@@ -2036,22 +2036,45 @@
composed of conjunctions, disjunctions and literals, into a
disjunction $\mathrm{TrDistr}(\Phi) := \Phi_1 \vee \ldots \vee
\Phi_n$, so that every $\Phi_i = G_i \wedge ST^{+}_i \wedge ST^{-}_i$,
-where all literals in $ST^{+}_i$ are positive \texttt{true} atoms and all
-literals in $ST^{-}_i$ are negated \texttt{true} atoms. (We
-avoid unnecessary expansions.) Let $\mathtt{ST}(\phi)$ be all the
-state terms, \ie arguments of \texttt{true} atoms, in $\phi$.
+where all literals in $ST^{+}_i$ are positive \texttt{true} atoms and
+all literals in $ST^{-}_i$ are negated \texttt{true} atoms, excluding
+application over counter terms (we avoid unnecessary expansions), note
+that \texttt{true} atoms over counter terms are left in $G_i$. Let
+$\mathtt{ST}(\phi)$ be all the state terms, \ie arguments of
+\texttt{true} atoms, in $\phi$, that are not counter
+terms, and let $\mathtt{CT}(\phi)$ be the counter term atoms respectively.
-$\TrRels(\phi, S_1, S_2)$ descends $\phi$ translating each literal as a
-conjunction of literals, for every combination of coordinate paths into $S_1$
-state terms, such that at least one of those terms is from $S_2$.
+For the purpose of translation involving counters, let $C^V_i$ be an
+assignment of counters (identified by their names) to GDL variables $x
+\ot c$ such that a positive atom $(\mathtt{true} \ (c \ x))$ occurs in
+$\Phi_i$. Also, let $CQ(\Psi)$ be $\exists v_C\big(\textmd{COUNTER}(v_C)
+\wedge \Psi \big)$ when $v_C \in \fv(\Psi)$, and $CQ(\Psi) = \Psi$
+otherwise, where $v_C$ is a distinguished variable for handling
+counters translation.
-$\TrST(\phi)$ translates \texttt{true} atoms as a conjunction of their
-coordinate and fluent predicates.
+$\TrRels(\phi, S_1, S_2)$ descends $\phi$ translating each literal not
+involving counters as a conjunction of literals, for every combination
+of coordinate paths into $S_1$ state terms, such that at least one of
+those terms is from $S_2$.
+When $\TrRels$ encounters a \texttt{true} atom over counter $c$, it
+builds an equation between $c(v_C)$ and the argument of $c$ in the
+atom when it is a constant, or in case $c$ is applied to a variable
+$x$, the value $c'(v_C)$ for $c' = C^V_i(x)$. If $\TrRels$ encounters
+a numeric function applied to either constants or variables in the
+domain of $C^V_i$, it applies the function to the right argument when
+building a similar equation. The translation will currently fail if
+relations other than numeric functions are applied to variables that
+also occur in counter terms: general case left as future work.
+
+$\TrST(\phi)$ translates \texttt{true} atoms which are not counters as
+a conjunction of their coordinate and fluent predicates.
+
Let $eqs_i$ be $\Land \big\{ \mathtt{EQ}(x,x) | x \in \fv(\Phi_i)
-\big\}$. The relation name $\mathtt{EQ}$ serves technical purposes:
-fact relations $\mathtt{EQ}_{p,q}$ are identified with subterm
-equality relations $Eq_{p,q}$.
+\setminus \fv(\mathtt{CT}(\Phi_i)) \big\}$. The relation name
+$\mathtt{EQ}$ serves technical purposes: fact relations
+$\mathtt{EQ}_{p,q}$ are identified with subterm equality relations
+$Eq_{p,q}$.
The result of translation is the disjunction of translations of each
$\Phi_i$. Let $\mathtt{BL}(t)=t\big[\calP_f \ot \mathtt{BLANK}\big]$. A single $\Phi_i = G_i \wedge ST^{+}_i \wedge ST^{-}_i$
@@ -2071,13 +2094,13 @@
V^{-} & := \big( \mathtt{BL}(\mathtt{ST}(ST^{-}_i)) \setminus V^{+} \big)
\end{align*}
-The result of translation is $\mathrm{Tr}(\Phi) := \mathrm{Tr}(\Phi_1)
-\vee \ldots \vee \mathrm{Tr}(\Phi_n)$. Note how variables with both
-positive and negative instantiating state terms are excluded from
-universal treatment; in particular, the variables corresponding to
-Toss rewrite rule structure elements will not be quantified
-universally, thanks to adding their ``blank representants'' to the
-rule condition.
+The result of translation is $\mathrm{Tr}(\Phi) := CQ \big(
+\mathrm{Tr}(\Phi_1) \vee \ldots \vee \mathrm{Tr}(\Phi_n) \big)$. Note how
+variables with both positive and negative instantiating state terms
+are excluded from universal treatment; in particular, the variables
+corresponding to Toss rewrite rule structure elements will not be
+quantified universally, thanks to adding their ``blank representants''
+to the rule condition.
We now proceed to define $\TrRels$ and $\TrST$. For an atom $r$, let
$\pm r$ mean either $r$ or $\neg r$ when on the left-hand-side, and
@@ -2097,20 +2120,30 @@
& p_1, \ldots, p_n \in \calP_c \wedge
s_1 \tpos_{p_1} = t_1 \wedge \ldots \wedge s_n \tpos_{p_n} = t_n \big\} \\
& \textit{(when $R$ is not translated as defined relation)} \\
+ \TrRels (\pm \mathtt{true}(c(t))) =
+ & \pm \big(c(v_C)-\mathtt{TrC}(t) = 0 \big) \\
+ \TrRels (\pm R(t_1,t_2)) = &
+ \pm \big(\big(\mathtt{NumF}(R)\big) (\mathtt{TrC}(t_1))
+ - \mathtt{TrC}(t_2) = 0 \big) \\
+ & \textit{(when $R$ can be translated as a numeric function
+ $\mathtt{NumF}(R)$} \\
+ & \textit{and both $t_1$ and $t_2$ are in the domain of $\mathtt{TrC}$)} \\
+ \mathtt{TrC}(n) = & n \ \ \textit{(when $n$ is a constant)} \\
+ \mathtt{TrC}(x) = & \big(C^V_i(x)\big)(v_C) \ \
+ \textit{(when $x$ is a variable in the domain of $C^V_i$)} \\
\TrST (\phi_1 \wedge \phi_2) = &
\TrST (\phi_1) \wedge \TrST(\phi_2) \\
\TrST (\phi_1 \vee \phi_2) = &
\TrST (\phi_1) \vee \TrST(\phi_2) \\
- \TrST (\mathtt{true}(t)) = & \Land \big\{
- Coord^s_p(v) \; \big| \; v = \mathtt{BL}(t) \wedge
- p \in \calP_c \wedge t \tpos_p = s \wedge s \neq \mathtt{BLANK}
+ \TrST (\mathtt{true}(t)) = & \Land \big\{ Coord^s_p(v) \; \big| \; v
+ = \mathtt{BL}(t) \wedge p \in \calP_c \wedge t \tpos_p = s \wedge s
+ \neq \mathtt{BLANK}
\big\} \wedge \\
- & \Land \big\{
- Flu^s_p(v) \; \big| \; v = \mathtt{BL}(t) \wedge
- p \in \calP_f \wedge t \tpos_p = s \wedge s \neq \mathtt{BLANK}
+ & \Land \big\{ Flu^s_p(v) \; \big| \; v = \mathtt{BL}(t) \wedge p
+ \in \calP_f \wedge t \tpos_p = s \wedge s \neq \mathtt{BLANK}
\big\} \wedge \\
- & \Land \big\{
- Root_m(v) \; \big| \; v = \mathtt{BL}(t) \wedge t \in m \big\}
+ & \Land \big\{ Root_m(v) \; \big| \; v = \mathtt{BL}(t) \wedge t \in
+ m \big\}
\end{align*}
The case of $\TrRels$ for relations intended to be translated as
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-09-12 22:25:17
|
Revision: 1565
http://toss.svn.sourceforge.net/toss/?rev=1565&view=rev
Author: lukaszkaiser
Date: 2011-09-12 22:25:10 +0000 (Mon, 12 Sep 2011)
Log Message:
-----------
Adapting update and dynamics syntax to real_expr, correcting tests.
Modified Paths:
--------------
trunk/Toss/Arena/ArenaTest.ml
trunk/Toss/Arena/ContinuousRuleTest.ml
trunk/Toss/Arena/Term.ml
trunk/Toss/Arena/TermParser.mly
trunk/Toss/Arena/TermTest.ml
trunk/Toss/Formula/Formula.ml
trunk/Toss/Formula/FormulaParser.mly
trunk/Toss/Play/HeuristicTest.ml
trunk/Toss/examples/bounce.toss
trunk/Toss/examples/rewriting_example.toss
Modified: trunk/Toss/Arena/ArenaTest.ml
===================================================================
--- trunk/Toss/Arena/ArenaTest.ml 2011-09-12 14:56:02 UTC (rev 1564)
+++ trunk/Toss/Arena/ArenaTest.ml 2011-09-12 22:25:10 UTC (rev 1565)
@@ -36,11 +36,11 @@
rule_e msg;
let rule_1 =
- "[ 1 | | vx { 1->0. }; vy { 1->0. }; x { 1->-15.4 }; y { 1->-50.6 } ] -> [ 1, 2 | | vx { 1->0., 2->0. }; vy { 1->0., 2->0. }; x { 1->-14.3, 2->6.6 }; y { 1->-77., 2->2.2 } ] with [1 <- 1] update x(1) = 1 pre true inv true post true "in
+ "[ 1 | | vx { 1->0. }; vy { 1->0. }; x { 1->-15.4 }; y { 1->-50.6 } ] -> [ 1, 2 | | vx { 1->0., 2->0. }; vy { 1->0., 2->0. }; x { 1->-14.3, 2->6.6 }; y { 1->-77., 2->2.2 } ] with [1 <- 1] update :x(1) = 1 pre true inv true post true "in
let rule_1_res =
"[1 | | vx {1->0.}; vy {1->0.}; x {1->-15.4}; y {1->-50.6}] -> [1, 2 | | vx {1->0., 2->0.}; vy {1->0., 2->0.}; x {1->-14.3, 2->6.6}; y {1->-77., 2->2.2}] with [1 <- 1]
update
- x(1) = 1.
+ :x(1) = 1.
pre true inv true post true" in
let s = "SET RULE 1 " ^ rule_1 in
let (gs,_) = Arena.handle_request Arena.empty_state (req_of_str s) in
Modified: trunk/Toss/Arena/ContinuousRuleTest.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRuleTest.ml 2011-09-12 14:56:02 UTC (rev 1564)
+++ trunk/Toss/Arena/ContinuousRuleTest.ml 2011-09-12 22:25:10 UTC (rev 1565)
@@ -29,18 +29,18 @@
let r = rule_of_str s signat [] "rule1" in
assert_equal ~msg:"1. no continuous" ~printer:(fun x->x) s (str r);
- let upd_eq = " f(c) = 2. * f(a);\n f(d) = f(b)\n" in
+ let upd_eq = " :f(c) = 2. * :f(a);\n :f(d) = :f(b)\n" in
let s = discr ^ "\nupdate\n" ^ upd_eq ^ " pre true inv true post true" in
let r = rule_of_str s signat [] "rule2" in
assert_equal ~msg:"2. update" ~printer:(fun x->x) s (str r);
- let dyn_eq = " f(a)' = (2. * f(a)) + t;\n f(b)' = f(b)" in
+ let dyn_eq = " :f(a)' = (2. * :f(a)) + t;\n :f(b)' = :f(b)" in
let s = discr ^ "\ndynamics\n" ^ dyn_eq ^ " pre true inv true post true" in
let r = rule_of_str s signat [] "rule3" in
assert_equal ~msg:"3. dynamics" ~printer:(fun x->x) s (str r);
- let dyn_eq = " f(a)' = (2. * f(a)) + t;\n f(b)' = f(b)" in
- let upd_eq = " f(c) = 2. * f(a);\n f(d) = f(b)\n" in
+ let dyn_eq = " :f(a)' = (2. * :f(a)) + t;\n :f(b)' = :f(b)" in
+ let upd_eq = " :f(c) = 2. * :f(a);\n :f(d) = :f(b)\n" in
let s = discr ^ "\ndynamics\n" ^ dyn_eq ^ "\nupdate\n" ^ upd_eq ^
" pre true inv true post true" in
let r = rule_of_str s signat [] "rule4" in
@@ -56,15 +56,15 @@
let r = rule_of_str s signat [] "rule1" in
assert_equal ~msg:"1. no continuous" ~printer:(fun x->x) s (sprint r);
- let upd_eq1 = " f(c) = 2. * f(a);"
- and upd_eq2 = " f(d) = f(b)" in
+ let upd_eq1 = " :f(c) = 2. * :f(a);"
+ and upd_eq2 = " :f(d) = :f(b)" in
let upd_eq = upd_eq1 ^ upd_eq2 in
let s = discr ^ "\n update" ^ upd_eq in
let r = rule_of_str s signat [] "rule2" in
assert_equal ~msg:"2. update" ~printer:(fun x->x) s (sprint r);
- let dyn_eq1 = " f(a)' = 2. * f(a) + t;"
- and dyn_eq2 = " f(b)' = f(b)" in
+ let dyn_eq1 = " :f(a)' = 2. * :f(a) + t;"
+ and dyn_eq2 = " :f(b)' = :f(b)" in
let dyn_eq = dyn_eq1 ^ dyn_eq2 in
let s = discr ^ "\n dynamics" ^ dyn_eq in
let r = rule_of_str s signat [] "rule3" in
@@ -88,8 +88,8 @@
let dr =
"[| P { (a) } | ] -> [| P:1{}; Q { (b) } | ] emb P with [b<-a]" in
let signat = ["P", 1; "Q", 1] in
- let dyn_eq = "x(a)' = x(a) + t" in
- let upd_eq = "x(b) = x(a)" in
+ let dyn_eq = ":x(a)' = :x(a) + t" in
+ let upd_eq = ":x(b) = :x(a)" in
let s = dr ^ " dynamics " ^ dyn_eq ^ " update " ^ upd_eq ^
" pre true inv true post true " in
let struc = struc_of_str "[ | P {a}; Q:1{} | x { a -> 0.0 } ]" in
@@ -107,8 +107,8 @@
(fun () ->
let dr =
"[| P { (a) } | ] -> [| P:1{}; Q { (b) } | ] emb P with [b<-a]" in
- let dyn_eq = "x(a)' = x(a) + t" in
- let upd_eq = "x(b) = x(a)" in
+ let dyn_eq = ":x(a)' = :x(a) + t" in
+ let upd_eq = ":x(b) = :x(a)" in
let s = dr ^ " dynamics " ^ dyn_eq ^ " update " ^ upd_eq ^
" pre true inv true post true " in
let signat = ["P", 1; "Q", 1] in
@@ -140,22 +140,22 @@
(true,"equal")
(ContinuousRule.compare_diff r1 r2);
- let upd_eq = " f(c) = 2. * f(a);\n f(d) = f(b)\n" in
+ let upd_eq = " :f(c) = 2. * :f(a);\n :f(d) = :f(b)\n" in
let s = discr ^ "\nupdate\n" ^ upd_eq ^ " pre true inv true post true" in
let r1 = rule_of_str s signat [] "rule2" in
- let upd_eq = " f(c) = 3. * f(a);\n f(d) = f(b)\n" in
+ let upd_eq = " :f(c) = 3. * :f(a);\n :f(d) = :f(b)\n" in
let s = discr ^ "\nupdate\n" ^ upd_eq ^ " pre true inv true post true" in
let r2 = rule_of_str s signat [] "rule3" in
assert_equal ~printer:(fun (_,x)->x) ~msg:"2. update"
(false,"Rule update functions differ")
(ContinuousRule.compare_diff r1 r2);
- let upd_eq = " f(c) = 2. * f(a);\n f(d) = f(b)\n" in
- let dyn_eq = " f(a)' = (2. * f(a)) + t;\n f(b)' = f(b)" in
+ let upd_eq = " :f(c) = 2. * :f(a);\n :f(d) = :f(b)\n" in
+ let dyn_eq = " :f(a)' = (2. * :f(a)) + t;\n :f(b)' = :f(b)" in
let s = discr ^ "\ndynamics\n" ^ dyn_eq ^ "\nupdate\n" ^ upd_eq ^
" pre true inv true post true" in
let r1 = rule_of_str s signat [] "rule4" in
- let dyn_eq = " f(a)' = (3. * f(a)) + t;\n f(b)' = f(b)" in
+ let dyn_eq = " :f(a)' = (3. * :f(a)) + t;\n :f(b)' = :f(b)" in
let s = discr ^ "\ndynamics\n" ^ dyn_eq ^ "\nupdate\n" ^ upd_eq ^
" pre true inv true post true" in
let r2 = rule_of_str s signat [] "rule5" in
Modified: trunk/Toss/Arena/Term.ml
===================================================================
--- trunk/Toss/Arena/Term.ml 2011-09-12 14:56:02 UTC (rev 1564)
+++ trunk/Toss/Arena/Term.ml 2011-09-12 22:25:10 UTC (rev 1565)
@@ -21,8 +21,8 @@
(* Print a term as a string. *)
let rec str = function
- Var s -> s
- | FVar (f, a) -> f ^ "(" ^ a ^ ")"
+ | Var s -> s
+ | FVar (f, a) -> ":" ^ f ^ "(" ^ a ^ ")"
| Const n -> string_of_float n
| Times (p, q) -> term_pair_str " * " p q
| Plus (p, Times (Const c, q)) when c = -1. -> term_pair_str " - " p q
@@ -41,7 +41,7 @@
(* Print an equation system as a string. *)
-let eq_str ?(diff=false) eqs =
+let eq_str ?(diff=true) eqs =
let sing_str ((f, a), t) =
let mid_str = if diff then "' = " else " = " in
let l_str = str (FVar (f, a)) in
@@ -52,7 +52,7 @@
(* Bracket-savvy precedences: + 0, - 1, * 2, / 3 *)
let rec fprint ?(prec=0) ppf = function
| Var s -> Format.pp_print_string ppf s
- | FVar (f, a) -> Format.fprintf ppf "%s(%s)" f a
+ | FVar (f, a) -> Format.fprintf ppf ":%s(%s)" f a
| Const n -> Format.fprintf ppf "%F" n
| Times (p, q) ->
let lb, rb =
@@ -87,7 +87,7 @@
let fprint_eqs ?(diff=false) ppf eqs =
let sing ppf ((f, a), t) =
let mid_str = if diff then "'" else "" in
- Format.fprintf ppf "@[<1>%s(%s)%s@ =@ @[<1>%a@]@]"
+ Format.fprintf ppf "@[<1>:%s(%s)%s@ =@ @[<1>%a@]@]"
f a mid_str (fprint ~prec:0) t in
Format.fprintf ppf "@[<hv>%a@]" (Aux.fprint_sep_list ";" sing) eqs
Modified: trunk/Toss/Arena/TermParser.mly
===================================================================
--- trunk/Toss/Arena/TermParser.mly 2011-09-12 14:56:02 UTC (rev 1564)
+++ trunk/Toss/Arena/TermParser.mly 2011-09-12 22:25:10 UTC (rev 1565)
@@ -18,8 +18,8 @@
| INT { Term.Const (float_of_int $1) }
| FLOAT { Term.Const ($1) }
| ID { Term.Var ($1) }
- | ID OPEN ID CLOSE { Term.FVar ($1, $3) }
- | ID OPEN INT CLOSE { Term.FVar ($1, string_of_int $3) }
+ | COLON ID OPEN ID CLOSE { Term.FVar ($2, $4) }
+ | COLON ID OPEN INT CLOSE { Term.FVar ($2, string_of_int $4) }
| term_expr FLOAT { Term.Plus ($1, Term.Const $2) } /* in x-1, "-1" is int */
| term_expr INT { Term.Plus ($1, Term.Const (float_of_int $2)) }
| term_expr PLUS term_expr { Term.Plus ($1, $3) }
@@ -29,11 +29,11 @@
| term_expr POW INT { Term.pow $1 $3 }
| OPEN term_expr CLOSE { $2 }
-eq_expr: /* we do not distinguish standard and differential equations here */
- | ID OPEN ID CLOSE EQ term_expr { (($1, $3), $6) }
- | ID OPEN INT CLOSE EQ term_expr { (($1, string_of_int $3), $6) }
- | ID OPEN ID CLOSE APOSTROPHE EQ term_expr { (($1, $3), $7) }
- | ID OPEN INT CLOSE APOSTROPHE EQ term_expr { (($1, string_of_int $3), $7) }
+eq_expr: /* differential equations only */
+ | COLON ID OPEN ID CLOSE APOSTROPHE EQ term_expr
+ { (($2, $4), $8) }
+ | COLON ID OPEN INT CLOSE APOSTROPHE EQ term_expr
+ { (($2, string_of_int $4), $8) }
%public eq_sys:
| eq_expr { [$1] }
Modified: trunk/Toss/Arena/TermTest.ml
===================================================================
--- trunk/Toss/Arena/TermTest.ml 2011-09-12 14:56:02 UTC (rev 1564)
+++ trunk/Toss/Arena/TermTest.ml 2011-09-12 22:25:10 UTC (rev 1565)
@@ -17,10 +17,10 @@
let s = "(x - 0.2) / ((z * y) - 3.)" in
assert_equal ~printer:(fun x->x) s (str (term_of_string s));
- let t0s = "f(a) + t" in
+ let t0s = ":f(a) + t" in
assert_equal ~printer:(fun x->x) t0s (str (term_of_string t0s));
- let eqs = " f(a)' = f(a) + t" in
+ let eqs = " :f(a)' = :f(a) + t" in
assert_equal ~printer:(fun x->x) eqs
(eq_str ~diff:true (eqs_of_string eqs));
@@ -31,10 +31,10 @@
let s = "(x - 0.2) / (z * y - 3.)" in
assert_equal ~printer:(fun x->x) s (sprint (term_of_string s));
- let t0s = "f(a) + t" in
+ let t0s = ":f(a) + t" in
assert_equal ~printer:(fun x->x) t0s (sprint (term_of_string t0s));
- let eqs = "f(a)' = f(a) + t" in
+ let eqs = ":f(a)' = :f(a) + t" in
assert_equal ~printer:(fun x->x) eqs
(sprint_eqs ~diff:true (eqs_of_string eqs));
@@ -42,9 +42,9 @@
"substitute" >::
(fun () ->
- let t0 = term_of_string "f(a) + t" in
+ let t0 = term_of_string ":f(a) + t" in
let t1 = subst ("t", (Const 2.)) t0 in
- assert_equal ~printer:(fun x->x) "f(a) + 2." (str t1);
+ assert_equal ~printer:(fun x->x) ":f(a) + 2." (str t1);
assert_equal ~printer:(fun x->x) "5."
(str (List.hd (subst_simp_f ["f", "a"] [Const 3.] [t1])));
@@ -52,14 +52,14 @@
"rk4" >::
(fun () ->
- let t0 = term_of_string "f(a) + t" in
+ let t0 = term_of_string ":f(a) + t" in
assert_equal ~printer:(fun x->x) "0.005"
(String.sub (str (List.hd (
rk4_step "t" (Const 0.) (Const 0.1)
[("f", "a"), t0] [Const 0.]))) 0 5);
- let eqs = eqs_of_string "f(a)' = f(a) + t" in
+ let eqs = eqs_of_string ":f(a)' = :f(a) + t" in
assert_equal ~printer:(fun x->x) "0.005"
(String.sub (str (List.hd (
rk4_step "t" (Const 0.) (Const 0.1) eqs [Const 0.]))) 0 5);
Modified: trunk/Toss/Formula/Formula.ml
===================================================================
--- trunk/Toss/Formula/Formula.ml 2011-09-12 14:56:02 UTC (rev 1564)
+++ trunk/Toss/Formula/Formula.ml 2011-09-12 22:25:10 UTC (rev 1565)
@@ -222,6 +222,10 @@
and fprint_real_prec prec f = function
| RVar s -> Format.fprintf f "%s" s
| Const fl -> Format.fprintf f "%F" fl
+ | Plus (r1, Times (Const fl, r2)) when fl = -1. -> (* r1 - r2 short *)
+ let lb, rb = if prec > 0 then "(", ")" else "", "" in
+ Format.fprintf f "@[<1>%s%a@ -@ %a%s@]" lb
+ (fprint_real_prec 0) r1 (fprint_real_prec 0) r2 rb
| Times (r1, r2) ->
let lb, rb =
if prec > 2 then "(", ")" else "", "" in
@@ -265,7 +269,7 @@
let fprint_eqs ?(diff=false) ppf eqs =
let sing ppf ((f, a), t) =
let mid_str = if diff then "'" else "" in
- Format.fprintf ppf "@[<1>%s(%s)%s@ =@ @[<1>%a@]@]"
+ Format.fprintf ppf "@[<1>:%s(%s)%s@ =@ @[<1>%a@]@]"
f a mid_str fprint_real t in
Format.fprintf ppf "@[<hv>%a@]" (Aux.fprint_sep_list ";" sing) eqs
Modified: trunk/Toss/Formula/FormulaParser.mly
===================================================================
--- trunk/Toss/Formula/FormulaParser.mly 2011-09-12 14:56:02 UTC (rev 1564)
+++ trunk/Toss/Formula/FormulaParser.mly 2011-09-12 22:25:10 UTC (rev 1565)
@@ -44,6 +44,7 @@
| FLOAT { Const ($1) }
| COLON ID { RVar (":" ^ $2) }
| COLON ID OPEN ID CLOSE { Fun ($2, fo_var_of_s $4) }
+ | COLON ID OPEN INT CLOSE { Fun ($2, fo_var_of_s (string_of_int $4)) }
| real_expr FLOAT { Plus ($1, Const $2) } /* in x-1, "-1" is int */
| real_expr INT { Plus ($1, Const (float_of_int $2)) }
| real_expr PLUS real_expr { Plus ($1, $3) }
@@ -123,11 +124,9 @@
{ Let (rel, args, body, phi) }
-expr_eq_expr: /* we do not distinguish standard and differential equations here */
- | ID OPEN ID CLOSE EQ real_expr { (($1, $3), $6) }
- | ID OPEN INT CLOSE EQ real_expr { (($1, string_of_int $3), $6) }
- | ID OPEN ID CLOSE APOSTROPHE EQ real_expr { (($1, $3), $7) }
- | ID OPEN INT CLOSE APOSTROPHE EQ real_expr { (($1, string_of_int $3), $7) }
+expr_eq_expr: /* only standard equations here for now (no differentials) */
+ | COLON ID OPEN ID CLOSE EQ real_expr { (($2, $4), $7) }
+ | COLON ID OPEN INT CLOSE EQ real_expr { (($2, string_of_int $4), $7) }
%public expr_eq_sys:
| expr_eq_expr { [$1] }
Modified: trunk/Toss/Play/HeuristicTest.ml
===================================================================
--- trunk/Toss/Play/HeuristicTest.ml 2011-09-12 14:56:02 UTC (rev 1564)
+++ trunk/Toss/Play/HeuristicTest.ml 2011-09-12 22:25:10 UTC (rev 1565)
@@ -199,7 +199,7 @@
"of_payoff: tic-tac-toe non monotonic" >::
(fun () ->
assert_eq_str ~msg:"adv_ratio=1.5"
- "Sum (x | P(x) : 0.64 + Sum (y | (R(x, y) and P(y)) : 0.96 + Sum (z | (R(y, z) and P(z)) : 1.44)) + Sum (y | (C(x, y) and P(y)) : 0.96 + Sum (z | (C(y, z) and P(z)) : 1.44)) + Sum (v0 | R(x, v0) : 0.29 + Sum (y | (C(v0, y) and P(y)) : 0.44 + Sum (u0 | R(y, u0) : 0.66 + Sum (z | (C(u0, z) and P(z)) : 1.))) ) + Sum (v | R(x, v) : 0.29 + Sum (y | (C(y, v) and P(y)) : 0.44 + Sum (u | R(y, u) : 0.66 + Sum (z | (C(z, u) and P(z)) : 1.))) ) ) + -1. * Sum (x | Q(x) : 0.64 + Sum (y | (R(x, y) and Q(y)) : 0.96 + Sum (z | (R(y, z) and Q(z)) : 1.44)) + Sum (y | (C(x, y) and Q(y)) : 0.96 + Sum (z | (C(y, z) and Q(z)) : 1.44)) + Sum (v0 | R(x, v0) : 0.29 + Sum (y | (C(v0, y) and Q(y)) : 0.44 + Sum (u0 | R(y, u0) : 0.66 + Sum (z | (C(u0, z) and Q(z)) : 1.)) ) ) + Sum (v | R(x, v) : 0.29 + Sum (y | (C(y, v) and Q(y)) : 0.44 + Sum (u | R(y, u) : 0.66 + Sum (z | (C(z, u) and Q(z)) : 1.))) ) )"
+ "Sum (x | P(x) : 0.64 + Sum (y | (R(x, y) and P(y)) : 0.96 + Sum (z | (R(y, z) and P(z)) : 1.44)) + Sum (y | (C(x, y) and P(y)) : 0.96 + Sum (z | (C(y, z) and P(z)) : 1.44)) + Sum (v0 | R(x, v0) : 0.29 + Sum (y | (C(v0, y) and P(y)) : 0.44 + Sum (u0 | R(y, u0) : 0.66 + Sum (z | (C(u0, z) and P(z)) : 1.))) ) + Sum (v | R(x, v) : 0.29 + Sum (y | (C(y, v) and P(y)) : 0.44 + Sum (u | R(y, u) : 0.66 + Sum (z | (C(z, u) and P(z)) : 1.))) ) ) - Sum (x | Q(x) : 0.64 + Sum (y | (R(x, y) and Q(y)) : 0.96 + Sum (z | (R(y, z) and Q(z)) : 1.44)) + Sum (y | (C(x, y) and Q(y)) : 0.96 + Sum (z | (C(y, z) and Q(z)) : 1.44)) + Sum (v0 | R(x, v0) : 0.29 + Sum (y | (C(v0, y) and Q(y)) : 0.44 + Sum (u0 | R(y, u0) : 0.66 + Sum (z | (C(u0, z) and Q(z)) : 1.))) ) + Sum (v | R(x, v) : 0.29 + Sum (y | (C(y, v) and Q(y)) : 0.44 + Sum (u | R(y, u) : 0.66 + Sum (z | (C(z, u) and Q(z)) : 1.))) ) )"
(Formula.real_str
(Heuristic.map_constants (fun c->(floor (c*.100.))/.100.)
(Heuristic.of_payoff 1.5
@@ -207,7 +207,7 @@
(real_of_str (":("^winPxyz^") - :("^winQxyz^")")))));
assert_eq_str ~msg:"adv_ratio=10"
- "Sum (x | P(x) : 0.0101 + Sum (y | (R(x, y) and P(y)) : 0.101 + Sum (z | (R(y, z) and P(z)) : 1.01)) + Sum (y | (C(x, y) and P(y)) : 0.101 + Sum (z | (C(y, z) and P(z)) : 1.01)) + Sum (v0 | R(x, v0) : 0.001 + Sum (y | (C(v0, y) and P(y)) : 0.01 + Sum (u0 | R(y, u0) : 0.1 + Sum (z | (C(u0, z) and P(z)) : 1.))) ) + Sum (v | R(x, v) : 0.001 + Sum (y | (C(y, v) and P(y)) : 0.01 + Sum (u | R(y, u) : 0.1 + Sum (z | (C(z, u) and P(z)) : 1.))) ) ) + -1. * Sum (x | Q(x) : 0.0101 + Sum (y | (R(x, y) and Q(y)) : 0.101 + Sum (z | (R(y, z) and Q(z)) : 1.01) ) + Sum (y | (C(x, y) and Q(y)) : 0.101 + Sum (z | (C(y, z) and Q(z)) : 1.01) ) + Sum (v0 | R(x, v0) : 0.001 + Sum (y | (C(v0, y) and Q(y)) : 0.01 + Sum (u0 | R(y, u0) : 0.1 + Sum (z | (C(u0, z) and Q(z)) : 1.))) ) + Sum (v | R(x, v) : 0.001 + Sum (y | (C(y, v) and Q(y)) : 0.01 + Sum (u | R(y, u) : 0.1 + Sum (z | (C(z, u) and Q(z)) : 1.))) ) )"
+ "Sum (x | P(x) : 0.0101 + Sum (y | (R(x, y) and P(y)) : 0.101 + Sum (z | (R(y, z) and P(z)) : 1.01)) + Sum (y | (C(x, y) and P(y)) : 0.101 + Sum (z | (C(y, z) and P(z)) : 1.01)) + Sum (v0 | R(x, v0) : 0.001 + Sum (y | (C(v0, y) and P(y)) : 0.01 + Sum (u0 | R(y, u0) : 0.1 + Sum (z | (C(u0, z) and P(z)) : 1.))) ) + Sum (v | R(x, v) : 0.001 + Sum (y | (C(y, v) and P(y)) : 0.01 + Sum (u | R(y, u) : 0.1 + Sum (z | (C(z, u) and P(z)) : 1.))) ) ) - Sum (x | Q(x) : 0.0101 + Sum (y | (R(x, y) and Q(y)) : 0.101 + Sum (z | (R(y, z) and Q(z)) : 1.01)) + Sum (y | (C(x, y) and Q(y)) : 0.101 + Sum (z | (C(y, z) and Q(z)) : 1.01)) + Sum (v0 | R(x, v0) : 0.001 + Sum (y | (C(v0, y) and Q(y)) : 0.01 + Sum (u0 | R(y, u0) : 0.1 + Sum (z | (C(u0, z) and Q(z)) : 1.))) ) + Sum (v | R(x, v) : 0.001 + Sum (y | (C(y, v) and Q(y)) : 0.01 + Sum (u | R(y, u) : 0.1 + Sum (z | (C(z, u) and Q(z)) : 1.))) ) )"
(Formula.real_str
(Heuristic.map_constants (fun c->(floor (c*.10000.))/.10000.)
(Heuristic.of_payoff 10.
@@ -219,7 +219,7 @@
"of_payoff: breakthrough expanded" >::
(fun () ->
assert_eq_str
- "Sum (y8 | W(y8) : 0.05 + Sum (y7 | C(y7, y8) : 0.08 + Sum (y6 | C(y6, y7) : 0.13 + Sum (y5 | C(y5, y6) : 0.19 + Sum (y4 | C(y4, y5) : 0.29 + Sum (y3 | C(y3, y4) : 0.44 + Sum (y2 | C(y2, y3) : 0.66 + Sum (y1 | C(y1, y2) : 1.))) ) ) ) ) ) + -1. * Sum (y1 | B(y1) : 0.05 + Sum (y2 | C(y1, y2) : 0.08 + Sum (y3 | C(y2, y3) : 0.13 + Sum (y4 | C(y3, y4) : 0.19 + Sum (y5 | C(y4, y5) : 0.29 + Sum (y6 | C(y5, y6) : 0.44 + Sum (y7 | C(y6, y7) : 0.66 + Sum (y8 | C(y7, y8) : 1.))) ) ) ) ) )"
+ "Sum (y8 | W(y8) : 0.05 + Sum (y7 | C(y7, y8) : 0.08 + Sum (y6 | C(y6, y7) : 0.13 + Sum (y5 | C(y5, y6) : 0.19 + Sum (y4 | C(y4, y5) : 0.29 + Sum (y3 | C(y3, y4) : 0.44 + Sum (y2 | C(y2, y3) : 0.66 + Sum (y1 | C(y1, y2) : 1.))) ) ) ) ) ) - Sum (y1 | B(y1) : 0.05 + Sum (y2 | C(y1, y2) : 0.08 + Sum (y3 | C(y2, y3) : 0.13 + Sum (y4 | C(y3, y4) : 0.19 + Sum (y5 | C(y4, y5) : 0.29 + Sum (y6 | C(y5, y6) : 0.44 + Sum (y7 | C(y6, y7) : 0.66 + Sum (y8 | C(y7, y8) : 1.))) ) ) ) ) )"
(Formula.real_str
(Heuristic.map_constants (fun c->(floor (c*.100.))/.100.)
(Heuristic.of_payoff 1.5
@@ -227,7 +227,7 @@
(real_of_str (":("^breakW^") - :("^breakB^")")))));
assert_eq_str
- "Sum (y8 | W(y8) : 1e-07 + Sum (y7 | C(y7, y8) : 1e-06 + Sum (y6 | C(y6, y7) : 1e-05 + Sum (y5 | C(y5, y6) : 0.0001 + Sum (y4 | C(y4, y5) : 0.001 + Sum (y3 | C(y3, y4) : 0.01 + Sum (y2 | C(y2, y3) : 0.1 + Sum (y1 | C(y1, y2) : 1.))) ) ) ) ) ) + -1. * Sum (y1 | B(y1) : 1e-07 + Sum (y2 | C(y1, y2) : 1e-06 + Sum (y3 | C(y2, y3) : 1e-05 + Sum (y4 | C(y3, y4) : 0.0001 + Sum (y5 | C(y4, y5) : 0.001 + Sum (y6 | C(y5, y6) : 0.01 + Sum (y7 | C(y6, y7) : 0.1 + Sum (y8 | C(y7, y8) : 1.))) ) ) ) ) )"
+ "Sum (y8 | W(y8) : 1e-07 + Sum (y7 | C(y7, y8) : 1e-06 + Sum (y6 | C(y6, y7) : 1e-05 + Sum (y5 | C(y5, y6) : 0.0001 + Sum (y4 | C(y4, y5) : 0.001 + Sum (y3 | C(y3, y4) : 0.01 + Sum (y2 | C(y2, y3) : 0.1 + Sum (y1 | C(y1, y2) : 1.))) ) ) ) ) ) - Sum (y1 | B(y1) : 1e-07 + Sum (y2 | C(y1, y2) : 1e-06 + Sum (y3 | C(y2, y3) : 1e-05 + Sum (y4 | C(y3, y4) : 0.0001 + Sum (y5 | C(y4, y5) : 0.001 + Sum (y6 | C(y5, y6) : 0.01 + Sum (y7 | C(y6, y7) : 0.1 + Sum (y8 | C(y7, y8) : 1.))) ) ) ) ) )"
(Formula.real_str
(Heuristic.of_payoff 10.
(Aux.strings_of_list ["B"; "W"])
@@ -257,7 +257,7 @@
W..W W..W W..W W..W
\"" in
assert_eq_str
- "Sum (x | W(x) : 1e-07 + Sum (y | C(y, x) : 1e-06 + Sum (y0 | C(y0, y) : 1e-05 + Sum (y1 | C(y1, y0) : 0.0001 + Sum (y2 | C(y2, y1) : 0.001 + Sum (y3 | C(y3, y2) : 0.01 + Sum (y4 | C(y4, y3) : 0.1 + Sum (y5 | C(y5, y4) : 1.))) ) ) ) ) ) + -1. * Sum (x | B(x) : 1e-07 + Sum (y | C(x, y) : 1e-06 + Sum (y0 | C(y, y0) : 1e-05 + Sum (y1 | C(y0, y1) : 0.0001 + Sum (y2 | C(y1, y2) : 0.001 + Sum (y3 | C(y2, y3) : 0.01 + Sum (y4 | C(y3, y4) : 0.1 + Sum (y5 | C(y4, y5) : 1.))) ) ) ) ) )"
+ "Sum (x | W(x) : 1e-07 + Sum (y | C(y, x) : 1e-06 + Sum (y0 | C(y0, y) : 1e-05 + Sum (y1 | C(y1, y0) : 0.0001 + Sum (y2 | C(y2, y1) : 0.001 + Sum (y3 | C(y3, y2) : 0.01 + Sum (y4 | C(y4, y3) : 0.1 + Sum (y5 | C(y5, y4) : 1.))) ) ) ) ) ) - Sum (x | B(x) : 1e-07 + Sum (y | C(x, y) : 1e-06 + Sum (y0 | C(y, y0) : 1e-05 + Sum (y1 | C(y0, y1) : 0.0001 + Sum (y2 | C(y1, y2) : 0.001 + Sum (y3 | C(y2, y3) : 0.01 + Sum (y4 | C(y3, y4) : 0.1 + Sum (y5 | C(y4, y5) : 1.))) ) ) ) ) )"
(Formula.real_str
(Heuristic.of_payoff ~struc:state 10.
(Aux.strings_of_list ["B"; "W"])
@@ -274,14 +274,14 @@
"[a | P:1 {}; Q:1 {} | ] -> [ | P:1 {}; Q(a) | ] emb P, Q"] in
assert_eq_str
- "Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (P(x) or P(y) or P(z)) and (not Q(x) or P(x)) and (not Q(y) or P(y)) and (not Q(z) or P(z))) : (:(P(x)) + :(P(y)) + :(P(z))) * 0.33) + -1. * Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (Q(x) or Q(y) or Q(z)) and (not P(x) or Q(x)) and (not P(y) or Q(y)) and (not P(z) or Q(z))) : (:(Q(x)) + :(Q(y)) + :(Q(z))) * 0.33)"
+ "Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (P(x) or P(y) or P(z)) and (not Q(x) or P(x)) and (not Q(y) or P(y)) and (not Q(z) or P(z))) : (:(P(x)) + :(P(y)) + :(P(z))) * 0.33) - Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (Q(x) or Q(y) or Q(z)) and (not P(x) or Q(x)) and (not P(y) or Q(y)) and (not P(z) or Q(z))) : (:(Q(x)) + :(Q(y)) + :(Q(z))) * 0.33)"
(Formula.real_str
(Heuristic.map_constants (fun c->(floor (c*.100.))/.100.)
(default_heuristic 1. rules
(real_of_str (":("^winPxyz^") - :("^winQxyz^")")))));
assert_eq_str
- "Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (P(x) or P(y) or P(z)) and (not Q(x) or P(x)) and (not Q(y) or P(y)) and (not Q(z) or P(z))) : (:(P(x)) + :(P(y)) + :(P(z))) * (:(P(x)) + :(P(y)) + :(P(z))) * 0.11) + -1. * Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (Q(x) or Q(y) or Q(z)) and (not P(x) or Q(x)) and (not P(y) or Q(y)) and (not P(z) or Q(z))) : (:(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(x)) + :(Q(y)) + :(Q(z))) * 0.11)"
+ "Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (P(x) or P(y) or P(z)) and (not Q(x) or P(x)) and (not Q(y) or P(y)) and (not Q(z) or P(z))) : (:(P(x)) + :(P(y)) + :(P(z))) * (:(P(x)) + :(P(y)) + :(P(z))) * 0.11) - Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (Q(x) or Q(y) or Q(z)) and (not P(x) or Q(x)) and (not P(y) or Q(y)) and (not P(z) or Q(z))) : (:(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(x)) + :(Q(y)) + :(Q(z))) * 0.11)"
(Formula.real_str
(Heuristic.map_constants (fun c->(floor (c*.100.))/.100.)
(default_heuristic 2. rules
@@ -297,14 +297,14 @@
"[a | P:1 {}; Q:1 {} | ] -> [ | P:1 {}; Q(a) | ] emb P, Q"] in
assert_eq_str
- "Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (P(z) or P(y) or P(x) or P(w) or P(v)) and (not Q(z) or P(z)) and (not Q(y) or P(y)) and (not Q(x) or P(x)) and (not Q(w) or P(w)) and (not Q(v) or P(v))) : (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * 0.04 ) + -1. * Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (Q(z) or Q(y) or Q(x) or Q(w) or Q(v)) and (not P(z) or Q(z)) and (not P(y) or Q(y)) and (not P(x) or Q(x)) and (not P(w) or Q(w)) and (not P(v) or Q(v))) : (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * 0.04 )"
+ "Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (P(z) or P(y) or P(x) or P(w) or P(v)) and (not Q(z) or P(z)) and (not Q(y) or P(y)) and (not Q(x) or P(x)) and (not Q(w) or P(w)) and (not Q(v) or P(v))) : (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * 0.04 ) - Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (Q(z) or Q(y) or Q(x) or Q(w) or Q(v)) and (not P(z) or Q(z)) and (not P(y) or Q(y)) and (not P(x) or Q(x)) and (not P(w) or Q(w)) and (not P(v) or Q(v))) : (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * 0.04 )"
(Formula.real_str
((* Heuristic.map_constants (fun c->(floor (c*.100.))/.100.) *)
(default_heuristic 2. rules
(real_of_str (":("^winPvwxyz^") - :("^winQvwxyz^")")))));
assert_eq_str
- "Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (P(z) or P(y) or P(x) or P(w) or P(v)) and (not Q(z) or P(z)) and (not Q(y) or P(y)) and (not Q(x) or P(x)) and (not Q(w) or P(w)) and (not Q(v) or P(v))) : (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * 0.008 ) + -1. * Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (Q(z) or Q(y) or Q(x) or Q(w) or Q(v)) and (not P(z) or Q(z)) and (not P(y) or Q(y)) and (not P(x) or Q(x)) and (not P(w) or Q(w)) and (not P(v) or Q(v))) : (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * 0.008 )"
+ "Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (P(z) or P(y) or P(x) or P(w) or P(v)) and (not Q(z) or P(z)) and (not Q(y) or P(y)) and (not Q(x) or P(x)) and (not Q(w) or P(w)) and (not Q(v) or P(v))) : (:(P(v)) + :(P(w)) + :(P(x)) + :(P...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-13 18:26:45
|
Revision: 1566
http://toss.svn.sourceforge.net/toss/?rev=1566&view=rev
Author: lukstafi
Date: 2011-09-13 17:47:33 +0000 (Tue, 13 Sep 2011)
Log Message:
-----------
GDL translation: transforming original state terms without fluent paths into relations; adding new state terms (therefore elements) with a single coordinate path in case of missing subterms.
Modified Paths:
--------------
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-12 22:25:10 UTC (rev 1565)
+++ trunk/Toss/GGP/GDL.ml 2011-09-13 17:47:33 UTC (rev 1566)
@@ -28,6 +28,12 @@
module Terms = Set.Make (
struct type t = term let compare = Pervasives.compare end)
+let add_terms nvs vs =
+ List.fold_left (fun vs nv -> Terms.add nv vs) vs nvs
+let terms_of_list nvs =
+ add_terms nvs Terms.empty
+
+
module Atoms = Set.Make (
struct type t = rel_atom let compare = Pervasives.compare end)
@@ -480,6 +486,10 @@
Tuples.mem tup (Aux.StrMap.find rel graph)
with Not_found -> false
+let gdl_rel_graph rel graph =
+ try Tuples.elements (Aux.StrMap.find rel graph)
+ with Not_found -> []
+
let instantiate_one tot_base cur_base irules =
Aux.concat_map (function
| (hrel, hargs as head), [], neg_body ->
@@ -829,6 +839,7 @@
cls)
program
+
(* ************************************************************ *)
(* ************************************************************ *)
(** {3 Transformations of GDL clauses: inlining, negation.} *)
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-09-12 22:25:10 UTC (rev 1565)
+++ trunk/Toss/GGP/GDL.mli 2011-09-13 17:47:33 UTC (rev 1566)
@@ -46,6 +46,10 @@
(** game ends here: match id, actions on previous step *)
+module Terms : Set.S with type elt = term
+val add_terms : term list -> Terms.t -> Terms.t
+val terms_of_list : term list -> Terms.t
+
val atoms_of_body : literal list -> atom list
val rel_of_atom : atom -> rel_atom
@@ -80,7 +84,10 @@
module Tuples : Set.S with type elt = term array
type graph = Tuples.t Aux.StrMap.t
val graph_mem : string -> term array -> graph -> bool
+val merge_graphs : graph -> graph -> graph
+val build_graph : rel_atom list -> graph
val graph_to_atoms : graph -> rel_atom list
+val gdl_rel_graph : string -> graph -> term array list
(** Saturation currently exposed for testing purposes. *)
val saturate : graph -> gdl_rule list -> graph
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-09-12 22:25:10 UTC (rev 1565)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-09-13 17:47:33 UTC (rev 1566)
@@ -18,12 +18,6 @@
occur in the structure)
TODO: filter out legal tuples that are not statically satisfiable
-
- TODO: after detecting that some state terms do not have any fluent
- paths in them, eliminate these state terms by performing a GDL
- source-level transformation into relations (i.e. erase the "init"
- and "true" wrappers, and their "next" clauses, which are frame
- clauses)
TODO: perform the argument-path analysis for all GDL relations,
not only future defined relations; if fact-only GDL relations have
@@ -234,7 +228,7 @@
(* Turns out the saturation-based solver is sometimes far better for
performing aggregate playout, which is very much
saturation-like. *)
- let static_rel_defs, nonstatic_rel_defs,
+ let _, _,
static_base, init_state, (agg_actions, agg_states, terminal_state) =
playout_satur ~aggregate:true players !playout_horizon rules in
(* *)
@@ -273,6 +267,51 @@
(List.map GDL.path_str (GDL.paths_to_list f_paths)))
);
(* }}} *)
+ (* Lifting state terms that are not operated-on during game
+ evolution into relations. *)
+ let used_roots = Aux.strings_of_list
+ (Aux.map_some (function Func (f,_),_ -> Some f
+ | _ -> None) move_clauses) in
+ let frame_clauses, unused_roots = Aux.partition_map
+ (function
+ | Func (f, args), _ when not (Aux.Strings.mem f used_roots) ->
+ Aux.Right (f, Array.length args)
+ | fr_cl -> Aux.Left fr_cl) frame_clauses in
+ let arities = Aux.unique_sorted unused_roots @ arities in
+ let unused_roots = Aux.strings_of_list (List.map fst unused_roots) in
+ let static_rels = Aux.Strings.elements unused_roots @ static_rels in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf "create_init_struc:\nused_roots=%s\nunused_roots=%s\nstatic_rels=%s\n%!"
+ (String.concat ", "(Aux.Strings.elements used_roots))
+ (String.concat ", "(Aux.Strings.elements unused_roots))
+ (String.concat ", " static_rels)
+ );
+ (* }}} *)
+ let ground_state_terms = List.filter
+ (function
+ | Func (f, _) when Aux.Strings.mem f unused_roots -> false
+ | _ -> true) ground_state_terms in
+ let more_base = Aux.map_some
+ (function
+ | [|Func (f, args)|] when Aux.Strings.mem f unused_roots ->
+ Some (f, args)
+ | _ -> None)
+ (gdl_rel_graph "init" static_base) in
+ let static_base = merge_graphs (build_graph more_base) static_base in
+ let rec lift_to_rel = function
+ | Pos (True (Func (f, args)))
+ when Aux.Strings.mem f unused_roots -> Pos (Rel (f, args))
+ | Neg (True (Func (f, args)))
+ when Aux.Strings.mem f unused_roots -> Neg (Rel (f, args))
+ | Disj disj -> Disj (List.map lift_to_rel disj)
+ | l -> l in
+ let clauses = List.map
+ (function
+ | ("init", [|Func (f, args)|]), body
+ when Aux.Strings.mem f unused_roots ->
+ (f, args), List.map lift_to_rel body
+ | h, body -> h, List.map lift_to_rel body) clauses in
let element_reps =
Aux.unique_sorted (List.map (fun t ->
simult_subst f_paths blank t) ground_state_terms) in
@@ -306,13 +345,47 @@
(List.map GDL.path_str (GDL.paths_to_list res)))
);
(* }}} *)
- res
+ res
) else c_paths in
let root_reps =
Aux.unique_sorted (List.map (fun t ->
simult_subst c_paths blank t) element_reps) in
+ (* Compute all available subterms to see what subterms are missing
+ among element representants. *)
+ let coord_subterms = List.fold_right add_terms
+ (List.map (at_paths c_paths) element_reps) Terms.empty in
+ (* Now compute what subterms are needed to represent all the
+ relations. *)
+ let needed_coords = List.fold_right add_terms
+ (List.map
+ (fun r-> if r="init" || r="role" then [] else
+ Aux.concat_map Array.to_list
+ (gdl_rel_graph r static_base))
+ static_rels) Terms.empty in
+ let missing_coords =
+ Terms.elements (Terms.diff needed_coords coord_subterms) in
(* {{{ log entry *)
if !debug_level > 2 then (
+ Printf.printf "create_init_struc: missing_coords=%s\n%!"
+ (String.concat ", "(List.map term_str missing_coords))
+ );
+ (* }}} *)
+ let val_elems = List.map
+ (fun subt -> Func ("val_", [|subt|])) missing_coords in
+ let val_path = ["val_", 0] in
+ let term_arities =
+ if val_elems = [] then term_arities
+ else ("val_", 1)::term_arities in
+ let c_paths =
+ if val_elems = [] then c_paths
+ else add_path (fun f->List.assoc f term_arities) val_path c_paths in
+ let element_reps = val_elems @ element_reps in
+ (* let gorund_state_terms = val_elems @ ground_state_terms in *)
+ let root_reps =
+ if val_elems = [] then root_reps
+ else Func ("val_", [|blank|])::root_reps in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
Printf.printf
"create_init_struc: root_reps=\n%s\n%!"
(String.concat ", " (List.map term_str root_reps))
@@ -333,6 +406,12 @@
static_rels in
let struc_rels = "EQ_"::struc_rels in
let defined_rels = defined_rels @ nonstatic_rels in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf "create_init_struc: struc_rels=%s; defined_rels=%s\n%!"
+ (String.concat ", " struc_rels) (String.concat ", " defined_rels)
+ );
+ (* }}} *)
(* we need to expand frame clauses so that later local variables will get
eliminated from erasure clauses *)
let defs = List.filter
@@ -340,8 +419,10 @@
let defs = defs_of_rules (Aux.concat_map rules_of_clause defs) in
let frame_clauses = List.map
(fun (h,body)->("next",[|h|]),body) frame_clauses in
- let frame_defs = List.assoc "next"
- (defs_of_rules (Aux.concat_map rules_of_clause frame_clauses)) in
+ let frame_defs =
+ try List.assoc "next"
+ (defs_of_rules (Aux.concat_map rules_of_clause frame_clauses))
+ with Not_found -> [] in
let frame_defs = expand_definitions defs frame_defs in
let pos = function Distinct _ as a -> Neg a | a -> Pos a in
let neg = function Distinct _ as a -> Pos a | a -> Neg a in
@@ -351,14 +432,8 @@
List.map (fun a->pos (atom_of_rel a)) body @
List.map (fun a->neg (atom_of_rel a)) neg_body)
frame_defs in
- (* {{{ log entry *)
- if !debug_level > 2 then (
- Printf.printf
- "create_init_struc: struc_rels=%s; defined_rels=%s\n%!"
- (String.concat ", " struc_rels) (String.concat ", " defined_rels)
- );
- (* }}} *)
let stable_rels = ref Aux.Strings.empty in
+ (* TODO: OPTIMIZE!!! *)
let struc =
List.fold_left (fun struc rel ->
let arity = List.assoc rel arities in
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-12 22:25:10 UTC (rev 1565)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-13 17:47:33 UTC (rev 1566)
@@ -307,20 +307,16 @@
let a () =
set_debug_level 4;
- game_test_case ~game_name:"breakthrough" ~player:"white"
- ~own_plnum:0 ~opponent_plnum:1
- ~loc0_rule_name:"move_x2_y3_x3_y4_noop"
- ~loc0_emb:[
- "cellholds_x2_y3__BLANK_", "cellholds_2_2__BLANK_";
- "cellholds_x3_y4__BLANK_", "cellholds_1_3__BLANK_";
- "control__BLANK_", "control__BLANK_"]
- ~loc0_move:"(move 2 2 1 3)" ~loc0_noop:"noop" ~loc1:1
- ~loc1_rule_name:"noop_move_x7_y9_x8_y10"
- ~loc1_emb:[
- "cellholds_x7_y9__BLANK_", "cellholds_7_7__BLANK_";
- "cellholds_x8_y10__BLANK_", "cellholds_6_6__BLANK_";
- "control__BLANK_", "control__BLANK_"]
- ~loc1_noop:"noop" ~loc1_move:"(move 7 7 6 6)"
+ 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";
+ "reward_r1_c1_90_90", "reward_r1_c1_90_90"]
+ ~own_move:"r1"
+ ~opp_rule_name:"m2"
+ ~opp_emb:["did__BLANK__m2", "did__BLANK__c1";
+ "reward_r1_c1_90_90", "reward_r1_c1_90_90"]
+ ~opp_move:"c1"
let a () =
Modified: trunk/Toss/www/reference/reference.tex
===================================================================
--- trunk/Toss/www/reference/reference.tex 2011-09-12 22:25:10 UTC (rev 1565)
+++ trunk/Toss/www/reference/reference.tex 2011-09-13 17:47:33 UTC (rev 1566)
@@ -2167,12 +2167,13 @@
(including both the heads $(R \ t^j_1 \ldots t^j_n)$, and inside of
$b_j$ above) be $\calR=\big\{(R \ r^1_1 \ldots r^1_n),\ldots,(R \
r^K_1 \ldots r^K_n)\big\}$. Based on $\calR$ we will find a partition
-of argument positions and an assignment of coordinate paths to positions
-$(a_1,p_1),\ldots,(a_n,p_n)$ such that $a_1=1$, $a_{i+1}-a_i \in \{0,1\}$, for any partition $\calI = \{i
-\ | \ a_i = I\}$, the paths $(p_i \ | \ i \in \calI)$ are distinct and
-do not conflict, \ie $(\exists s) (\forall p_i \ | \ i \in \calI) \
-s\tpos_{p_i}$. GDL arguments of a single partition will be passed as a
-single defined relation argument.
+of argument positions and an assignment of coordinate paths to
+positions $(a_1,p_1),\ldots,(a_n,p_n)$ such that $a_1=1$,
+$\{a_1,\ldots,a_n\} = \{1,2,\ldots,\max\{a_1,\ldots,a_n\}\}$, for any
+partition $\calI = \{i \ | \ a_i = I\}$, the paths $(p_i \ | \ i \in
+\calI)$ are distinct and do not conflict, \ie $(\exists s) (\forall
+p_i \ | \ i \in \calI) \ s\tpos_{p_i}$. GDL arguments of a single
+partition will be passed as a single defined relation argument.
To find the paths and the partition, consider a clause body
$\mathtt{b}$, any occurrence of relation $R$ atom $(R \ r^j_1 \ldots
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-09-14 01:01:00
|
Revision: 1567
http://toss.svn.sourceforge.net/toss/?rev=1567&view=rev
Author: lukaszkaiser
Date: 2011-09-14 01:00:51 +0000 (Wed, 14 Sep 2011)
Log Message:
-----------
Moving translate examples testing to OUnit, correcting parsing, adding timeouts and new examples.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/GDLParser.mly
trunk/Toss/GGP/KIFLexer.mll
trunk/Toss/GGP/Makefile
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGame.mli
trunk/Toss/GGP/TranslateGameTest.ml
Added Paths:
-----------
trunk/Toss/GGP/examples/ad_game_2x2.gdl
trunk/Toss/GGP/examples/aipsrovers01.gdl
trunk/Toss/GGP/examples/asteroids.gdl
trunk/Toss/GGP/examples/asteroidsparallel.gdl
trunk/Toss/GGP/examples/asteroidsserial.gdl
Removed Paths:
-------------
trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.1.qdimacs.SAT.gdl
trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.1.qdimacs.viz.SAT.gdl
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/Formula/Aux.ml 2011-09-14 01:00:51 UTC (rev 1567)
@@ -691,6 +691,11 @@
with End_of_file -> ());
Buffer.contents buf
+let list_dir dirname =
+ let files, dir_handle = (ref [], Unix.opendir dirname) in
+ let rec add () = files := (Unix.readdir dir_handle) :: !files; add () in
+ try add () with End_of_file -> Unix.closedir dir_handle; !files
+
let is_space c =
c = '\n' || c = '\r' || c = ' ' || c = '\t'
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/Formula/Aux.mli 2011-09-14 01:00:51 UTC (rev 1567)
@@ -332,6 +332,9 @@
(** Input a file to a string. *)
val input_file : in_channel -> string
+(** List the contents of a directory *)
+val list_dir : string -> string list
+
(** Extracting the [Content-length] field and input the content of
an HTTP message. Return the pair: header first, content next. *)
val input_http_message : in_channel -> string * string * (string * string) list
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/GDL.ml 2011-09-14 01:00:51 UTC (rev 1567)
@@ -12,6 +12,13 @@
let debug_level = ref 0
let playout_fixpoint = ref true
+(** Timeout functions *)
+let timeout = ref (fun () -> false)
+let set_timeout f = timeout := f
+let check_timeout ?(print=true) msg =
+ if print && !debug_level > 1 then print_endline ("TimeoutCheck: " ^ msg);
+ if !timeout () then (timeout := (fun () -> false); raise (Aux.Timeout msg))
+
type term =
| Const of string
| Var of string
@@ -675,6 +682,7 @@
cls
let rec run_clauses a p sc fc sb =
+ check_timeout ~print:false "GDL: run_clauses";
match a with
| Distinct ts ->
(try
@@ -828,6 +836,7 @@
| Disj disj as l ->
List.fold_left (+) 0 (List.map (fst -| branching_f) disj), l
| _ -> assert false in
+ check_timeout ~print:false "GDL: optimize_goal";
let posi = List.map branching_f posi in
let posi = List.sort (fun (i,_) (j,_) -> i-j) posi in
ground @ unif @ List.map snd posi @ nega
@@ -1160,6 +1169,7 @@
let playout_satur ~aggregate players horizon rules =
(* separate and precompute the static part *)
let rec separate static_rels state_rels =
+ check_timeout "GDL: playout_satur: separate";
let static, more_state =
List.partition (fun rel ->
List.for_all (fun ((rule,_), body, neg_body) ->
@@ -1183,6 +1193,7 @@
(* head, body, [] *)
| rule -> rule) dynamic_rules in
let rec loop actions_accu state_accu step state =
+ check_timeout ("GDL: playout_satur: loop step " ^ (string_of_int step));
(* {{{ log entry *)
if !debug_level > 0 then (
Printf.printf "playout: step %d...\n%!" step
@@ -1327,6 +1338,7 @@
Printf.printf "playout_prolog: step %d...\n%!" step
);
(* }}} *)
+ check_timeout ("GDL: playout_prolog: step " ^ (string_of_int step));
(let try actions, next =
ply_prolog ~aggregate players state program in
(* {{{ log entry *)
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/GDL.mli 2011-09-14 01:00:51 UTC (rev 1567)
@@ -3,6 +3,7 @@
val debug_level : int ref
val playout_fixpoint : bool ref
+val set_timeout : (unit -> bool) -> unit
(** {3 Datalog programs: Type definitions and saturation.} *)
Modified: trunk/Toss/GGP/GDLParser.mly
===================================================================
--- trunk/Toss/GGP/GDLParser.mly 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/GDLParser.mly 2011-09-14 01:00:51 UTC (rev 1567)
@@ -9,9 +9,8 @@
%token <string> SEQVAR
%token OPEN CLOSE COMMA QUOTE BACKQUOTE DBLQUOTE SHARP DOT
%token NOT_EQ NOT AND OR IMPL REVIMPL EQUIV LISTOF SETOF QUOTE_KWD
-%token IF COND THE SETOFALL KAPPA LAMBDA RULE_RIGHT RULE_LEFT CONSIS
-%token DEFOBJECT DEFUNCTION DEFRELATION ASSIGN ASSIGN_IMPLIES ASSIGN_AND
-%token FORALL EXISTS EOF
+%token IF COND SETOFALL KAPPA LAMBDA RULE_RIGHT RULE_LEFT CONSIS
+%token DEFOBJECT DEFUNCTION DEFRELATION ASSIGN ASSIGN_IMPLIES ASSIGN_AND EOF
%start parse_game_description parse_request parse_term parse_literal_list
Modified: trunk/Toss/GGP/KIFLexer.mll
===================================================================
--- trunk/Toss/GGP/KIFLexer.mll 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/KIFLexer.mll 2011-09-14 01:00:51 UTC (rev 1567)
@@ -36,8 +36,6 @@
| ASSIGN
| ASSIGN_IMPLIES
| ASSIGN_AND
- | FORALL
- | EXISTS
| EOF
let reset_as_file lexbuf s =
@@ -123,8 +121,6 @@
| "IF" { IF }
| "cond" { COND }
| "COND" { COND }
- | "the" { THE }
- | "THE" { THE }
| "setofall" { SETOFALL }
| "SETOFALL" { SETOFALL }
| "kappa" { KAPPA }
@@ -144,10 +140,6 @@
| ":=" { ASSIGN }
| ":=>" { ASSIGN_IMPLIES }
| ":&" { ASSIGN_AND }
- | "forall" { FORALL }
- | "FORALL" { FORALL }
- | "exists" { EXISTS }
- | "EXISTS" { EXISTS }
| ['!' '$' '%' '&' '*' '+' '-' '/' '0'-'9' ':' '<' '>'
'A'-'Z' '[' ']' '^' '_' 'a'-'z' '{' '|' '}' '~'] as s
{WORD (Char.escaped s)}
Modified: trunk/Toss/GGP/Makefile
===================================================================
--- trunk/Toss/GGP/Makefile 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/Makefile 2011-09-14 01:00:51 UTC (rev 1567)
@@ -42,7 +42,9 @@
@-ulimit -t $(TESTTIME); ../TranslateGameTest.native -v -f $< > /dev/null
@echo ''
-translate_all: $(addsuffix .translate, $(GDL_GAMES))
+translate_all:
+ make -C .. GGP/TranslateGameTest.native
+ ../TranslateGameTest.native -t examples/ -s $(TESTTIME)
.PHONY: clean
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-09-14 01:00:51 UTC (rev 1567)
@@ -35,6 +35,14 @@
let debug_level = ref 0
let generate_test_case = ref None
+(** Timeout functions *)
+let timeout = ref (fun () -> false)
+let set_timeout f = (timeout := f; GDL.set_timeout f)
+let check_timeout ?(print=true) msg =
+ if print && !debug_level > 1 then print_endline ("TimeoutCheck: " ^ msg);
+ if !timeout () then (timeout := (fun () -> false); raise (Aux.Timeout msg))
+
+
(** Refine fluent paths to always point to some leaf, keeping the same
coverage of leafs on all ground state terms. *)
let refine_leaf_f_paths = ref false
@@ -242,6 +250,7 @@
Aux.sorted_merge (Aux.unique_sorted st) acc) []
(terminal_state::agg_states) in
let init_state = List.hd agg_states in
+ check_timeout "TranslateGame: create_init_struc: init_state";
let arities =
("EQ_", 2)::
Aux.unique_sorted
@@ -575,6 +584,7 @@
| Pos (Does (dp, d)) when dp = p -> Some d
| _ -> None) body in
let sb = unify_all sb djs in
+ check_timeout ~print:false "TranslateGame: move_tuples: does_facts: sb";
let d =
match djs with
| [] ->
@@ -583,9 +593,9 @@
| d::_ -> subst sb d in
sb, d::dis
) players ([], []) in
+ check_timeout "TranslateGame: move_tuples: start";
let next_cls =
- if mode = `Environment
- then
+ if mode = `Environment then
Aux.map_some (fun (_,_,body as cl) ->
if List.exists
(function Pos (Does _) | Neg (Does _) -> true | _ -> false) body
@@ -598,6 +608,7 @@
subst_fnextcl sb cl, ds) next_cls in
(* selecting $\ol{\calC},\ol{\calN}$ clauses with
$\sigma_{\ol{\calC},\ol{\calN}}$ applied *)
+ check_timeout "TranslateGame: move_tuples: next_cls";
let tup_unifies ts1 ts2 =
try ignore (unify [] ts1 ts2); true
with Not_found -> false in
@@ -625,6 +636,7 @@
| _, [] -> assert false in
let cl_tups =
coverage (next_clauses, [[], cs, []]) in
+ check_timeout "TranslateGame: move_tuples: cl_tups";
let maximality cl_tup =
List.fold_left (fun (sb, tup_ds, n_cls as cl_tup) (n_cl, ds) ->
if List.mem n_cl n_cls then cl_tup
@@ -658,6 +670,7 @@
let add_erasure_clauses f_paths (legal_tup, next_cls) =
let fixed_vars = terms_vars (Aux.array_map_of_list fst legal_tup) in
+ check_timeout "TranslateGame: add_erasure_clauses: start";
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf "add_erasure_clauses: fixed_vars=%s\n%!"
@@ -692,6 +705,7 @@
| (s, body)::more_cls, [] ->
coverage (more_cls, [[], s, [body]]) in
let frames = coverage (frame_cls, []) in
+ check_timeout "TranslateGame: add_erasure_clauses: basic frames";
let maximality frame =
List.fold_left (fun (sb, s_acc, bodies as frame) (s, body) ->
if List.mem body bodies then frame
@@ -712,7 +726,8 @@
List.filter
(function Pos (True t) when t=s -> false | _ -> true) body in
List.map (fun (s, bodies) ->
- s, List.map (filter_out s) bodies) frames in
+ s, List.map (filter_out s) bodies) frames in
+ check_timeout "TranslateGame: add_erasure_clauses: frames filtered";
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf "add_erasure_clauses: frames --\n%!";
@@ -1119,6 +1134,7 @@
num_not_noops = 1
|| (num_not_noops = 0 && not !noops_not_moves))
legal_tuples in
+ check_timeout "TranslateGame: turnbased_rule_cases: legal tuples";
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf "turnbased_rule_cases: legal_tuples --\n%!";
@@ -1131,6 +1147,7 @@
let move_tups =
process_rule_cands
used_vars f_paths next_cls `General players legal_tuples in
+ check_timeout "TranslateGame: turnbased_rule_cases: processed rule cands";
let rules = Aux.concat_map
(add_legal_cond counters num_functors static_rels
testground program playout_states) move_tups in
@@ -1154,6 +1171,7 @@
used_vars f_paths next_cls `Concurrent [player] legal_tuples in
player, move_tups
) players legal_by_player in
+ check_timeout "TranslateGame: concurrent_rule_cases";
let player_rules = List.map
(fun (player, move_tups) ->
player, Aux.concat_map
@@ -2019,15 +2037,21 @@
| _ -> None
) clauses in
let players = Array.of_list players in
+ check_timeout "TranslateGame: players";
let program = preprocess_program clauses in
+ check_timeout "TranslateGame: preprocessed clauses";
let init_state = List.map (fun (_,args) -> args.(0))
(run_prolog_atom ("init", [|Var "x"|]) program) in
+ check_timeout "TranslateGame: init_state";
let testground =
replace_rel_in_program "true" (state_cls init_state) program in
+ check_timeout "TranslateGame: testground";
let program = optimize_program ~testground program in
+ check_timeout "TranslateGame: optimized program";
let playout_states = generate_playout_states program players in
(* We also detect and remove the goal clauses that use counters to
determine values, not to expand their goal value variables later. *)
+ check_timeout "TranslateGame: generated playout";
let counter_inits, counter_cls, goal_cls_w_counters,
num_functions, clauses = detect_counters clauses in
(* {{{ log entry *)
@@ -2047,6 +2071,7 @@
let clauses = ground_goal_values ground_state_terms clauses in
(* Now, we can add back the separated clauses. *)
let clauses = counter_cls @ goal_cls_w_counters @ clauses in
+ check_timeout "TranslateGame: basic clauses";
let ground_at paths = List.map
(fun p ->
p, Aux.unique_sorted
@@ -2060,6 +2085,7 @@
else body in
let clauses =
GDL.ground_vars_at_paths prepare_lits ground_at_f_paths clauses in
+ check_timeout "TranslateGame: clauses";
let defined_rels = Aux.list_diff defined_rels
["goal"; "legal"; "next"] in
let defined_rels, clauses = elim_ground_args defined_rels clauses in
@@ -2069,6 +2095,7 @@
| ("next",[|s_C|]),body_C -> Some (s_C, false, body_C)
| _ -> None)
clauses in
+ check_timeout "TranslateGame: defined rels";
(* For determining turn-based we can use the original program, but
for filtering the rule candidates we need the transformed
clauses. We restore the frame clauses. *)
@@ -2090,12 +2117,14 @@
replace_rel_in_program "true" (state_cls init_state) program in
let static_rels, nonstatic_rels =
static_rels (defs_of_rules (Aux.concat_map rules_of_clause clauses)) in
+ check_timeout "TranslateGame: static rels";
let counters = List.map fst counter_inits
and num_functors = List.map fst num_functions in
let rule_cands, is_concurrent =
create_rule_cands counters num_functors static_rels turn_data
used_vars f_paths
testground program playout_states next_cls clauses in
+ check_timeout "TranslateGame: first rule cands";
(* optimize candidates for fast pruning *)
let rule_cands =
let process cands = List.map
Modified: trunk/Toss/GGP/TranslateGame.mli
===================================================================
--- trunk/Toss/GGP/TranslateGame.mli 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/TranslateGame.mli 2011-09-14 01:00:51 UTC (rev 1567)
@@ -1,6 +1,7 @@
(** Local level of logging. *)
val debug_level : int ref
val generate_test_case : string option ref
+val set_timeout : (unit -> bool) -> unit
(** two heuristics for selecting defined relations: select relations
with arity smaller than three; or, select relations that have ground
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-14 01:00:51 UTC (rev 1567)
@@ -362,6 +362,34 @@
(* failwith "generated"; *)
()
+let translate_file fname =
+ try
+ let descr = load_rules fname in
+ let gdl_data, result =
+ TranslateGame.translate_game ~playing_as:(GDL.Const "") descr in
+ (true, Arena.state_str result)
+ with
+ | Aux.Timeout msg -> (false, "Timeout: " ^ msg)
+ | _ -> (false, "Failed")
+
+let translate_dir_tests dirname timeout =
+ let is_gdl fn = (String.length fn > 4) &&
+ String.sub fn ((String.length fn) - 4) 4 = ".gdl" in
+ let files = List.sort compare (List.filter is_gdl (Aux.list_dir dirname)) in
+ let mk_tst fname =
+ (fname ^ " (" ^ (string_of_int timeout) ^ "s)") >::
+ (fun () ->
+ let start = Unix.gettimeofday () in
+ TranslateGame.set_timeout
+ (fun () -> Unix.gettimeofday() -. start > float (timeout));
+ let res, msg = translate_file (dirname ^ fname) in
+ let t = Unix.gettimeofday() -. start in
+ let final = if res then Printf.sprintf "Suceeded (%f sec.)\n%!" t else
+ Printf.sprintf "%s (%f sec)\n%!" msg t in
+ assert_bool final res
+ ) in
+ ("TranslateGame " ^ dirname) >::: (List.map mk_tst files)
+
let exec () =
Aux.run_test_if_target "TranslateGameTest"
("TranslateGame" >::: [tests; bigtests])
@@ -369,17 +397,20 @@
let main () =
Aux.set_optimized_gc ();
- let (file) = (ref "") in
+ let (file, testdir, timeout) = (ref "", ref "", ref 45) in
let opts = [
("-v", Arg.Unit (fun () -> set_debug_level 1), "be verbose");
("-d", Arg.Int (fun i -> set_debug_level i), "set debug level");
("-f", Arg.String (fun s -> file := s), "process file");
+ ("-t", Arg.String (fun s -> testdir:= s), "run all tests from a directory");
+ ("-s", Arg.Int (fun i -> timeout := i), "set timeout for tests (seconds)");
] in
Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
- if !file = "" then exec () else
- let descr = load_rules !file in
- let gdl_data, result =
- TranslateGame.translate_game ~playing_as:(GDL.Const "") descr in
- print_endline (Arena.state_str result)
+ if !file <> "" then
+ print_endline (snd (translate_file !file))
+ else if !testdir <> "" then
+ Aux.run_test_if_target "TranslateGameTest"
+ (translate_dir_tests !testdir !timeout)
+ else exec ()
let _ = Aux.run_if_target "TranslateGameTest" main
Deleted: trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.1.qdimacs.SAT.gdl
===================================================================
--- trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.1.qdimacs.SAT.gdl 2011-09-13 17:47:33 UTC (rev 1566)
+++ trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.1.qdimacs.SAT.gdl 2011-09-14 01:00:51 UTC (rev 1567)
@@ -1,578 +0,0 @@
-(contains 1 (not 1))
-(contains 1 52)
-(contains 1 16)
-(contains 1 4)
-(contains 1 (not 27))
-(contains 2 (not 27))
-(contains 2 (not 51))
-(contains 2 19)
-(contains 2 1)
-(contains 2 30)
-(contains 3 35)
-(contains 3 52)
-(contains 3 (not 41))
-(contains 3 (not 18))
-(contains 3 (not 59))
-(contains 4 24)
-(contains 4 30)
-(contains 4 20)
-(contains 4 (not 7))
-(contains 4 (not 23))
-(contains 5 (not 34))
-(contains 5 (not 4))
-(contains 5 13)
-(contains 5 (not 49))
-(contains 5 (not 17))
-(contains 6 51)
-(contains 6 (not 37))
-(contains 6 1)
-(contains 6 5)
-(contains 6 (not 29))
-(contains 7 (not 2))
-(contains 7 (not 7))
-(contains 7 (not 53))
-(contains 7 (not 12))
-(contains 7 (not 35))
-(contains 8 (not 39))
-(contains 8 (not 44))
-(contains 8 28)
-(contains 8 (not 2))
-(contains 8 51)
-(contains 9 (not 21))
-(contains 9 (not 11))
-(contains 9 8)
-(contains 9 (not 20))
-(contains 9 2)
-(contains 10 (not 37))
-(contains 10 (not 21))
-(contains 10 58)
-(contains 10 (not 59))
-(contains 10 7)
-(contains 11 33)
-(contains 11 59)
-(contains 11 (not 41))
-(contains 11 52)
-(contains 11 21)
-(contains 12 43)
-(contains 12 35)
-(contains 12 (not 7))
-(contains 12 33)
-(contains 12 50)
-(contains 13 29)
-(contains 13 45)
-(contains 13 (not 14))
-(contains 13 25)
-(contains 13 24)
-(contains 14 (not 21))
-(contains 14 54)
-(contains 14 49)
-(contains 14 2)
-(contains 14 42)
-(contains 15 (not 25))
-(contains 15 7)
-(contains 15 (not 43))
-(contains 15 (not 39))
-(contains 15 59)
-(contains 16 32)
-(contains 16 (not 30))
-(contains 16 14)
-(contains 16 17)
-(contains 16 51)
-(contains 17 (not 9))
-(contains 17 44)
-(contains 17 (not 3))
-(contains 17 4)
-(contains 17 (not 54))
-(contains 18 (not 46))
-(contains 18 48)
-(contains 18 55)
-(contains 18 (not 6))
-(contains 18 59)
-(contains 19 51)
-(contains 19 (not 12))
-(contains 19 1)
-(contains 19 52)
-(contains 19 58)
-(contains 20 (not 8))
-(contains 20 47)
-(contains 20 19)
-(contains 20 (not 42))
-(contains 20 (not 12))
-(contains 21 (not 39))
-(contains 21 11)
-(contains 21 1)
-(contains 21 (not 41))
-(contains 21 (not 31))
-(contains 22 (not 26))
-(contains 22 34)
-(contains 22 9)
-(contains 22 (not 35))
-(contains 22 41)
-(contains 23 54)
-(contains 23 26)
-(contains 23 (not 47))
-(contains 23 31)
-(contains 23 (not 36))
-(contains 24 (not 15))
-(contains 24 (not 60))
-(contains 24 (not 13))
-(contains 24 6)
-(contains 24 47)
-(contains 25 (not 21))
-(contains 25 (not 10))
-(contains 25 26)
-(contains 25 33)
-(contains 25 15)
-(contains 26 (not 20))
-(contains 26 11)
-(contains 26 49)
-(contains 26 12)
-(contains 26 (not 41))
-(contains 27 (not 3))
-(contains 27 53)
-(contains 27 15)
-(contains 27 (not 23))
-(contains 27 58)
-(contains 28 (not 3))
-(contains 28 (not 48))
-(contains 28 (not 21))
-(contains 28 59)
-(contains 28 46)
-(contains 29 28)
-(contains 29 25)
-(contains 29 (not 10))
-(contains 29 18)
-(contains 29 4)
-(contains 30 (not 55))
-(contains 30 7)
-(contains 30 (not 44))
-(contains 30 22)
-(contains 30 (not 32))
-(contains 31 (not 12))
-(contains 31 (not 35))
-(contains 31 (not 48))
-(contains 31 (not 14))
-(contains 31 (not 39))
-(contains 32 13)
-(contains 32 (not 45))
-(contains 32 49)
-(contains 32 (not 35))
-(contains 32 60)
-(contains 33 (not 60))
-(contains 33 27)
-(contains 33 (not 19))
-(contains 33 (not 25))
-(contains 33 29)
-(contains 34 (not 12))
-(contains 34 43)
-(contains 34 3)
-(contains 34 (not 5))
-(contains 34 30)
-(contains 35 (not 9))
-(contains 35 50)
-(contains 35 (not 19))
-(contains 35 (not 59))
-(contains 35 (not 2))
-(contains 36 (not 20))
-(contains 36 14)
-(contains 36 (not 58))
-(contains 36 (not 12))
-(contains 36 (not 34))
-(contains 37 22)
-(contains 37 (not 16))
-(contains 37 (not 4))
-(contains 37 (not 14))
-(contains 37 52)
-(contains 38 (not 45))
-(contains 38 (not 13))
-(contains 38 47)
-(contains 38 (not 12))
-(contains 38 15)
-(contains 39 (not 50))
-(contains 39 60)
-(contains 39 9)
-(contains 39 (not 4))
-(contains 39 18)
-(contains 40 (not 10))
-(contains 40 (not 54))
-(contains 40 (not 15))
-(contains 40 47)
-(contains 40 (not 22))
-(prop_var 1)
-(prop_var 2)
-(prop_var 3)
-(prop_var 4)
-(prop_var 5)
-(prop_var 6)
-(prop_var 7)
-(prop_var 8)
-(prop_var 9)
-(prop_var 10)
-(prop_var 11)
-(prop_var 12)
-(prop_var 13)
-(prop_var 14)
-(prop_var 15)
-(prop_var 16)
-(prop_var 17)
-(prop_var 18)
-(prop_var 19)
-(prop_var 20)
-(prop_var 21)
-(prop_var 22)
-(prop_var 23)
-(prop_var 24)
-(prop_var 25)
-(prop_var 26)
-(prop_var 27)
-(prop_var 28)
-(prop_var 29)
-(prop_var 30)
-(prop_var 31)
-(prop_var 32)
-(prop_var 33)
-(prop_var 34)
-(prop_var 35)
-(prop_var 36)
-(prop_var 37)
-(prop_var 38)
-(prop_var 39)
-(prop_var 40)
-(prop_var 41)
-(prop_var 42)
-(prop_var 43)
-(prop_var 44)
-(prop_var 45)
-(prop_var 46)
-(prop_var 47)
-(prop_var 48)
-(prop_var 49)
-(prop_var 50)
-(prop_var 51)
-(prop_var 52)
-(prop_var 53)
-(prop_var 54)
-(prop_var 55)
-(prop_var 56)
-(prop_var 57)
-(prop_var 58)
-(prop_var 59)
-(prop_var 60)
-(clause 1)
-(clause 2)
-(clause 3)
-(clause 4)
-(clause 5)
-(clause 6)
-(clause 7)
-(clause 8)
-(clause 9)
-(clause 10)
-(clause 11)
-(clause 12)
-(clause 13)
-(clause 14)
-(clause 15)
-(clause 16)
-(clause 17)
-(clause 18)
-(clause 19)
-(clause 20)
-(clause 21)
-(clause 22)
-(clause 23)
-(clause 24)
-(clause 25)
-(clause 26)
-(clause 27)
-(clause 28)
-(clause 29)
-(clause 30)
-(clause 31)
-(clause 32)
-(clause 33)
-(clause 34)
-(clause 35)
-(clause 36)
-(clause 37)
-(clause 38)
-(clause 39)
-(clause 40)
-(role exists)
-(role forall)
-(truth_value t)
-(truth_value f)
-(init (control exists 1))
-(<= (legal ?v5689 (assign ?v5699 ?v5700)) (true (control ?v5689 ?v5699)) (role ?v5689) (prop_var ?v5699) (truth_value ?v5700))
-(<= (legal exists noop) (true (control forall ?v5735)) (prop_var ?v5735))
-(<= (legal forall noop) (true (control exists ?v5735)) (prop_var ?v5735))
-(<= (next (sat ?v5759)) (true (sat ?v5759)) (clause ?v5759))
-(<= (next (control exists 2)) (true (control exists 1)))
-(<= (next (control exists 3)) (true (control exists 2)))
-(<= (next (control exists 4)) (true (control exists 3)))
-(<= (next (control exists 5)) (true (control exists 4)))
-(<= (next (control exists 6)) (true (control exists 5)))
-(<= (next (control exists 7)) (true (control exists 6)))
-(<= (next (control exists 8)) (true (control exists 7)))
-(<= (next (control exists 9)) (true (control exists 8)))
-(<= (next (control exists 10)) (true (control exists 9)))
-(<= (next (control exists 11)) (true (control exists 10)))
-(<= (next (control exists 12)) (true (control exists 11)))
-(<= (next (control exists 13)) (true (control exists 12)))
-(<= (next (control exists 14)) (true (control exists 13)))
-(<= (next (control exists 15)) (true (control exists 14)))
-(<= (next (control exists 16)) (true (control exists 15)))
-(<= (next (control exists 17)) (true (control exists 16)))
-(<= (next (control exists 18)) (true (control exists 17)))
-(<= (next (control exists 19)) (true (control exists 18)))
-(<= (next (control exists 20)) (true (control exists 19)))
-(<= (next (control forall 21)) (true (control exists 20)))
-(<= (next (control forall 22)) (true (control forall 21)))
-(<= (next (control forall 23)) (true (control forall 22)))
-(<= (next (control forall 24)) (true (control forall 23)))
-(<= (next (control forall 25)) (true (control forall 24)))
-(<= (next (control forall 26)) (true (control forall 25)))
-(<= (next (control forall 27)) (true (control forall 26)))
-(<= (next (control forall 28)) (true (control forall 27)))
-(<= (next (control forall 29)) (true (control forall 28)))
-(<= (next (control forall 30)) (true (control forall 29)))
-(<= (next (control forall 31)) (true (control forall 30)))
-(<= (next (control forall 32)) (true (control forall 31)))
-(<= (next (control forall 33)) (true (control forall 32)))
-(<= (next (control forall 34)) (true (control forall 33)))
-(<= (next (control forall 35)) (true (control forall 34)))
-(<= (next (control forall 36)) (true (control forall 35)))
-(<= (next (control forall 37)) (true (control forall 36)))
-(<= (next (control forall 38)) (true (control forall 37)))
-(<= (next (control forall 39)) (true (control forall 38)))
-(<= (next (control forall 40)) (true (control forall 39)))
-(<= (next (control exists 41)) (true (control forall 40)))
-(<= (next (control exists 42)) (true (control exists 41)))
-(<= (next (control exists 43)) (true (control exists 42)))
-(<= (next (control exists 44)) (true (control exists 43)))
-(<= (next (control exists 45)) (true (control exists 44)))
-(<= (next (control exists 46)) (true (control exists 45)))
-(<= (next (control exists 47)) (true (control exists 46)))
-(<= (next (control exists 48)) (true (control exists 47)))
-(<= (next (control exists 49)) (true (control exists 48)))
-(<= (next (control exists 50)) (true (control exists 49)))
-(<= (next (control exists 51)) (true (control exists 50)))
-(<= (next (control exists 52)) (true (control exists 51)))
-(<= (next (control exists 53)) (true (control exists 52)))
-(<= (next (control exists 54)) (true (control exists 53)))
-(<= (next (control exists 55)) (true (control exists 54)))
-(<= (next (control exists 56)) (true (control exists 55)))
-(<= (next (control exists 57)) (true (control exists 56)))
-(<= (next (control exists 58)) (true (control exists 57)))
-(<= (next (control exists 59)) (true (control exists 58)))
-(<= (next (control exists 60)) (true (control exists 59)))
-(<= (next (control the end)) (true (control exists 60)))
-(<= (next (sat 1)) (does ?v9608 (assign 1 f)) (role ?v9608))
-(<= (next (sat 1)) (does ?v9629 (assign 52 t)) (role ?v9629))
-(<= (next (sat 1)) (does ?v9650 (assign 16 t)) (role ?v9650))
-(<= (next (sat 1)) (does ?v9671 (assign 4 t)) (role ?v9671))
-(<= (next (sat 1)) (does ?v9692 (assign 27 f)) (role ?v9692))
-(<= (next (sat 2)) (does ?v9715 (assign 27 f)) (role ?v9715))
-(<= (next (sat 2)) (does ?v9736 (assign 51 f)) (role ?v9736))
-(<= (next (sat 2)) (does ?v9757 (assign 19 t)) (role ?v9757))
-(<= (next (sat 2)) (does ?v9778 (assign 1 t)) (role ?v9778))
-(<= (next (sat 2)) (does ?v9799 (assign 30 t)) (role ?v9799))
-(<= (next (sat 3)) (does ?v9822 (assign 35 t)) (role ?v9822))
-(<= (next (sat 3)) (does ?v9843 (assign 52 t)) (role ?v9843))
-(<= (next (sat 3)) (does ?v9864 (assign 41 f)) (role ?v9864))
-(<= (next (sat 3)) (does ?v9885 (assign 18 f)) (role ?v9885))
-(<= (next (sat 3)) (does ?v9906 (assign 59 f)) (role ?v9906))
-(<= (next (sat 4)) (does ?v9929 (assign 24 t)) (role ?v9929))
-(<= (next (sat 4)) (does ?v9950 (assign 30 t)) (role ?v9950))
-(<= (next (sat 4)) (does ?v9971 (assign 20 t)) (role ?v9971))
-(<= (next (sat 4)) (does ?v9992 (assign 7 f)) (role ?v9992))
-(<= (next (sat 4)) (does ?v10013 (assign 23 f)) (role ?v10013))
-(<= (next (sat 5)) (does ?v10036 (assign 34 f)) (role ?v10036))
-(<= (next (sat 5)) (does ?v10057 (assign 4 f)) (role ?v10057))
-(<= (next (sat 5)) (does ?v10078 (assign 13 t)) (role ?v10078))
-(<= (next (sat 5)) (does ?v10099 (assign 49 f)) (role ?v10099))
-(<= (next (sat 5)) (does ?v10120 (assign 17 f)) (role ?v10120))
-(<= (next (sat 6)) (does ?v10143 (assign 51 t)) (role ?v10143))
-(<= (next (sat 6)) (does ?v10164 (assign 37 f)) (role ?v10164))
-(<= (next (sat 6)) (does ?v10185 (assign 1 t)) (role ?v10185))
-(<= (next (sat 6)) (does ?v10206 (assign 5 t)) (role ?v10206))
-(<= (next (sat 6)) (does ?v10227 (assign 29 f)) (role ?v10227))
-(<= (next (sat 7)) (does ?v10250 (assign 2 f)) (role ?v10250))
-(<= (next (sat 7)) (does ?v10271 (assign 7 f)) (role ?v10271))
-(<= (next (sat 7)) (does ?v10292 (assign 53 f)) (role ?v10292))
-(<= (next (sat 7)) (does ?v10313 (assign 12 f)) (role ?v10313))
-(<= (next (sat 7)) (does ?v10334 (assign 35 f)) (role ?v10334))
-(<= (next (sat 8)) (does ?v10357 (assign 39 f)) (role ?v10357))
-(<= (next (sat 8)) (does ?v10378 (assign 44 f)) (role ?v10378))
-(<= (next (sat 8)) (does ?v10399 (assign 28 t)) (role ?v10399))
-(<= (next (sat 8)) (does ?v10420 (assign 2 f)) (role ?v10420))
-(<= (next (sat 8)) (does ?v10441 (assign 51 t)) (role ?v10441))
-(<= (next (sat 9)) (does ?v10464 (assign 21 f)) (role ?v10464))
-(<= (next (sat 9)) (does ?v10485 (assign 11 f)) (role ?v10485))
-(<= (next (sat 9)) (does ?v10506 (assign 8 t)) (role ?v10506))
-(<= (next (sat 9)) (does ?v10527 (assign 20 f)) (role ?v10527))
-(<= (next (sat 9)) (does ?v10548 (assign 2 t))...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-14 23:17:32
|
Revision: 1568
http://toss.svn.sourceforge.net/toss/?rev=1568&view=rev
Author: lukaszkaiser
Date: 2011-09-14 23:17:26 +0000 (Wed, 14 Sep 2011)
Log Message:
-----------
Simple game editing in WebClient.
Modified Paths:
--------------
trunk/Toss/Server/ReqHandler.ml
trunk/Toss/Server/ReqHandler.mli
trunk/Toss/Server/Server.ml
trunk/Toss/WebClient/Connect.js
trunk/Toss/WebClient/Main.js
trunk/Toss/WebClient/Style.css
trunk/Toss/WebClient/index.html
Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml 2011-09-14 01:00:51 UTC (rev 1567)
+++ trunk/Toss/Server/ReqHandler.ml 2011-09-14 23:17:26 UTC (rev 1568)
@@ -7,8 +7,8 @@
"/usr/share/toss/html" else "WebClient/")
let quit_on_eof = ref true
-
let do_mails = ref false
+let save_games = ref true
(* ---------- Basic request type and internal handler ---------- *)
@@ -645,6 +645,24 @@
print_endline ("Subject: " ^ subj);
print_endline mailtxt;
"Invitation email has been sent to " ^ email ^ "." in
+ let save_game game toss =
+ let gs_of_str s =
+ ArenaParser.parse_game_state Lexer.lex (Lexing.from_string s) in
+ if !save_games then
+ try
+ let _ = gs_of_str toss in
+ let res = dbtable ("game='" ^ game ^ "'") "games" in
+ if List.length res = 0 then
+ DB.insert_table dbFILE "games" "game, toss" [game; toss]
+ else
+ ignore (DB.update_table dbFILE ~select:("game='" ^ game ^ "'")
+ ("toss='" ^ toss ^ "'") "games");
+ Hashtbl.remove client_game_states game;
+ "Game saved"
+ with
+ | Lexer.Parsing_error msg -> "Parsing error: " ^ msg
+ | _ -> "Parsing error"
+ else "Sorry, saving games is not allowed on this server." in
let (tcmd, data) = split_two "#" msg in
let resp, new_cookies = match tcmd with
| "USERNAME" ->
@@ -714,16 +732,29 @@
let tp2 = String.sub tp_s (tp_i+1) (tp_l - tp_i - 1) in
let tp, a = (strip_ws tp0, strip_ws tp1, strip_ws tp2), get_args args_s in
move_play tp a.(0), []
+ | "GETGAME" ->
+ let res = dbtable ("game='" ^ data ^ "'") "games" in
+ (match List.length res with
+ | 0 -> "ERROR: no such game found in db", []
+ | x when x > 1 -> "ERROR: multiple such games in db", []
+ | _ -> (List.hd res).(1), []
+ )
+ | "SETGAME" ->
+ let (game, toss) = split_two " $_$ " data in save_game game toss, []
| _ ->
"MOD_PYTHON ERROR ; Traceback: Unknown Toss Command! \n " ^ tcmd, [] in
http_msg false "200 OK" "text/html; charset=utf-8" new_cookies resp
+let http_post_ok_concurrent msg = (* Some things must be in main thread. *)
+ let (tcmd, data) = split_two "#" msg in tcmd <> "SETGAME"
let handle_http_msg rstate cmd head msg ck =
if String.sub cmd 0 5 = "GET /" then
Aux.Right (rstate, fun () -> handle_http_get cmd head msg ck)
else if String.length cmd > 13 && String.sub cmd 0 13 = "POST /Handler" then
- Aux.Right (rstate, fun () -> handle_http_post cmd head msg ck)
+ if http_post_ok_concurrent msg then
+ Aux.Right (rstate, fun () -> handle_http_post cmd head msg ck)
+ else Aux.Left (rstate, handle_http_post cmd head msg ck)
else try Aux.Left (req_handle rstate
(Aux.Right (GDLParser.parse_request KIFLexer.lex
(Lexing.from_string msg))))
Modified: trunk/Toss/Server/ReqHandler.mli
===================================================================
--- trunk/Toss/Server/ReqHandler.mli 2011-09-14 01:00:51 UTC (rev 1567)
+++ trunk/Toss/Server/ReqHandler.mli 2011-09-14 23:17:26 UTC (rev 1568)
@@ -6,7 +6,7 @@
val set_debug_level : int -> unit
val quit_on_eof : bool ref
-
+val save_games : bool ref
val do_mails : bool ref
Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml 2011-09-14 01:00:51 UTC (rev 1567)
+++ trunk/Toss/Server/Server.ml 2011-09-14 23:17:26 UTC (rev 1568)
@@ -177,6 +177,8 @@
("-mail", Arg.Unit (fun () -> ReqHandler.do_mails:= true), "do send mails");
("-eof", Arg.Unit (fun () -> ReqHandler.quit_on_eof := false),
"do not quit server on end of file of requests");
+ ("-nosave", Arg.Unit (fun () -> ReqHandler.save_games := false),
+ "disallow to save games in database");
("-html", Arg.String (fun s -> ReqHandler.html_dir_path := s),
"set path to directory with html files for the web-based client");
("-db", Arg.String (fun s -> (DB.dbFILE := s)), "use specified DB file");
Modified: trunk/Toss/WebClient/Connect.js
===================================================================
--- trunk/Toss/WebClient/Connect.js 2011-09-14 01:00:51 UTC (rev 1567)
+++ trunk/Toss/WebClient/Connect.js 2011-09-14 23:17:26 UTC (rev 1568)
@@ -152,6 +152,10 @@
this.change_data = function (name, surname, email) {
return (srv ("CHANGEUSR", name +"$"+ surname +"$"+ email));
}
+ this.get_game = function (game) { return (srv("GETGAME", game)); }
+ this.set_game = function (game, toss) {
+ return (srv("SETGAME", game + " $_$ " + toss));
+ }
return (this);
}
Modified: trunk/Toss/WebClient/Main.js
===================================================================
--- trunk/Toss/WebClient/Main.js 2011-09-14 01:00:51 UTC (rev 1567)
+++ trunk/Toss/WebClient/Main.js 2011-09-14 23:17:26 UTC (rev 1568)
@@ -71,6 +71,7 @@
var paragraph = document.createElement("p");
this.paragraphs[game] = paragraph;
paragraph.setAttribute("class", "game-par");
+ this.container.appendChild (paragraph);
var button = document.createElement("button");
paragraph.game_button = button;
@@ -78,9 +79,8 @@
button.setAttribute("onclick", "new_play('" + game + "')");
button.innerHTML = game;
button.style.display = "block";
- this.container.appendChild (paragraph);
paragraph.appendChild (button);
-
+
var open_play_list = document.createElement("ul");
paragraph.open_play_list = open_play_list;
open_play_list.setAttribute("class", "plays-list");
@@ -108,7 +108,39 @@
closed_plays.style.display = "none";
paragraph.appendChild (closed_plays);
+
+ var edit_div = document.createElement("div");
+ paragraph.edit_div = edit_div;
+ edit_div.setAttribute("id", "edit-div-" + game);
+ edit_div.setAttribute("class", "edit-div");
+
+ var edit_button = document.createElement("button");
+ paragraph.edit_button = edit_button;
+ edit_button.setAttribute("class", "completedbt");
+ edit_button.setAttribute("onclick",
+ "GAMESPAGE.toggle_edit ('" + game + "')");
+ edit_button.innerHTML = "Edit " + game + " (Show)";
+ edit_div.appendChild (edit_button);
+
+ var edit_save_button = document.createElement("button");
+ paragraph.edit_save_button = edit_save_button;
+ edit_save_button.setAttribute("class", "completedbt");
+ edit_save_button.setAttribute("onclick",
+ "GAMESPAGE.save_edit ('" + game + "')");
+ edit_save_button.innerHTML = "Save";
+ edit_save_button.style.display = "none";
+ edit_div.appendChild (edit_save_button);
+
+ var edit_area = document.createElement("textarea");
+ edit_area.setAttribute("class", "edit-area");
+ paragraph.edit_area = edit_area;
+ edit_div.appendChild (edit_area);
+ edit_area.style.display = "none";
+ edit_area.value = CONN.get_game (game);
+ paragraph.appendChild (edit_div);
+
paragraph.completed_shown = false;
+ paragraph.edit_shown = false;
this.container.appendChild (paragraph);
}
return (this);
@@ -143,7 +175,25 @@
}
}
+GamesPage.prototype.toggle_edit = function (game) {
+ var par = this.paragraphs[game];
+ if (par.edit_shown) {
+ par.edit_area.style.display = "none";
+ par.edit_save_button.style.display = "none";
+ par.edit_button.innerHTML = "Edit " + game + " (Show)";
+ par.edit_shown = false;
+ } else {
+ par.edit_area.style.display = "block";
+ par.edit_save_button.style.display = "inline";
+ par.edit_button.innerHTML = "Edit " + game + " (Hide)";
+ par.edit_shown = true;
+ }
+}
+GamesPage.prototype.save_edit = function (game) {
+ alert (CONN.set_game (game, this.paragraphs[game].edit_area.value));
+}
+
function play_from_string (game, s) {
var p = s.substring(game.length + 1);
var lst = parse_list ('#', p);
Modified: trunk/Toss/WebClient/Style.css
===================================================================
--- trunk/Toss/WebClient/Style.css 2011-09-14 01:00:51 UTC (rev 1567)
+++ trunk/Toss/WebClient/Style.css 2011-09-14 23:17:26 UTC (rev 1568)
@@ -93,7 +93,7 @@
.gamebt {
margin-bottom: 1em;
-
+ padding-top: 0.5em;
}
.completedbt {
@@ -139,6 +139,17 @@
margin-top: 0.3em;
}
+.edit-div {
+ margin-bottom: -1em;
+ margin-top: -1px;
+ border-top: 1px solid #260314;
+}
+
+.edit-area {
+ width: 100%;
+ height: 35em;
+}
+
.game-picbt {
position: relative;
top:0px;
@@ -796,7 +807,6 @@
.game-par {
padding: 0px;
- padding-bottom: 0.2em;
/* border-bottom: 1px solid #260314; */
}
@@ -825,6 +835,7 @@
}
.plays-list {
+ width: 100%;
list-style: none;
margin: 0.5em;
margin-bottom: 0px;
@@ -835,7 +846,7 @@
}
.plays-list-elem {
- margin-left: 1em;
+ margin-left: 1.5em;
margin-bottom: 0em;
}
Modified: trunk/Toss/WebClient/index.html
===================================================================
--- trunk/Toss/WebClient/index.html 2011-09-14 01:00:51 UTC (rev 1567)
+++ trunk/Toss/WebClient/index.html 2011-09-14 23:17:26 UTC (rev 1568)
@@ -177,6 +177,7 @@
<div id="news">
<h3>News</h3>
<ul id="welcome-list-news" class="welcome-list">
+<li><b>14/09/11</b> Simple editing of games added to web interface</li>
<li><b>31/07/11</b> Store date and time of moves in games</li>
<li><b>30/07/11</b> Corrected opponent lists in the Profile tab</li>
<li><b>03/07/11</b> Added game descriptions viewable when playing</li>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-09-25 23:57:30
|
Revision: 1570
http://toss.svn.sourceforge.net/toss/?rev=1570&view=rev
Author: lukaszkaiser
Date: 2011-09-25 23:57:21 +0000 (Sun, 25 Sep 2011)
Log Message:
-----------
Removing Client and substituting DPT parts for MiniSAT. No C/C++ dependency any more :).
Modified Paths:
--------------
trunk/Toss/Formula/BoolFormulaTest.ml
trunk/Toss/Formula/Sat/MiniSAT.ml
trunk/Toss/Formula/Sat/MiniSAT.mli
trunk/Toss/Formula/Sat/Sat.ml
trunk/Toss/Formula/Sat/SatTest.ml
trunk/Toss/Makefile
trunk/Toss/README
trunk/Toss/Server/Tests.ml
trunk/Toss/Solver/AssignmentsTest.ml
trunk/Toss/Solver/SolverTest.ml
Added Paths:
-----------
trunk/Toss/Formula/Sat/dpll/
trunk/Toss/Formula/Sat/dpll/LICENSE.txt
trunk/Toss/Formula/Sat/dpll/array_util.ml
trunk/Toss/Formula/Sat/dpll/array_util.mli
trunk/Toss/Formula/Sat/dpll/dpll_core.ml
trunk/Toss/Formula/Sat/dpll/dpll_core.mli
trunk/Toss/Formula/Sat/dpll/dpll_core_representation.ml
trunk/Toss/Formula/Sat/dpll/dpll_core_representation.mli
trunk/Toss/Formula/Sat/dpll/function.ml
trunk/Toss/Formula/Sat/dpll/function.mli
trunk/Toss/Formula/Sat/dpll/id.ml
trunk/Toss/Formula/Sat/dpll/id.mli
trunk/Toss/Formula/Sat/dpll/list_util.ml
trunk/Toss/Formula/Sat/dpll/list_util.mli
trunk/Toss/Formula/Sat/dpll/mutable_set.ml
trunk/Toss/Formula/Sat/dpll/mutable_set.mli
trunk/Toss/Formula/Sat/dpll/subarray.ml
trunk/Toss/Formula/Sat/dpll/subarray.mli
trunk/Toss/Formula/Sat/dpll/ternary.ml
trunk/Toss/Formula/Sat/dpll/ternary.mli
trunk/Toss/Formula/Sat/dpll/vec.ml
trunk/Toss/Formula/Sat/dpll/vec.mli
Removed Paths:
-------------
trunk/Toss/Client/
trunk/Toss/Formula/Sat/LICENSE-MiniSATWrap
trunk/Toss/Formula/Sat/MiniSATWrap.C
trunk/Toss/Formula/Sat/minisat/
Modified: trunk/Toss/Formula/BoolFormulaTest.ml
===================================================================
--- trunk/Toss/Formula/BoolFormulaTest.ml 2011-09-18 21:35:48 UTC (rev 1569)
+++ trunk/Toss/Formula/BoolFormulaTest.ml 2011-09-25 23:57:21 UTC (rev 1570)
@@ -169,7 +169,7 @@
("(P(x) and P(a)) or (P(x) and P(b)) or (P(x) and P(c))" ^
" or (P(x) and P(d)) or (not P(x) and Q(a))" ^
" or (not P(x) and Q(b)) or (not P(x) and Q(c))")
- "1 | 6 | 7 | 8 & -1 | 2 | 3 | 4 | 5";
+ "-1 | 2 | 3 | 4 | 5 & 1 | 6 | 7 | 8";
test_cnf_bool ("(P(x) and P(a)) or (P(x) and P(b)) or (P(x) and P(c))" ^
" or (P(x) and P(d)) or (not P(x) and Q(a))" ^
" or (not P(x) and Q(b)) or (not P(x) and Q(c))")
Deleted: trunk/Toss/Formula/Sat/LICENSE-MiniSATWrap
===================================================================
--- trunk/Toss/Formula/Sat/LICENSE-MiniSATWrap 2011-09-18 21:35:48 UTC (rev 1569)
+++ trunk/Toss/Formula/Sat/LICENSE-MiniSATWrap 2011-09-25 23:57:21 UTC (rev 1570)
@@ -1,165 +0,0 @@
- GNU LESSER GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-
- This version of the GNU Lesser General Public License incorporates
-the terms and conditions of version 3 of the GNU General Public
-License, supplemented by the additional permissions listed below.
-
- 0. Additional Definitions.
-
- As used herein, "this License" refers to version 3 of the GNU Lesser
-General Public License, and the "GNU GPL" refers to version 3 of the GNU
-General Public License.
-
- "The Library" refers to a covered work governed by this License,
-other than an Application or a Combined Work as defined below.
-
- An "Application" is any work that makes use of an interface provided
-by the Library, but which is not otherwise based on the Library.
-Defining a subclass of a class defined by the Library is deemed a mode
-of using an interface provided by the Library.
-
- A "Combined Work" is a work produced by combining or linking an
-Application with the Library. The particular version of the Library
-with which the Combined Work was made is also called the "Linked
-Version".
-
- The "Minimal Corresponding Source" for a Combined Work means the
-Corresponding Source for the Combined Work, excluding any source code
-for portions of the Combined Work that, considered in isolation, are
-based on the Application, and not on the Linked Version.
-
- The "Corresponding Application Code" for a Combined Work means the
-object code and/or source code for the Application, including any data
-and utility programs needed for reproducing the Combined Work from the
-Application, but excluding the System Libraries of the Combined Work.
-
- 1. Exception to Section 3 of the GNU GPL.
-
- You may convey a covered work under sections 3 and 4 of this License
-without being bound by section 3 of the GNU GPL.
-
- 2. Conveying Modified Versions.
-
- If you modify a copy of the Library, and, in your modifications, a
-facility refers to a function or data to be supplied by an Application
-that uses the facility (other than as an argument passed when the
-facility is invoked), then you may convey a copy of the modified
-version:
-
- a) under this License, provided that you make a good faith effort to
- ensure that, in the event an Application does not supply the
- function or data, the facility still operates, and performs
- whatever part of its purpose remains meaningful, or
-
- b) under the GNU GPL, with none of the additional permissions of
- this License applicable to that copy.
-
- 3. Object Code Incorporating Material from Library Header Files.
-
- The object code form of an Application may incorporate material from
-a header file that is part of the Library. You may convey such object
-code under terms of your choice, provided that, if the incorporated
-material is not limited to numerical parameters, data structure
-layouts and accessors, or small macros, inline functions and templates
-(ten or fewer lines in length), you do both of the following:
-
- a) Give prominent notice with each copy of the object code that the
- Library is used in it and that the Library and its use are
- covered by this License.
-
- b) Accompany the object code with a copy of the GNU GPL and this license
- document.
-
- 4. Combined Works.
-
- You may convey a Combined Work under terms of your choice that,
-taken together, effectively do not restrict modification of the
-portions of the Library contained in the Combined Work and reverse
-engineering for debugging such modifications, if you also do each of
-the following:
-
- a) Give prominent notice with each copy of the Combined Work that
- the Library is used in it and that the Library and its use are
- covered by this License.
-
- b) Accompany the Combined Work with a copy of the GNU GPL and this license
- document.
-
- c) For a Combined Work that displays copyright notices during
- execution, include the copyright notice for the Library among
- these notices, as well as a reference directing the user to the
- copies of the GNU GPL and this license document.
-
- d) Do one of the following:
-
- 0) Convey the Minimal Corresponding Source under the terms of this
- License, and the Corresponding Application Code in a form
- suitable for, and under terms that permit, the user to
- recombine or relink the Application with a modified version of
- the Linked Version to produce a modified Combined Work, in the
- manner specified by section 6 of the GNU GPL for conveying
- Corresponding Source.
-
- 1) Use a suitable shared library mechanism for linking with the
- Library. A suitable mechanism is one that (a) uses at run time
- a copy of the Library already present on the user's computer
- system, and (b) will operate properly with a modified version
- of the Library that is interface-compatible with the Linked
- Version.
-
- e) Provide Installation Information, but only if you would otherwise
- be required to provide such information under section 6 of the
- GNU GPL, and only to the extent that such information is
- necessary to install and execute a modified version of the
- Combined Work produced by recombining or relinking the
- Application with a modified version of the Linked Version. (If
- you use option 4d0, the Installation Information must accompany
- the Minimal Corresponding Source and Corresponding Application
- Code. If you use option 4d1, you must provide the Installation
- Information in the manner specified by section 6 of the GNU GPL
- for conveying Corresponding Source.)
-
- 5. Combined Libraries.
-
- You may place library facilities that are a work based on the
-Library side by side in a single library together with other library
-facilities that are not Applications and are not covered by this
-License, and convey such a combined library under terms of your
-choice, if you do both of the following:
-
- a) Accompany the combined library with a copy of the same work based
- on the Library, uncombined with any other library facilities,
- conveyed under the terms of this License.
-
- b) Give prominent notice with the combined library that part of it
- is a work based on the Library, and explaining where to find the
- accompanying uncombined form of the same work.
-
- 6. Revised Versions of the GNU Lesser General Public License.
-
- The Free Software Foundation may publish revised and/or new versions
-of the GNU Lesser General Public License from time to time. Such new
-versions will be similar in spirit to the present version, but may
-differ in detail to address new problems or concerns.
-
- Each version is given a distinguishing version number. If the
-Library as you received it specifies that a certain numbered version
-of the GNU Lesser General Public License "or any later version"
-applies to it, you have the option of following the terms and
-conditions either of that published version or of any later version
-published by the Free Software Foundation. If the Library as you
-received it does not specify a version number of the GNU Lesser
-General Public License, you may choose any version of the GNU Lesser
-General Public License ever published by the Free Software Foundation.
-
- If the Library as you received it specifies that a proxy can decide
-whether future versions of the GNU Lesser General Public License shall
-apply, that proxy's public statement of acceptance of any version is
-permanent authorization for you to choose that version for the
-Library.
Modified: trunk/Toss/Formula/Sat/MiniSAT.ml
===================================================================
--- trunk/Toss/Formula/Sat/MiniSAT.ml 2011-09-18 21:35:48 UTC (rev 1569)
+++ trunk/Toss/Formula/Sat/MiniSAT.ml 2011-09-25 23:57:21 UTC (rev 1570)
@@ -1,19 +1,79 @@
-type var = int
-type lit = int
+let make_solver (sv: Dpll_core.solver) =
+object (self)
+ val mutable conflict_limit = 100
+ val mutable learneds_limit = 0
+
+ method private solved =
+ Dpll_core.satisfied sv || Dpll_core.unsatisfiable sv ||
+ Dpll_core.conflict_detected sv
+
+ method private search =
+ while not self#solved && Dpll_core.num_conflicts sv < conflict_limit do
+ while not (Dpll_core.conflict_detected sv) &&
+ Dpll_core.inference_possible sv do
+ Dpll_core.infer sv
+ done;
+ if Dpll_core.conflict_detected sv then begin
+ if not (Dpll_core.unsatisfiable sv) then begin
+ Dpll_core.backjump sv;
+ if Dpll_core.num_learneds sv > learneds_limit then
+ Dpll_core.forget_some_learned_clauses sv;
+ end
+ end
+ else if Dpll_core.decision_possible sv then
+ Dpll_core.decide sv
+ else
+ assert (Dpll_core.satisfied sv)
+ done;
+ assert (not (Dpll_core.conflict_detected sv) || Dpll_core.unsatisfiable sv);
+
+ method solve =
+ learneds_limit <- max 1000 (Dpll_core.num_clauses sv / 3);
+ while not self#solved do
+ Dpll_core.restart sv;
+ self#search;
+ conflict_limit <- conflict_limit * 2;
+ learneds_limit <- learneds_limit * 12 / 10;
+ done;
+ assert self#solved;
+ Dpll_core.satisfied sv
+end
+
+let solver = ref (Dpll_core.new_solver ())
+let free_var_no = ref 1;
+
+type var = Dpll_core_representation.Literal.t
+type lit = Dpll_core_representation.Literal.t
type value = int (* F | T | X *)
type solution = SAT | UNSAT | TIMEOUT
-external reset : unit -> unit = "minisat_reset"
-external new_var : unit -> var = "minisat_new_var"
-external pos_lit : var -> lit = "minisat_pos_lit"
-external neg_lit : var -> lit = "minisat_neg_lit"
-external add_clause : lit list -> unit = "minisat_add_clause"
-external solve : unit -> solution = "minisat_solve"
-external solve_with_assumption : lit list -> solution = "minisat_solve_with_assumption"
-external value_of : var -> value = "minisat_value_of"
-external set_threshold : int -> unit = "minisat_set_threshold"
-external set_timeout : float -> unit = "minisat_set_timeout"
+let reset () = (solver := Dpll_core.new_solver ())
+let restart () = Dpll_core.restart !solver
+let new_var () = Dpll_core.fresh_literal !solver
+
+let pos_lit l = l
+
+let neg_lit l = Dpll_core_representation.negation l
+
+let add_clause ls =
+ Dpll_core.add_clause !solver ls
+
+let solve () =
+ let s = make_solver !solver in
+ let res = s#solve in
+ (* let print_formula f = print_endline (sprint_formula f) in
+ Printf.printf "dpll sat %b len %i\n%!" !Dpll_core.satisfied (List.length !Dpll_core.model);
+ List.iter print_formula !Dpll_core.model; *)
+ if res then SAT else UNSAT
+
+let value_of v =
+ if Dpll_core.is_true !solver (pos_lit v) then 1 else
+ if Dpll_core.is_true !solver (neg_lit v) then 0 else 2
+
+let set_threshold _ = ()
+let set_timeout _ = ()
+
let string_of_value (v: value): string =
match v with
| 0 -> "false"
Modified: trunk/Toss/Formula/Sat/MiniSAT.mli
===================================================================
--- trunk/Toss/Formula/Sat/MiniSAT.mli 2011-09-18 21:35:48 UTC (rev 1569)
+++ trunk/Toss/Formula/Sat/MiniSAT.mli 2011-09-25 23:57:21 UTC (rev 1570)
@@ -1,16 +1,17 @@
-type var = int
-type lit = int
+type var
+type lit
type value = int (* F | T | X *)
type solution = SAT | UNSAT | TIMEOUT
-external reset : unit -> unit = "minisat_reset"
-external new_var : unit -> var = "minisat_new_var"
-external pos_lit : var -> lit = "minisat_pos_lit"
-external neg_lit : var -> lit = "minisat_neg_lit"
-external add_clause : lit list -> unit = "minisat_add_clause"
-external solve : unit -> solution = "minisat_solve"
-external solve_with_assumption : lit list -> solution = "minisat_solve_with_assumption"
-external value_of : var -> value = "minisat_value_of"
-external set_threshold : int -> unit = "minisat_set_threshold"
-external set_timeout : float -> unit = "minisat_set_timeout"
+val reset : unit -> unit
+val restart : unit -> unit
+val new_var : unit -> var
+val pos_lit : var -> lit
+val neg_lit : var -> lit
+val add_clause : lit list -> unit
+val solve : unit -> solution
+
+val value_of : var -> value
+val set_threshold : int -> unit
+val set_timeout : float -> unit
val string_of_value : value -> string
Deleted: trunk/Toss/Formula/Sat/MiniSATWrap.C
===================================================================
--- trunk/Toss/Formula/Sat/MiniSATWrap.C 2011-09-18 21:35:48 UTC (rev 1569)
+++ trunk/Toss/Formula/Sat/MiniSATWrap.C 2011-09-25 23:57:21 UTC (rev 1570)
@@ -1,116 +0,0 @@
-/* For questions, comments, suggestion, or improvements please contact
- Flavio Lerda <fl...@gm...>. */
-
-#include <caml/mlvalues.h>
-#include <caml/memory.h>
-#include "Solver.h"
-
-Solver *solver = new Solver();
-
-static void convert_literals(value l, vec<Lit> &r) {
- while(Int_val(l) != 0) {
- Lit lit = toLit(Int_val(Field(l, 0)));
- r.push(lit);
- l = Field(l, 1);
- }
-}
-
-extern "C" value minisat_reset(value unit) {
- delete solver;
- solver = new Solver();
-
- return Val_unit;
-}
-
-extern "C" value minisat_new_var(value unit) {
- Var var = solver->newVar();
- return Val_int(var);
-}
-
-extern "C" value minisat_pos_lit(value v) {
- Var var = Int_val(v);
- Lit lit(var, false);
- return Val_int(toInt(lit));
-}
-
-extern "C" value minisat_neg_lit(value v) {
- Var var = Int_val(v);
- Lit lit(var, true);
- return Val_int(toInt(lit));
-}
-
-extern "C" value minisat_add_clause(value c) {
- vec<Lit> clause;
- convert_literals(c, clause);
- solver->addClause(clause);
-
- return Val_unit;
-}
-
-extern "C" value minisat_set_timeout(value c) {
- double t = Double_val(c);
- solver->setTimeout(t);
-
- return Val_unit;
-}
-
-/*extern "C" value minisat_simplify_db(value unit) {
- solver->simplifyDB();
-
- return Val_unit;
-}*/
-
-extern "C" value minisat_solve(value unit) {
- value r;
-
- if(solver->solve()) {
- r = Val_int(0);
- } else if (solver->sat_timeout > 0) {
- r = Val_int(1);
- } else {
- r = Val_int(2);
- }
-
- return r;
-}
-
-extern "C" value minisat_solve_with_assumption(value a) {
- vec<Lit> assumption;
- convert_literals(a, assumption);
- value r;
-
- if(solver->solve(assumption)) {
- r = Val_int(0);
- } else if (solver->sat_timeout > 0) {
- r = Val_int(1);
- } else {
- r = Val_int(2);
- }
-
- return r;
-}
-
-extern "C" value minisat_value_of(value v) {
- Var var = Int_val(v);
- lbool val = solver->model[var];
- value r;
-
- if(val == l_False) {
- r = Val_int(0);
- } else if(val == l_True) {
- r = Val_int(1);
- } else if (val == l_Undef) {
- r = Val_int(2);
- } else {
- assert(0);
- }
-
- return r;
-}
-
-extern "C" value minisat_set_threshold(value v) {
- Var var = Int_val(v);
- solver->var_threshold = var;
-
- return Val_unit;
-}
Modified: trunk/Toss/Formula/Sat/Sat.ml
===================================================================
--- trunk/Toss/Formula/Sat/Sat.ml 2011-09-18 21:35:48 UTC (rev 1569)
+++ trunk/Toss/Formula/Sat/Sat.ml 2011-09-25 23:57:21 UTC (rev 1570)
@@ -176,14 +176,14 @@
| MiniSAT.TIMEOUT ->
raise (Aux.Timeout "MiniSat")
| MiniSAT.SAT ->
- let res = ref [] in
- let update mv v =
- if MiniSAT.value_of mv = 0 then res := (-v) :: !res
- else if MiniSAT.value_of mv = 1 then res := v :: !res
- else ()
- in
- Hashtbl.iter update !var_rev_map;
- Some (!res)
+ let res = ref [] in
+ let update mv v =
+ if MiniSAT.value_of mv = 0 then res := (-v) :: !res
+ else if MiniSAT.value_of mv = 1 then res := v :: !res
+ in
+ Hashtbl.iter update !var_rev_map;
+ MiniSAT.restart ();
+ Some (!res)
(* Check sat. of [phi] in CNF, return None or a satisfying assignment. *)
let sat cnf =
Modified: trunk/Toss/Formula/Sat/SatTest.ml
===================================================================
--- trunk/Toss/Formula/Sat/SatTest.ml 2011-09-18 21:35:48 UTC (rev 1569)
+++ trunk/Toss/Formula/Sat/SatTest.ml 2011-09-25 23:57:21 UTC (rev 1570)
@@ -1,7 +1,7 @@
(* Simple MiniSAT cnf-dnf tests. *)
open OUnit
-Sat.set_debug_level 0 ;;
+let _ = Sat.set_debug_level 0
let assert_eq_string arg msg x y =
let full_msg = msg ^ " (argument: " ^ arg ^ ")" in
@@ -21,15 +21,17 @@
let tests = "Sat" >::: [
"basic dnf to cnf" >::
(fun () ->
- test [[1; 2]; [3]] "(2 | 3) & (1 | 3)";
+ test [[1; 2]; [3]] "(1 | 3) & (2 | 3)";
test [[1; 2]; [-1; -2]] "(-1 | 2) & (1 | -2)";
- test [[1; 2; 3]] "(2) & (1) & (3)";
+ test [[1; 2; 3]] "(1) & (2) & (3)";
test [[1; -1]] "F";
test [[1]; [-1; 2]; [-2; 3]; [-3]] "T";
test [[1]; [-1; 2]; [-2; 3]; [-3; 4]] "(1 | 2 | 3 | 4)";
- test [[1; 2]; [3; 4]] "(2 | 3) & (2 | 4) & (1 | 3) & (1 | 4)";
+ test [[1; 2]; [3; 4]] "(1 | 3) & (2 | 3) & (1 | 4) & (2 | 4)";
);
+]
+let bigtests = "SatBig" >::: [
"conversion to cnf on larger classes" >::
(fun () ->
test_nbr_clauses 128
@@ -207,9 +209,12 @@
[-131]; [-132; -6]; [-133; -6; -14]; [-134; -6; -14; -10];
[-135; -6; -14; -10; -5]; [-136; -6; -14; -10; -5; -9];
[-137;-6;-14;-10;-5;-9;-4]; [-138;-6;-14;-10;-5;-9;-4;-8]; [-139] ] in
- test_nbr_clauses 277 s;
+ test_nbr_clauses 256 s;
);
]
-let exec = Aux.run_test_if_target "SatTest" tests
+let exec = (
+ Aux.run_test_if_target "SatTest" tests;
+ Aux.run_test_if_target "SatTest" bigtests;
+)
Added: trunk/Toss/Formula/Sat/dpll/LICENSE.txt
===================================================================
--- trunk/Toss/Formula/Sat/dpll/LICENSE.txt (rev 0)
+++ trunk/Toss/Formula/Sat/dpll/LICENSE.txt 2011-09-25 23:57:21 UTC (rev 1570)
@@ -0,0 +1,248 @@
+
+This directory contains parts of the source code of version 2.0 of the
+
+ Decision Procedure Toolkit.
+
+Contents
+
+ The Decision Procedure Toolkit (DPT) is a system of cooperating
+ decision procedures for answering satisfiability queries. The DPT
+ implementation in OCaml comprises a DPLL-style SAT solver with
+ theory-specific decision procedures.
+
+License
+
+ Copyright \xA9 2007 Intel Corporation
+
+ Licensed under the Apache License, Version 2.0 (the "License"); you
+ may not use this file except in compliance with the License. You may
+ obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ implied. See the License for the specific language governing
+ permissions and limitations under the License.
+
+ Disclaimer
+
+ This manual as well as the software described in it is furnished under
+ license and may only be used or copied in accordance with the terms of
+ the license. The information in this manual is furnished for
+ informational use only, is subject to change without notice, and
+ should not be construed as a commitment by Intel Corporation. Intel
+ Corporation assumes no responsibility or liability for any errors or
+ inaccuracies that may appear in this document or any software that may
+ be provided in association with this document.
+
+ Except as permitted by such license, no part of this document may be
+ reproduced, stored in a retrieval system, or transmitted in any form
+ or by any means without the express written consent of Intel
+ Corporation.
+
+
+Copyright \xA9 2007 Intel Corporation
+
+ Apache License
+ Version 2.0, January 2004
+ http://www.apache.org/licenses/
+
+ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+ 1. Definitions.
+
+ "License" shall mean the terms and conditions for use, reproduction,
+ and distribution as defined by Sections 1 through 9 of this document.
+
+ "Licensor" shall mean the copyright owner or entity authorized by
+ the copyright owner that is granting the License.
+
+ "Legal Entity" shall mean the union of the acting entity and all
+ other entities that control, are controlled by, or are under common
+ control with that entity. For the purposes of this definition,
+ "control" means (i) the power, direct or indirect, to cause the
+ direction or management of such entity, whether by contract or
+ otherwise, or (ii) ownership of fifty percent (50%) or more of the
+ outstanding shares, or (iii) beneficial ownership of such entity.
+
+ "You" (or "Your") shall mean an individual or Legal Entity
+ exercising permissions granted by this License.
+
+ "Source" form shall mean the preferred form for making modifications,
+ including but not limited to software source code, documentation
+ source, and configuration files.
+
+ "Object" form shall mean any form resulting from mechanical
+ transformation or translation of a Source form, including but
+ not limited to compiled object code, generated documentation,
+ and conversions to other media types.
+
+ "Work" shall mean the work of authorship, whether in Source or
+ Object form, made available under the License, as indicated by a
+ copyright notice that is included in or attached to the work
+ (an example is provided in the Appendix below).
+
+ "Derivative Works" shall mean any work, whether in Source or Object
+ form, that is based on (or derived from) the Work and for which the
+ editorial revisions, annotations, elaborations, or other modifications
+ represent, as a whole, an original work of authorship. For the purposes
+ of this License, Derivative Works shall not include works that remain
+ separable from, or merely link (or bind by name) to the interfaces of,
+ the Work and Derivative Works thereof.
+
+ "Contribution" shall mean any work of authorship, including
+ the original version of the Work and any modifications or additions
+ to that Work or Derivative Works thereof, that is intentionally
+ submitted to Licensor for inclusion in the Work by the copyright owner
+ or by an individual or Legal Entity authorized to submit on behalf of
+ the copyright owner. For the purposes of this definition, "submitted"
+ means any form of electronic, verbal, or written communication sent
+ to the Licensor or its representatives, including but not limited to
+ communication on electronic mailing lists, source code control systems,
+ and issue tracking systems that are managed by, or on behalf of, the
+ Licensor for the purpose of discussing and improving the Work, but
+ excluding communication that is conspicuously marked or otherwise
+ designated in writing by the copyright owner as "Not a Contribution."
+
+ "Contributor" shall mean Licensor and any individual or Legal Entity
+ on behalf of whom a Contribution has been received by Licensor and
+ subsequently incorporated within the Work.
+
+ 2. Grant of Copyright License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ copyright license to reproduce, prepare Derivative Works of,
+ publicly display, publicly perform, sublicense, and distribute the
+ Work and such Derivative Works in Source or Object form.
+
+ 3. Grant of Patent License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ (except as stated in this section) patent license to make, have made,
+ use, offer to sell, sell, import, and otherwise transfer the Work,
+ where such license applies only to those patent claims licensable
+ by such Contributor that are necessarily infringed by their
+ Contribution(s) alone or by combination of their Contribution(s)
+ with the Work to which such Contribution(s) was submitted. If You
+ institute patent litigation against any entity (including a
+ cross-claim or counterclaim in a lawsuit) alleging that the Work
+ or a Contribution incorporated within the Work constitutes direct
+ or contributory patent infringement, then any patent licenses
+ granted to You under this License for that Work shall terminate
+ as of the date such litigation is filed.
+
+ 4. Redistribution. You may reproduce and distribute copies of the
+ Work or Derivative Works thereof in any medium, with or without
+ modifications, and in Source or Object form, provided that You
+ meet the following conditions:
+
+ (a) You must give any other recipients of the Work or
+ Derivative Works a copy of this License; and
+
+ (b) You must cause any modified files to carry prominent notices
+ stating that You changed the files; and
+
+ (c) You must retain, in the Source form of any Derivative Works
+ that You distribute, all copyright, patent, trademark, and
+ attribution notices from the Source form of the Work,
+ excluding those notices that do not pertain to any part of
+ the Derivative Works; and
+
+ (d) If the Work includes a "NOTICE" text file as part of its
+ distribution, then any Derivative Works that You distribute must
+ include a readable copy of the attribution notices contained
+ within such NOTICE file, excluding those notices that do not
+ pertain to any part of the Derivative Works, in at least one
+ of the following places: within a NOTICE text file distributed
+ as part of the Derivative Works; within the Source form or
+ documentation, if provided along with the Derivative Works; or,
+ within a display generated by the Derivative Works, if and
+ wherever such third-party notices normally appear. The contents
+ of the NOTICE file are for informational purposes only and
+ do not modify the License. You may add Your own attribution
+ notices within Derivative Works that You distribute, alongside
+ or as an addendum to the NOTICE text from the Work, provided
+ that such additional attribution notices cannot be construed
+ as modifying the License.
+
+ You may add Your own copyright statement to Your modifications and
+ may provide additional or different license terms and conditions
+ for use, reproduction, or distribution of Your modifications, or
+ for any such Derivative Works as a whole, provided Your use,
+ reproduction, and distribution of the Work otherwise complies with
+ the conditions stated in this License.
+
+ 5. Submission of Contributions. Unless You explicitly state otherwise,
+ any Contribution intentionally submitted for inclusion in the Work
+ by You to the Licensor shall be under the terms and conditions of
+ this License, without any additional terms or con...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-26 00:09:36
|
Revision: 1571
http://toss.svn.sourceforge.net/toss/?rev=1571&view=rev
Author: lukaszkaiser
Date: 2011-09-26 00:09:28 +0000 (Mon, 26 Sep 2011)
Log Message:
-----------
Cleanups after previous removal.
Removed Paths:
-------------
trunk/Toss/Resources.py
trunk/Toss/Toss.qrc
trunk/Toss/pics/
Deleted: trunk/Toss/Resources.py
===================================================================
--- trunk/Toss/Resources.py 2011-09-25 23:57:21 UTC (rev 1570)
+++ trunk/Toss/Resources.py 2011-09-26 00:09:28 UTC (rev 1571)
@@ -1,19935 +0,0 @@
-# -*- coding: utf-8 -*-
-
-# Resource object code
-#
-# Created: Sun Mar 21 03:19:00 2010
-# by: The Resource Compiler for PyQt (Qt v4.6.1)
-#
-# WARNING! All changes made in this file will be lost!
-
-from PyQt4 import QtCore
-
-qt_resource_data = "\
-\x00\x00\xba\xcf\
-\x3c\
-\x3f\x78\x6d\x6c\x20\x76\x65\x72\x73\x69\x6f\x6e\x3d\x22\x31\x2e\
-\x30\x22\x20\x65\x6e\x63\x6f\x64\x69\x6e\x67\x3d\x22\x55\x54\x46\
-\x2d\x38\x22\x20\x73\x74\x61\x6e\x64\x61\x6c\x6f\x6e\x65\x3d\x22\
-\x6e\x6f\x22\x3f\x3e\x0a\x3c\x21\x2d\x2d\x20\x43\x72\x65\x61\x74\
-\x65\x64\x20\x77\x69\x74\x68\x20\x49\x6e\x6b\x73\x63\x61\x70\x65\
-\x20\x28\x68\x74\x74\x70\x3a\x2f\x2f\x77\x77\x77\x2e\x69\x6e\x6b\
-\x73\x63\x61\x70\x65\x2e\x6f\x72\x67\x2f\x29\x20\x2d\x2d\x3e\x0a\
-\x0a\x3c\x73\x76\x67\x0a\x20\x20\x20\x78\x6d\x6c\x6e\x73\x3a\x64\
-\x63\x3d\x22\x68\x74\x74\x70\x3a\x2f\x2f\x70\x75\x72\x6c\x2e\x6f\
-\x72\x67\x2f\x64\x63\x2f\x65\x6c\x65\x6d\x65\x6e\x74\x73\x2f\x31\
-\x2e\x31\x2f\x22\x0a\x20\x20\x20\x78\x6d\x6c\x6e\x73\x3a\x63\x63\
-\x3d\x22\x68\x74\x74\x70\x3a\x2f\x2f\x63\x72\x65\x61\x74\x69\x76\
-\x65\x63\x6f\x6d\x6d\x6f\x6e\x73\x2e\x6f\x72\x67\x2f\x6e\x73\x23\
-\x22\x0a\x20\x20\x20\x78\x6d\x6c\x6e\x73\x3a\x72\x64\x66\x3d\x22\
-\x68\x74\x74\x70\x3a\x2f\x2f\x77\x77\x77\x2e\x77\x33\x2e\x6f\x72\
-\x67\x2f\x31\x39\x39\x39\x2f\x30\x32\x2f\x32\x32\x2d\x72\x64\x66\
-\x2d\x73\x79\x6e\x74\x61\x78\x2d\x6e\x73\x23\x22\x0a\x20\x20\x20\
-\x78\x6d\x6c\x6e\x73\x3a\x73\x76\x67\x3d\x22\x68\x74\x74\x70\x3a\
-\x2f\x2f\x77\x77\x77\x2e\x77\x33\x2e\x6f\x72\x67\x2f\x32\x30\x30\
-\x30\x2f\x73\x76\x67\x22\x0a\x20\x20\x20\x78\x6d\x6c\x6e\x73\x3d\
-\x22\x68\x74\x74\x70\x3a\x2f\x2f\x77\x77\x77\x2e\x77\x33\x2e\x6f\
-\x72\x67\x2f\x32\x30\x30\x30\x2f\x73\x76\x67\x22\x0a\x20\x20\x20\
-\x78\x6d\x6c\x6e\x73\x3a\x78\x6c\x69\x6e\x6b\x3d\x22\x68\x74\x74\
-\x70\x3a\x2f\x2f\x77\x77\x77\x2e\x77\x33\x2e\x6f\x72\x67\x2f\x31\
-\x39\x39\x39\x2f\x78\x6c\x69\x6e\x6b\x22\x0a\x20\x20\x20\x78\x6d\
-\x6c\x6e\x73\x3a\x73\x6f\x64\x69\x70\x6f\x64\x69\x3d\x22\x68\x74\
-\x74\x70\x3a\x2f\x2f\x73\x6f\x64\x69\x70\x6f\x64\x69\x2e\x73\x6f\
-\x75\x72\x63\x65\x66\x6f\x72\x67\x65\x2e\x6e\x65\x74\x2f\x44\x54\
-\x44\x2f\x73\x6f\x64\x69\x70\x6f\x64\x69\x2d\x30\x2e\x64\x74\x64\
-\x22\x0a\x20\x20\x20\x78\x6d\x6c\x6e\x73\x3a\x69\x6e\x6b\x73\x63\
-\x61\x70\x65\x3d\x22\x68\x74\x74\x70\x3a\x2f\x2f\x77\x77\x77\x2e\
-\x69\x6e\x6b\x73\x63\x61\x70\x65\x2e\x6f\x72\x67\x2f\x6e\x61\x6d\
-\x65\x73\x70\x61\x63\x65\x73\x2f\x69\x6e\x6b\x73\x63\x61\x70\x65\
-\x22\x0a\x20\x20\x20\x77\x69\x64\x74\x68\x3d\x22\x31\x34\x30\x22\
-\x0a\x20\x20\x20\x68\x65\x69\x67\x68\x74\x3d\x22\x31\x32\x37\x22\
-\x0a\x20\x20\x20\x69\x64\x3d\x22\x73\x76\x67\x32\x22\x0a\x20\x20\
-\x20\x73\x6f\x64\x69\x70\x6f\x64\x69\x3a\x76\x65\x72\x73\x69\x6f\
-\x6e\x3d\x22\x30\x2e\x33\x32\x22\x0a\x20\x20\x20\x69\x6e\x6b\x73\
-\x63\x61\x70\x65\x3a\x76\x65\x72\x73\x69\x6f\x6e\x3d\x22\x30\x2e\
-\x34\x37\x20\x72\x32\x32\x35\x38\x33\x22\x0a\x20\x20\x20\x73\x6f\
-\x64\x69\x70\x6f\x64\x69\x3a\x64\x6f\x63\x6e\x61\x6d\x65\x3d\x22\
-\x72\x75\x6e\x5f\x74\x6f\x73\x73\x2e\x73\x76\x67\x22\x0a\x20\x20\
-\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x6f\x75\x74\x70\x75\x74\
-\x5f\x65\x78\x74\x65\x6e\x73\x69\x6f\x6e\x3d\x22\x6f\x72\x67\x2e\
-\x69\x6e\x6b\x73\x63\x61\x70\x65\x2e\x6f\x75\x74\x70\x75\x74\x2e\
-\x73\x76\x67\x2e\x69\x6e\x6b\x73\x63\x61\x70\x65\x22\x0a\x20\x20\
-\x20\x76\x65\x72\x73\x69\x6f\x6e\x3d\x22\x31\x2e\x30\x22\x3e\x0a\
-\x20\x20\x3c\x73\x6f\x64\x69\x70\x6f\x64\x69\x3a\x6e\x61\x6d\x65\
-\x64\x76\x69\x65\x77\x0a\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x62\
-\x61\x73\x65\x22\x0a\x20\x20\x20\x20\x20\x70\x61\x67\x65\x63\x6f\
-\x6c\x6f\x72\x3d\x22\x23\x66\x66\x66\x66\x66\x66\x22\x0a\x20\x20\
-\x20\x20\x20\x62\x6f\x72\x64\x65\x72\x63\x6f\x6c\x6f\x72\x3d\x22\
-\x23\x36\x36\x36\x36\x36\x36\x22\x0a\x20\x20\x20\x20\x20\x62\x6f\
-\x72\x64\x65\x72\x6f\x70\x61\x63\x69\x74\x79\x3d\x22\x31\x2e\x30\
-\x22\x0a\x20\x20\x20\x20\x20\x67\x72\x69\x64\x74\x6f\x6c\x65\x72\
-\x61\x6e\x63\x65\x3d\x22\x31\x30\x30\x30\x30\x22\x0a\x20\x20\x20\
-\x20\x20\x67\x75\x69\x64\x65\x74\x6f\x6c\x65\x72\x61\x6e\x63\x65\
-\x3d\x22\x31\x30\x22\x0a\x20\x20\x20\x20\x20\x6f\x62\x6a\x65\x63\
-\x74\x74\x6f\x6c\x65\x72\x61\x6e\x63\x65\x3d\x22\x31\x30\x22\x0a\
-\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x70\x61\
-\x67\x65\x6f\x70\x61\x63\x69\x74\x79\x3d\x22\x30\x2e\x30\x22\x0a\
-\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x70\x61\
-\x67\x65\x73\x68\x61\x64\x6f\x77\x3d\x22\x32\x22\x0a\x20\x20\x20\
-\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x7a\x6f\x6f\x6d\x3d\
-\x22\x30\x2e\x39\x38\x39\x39\x34\x39\x34\x39\x22\x0a\x20\x20\x20\
-\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x63\x78\x3d\x22\x32\
-\x31\x31\x2e\x38\x37\x32\x30\x31\x22\x0a\x20\x20\x20\x20\x20\x69\
-\x6e\x6b\x73\x63\x61\x70\x65\x3a\x63\x79\x3d\x22\x35\x35\x2e\x35\
-\x39\x38\x38\x38\x37\x22\x0a\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\
-\x63\x61\x70\x65\x3a\x64\x6f\x63\x75\x6d\x65\x6e\x74\x2d\x75\x6e\
-\x69\x74\x73\x3d\x22\x70\x78\x22\x0a\x20\x20\x20\x20\x20\x69\x6e\
-\x6b\x73\x63\x61\x70\x65\x3a\x63\x75\x72\x72\x65\x6e\x74\x2d\x6c\
-\x61\x79\x65\x72\x3d\x22\x6c\x61\x79\x65\x72\x31\x22\x0a\x20\x20\
-\x20\x20\x20\x73\x68\x6f\x77\x67\x72\x69\x64\x3d\x22\x66\x61\x6c\
-\x73\x65\x22\x0a\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\
-\x65\x3a\x77\x69\x6e\x64\x6f\x77\x2d\x77\x69\x64\x74\x68\x3d\x22\
-\x31\x34\x34\x30\x22\x0a\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\
-\x61\x70\x65\x3a\x77\x69\x6e\x64\x6f\x77\x2d\x68\x65\x69\x67\x68\
-\x74\x3d\x22\x37\x38\x37\x22\x0a\x20\x20\x20\x20\x20\x69\x6e\x6b\
-\x73\x63\x61\x70\x65\x3a\x77\x69\x6e\x64\x6f\x77\x2d\x78\x3d\x22\
-\x30\x22\x0a\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\
-\x3a\x77\x69\x6e\x64\x6f\x77\x2d\x79\x3d\x22\x30\x22\x0a\x20\x20\
-\x20\x20\x20\x73\x68\x6f\x77\x67\x75\x69\x64\x65\x73\x3d\x22\x74\
-\x72\x75\x65\x22\x0a\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\
-\x70\x65\x3a\x67\x75\x69\x64\x65\x2d\x62\x62\x6f\x78\x3d\x22\x74\
-\x72\x75\x65\x22\x0a\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\
-\x70\x65\x3a\x77\x69\x6e\x64\x6f\x77\x2d\x6d\x61\x78\x69\x6d\x69\
-\x7a\x65\x64\x3d\x22\x30\x22\x20\x2f\x3e\x0a\x20\x20\x3c\x64\x65\
-\x66\x73\x0a\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x64\x65\x66\x73\
-\x34\x22\x3e\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\
-\x72\x61\x64\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\
-\x6e\x6b\x73\x63\x61\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\
-\x22\x61\x6c\x77\x61\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\
-\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\
-\x6e\x74\x33\x32\x39\x30\x22\x3e\x0a\x20\x20\x20\x20\x20\x20\x3c\
-\x73\x74\x6f\x70\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x73\x74\
-\x79\x6c\x65\x3d\x22\x73\x74\x6f\x70\x2d\x63\x6f\x6c\x6f\x72\x3a\
-\x23\x66\x66\x66\x66\x66\x66\x3b\x73\x74\x6f\x70\x2d\x6f\x70\x61\
-\x63\x69\x74\x79\x3a\x31\x3b\x22\x0a\x20\x20\x20\x20\x20\x20\x20\
-\x20\x20\x6f\x66\x66\x73\x65\x74\x3d\x22\x30\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x73\x74\x6f\x70\x33\x32\
-\x39\x32\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x20\x20\x3c\x73\x74\
-\x6f\x70\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x73\x74\x79\x6c\
-\x65\x3d\x22\x73\x74\x6f\x70\x2d\x63\x6f\x6c\x6f\x72\x3a\x23\x66\
-\x66\x66\x66\x66\x66\x3b\x73\x74\x6f\x70\x2d\x6f\x70\x61\x63\x69\
-\x74\x79\x3a\x30\x3b\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\
-\x6f\x66\x66\x73\x65\x74\x3d\x22\x31\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x20\x20\x69\x64\x3d\x22\x73\x74\x6f\x70\x33\x32\x39\x34\
-\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x2f\x6c\x69\x6e\x65\x61\
-\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x3e\x0a\x20\x20\x20\x20\x3c\
-\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\
-\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x38\x31\x32\x22\x3e\x0a\x20\
-\x20\x20\x20\x20\x20\x3c\x73\x74\x6f\x70\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x20\x20\x73\x74\x79\x6c\x65\x3d\x22\x73\x74\x6f\x70\x2d\
-\x63\x6f\x6c\x6f\x72\x3a\x23\x32\x65\x32\x65\x32\x65\x3b\x73\x74\
-\x6f\x70\x2d\x6f\x70\x61\x63\x69\x74\x79\x3a\x31\x3b\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x20\x20\x6f\x66\x66\x73\x65\x74\x3d\x22\
-\x30\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\
-\x73\x74\x6f\x70\x33\x38\x31\x34\x22\x20\x2f\x3e\x0a\x20\x20\x20\
-\x20\x20\x20\x3c\x73\x74\x6f\x70\x0a\x20\x20\x20\x20\x20\x20\x20\
-\x20\x20\x73\x74\x79\x6c\x65\x3d\x22\x73\x74\x6f\x70\x2d\x63\x6f\
-\x6c\x6f\x72\x3a\x23\x30\x30\x30\x30\x30\x30\x3b\x73\x74\x6f\x70\
-\x2d\x6f\x70\x61\x63\x69\x74\x79\x3a\x30\x3b\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x20\x20\x6f\x66\x66\x73\x65\x74\x3d\x22\x31\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x73\x74\
-\x6f\x70\x33\x38\x31\x36\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\
-\x2f\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x3e\
-\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\
-\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\
-\x63\x61\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\
-\x77\x61\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\
-\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\
-\x36\x34\x34\x22\x3e\x0a\x20\x20\x20\x20\x20\x20\x3c\x73\x74\x6f\
-\x70\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x73\x74\x79\x6c\x65\
-\x3d\x22\x73\x74\x6f\x70\x2d\x63\x6f\x6c\x6f\x72\x3a\x23\x30\x30\
-\x30\x30\x30\x30\x3b\x73\x74\x6f\x70\x2d\x6f\x70\x61\x63\x69\x74\
-\x79\x3a\x31\x3b\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x6f\
-\x66\x66\x73\x65\x74\x3d\x22\x30\x22\x0a\x20\x20\x20\x20\x20\x20\
-\x20\x20\x20\x69\x64\x3d\x22\x73\x74\x6f\x70\x33\x36\x34\x36\x22\
-\x20\x2f\x3e\x0a\x20\x20\x20\x20\x20\x20\x3c\x73\x74\x6f\x70\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x20\x20\x73\x74\x79\x6c\x65\x3d\x22\
-\x73\x74\x6f\x70\x2d\x63\x6f\x6c\x6f\x72\x3a\x23\x30\x30\x30\x30\
-\x30\x30\x3b\x73\x74\x6f\x70\x2d\x6f\x70\x61\x63\x69\x74\x79\x3a\
-\x30\x3b\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x6f\x66\x66\
-\x73\x65\x74\x3d\x22\x31\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\
-\x20\x69\x64\x3d\x22\x73\x74\x6f\x70\x33\x36\x34\x38\x22\x20\x2f\
-\x3e\x0a\x20\x20\x20\x20\x3c\x2f\x6c\x69\x6e\x65\x61\x72\x47\x72\
-\x61\x64\x69\x65\x6e\x74\x3e\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\
-\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\
-\x64\x69\x65\x6e\x74\x33\x32\x39\x39\x22\x3e\x0a\x20\x20\x20\x20\
-\x20\x20\x3c\x73\x74\x6f\x70\x0a\x20\x20\x20\x20\x20\x20\x20\x20\
-\x20\x73\x74\x79\x6c\x65\x3d\x22\x73\x74\x6f\x70\x2d\x63\x6f\x6c\
-\x6f\x72\x3a\x23\x36\x61\x37\x33\x39\x30\x3b\x73\x74\x6f\x70\x2d\
-\x6f\x70\x61\x63\x69\x74\x79\x3a\x31\x3b\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x20\x20\x6f\x66\x66\x73\x65\x74\x3d\x22\x30\x22\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x73\x74\x6f\
-\x70\x33\x33\x30\x31\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x20\x20\
-\x3c\x73\x74\x6f\x70\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x73\
-\x74\x79\x6c\x65\x3d\x22\x73\x74\x6f\x70\x2d\x63\x6f\x6c\x6f\x72\
-\x3a\x23\x65\x61\x65\x62\x65\x66\x3b\x73\x74\x6f\x70\x2d\x6f\x70\
-\x61\x63\x69\x74\x79\x3a\x31\x3b\x22\x0a\x20\x20\x20\x20\x20\x20\
-\x20\x20\x20\x6f\x66\x66\x73\x65\x74\x3d\x22\x31\x22\x0a\x20\x20\
-\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x73\x74\x6f\x70\x33\
-\x33\x30\x33\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x2f\x6c\x69\
-\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x3e\x0a\x20\x20\
-\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\
-\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\
-\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x32\x38\x33\x22\
-\x3e\x0a\x20\x20\x20\x20\x20\x20\x3c\x73\x74\x6f\x70\x0a\x20\x20\
-\x20\x20\x20\x20\x20\x20\x20\x73\x74\x79\x6c\x65\x3d\x22\x73\x74\
-\x6f\x70\x2d\x63\x6f\x6c\x6f\x72\x3a\x23\x66\x66\x66\x66\x66\x66\
-\x3b\x73\x74\x6f\x70\x2d\x6f\x70\x61\x63\x69\x74\x79\x3a\x30\x2e\
-\x37\x38\x36\x38\x38\x35\x32\x36\x3b\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x20\x20\x6f\x66\x66\x73\x65\x74\x3d\x22\x30\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x73\x74\x6f\x70\
-\x33\x32\x38\x35\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x20\x20\x3c\
-\x73\x74\x6f\x70\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x73\x74\
-\x79\x6c\x65\x3d\x22\x73\x74\x6f\x70\x2d\x63\x6f\x6c\x6f\x72\x3a\
-\x23\x66\x66\x66\x66\x66\x66\x3b\x73\x74\x6f\x70\x2d\x6f\x70\x61\
-\x63\x69\x74\x79\x3a\x30\x3b\x22\x0a\x20\x20\x20\x20\x20\x20\x20\
-\x20\x20\x6f\x66\x66\x73\x65\x74\x3d\x22\x31\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x73\x74\x6f\x70\x33\x32\
-\x38\x37\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x2f\x6c\x69\x6e\
-\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x3e\x0a\x20\x20\x20\
-\x20\x3c\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x70\x65\x72\x73\x70\
-\x65\x63\x74\x69\x76\x65\x0a\x20\x20\x20\x20\x20\x20\x20\x73\x6f\
-\x64\x69\x70\x6f\x64\x69\x3a\x74\x79\x70\x65\x3d\x22\x69\x6e\x6b\
-\x73\x63\x61\x70\x65\x3a\x70\x65\x72\x73\x70\x33\x64\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x76\
-\x70\x5f\x78\x3d\x22\x30\x20\x3a\x20\x35\x32\x36\x2e\x31\x38\x31\
-\x30\x39\x20\x3a\x20\x31\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\
-\x6e\x6b\x73\x63\x61\x70\x65\x3a\x76\x70\x5f\x79\x3d\x22\x30\x20\
-\x3a\x20\x31\x30\x30\x30\x20\x3a\x20\x30\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x76\x70\x5f\x7a\
-\x3d\x22\x37\x34\x34\x2e\x30\x39\x34\x34\x38\x20\x3a\x20\x35\x32\
-\x36\x2e\x31\x38\x31\x30\x39\x20\x3a\x20\x31\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x70\x65\x72\
-\x73\x70\x33\x64\x2d\x6f\x72\x69\x67\x69\x6e\x3d\x22\x33\x37\x32\
-\x2e\x30\x34\x37\x32\x34\x20\x3a\x20\x33\x35\x30\x2e\x37\x38\x37\
-\x33\x39\x20\x3a\x20\x31\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\
-\x64\x3d\x22\x70\x65\x72\x73\x70\x65\x63\x74\x69\x76\x65\x31\x30\
-\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x69\x6e\x6b\x73\x63\x61\
-\x70\x65\x3a\x70\x65\x72\x73\x70\x65\x63\x74\x69\x76\x65\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x73\x6f\x64\x69\x70\x6f\x64\x69\x3a\x74\
-\x79\x70\x65\x3d\x22\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x70\x65\
-\x72\x73\x70\x33\x64\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\
-\x6b\x73\x63\x61\x70\x65\x3a\x76\x70\x5f\x78\x3d\x22\x30\x20\x3a\
-\x20\x35\x32\x36\x2e\x31\x38\x31\x30\x39\x20\x3a\x20\x31\x22\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\
-\x76\x70\x5f\x79\x3d\x22\x30\x20\x3a\x20\x31\x30\x30\x30\x20\x3a\
-\x20\x30\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\
-\x61\x70\x65\x3a\x76\x70\x5f\x7a\x3d\x22\x37\x34\x34\x2e\x30\x39\
-\x34\x34\x38\x20\x3a\x20\x35\x32\x36\x2e\x31\x38\x31\x30\x39\x20\
-\x3a\x20\x31\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\
-\x63\x61\x70\x65\x3a\x70\x65\x72\x73\x70\x33\x64\x2d\x6f\x72\x69\
-\x67\x69\x6e\x3d\x22\x33\x37\x32\x2e\x30\x34\x37\x32\x34\x20\x3a\
-\x20\x33\x35\x30\x2e\x37\x38\x37\x33\x39\x20\x3a\x20\x31\x22\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x70\x65\x72\x73\x70\
-\x65\x63\x74\x69\x76\x65\x32\x34\x36\x33\x22\x20\x2f\x3e\x0a\x20\
-\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\
-\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\
-\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\
-\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x6c\x69\x6e\x6b\
-\x3a\x68\x72\x65\x66\x3d\x22\x23\x6c\x69\x6e\x65\x61\x72\x47\x72\
-\x61\x64\x69\x65\x6e\x74\x33\x32\x39\x39\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\
-\x64\x69\x65\x6e\x74\x33\x33\x33\x39\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x78\x31\x3d\x22\x32\x33\x36\x2e\x31\x34\x36\x37\x39\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x31\x3d\x22\x35\x30\x39\x2e\
-\x30\x38\x38\x39\x39\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x32\
-\x3d\x22\x32\x35\x36\x2e\x32\x35\x22\x0a\x20\x20\x20\x20\x20\x20\
-\x20\x79\x32\x3d\x22\x35\x35\x33\x2e\x31\x39\x31\x38\x33\x22\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\
-\x6e\x69\x74\x73\x3d\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\
-\x6e\x55\x73\x65\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x6c\x69\
-\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x63\x6f\x6c\
-\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\x79\x73\x22\x0a\x20\x20\
-\x20\x20\x20\x20\x20\x78\x6c\x69\x6e\x6b\x3a\x68\x72\x65\x66\x3d\
-\x22\x23\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\
-\x33\x32\x39\x39\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\
-\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\
-\x33\x34\x37\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\x3d\x22\
-\x32\x35\x31\x2e\x34\x36\x33\x34\x34\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x79\x31\x3d\x22\x35\x31\x30\x2e\x33\x37\x30\x34\x32\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x32\x3d\x22\x32\x36\x31\x2e\
-\x36\x37\x34\x37\x37\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x32\
-\x3d\x22\x35\x35\x38\x2e\x32\x39\x39\x38\x37\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\x6e\x69\x74\
-\x73\x3d\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\x6e\x55\x73\
-\x65\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x66\x69\x6c\x74\x65\
-\x72\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\
-\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\x79\
-\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x66\x69\
-\x6c\x74\x65\x72\x33\x35\x32\x35\x22\x3e\x0a\x20\x20\x20\x20\x20\
-\x20\x3c\x66\x65\x47\x61\x75\x73\x73\x69\x61\x6e\x42\x6c\x75\x72\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\
-\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\
-\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x73\x74\x64\
-\x44\x65\x76\x69\x61\x74\x69\x6f\x6e\x3d\x22\x33\x2e\x31\x30\x39\
-\x33\x33\x33\x32\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x69\
-\x64\x3d\x22\x66\x65\x47\x61\x75\x73\x73\x69\x61\x6e\x42\x6c\x75\
-\x72\x33\x35\x32\x37\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x2f\
-\x66\x69\x6c\x74\x65\x72\x3e\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\
-\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x63\x6f\x6c\x6c\
-\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\x79\x73\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x78\x6c\x69\x6e\x6b\x3a\x68\x72\x65\x66\x3d\x22\
-\x23\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\
-\x32\x39\x39\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\
-\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x35\
-\x34\x37\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x67\x72\x61\x64\x69\
-\x65\x6e\x74\x55\x6e\x69\x74\x73\x3d\x22\x75\x73\x65\x72\x53\x70\
-\x61\x63\x65\x4f\x6e\x55\x73\x65\x22\x0a\x20\x20\x20\x20\x20\x20\
-\x20\x78\x31\x3d\x22\x31\x37\x30\x2e\x34\x32\x30\x31\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x79\x31\x3d\x22\x35\x31\x33\x2e\x33\x32\
-\x34\x33\x34\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x32\x3d\x22\
-\x31\x37\x30\x2e\x34\x32\x30\x31\x22\x0a\x20\x20\x20\x20\x20\x20\
-\x20\x79\x32\x3d\x22\x35\x37\x37\x2e\x30\x36\x38\x37\x33\x22\x20\
-\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\
-\x61\x64\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\
-\x6b\x73\x63\x61\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\
-\x61\x6c\x77\x61\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\
-\x6c\x69\x6e\x6b\x3a\x68\x72\x65\x66\x3d\x22\x23\x6c\x69\x6e\x65\
-\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x32\x38\x33\x22\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\
-\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x35\x35\x35\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\x6e\
-\x69\x74\x73\x3d\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\x6e\
-\x55\x73\x65\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\x3d\x22\
-\x32\x36\x33\x2e\x33\x30\x39\x35\x37\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x79\x31\x3d\x22\x35\x31\x37\x2e\x39\x32\x39\x33\x38\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x32\x3d\x22\x32\x35\x34\x2e\
-\x33\x34\x31\x34\x36\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x32\
-\x3d\x22\x35\x34\x30\x2e\x32\x34\x38\x36\x22\x20\x2f\x3e\x0a\x20\
-\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\
-\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\
-\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\
-\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x6c\x69\x6e\x6b\
-\x3a\x68\x72\x65\x66\x3d\x22\x23\x6c\x69\x6e\x65\x61\x72\x47\x72\
-\x61\x64\x69\x65\x6e\x74\x33\x32\x38\x33\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\
-\x64\x69\x65\x6e\x74\x33\x35\x35\x39\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\x6e\x69\x74\x73\x3d\
-\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\x6e\x55\x73\x65\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\x3d\x22\x31\x37\x30\x2e\
-\x34\x32\x30\x31\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x31\x3d\
-\x22\x35\x30\x31\x2e\x37\x31\x39\x34\x35\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x78\x32\x3d\x22\x31\x37\x30\x2e\x34\x32\x30\x31\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x32\x3d\x22\x35\x31\x38\x2e\
-\x33\x36\x31\x36\x39\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x6c\
-\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x0a\x20\x20\
-\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x63\x6f\
-\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\x79\x73\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x78\x6c\x69\x6e\x6b\x3a\x68\x72\x65\x66\
-\x3d\x22\x23\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\
-\x74\x33\x36\x34\x34\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\
-\x3d\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\
-\x33\x36\x35\x30\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\x3d\
-\x22\x31\x32\x38\x2e\x34\x32\x35\x38\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x79\x31\x3d\x22\x34\x39\x38\x2e\x30\x37\x31\x34\x34\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x32\x3d\x22\x31\x32\x38\x2e\
-\x34\x32\x35\x38\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x32\x3d\
-\x22\x35\x32\x37\x2e\x35\x35\x33\x39\x36\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\x6e\x69\x74\x73\
-\x3d\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\x6e\x55\x73\x65\
-\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x66\x69\x6c\x74\x65\x72\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\
-\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\x79\x73\
-\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x66\x69\x6c\
-\x74\x65\x72\x33\x38\x30\x38\x22\x3e\x0a\x20\x20\x20\x20\x20\x20\
-\x3c\x66\x65\x47\x61\x75\x73\x73\x69\x61\x6e\x42\x6c\x75\x72\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\
-\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\x79\
-\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x73\x74\x64\x44\
-\x65\x76\x69\x61\x74\x69\x6f\x6e\x3d\x22\x31\x2e\x38\x38\x37\x34\
-\x39\x39\x39\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x20\x20\x69\x64\
-\x3d\x22\x66\x65\x47\x61\x75\x73\x73\x69\x61\x6e\x42\x6c\x75\x72\
-\x33\x38\x31\x30\x22\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x2f\x66\
-\x69\x6c\x74\x65\x72\x3e\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\x65\
-\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\x65\x3a\x63\x6f\x6c\x6c\x65\
-\x63\x74\x3d\x22\x61\x6c\x77\x61\x79\x73\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x78\x6c\x69\x6e\x6b\x3a\x68\x72\x65\x66\x3d\x22\x23\
-\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x38\
-\x31\x32\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x6c\
-\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x38\x31\
-\x38\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\x3d\x22\x33\x37\
-\x37\x2e\x35\x30\x32\x31\x34\x22\x0a\x20\x20\x20\x20\x20\x20\x20\
-\x79\x31\x3d\x22\x35\x30\x37\x2e\x32\x32\x31\x31\x39\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x78\x32\x3d\x22\x33\x37\x37\x2e\x35\x30\
-\x32\x31\x34\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x32\x3d\x22\
-\x35\x33\x34\x2e\x31\x36\x32\x31\x31\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\x6e\x69\x74\x73\x3d\
-\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\x6e\x55\x73\x65\x22\
-\x20\x2f\x3e\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\
-\x72\x61\x64\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\
-\x6e\x6b\x73\x63\x61\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\
-\x22\x61\x6c\x77\x61\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\
-\x78\x6c\x69\x6e\x6b\x3a\x68\x72\x65\x66\x3d\x22\x23\x6c\x69\x6e\
-\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x38\x31\x32\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\
-\x61\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x38\x33\x33\x22\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\
-\x6e\x69\x74\x73\x3d\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\
-\x6e\x55\x73\x65\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\x3d\
-\x22\x33\x37\x37\x2e\x35\x30\x32\x31\x34\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x79\x31\x3d\x22\x35\x30\x37\x2e\x32\x32\x31\x31\x39\
-\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x32\x3d\x22\x33\x37\x37\
-\x2e\x35\x30\x32\x31\x34\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x79\
-\x32\x3d\x22\x35\x33\x34\x2e\x31\x36\x32\x31\x31\x22\x20\x2f\x3e\
-\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\
-\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\
-\x63\x61\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\
-\x77\x61\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x6c\x69\
-\x6e\x6b\x3a\x68\x72\x65\x66\x3d\x22\x23\x6c\x69\x6e\x65\x61\x72\
-\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x32\x39\x30\x22\x0a\x20\x20\
-\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\x47\
-\x72\x61\x64\x69\x65\x6e\x74\x33\x32\x39\x36\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x78\x31\x3d\x22\x34\x35\x34\x2e\x35\x32\x36\x37\
-\x39\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x31\x3d\x22\x34\x38\
-\x31\x2e\x32\x39\x30\x37\x34\x22\x0a\x20\x20\x20\x20\x20\x20\x20\
-\x78\x32\x3d\x22\x33\x33\x30\x2e\x30\x30\x34\x34\x36\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x79\x32\x3d\x22\x34\x38\x31\x2e\x32\x39\
-\x30\x37\x34\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x67\x72\x61\x64\
-\x69\x65\x6e\x74\x55\x6e\x69\x74\x73\x3d\x22\x75\x73\x65\x72\x53\
-\x70\x61\x63\x65\x4f\x6e\x55\x73\x65\x22\x20\x2f\x3e\x0a\x20\x20\
-\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\x65\x6e\
-\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\x61\x70\
-\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\x61\x79\
-\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x6c\x69\x6e\x6b\x3a\
-\x68\x72\x65\x66\x3d\x22\x23\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\
-\x64\x69\x65\x6e\x74\x33\x32\x39\x39\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\
-\x69\x65\x6e\x74\x33\x33\x31\x30\x22\x0a\x20\x20\x20\x20\x20\x20\
-\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\x6e\x69\x74\x73\x3d\x22\
-\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\x6e\x55\x73\x65\x22\x0a\
-\x20\x20\x20\x20\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x54\
-\x72\x61\x6e\x73\x66\x6f\x72\x6d\x3d\x22\x74\x72\x61\x6e\x73\x6c\
-\x61\x74\x65\x28\x33\x2e\x36\x32\x32\x31\x30\x39\x34\x65\x2d\x34\
-\x2c\x30\x29\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\x3d\x22\
-\x33\x32\x37\x2e\x31\x34\x32\x38\x35\x22\x0a\x20\x20\x20\x20\x20\
-\x20\x20\x79\x31\x3d\x22\x35\x37\x31\x2e\x32\x39\x30\x37\x37\x22\
-\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x32\x3d\x22\x33\x32\x37\x2e\
-\x31\x34\x32\x38\x35\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x79\x32\
-\x3d\x22\x34\x38\x31\x2e\x32\x39\x30\x37\x34\x22\x20\x2f\x3e\x0a\
-\x20\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\x64\x69\
-\x65\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\x73\x63\
-\x61\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\x6c\x77\
-\x61\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x6c\x69\x6e\
-\x6b\x3a\x68\x72\x65\x66\x3d\x22\x23\x6c\x69\x6e\x65\x61\x72\x47\
-\x72\x61\x64\x69\x65\x6e\x74\x33\x32\x39\x39\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\x47\x72\
-\x61\x64\x69\x65\x6e\x74\x33\x33\x37\x34\x22\x0a\x20\x20\x20\x20\
-\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\x6e\x69\x74\x73\
-\x3d\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\x6e\x55\x73\x65\
-\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\
-\x74\x54\x72\x61\x6e\x73\x66\x6f\x72\x6d\x3d\x22\x74\x72\x61\x6e\
-\x73\x6c\x61\x74\x65\x28\x33\x2e\x36\x32\x32\x31\x30\x39\x34\x65\
-\x2d\x34\x2c\x30\x29\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\
-\x3d\x22\x33\x32\x37\x2e\x31\x34\x32\x38\x35\x22\x0a\x20\x20\x20\
-\x20\x20\x20\x20\x79\x31\x3d\x22\x35\x37\x31\x2e\x32\x39\x30\x37\
-\x37\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x32\x3d\x22\x33\x32\
-\x37\x2e\x31\x34\x32\x38\x35\x22\x0a\x20\x20\x20\x20\x20\x20\x20\
-\x79\x32\x3d\x22\x34\x38\x31\x2e\x32\x39\x30\x37\x34\x22\x20\x2f\
-\x3e\x0a\x20\x20\x20\x20\x3c\x6c\x69\x6e\x65\x61\x72\x47\x72\x61\
-\x64\x69\x65\x6e\x74\x0a\x20\x20\x20\x20\x20\x20\x20\x69\x6e\x6b\
-\x73\x63\x61\x70\x65\x3a\x63\x6f\x6c\x6c\x65\x63\x74\x3d\x22\x61\
-\x6c\x77\x61\x79\x73\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x6c\
-\x69\x6e\x6b\x3a\x68\x72\x65\x66\x3d\x22\x23\x6c\x69\x6e\x65\x61\
-\x72\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x32\x39\x39\x22\x0a\x20\
-\x20\x20\x20\x20\x20\x20\x69\x64\x3d\x22\x6c\x69\x6e\x65\x61\x72\
-\x47\x72\x61\x64\x69\x65\x6e\x74\x33\x33\x37\x36\x22\x0a\x20\x20\
-\x20\x20\x20\x20\x20\x67\x72\x61\x64\x69\x65\x6e\x74\x55\x6e\x69\
-\x74\x73\x3d\x22\x75\x73\x65\x72\x53\x70\x61\x63\x65\x4f\x6e\x55\
-\x73\x65\x22\x0a\x20\x20\x20\x20\x20\x20\x20\x78\x31\x3d\x22\x32\
-\x33\x36\x2e\x31\x34\x36\x37\x39\x22\x0a\x20\x20\x20\x20\x20\x20\
-\x20\x79\x31\x3d\x22\x35\x30\x39\x2e\x30\x38\x38\x39\x39\x22\x0a\
-\x20\x20\x20\x20\x20\x20\x2...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-27 09:44:04
|
Revision: 1574
http://toss.svn.sourceforge.net/toss/?rev=1574&view=rev
Author: lukstafi
Date: 2011-09-27 09:43:50 +0000 (Tue, 27 Sep 2011)
Log Message:
-----------
GDL translation: major overhaul due to extending compact argument passing from defined relations to all relations; removed constant argument elimination, instead fluent-discriminating information is passed to relations using additional (val_X) elements introduced recently.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/GDLTest.ml
trunk/Toss/GGP/TranslateFormula.ml
trunk/Toss/GGP/TranslateFormula.mli
trunk/Toss/GGP/TranslateFormulaTest.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGame.mli
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
trunk/Toss/GGP/tests/breakthrough-raw.toss
trunk/Toss/GGP/tests/breakthrough-simpl.toss
trunk/Toss/GGP/tests/connect4-raw.toss
trunk/Toss/GGP/tests/connect4-simpl.toss
trunk/Toss/GGP/tests/connect5-raw.toss
trunk/Toss/GGP/tests/connect5-simpl.toss
trunk/Toss/GGP/tests/tictactoe-raw.toss
trunk/Toss/GGP/tests/tictactoe-simpl.toss
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-09-26 00:10:41 UTC (rev 1573)
+++ trunk/Toss/Formula/Aux.ml 2011-09-27 09:43:50 UTC (rev 1574)
@@ -342,11 +342,11 @@
x :: unique eq (List.filter (fun y -> not (eq y x)) xs)
let not_unique xs =
- let rec aux left = function
+ let rec aux = function
| [] -> false
- | x :: xs when List.mem x left || List.mem x xs -> true
- | x :: xs -> aux (x::left) xs in
- aux [] xs
+ | x :: xs when List.mem x xs -> true
+ | x :: xs -> aux xs in
+ aux xs
let take_n n l =
let rec aux n acc = function
@@ -545,6 +545,8 @@
let neg f x = not (f x)
+let is_right = function Right _ -> true | Left _ -> false
+
let partition_choice l =
let rec split laux raux = function
| [] -> List.rev laux, List.rev raux
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-09-26 00:10:41 UTC (rev 1573)
+++ trunk/Toss/Formula/Aux.mli 2011-09-27 09:43:50 UTC (rev 1574)
@@ -267,6 +267,8 @@
(** [neg f x = not (f x)] *)
val neg : ('a -> bool) -> 'a -> bool
+val is_right : ('a, 'b) choice -> bool
+
(** Partition a list of tagged elements into the [Left] and
[Right]-tagged elements. *)
val partition_choice : ('a, 'b) choice list -> 'a list * 'b list
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-26 00:10:41 UTC (rev 1573)
+++ trunk/Toss/GGP/GDL.ml 2011-09-27 09:43:50 UTC (rev 1574)
@@ -221,7 +221,7 @@
stratify (stratum::strata) (more_rules @ rules)
(* Topological-like sort w.r.t. the call-graph. *)
-let topsort_callgraph clauses for_rels =
+let topsort_callgraph (*for_rels*) clauses =
let defs = defs_of_rules (Aux.concat_map rules_of_clause clauses) in
(* building incidence list *)
let defs = List.map
@@ -232,7 +232,7 @@
defs in
let defs = List.map
(fun (rel, drels) ->
- rel, Aux.strings_of_list (Aux.list_inter drels for_rels)) defs in
+ rel, Aux.strings_of_list (*Aux.list_inter for_rels*) drels) defs in
let rec aux strata defs =
if defs = [] then List.flatten (List.rev strata)
else
@@ -247,7 +247,7 @@
let defs = List.map
(fun (r,calls) -> r, Aux.Strings.diff calls visited) defs in
aux (stratum::strata) defs in
- aux [] (List.filter (fun (r,_) -> List.mem r for_rels) defs)
+ aux [] (*List.filter (fun (r,_) -> List.mem r for_rels)*) defs
let rec subst_one (x, term as sb) = function
| Var y when x=y -> term
@@ -444,6 +444,9 @@
| Disj disjs ->
"(or "^String.concat " " (List.map literal_str disjs)^")"
+let literals_str lits =
+ String.concat " " (List.map literal_str lits)
+
let clause_str (head, body) =
"(<= "^rel_atom_str head^"\n "^String.concat "\n "
(List.map literal_str body)^")"
@@ -1050,29 +1053,69 @@
Aux.concat_map (elim_ground_arg_in_body rel arg grounding)
(renamed_brs @ clauses)
-let elim_ground_args rels clauses =
- let new_rels = ref [] and all_rels = ref [] in
- let rec aux clauses = function
+let elim_ground_args rels1 rels2 clauses =
+ let new_rels1 = ref [] and all_rels1 = ref [] in
+ let new_rels2 = ref [] and all_rels2 = ref [] in
+ let rec aux new_rels all_rels clauses = function
| [] -> clauses
| rel::rels ->
(let try arg = find_ground_arg rel clauses in
- aux (elim_ground_arg new_rels rel arg clauses) rels
+ let clauses = elim_ground_arg new_rels rel arg clauses in
+ aux new_rels all_rels clauses rels
with Not_found ->
- all_rels := rel:: !all_rels; aux clauses rels) in
+ all_rels := rel:: !all_rels;
+ aux new_rels all_rels clauses rels) in
let rec fix clauses =
- all_rels := !new_rels @ !all_rels;
- new_rels := [];
- let clauses = aux clauses rels in
- if !new_rels <> []
+ all_rels1 := !new_rels1 @ !all_rels1;
+ new_rels1 := [];
+ let clauses = aux new_rels1 all_rels1 clauses rels1 in
+ all_rels2 := !new_rels2 @ !all_rels2;
+ new_rels2 := [];
+ let clauses = aux new_rels2 all_rels2 clauses rels2 in
+ if !new_rels1 <> [] || !new_rels2 <> []
then fix clauses
else
- let all_rels = List.filter
+ let all_rels1 = List.filter
(fun r->List.exists
(function ((rel,_),_) when r=rel -> true | _ -> false) clauses)
- (Aux.unique_sorted !all_rels) in
- all_rels, clauses in
+ (Aux.unique_sorted !all_rels1) in
+ let all_rels2 = List.filter
+ (fun r->List.exists
+ (function ((rel,_),_) when r=rel -> true | _ -> false) clauses)
+ (Aux.unique_sorted !all_rels2) in
+ all_rels1, all_rels2, clauses in
fix clauses
+let elim_ground_distinct clauses =
+ let rec filter_disj = function
+ | Pos (Distinct ts) when Aux.Strings.is_empty (terms_vars ts) ->
+ if Aux.not_unique (Array.to_list ts)
+ then None
+ else raise Not_found (* disjunction is true *)
+ | Neg (Distinct ts) when Aux.Strings.is_empty (terms_vars ts) ->
+ if Aux.not_unique (Array.to_list ts)
+ then raise Not_found (* disjunction is true *)
+ else None
+ | Disj d -> Some (Disj (Aux.map_some filter_disj d))
+ | lit -> Some lit in
+ let filter_conj = function
+ | Pos (Distinct ts) when Aux.Strings.is_empty (terms_vars ts) ->
+ if Aux.not_unique (Array.to_list ts)
+ then raise Not_found
+ else None
+ | Neg (Distinct ts) when Aux.Strings.is_empty (terms_vars ts) ->
+ if Aux.not_unique (Array.to_list ts)
+ then None
+ else raise Not_found
+ | Disj d ->
+ (try Some (Disj (Aux.map_some filter_disj d)) with Not_found -> None)
+ | lit -> Some lit in
+ Aux.map_try
+ (fun (h, body) ->
+ h, Aux.map_some filter_conj body)
+ clauses
+
+
let state_cls terms =
List.map (fun t -> ("true", [|t|]), []) terms
@@ -1765,7 +1808,9 @@
List.fold_left (fun acc (p, s) -> subst_past_blank arities p s acc)
blank path_subts
with Not_found ->
- invalid_arg "blank_outside_subterms: conflicting paths"
+ invalid_arg
+ ("blank_outside_subterms: conflicting paths "^
+ (String.concat "; "(List.map (fun (p,_)->path_str p) path_subts)))
(* If some path points only to bigger than one (i.e. non-leaf)
@@ -1889,3 +1934,13 @@
(* }}} *)
let res = aux terms paths in
res
+
+(* The integers should be all-distinct and in {0..N-1}. *)
+type argpaths = (path * int) list list
+
+
+let find_rel_arg sterms args apset =
+ List.find
+ (fun s -> List.for_all (fun (p,i) ->
+ try at_path s p = args.(i) with Not_found -> false) apset)
+ sterms
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-09-26 00:10:41 UTC (rev 1573)
+++ trunk/Toss/GGP/GDL.mli 2011-09-27 09:43:50 UTC (rev 1574)
@@ -151,8 +151,11 @@
defining clause. Return the new clauses, and also the new
relation set. *)
val elim_ground_args :
- string list -> clause list -> string list * clause list
+ string list -> string list -> clause list ->
+ string list * string list * clause list
+val elim_ground_distinct : clause list -> clause list
+
val state_cls : term list -> clause list
(** {3 GDL translation helpers.} *)
@@ -171,9 +174,11 @@
val rel_atom_str : rel_atom -> string
val def_str : string * def_branch list -> string
val literal_str : literal -> string
+val literals_str : literal list -> string
val clause_str : clause -> string
+val sb_str : (string * term) list -> string
-val topsort_callgraph : clause list -> string list -> string list
+val topsort_callgraph : (* string list -> *) clause list -> string list
(** {3 GDL whole-game operations.}
@@ -286,3 +291,8 @@
in terms. *)
val refine_paths_avoiding :
path_set -> (term -> bool) -> (term -> bool) -> term list -> path_set
+
+(** The integers should be all-distinct and in {0..N-1}. *)
+type argpaths = (path * int) list list
+
+val find_rel_arg : term list -> term array -> (path * int) list -> term
Modified: trunk/Toss/GGP/GDLTest.ml
===================================================================
--- trunk/Toss/GGP/GDLTest.ml 2011-09-26 00:10:41 UTC (rev 1573)
+++ trunk/Toss/GGP/GDLTest.ml 2011-09-27 09:43:50 UTC (rev 1574)
@@ -338,8 +338,8 @@
(nextcol ?d ?e)
(true (cell ?x ?e o)))
" in
- let defined_rels, result =
- elim_ground_args ["conn5"; "col"; "row"] descr in
+ let _, defined_rels, result =
+ elim_ground_args [] ["conn5"; "col"; "row"] descr in
let res_s =
(String.concat "\n" (List.map GDL.clause_str result)) in
assert_equal ~printer:(fun x->x)
Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml 2011-09-26 00:10:41 UTC (rev 1573)
+++ trunk/Toss/GGP/TranslateFormula.ml 2011-09-27 09:43:50 UTC (rev 1574)
@@ -4,6 +4,21 @@
let debug_level = ref 0
+type transl_data = {
+ f_paths : path_set; (* fluent paths *)
+ c_paths : path_set; (* coordinate paths *)
+ all_paths : path_set; (* sum of f_paths and c_paths *)
+ root_reps : term list; (* coordinate root terms *)
+ counters : string list;
+ num_functions : (string * Formula.real_expr) list;
+ defined_rels : string list;
+ argpaths : (string * (path list array, argpaths) Aux.choice) list;
+ (* [Left argpaths] are coordinating relation argument paths, [Right
+ argpaths] is fact relation argument partition. *)
+ term_arities : (string * int) list;
+}
+
+
let rel_atoms body =
Aux.map_some (function Rel (rel, args) -> Some (rel, args)
| _ -> None) (atoms_of_body body)
@@ -61,22 +76,6 @@
| _ -> assert false
) state_terms in
other, pos_terms, neg_terms) disj
-
-type defrel_argpaths = (GDL.path * int) list list
-
-type transl_data = {
- f_paths : path_set; (* fluent paths *)
- c_paths : path_set; (* coordinate paths *)
- all_paths : path_set; (* sum of f_paths and c_paths *)
- root_reps : term list; (* coordinate root terms *)
- counters : string list;
- num_functions : (string * Formula.real_expr) list;
- defined_rels : string list;
- mutable defrel_argpaths : (string * defrel_argpaths) list;
- (* late binding to store $ArgMode# data *)
- term_arities : (string * int) list;
- rel_default_path : (string * path option array) list;
-}
let empty_transl_data = {
f_paths = empty_path_set;
@@ -86,9 +85,8 @@
num_functions = [];
counters = [];
defined_rels = [];
- defrel_argpaths = [];
+ argpaths = [];
term_arities = [];
- rel_default_path = [];
}
let blank_out data t =
@@ -106,27 +104,26 @@
(term_to_name (blank_outside_subterms data.term_arities path_subts))
-let find_defrel_arg sterms args apset =
+let find_rel_arg sterms args apset =
List.find
(fun s -> List.for_all (fun (p,i) ->
try at_path s p = args.(i) with Not_found -> false) apset)
sterms
-let translate_defrel data sterms sign rel args =
+let translate_factrel data sterms sign rel args partition =
(* {{{ log entry *)
if !debug_level > 2 then (
- Printf.printf "translate_defrel: phi=%s, sign=%b\n"
+ Printf.printf "translate_factrel: phi=%s, sign=%b\n"
(rel_atom_str (rel, args)) sign
);
(* }}} *)
- let partition = List.assoc rel data.defrel_argpaths in
let s_l =
- try List.map (find_defrel_arg sterms args) partition
+ try List.map (find_rel_arg sterms args) partition
with Not_found -> failwith
- ("could not build arguments for defined relation "^rel) in
+ ("could not build arguments for relation "^rel) in
let vtup = Array.of_list (List.map (var_of_term data) s_l) in
- let defrel_phi = Formula.Rel (rel, vtup) in
- if sign then defrel_phi else Formula.Not defrel_phi
+ let rel_phi = Formula.Rel (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))
let counter_v = `FO counter_n
@@ -149,7 +146,13 @@
);
(* }}} *)
let s_subterms = Aux.collect s_subterms in
- let transl_rel sign rel args =
+ let transl_coordrel sign rel args =
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "transl_coordrel: sign=%B; atom=%s\n%!"
+ sign (rel_atom_str (rel, args))
+ );
+ (* }}} *)
(let try stuples =
List.map (fun arg -> List.assoc arg s_subterms)
(Array.to_list args) in
@@ -167,17 +170,18 @@
if rel = "EQ_" && vartup.(0) = vartup.(1)
then None
else
- let fact_rel = rel_on_paths rel (List.map snd stup) in
- Some (Formula.Rel (fact_rel, vartup)))
+ let rname = rel_on_paths rel (List.map snd stup) in
+ Some (Formula.Rel (rname, vartup)))
stuples in
if sign then atoms
else List.map (fun a -> Formula.Not a) atoms
- with Not_found -> []) in
- let transl_posdefrel sign rel args =
- if List.mem rel data.defined_rels
- then
- [translate_defrel data sterms_all sign rel args]
- else transl_rel sign rel args in
+ with Not_found -> assert false) in
+ let transl_rel sign rel args =
+ match List.assoc rel data.argpaths with
+ | Aux.Left _ ->
+ transl_coordrel sign rel args
+ | Aux.Right partition ->
+ [translate_factrel data sterms_all sign rel args partition] in
let transl_c = function
| Const v when
(try ignore (float_of_string v); true with _ -> false) ->
@@ -218,8 +222,8 @@
(try ignore [transl_c t1; transl_c t2]; true
with Not_found -> false) ->
transl_numfun_rel false rel t1 t2
- | Pos (Rel (rel, args)) -> transl_posdefrel true rel args
- | Neg (Rel (rel, args)) -> transl_posdefrel false rel args
+ | Pos (Rel (rel, args)) -> transl_rel true rel args
+ | Neg (Rel (rel, args)) -> transl_rel false rel args
| Pos (Does _ | Role _) | Neg (Does _ | Role _) ->
[]
| Pos (Distinct ts) ->
@@ -372,171 +376,19 @@
else res
(* **************************************** *)
-(* {3 Build and use defined relations.} *)
+(* {3 Build defined relations.} *)
-let select_defrel_argpaths drel data clauses =
- let atoms_sterms = List.map
- (fun ((rel,args), body) ->
- let r_atoms = if rel = drel then [args] else [] in
- let r_atoms = r_atoms @ Aux.map_some
- (function Rel (rel, args) when rel = drel -> Some args
- | _ -> None)
- (atoms_of_body body) in
- r_atoms, state_terms body
- (* we take all state terms to have more compact partition *)
- (*Aux.map_some
- (function Pos (True s) -> Some s | _ -> None) body*))
- clauses in
- let check_path args p s_p =
- let inds = Aux.array_argfind_all (fun r -> r=s_p) args in
- List.map (fun i->p,i) inds in
- let sterm_path_sets args s =
- (* {{{ log entry *)
- if !debug_level > 4 then (
- Printf.printf "sterm_path_sets: rel=%s args={%s} sterm=%s\n%!"
- drel
- (String.concat ", " (Array.to_list (Array.map term_str args)))
- (term_str s)
- );
- (* }}} *)
- let psets = map_paths (check_path args) data.c_paths s in
- (* {{{ log entry *)
- if !debug_level > 4 then (
- Printf.printf "sterm_path_sets: psets=%s\n%!"
- (String.concat "; "(List.map (fun pset->"["^
- String.concat ", " (List.map (fun (p,i)->
- path_str p^":"^string_of_int i) pset)^"]") psets))
- );
- (* }}} *)
- let ptups = Aux.product (Aux.list_remove [] psets) in
- (* distinct [p] in a tuple is already ensured *)
- List.filter (fun tup ->
- not (Aux.not_unique (List.map snd tup))) ptups in
- let argpath_sets = Aux.concat_map
- (fun (atoms, sterms) -> Aux.concat_map
- (fun args -> Aux.concat_map (sterm_path_sets args) sterms)
- atoms)
- atoms_sterms in
- let argpath_sets =
- Aux.map_reduce (fun pset -> pset, 1) (+) 0 argpath_sets in
- let argpath_sets = List.sort Pervasives.compare
- (List.map (* lexicographic comparison *)
- (fun (pset,count) -> List.length pset, count, pset)
- argpath_sets) in
- (* {{{ log entry *)
- if !debug_level > 2 then (
- Printf.printf
- "select_defrel_argpaths: drel=%s; argpath_sets=\n%!" drel;
- List.iter (fun (len, count, pset) ->
- Printf.printf "len=%d; count=%d; pset=%s\n%!" len count
- (String.concat ", "
- (List.map (fun (p,i)->path_str p^": "^string_of_int i) pset)))
- argpath_sets
- );
- (* }}} *)
- let argpath_sets = List.map Aux.trd3 (List.rev argpath_sets) in
- (* now greedily -- by traversing the ordering -- select covering *)
- let apsets_cover = List.fold_left
- (fun cover apset ->
- if List.exists
- (fun (_,i) -> not (List.exists (fun cov_apset ->
- List.exists (fun (_,j)->i=j) cov_apset) cover)) apset
- then apset::cover else cover)
- [] argpath_sets in
- (* eliminating multiple points -- starting with best apsets so
- they're unchanged *)
- let partition = List.fold_left
- (fun partition apset ->
- let apset = List.filter (fun (_,i) ->
- not (List.exists (fun cov_apset ->
- List.exists (fun (_,j)->i=j) cov_apset) partition)) apset in
- if apset = [] then partition else apset::partition)
- [] apsets_cover in
- (* {{{ log entry *)
- if !debug_level > 2 then (
- Printf.printf
- "select_defrel_argpaths: drel=%s; partition=\n%!" drel;
- List.iter (fun pset ->
- Printf.printf "pset=%s\n%!"
- (String.concat ", "
- (List.map (fun (p,i)->path_str p^": "^string_of_int i) pset)))
- partition
- );
- (* }}} *)
- (* filling-in missing paths from precomputed defaults *)
- let arity = Array.length
- (List.hd (fst (List.find (fun (atoms,_) -> atoms<>[])
- atoms_sterms))) in
- let argpaths = Array.init arity
- (fun i ->
- try List.find (List.exists (fun (_,j)->i=j)) partition
- with Not_found ->
- try
- match (List.assoc drel data.rel_default_path).(i) with
- | Some p -> [p, i]
- | None -> raise Not_found
- with Not_found ->
- failwith
- (Printf.sprintf
- "TranslateFormula.build_defrels: could not \
- determine path for relation %s argument %d" drel i)
- ) in
- let res = Aux.unique (=) (Array.to_list argpaths) in
- (* {{{ log entry *)
- if !debug_level > 2 then (
- Printf.printf
- "select_defrel_argpaths: drel=%s; result=\n%!" drel;
- List.iter (fun pset ->
- Printf.printf "pset=%s\n%!"
- (String.concat ", "
- (List.map (fun (p,i)->path_str p^": "^string_of_int i) pset)))
- res
- );
- (* }}} *)
- res
-
-
-let defrel_transform drel partition data ((h_rel,h_args as h),body as cl) =
- (* adding "true" atoms to clauses for missing argpath state terms *)
- let r_atoms = if h_rel = drel then [h_args] else [] in
- let r_atoms = r_atoms @ Aux.map_some
- (function Rel (rel, args) when rel = drel -> Some args
- | _ -> None)
- (atoms_of_body body) in
- let sterms = Aux.map_some
- (function Pos (True s) -> Some s | _ -> None) body in
- let sterm_arg_for_atom args apset =
- try ignore (find_defrel_arg sterms args apset); None
- with Not_found ->
- let path_subts = List.map (fun (p,i)->p, args.(i)) apset in
- Some (blank_outside_subterms data.term_arities path_subts) in
- let add_sterms = Aux.concat_map
- (fun args -> Aux.map_some (sterm_arg_for_atom args) partition)
- r_atoms in
- (* {{{ log entry *)
- if !debug_level > 2 && add_sterms <> [] then (
- Printf.printf
- "defrel_transform: add_sterms=%s; clause=\n%s\n\n%!"
- (String.concat ", " (List.map term_str add_sterms))
- (clause_str cl)
- );
- (* }}} *)
- h, Aux.map_rev_prepend body (fun s -> Pos (True s)) add_sterms
-
-
let build_defrels data clauses =
- let defined_rels_ord =
- topsort_callgraph clauses data.defined_rels in
- let process_drel clauses drel =
- let partition =
- select_defrel_argpaths drel data clauses in
- data.defrel_argpaths <- (drel, partition)::data.defrel_argpaths;
- List.map (defrel_transform drel partition data) clauses in
- (* first arguments processed first -- fold_left *)
- let clauses = List.fold_left process_drel clauses defined_rels_ord in
let build_defrel drel =
- (* now building the translation *)
- let partition = List.assoc drel data.defrel_argpaths in
+ (* {{{ log entry *)
+ if !debug_level > 1 then (
+ Printf.printf "build_defrel: %s\n%!" drel
+ );
+ (* }}} *)
+ let partition =
+ match List.assoc drel data.argpaths with
+ | Aux.Right partition -> partition
+ | Aux.Left _ -> assert false in
let r_clauses = Aux.map_some
(fun ((rel,args),body) ->
if rel=drel then Some (args,body) else None) clauses in
@@ -546,7 +398,7 @@
let tr_def_r (args, body) =
let sterms = Aux.map_some
(function Pos (True s) -> Some s | _ -> None) body in
- let s_l = List.map (find_defrel_arg sterms args) partition in
+ let s_l = List.map (find_rel_arg sterms args) partition in
let v_l = List.map (var_of_term data) s_l in
let eqs = List.map2
(fun v sv -> Formula.Eq (`FO v, sv))
@@ -558,5 +410,5 @@
Formula.And (eqs @ [def_phi])) in
drel, (Array.to_list defvars,
Formula.Or (List.map tr_def_r r_clauses)) in
- clauses, List.map build_defrel defined_rels_ord
+ List.map build_defrel data.defined_rels
Modified: trunk/Toss/GGP/TranslateFormula.mli
===================================================================
--- trunk/Toss/GGP/TranslateFormula.mli 2011-09-26 00:10:41 UTC (rev 1573)
+++ trunk/Toss/GGP/TranslateFormula.mli 2011-09-27 09:43:50 UTC (rev 1574)
@@ -1,7 +1,5 @@
val debug_level : int ref
-type defrel_argpaths = (GDL.path * int) list list
-
type transl_data = {
f_paths : GDL.path_set; (** fluent paths *)
c_paths : GDL.path_set; (** coordinate paths *)
@@ -10,10 +8,10 @@
counters : string list;
num_functions : (string * Formula.real_expr) list;
defined_rels : string list;
- mutable defrel_argpaths : (string * defrel_argpaths) list;
- (** late binding to store argument paths data *)
+ argpaths : (string * (GDL.path list array, GDL.argpaths) Aux.choice) list;
+ (** [Left argpaths] are coordinating relation argument paths, [Right
+ argpaths] is fact relation argument partition. *)
term_arities : (string * int) list;
- rel_default_path : (string * GDL.path option array) list;
}
val blank_out : transl_data -> GDL.term -> GDL.term
@@ -31,4 +29,4 @@
val build_defrels :
transl_data -> GDL.clause list ->
- GDL.clause list * (string * (string list * Formula.formula)) list
+ (string * (string list * Formula.formula)) list
Modified: trunk/Toss/GGP/TranslateFormulaTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormulaTest.ml 2011-09-26 00:10:41 UTC (rev 1573)
+++ trunk/Toss/GGP/TranslateFormulaTest.ml 2011-09-27 09:43:50 UTC (rev 1574)
@@ -29,49 +29,6 @@
(Lexing.from_channel f) in
descr
-let connect5_data =
- let term_arities =
- ["control", 1; "cell", 3; "x", 0; "o", 0; "b", 0; "mark", 2;
- "a", 0; "b", 0; "c", 0; "d", 0; "e", 0; "f", 0; "g", 0; "h", 0] in
- let arities f = List.assoc f term_arities in
- let f_paths = [["cell", 2]; ["control", 0]] in
- let ground_flu = [GDL.Const "x"; GDL.Const "o"; GDL.Const "b"] in
- let ground_at_f_paths = List.map (fun f -> f, ground_flu) f_paths in
- let f_paths = List.fold_right (GDL.add_path arities)
- f_paths GDL.empty_path_set in
- let c_paths = List.fold_right (GDL.add_path arities)
- [["cell", 0]; ["cell", 1]] GDL.empty_path_set in
- let all_paths = GDL.paths_union f_paths c_paths in
- let root_reps =
- [GDL.Func ("control", [|GDL.blank|]);
- GDL.Func ("cell", [|GDL.blank; GDL.blank; GDL.blank|])] in
- let exp_defrel_arities = [
- "adjacent_cell", 4;
- "col__x", 0; "col__o", 0; "col__b", 0;
- "conn5__x", 0; "conn5__o", 0; "conn5__b", 0;
- "diag1__x", 0; "diag1__o", 0; "diag1__b", 0;
- "diag2__x", 0; "diag2__o", 0; "diag2__b", 0;
- "exists_empty_cell", 0; "exists_line_of_five", 0;
- "row__x", 0; "row__o", 0; "row__b", 0] in
- let defined_rels =
- ["adjacent_cell"; "col"; "conn5"; "diag1"; "diag2";
- "exists_empty_cell"; "exists_line_of_five"; "row"] in
- let default_path = Some ["cell", 0] in
- let rel_default_path = List.map
- (fun (rel, ar) -> rel, Array.make ar default_path) exp_defrel_arities in
- ground_at_f_paths,
- {
- f_paths = f_paths;
- c_paths = c_paths;
- all_paths = all_paths;
- root_reps = root_reps;
- counters = [];
- num_functions = [];
- defined_rels = defined_rels;
- defrel_argpaths = [];
- term_arities = term_arities;
- rel_default_path = rel_default_path;
- }
let tests = "TranslateFormula" >::: [
@@ -140,86 +97,7 @@
(String.concat "\n" (Array.to_list (str_res disj)));
);
-
- "defined relations connect5" >::
- (fun () ->
- let descr = load_rules ("./GGP/examples/connect5.gdl") in
- let ground_at_f_paths, transl_data = connect5_data in
- let clauses = GDL.expand_players descr in
- let prepare_lits ((h_rel, h_args), body) =
- if h_rel = "next" then (GDL.Pos (GDL.True h_args.(0))::body)
- else if h_rel = "frame next"
- then Aux.list_remove (GDL.Pos (GDL.True h_args.(0))) body
- else body in
- let clauses =
- GDL.ground_vars_at_paths prepare_lits ground_at_f_paths clauses in
- let defined_rels, clauses =
- GDL.elim_ground_args transl_data.defined_rels clauses in
- let transl_data = {transl_data with defined_rels = defined_rels} in
- let clauses, defined_rels =
- TranslateFormula.build_defrels transl_data clauses in
- (* {{{ log entry *)
- if !TranslateFormula.debug_level > 2 then (
- Printf.printf
- "defined relations connect5: transformed clauses =\n%s\n%!"
- (String.concat "\n" (List.map GDL.clause_str clauses))
- );
- (* }}} *)
- let result drel =
- let args, body = List.assoc drel defined_rels in
- drel^"("^String.concat ", " args^
- ") = "^Formula.str (FormulaOps.simplify body) in
- assert_equal ~msg:"adjacent_cell defined relation translation"
- ~printer:(fun x->x)
- "adjacent_cell(v0, v1) ="
- (result "adjacent_cell");
- assert_equal ~msg:"conn5__o defined relation translation"
- ~printer:(fun x->x)
- "conn5__o() = col__o() or diag1__o() or diag2__o() or row__o()"
- (result "conn5__o");
-
- assert_equal ~msg:"col__x defined relation translation"
- ~printer:(fun x->x)
- "col__x() = ex cell_x_a__BLANK_, cell_x_b__BLANK_, cell_x_c__BLANK_, cell_x_d__BLANK_,
- cell_x_e__BLANK_
- (cell__BLANK___BLANK___BLANK_(cell_x_a__BLANK_) and
- cell_2x(cell_x_a__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_x_b__BLANK_) and
- cell_2x(cell_x_b__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_x_c__BLANK_) and
- cell_2x(cell_x_c__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_x_d__BLANK_) and
- cell_2x(cell_x_d__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_x_e__BLANK_) and
- cell_2x(cell_x_e__BLANK_) and nextcol__cell_1__cell_1(cell_x_a__BLANK_,
- cell_x_b__BLANK_) and nextcol__cell_1__cell_1(cell_x_b__BLANK_,
- cell_x_c__BLANK_) and nextcol__cell_1__cell_1(cell_x_c__BLANK_,
- cell_x_d__BLANK_) and nextcol__cell_1__cell_1(cell_x_d__BLANK_,
- cell_x_e__BLANK_) and EQ___cell_0__cell_0(cell_x_a__BLANK_,
- cell_x_b__BLANK_) and EQ___cell_0__cell_0(cell_x_a__BLANK_,
- cell_x_c__BLANK_) and EQ___cell_0__cell_0(cell_x_a__BLANK_,
- cell_x_d__BLANK_) and EQ___cell_0__cell_0(cell_x_a__BLANK_,
- cell_x_e__BLANK_) and EQ___cell_0__cell_0(cell_x_b__BLANK_,
- cell_x_a__BLANK_) and EQ___cell_0__cell_0(cell_x_b__BLANK_,
- cell_x_c__BLANK_) and EQ___cell_0__cell_0(cell_x_b__BLANK_,
- cell_x_d__BLANK_) and EQ___cell_0__cell_0(cell_x_b__BLANK_,
- cell_x_e__BLANK_) and EQ___cell_0__cell_0(cell_x_c__BLANK_,
- cell_x_a__BLANK_) and EQ___cell_0__cell_0(cell_x_c__BLANK_,
- cell_x_b__BLANK_) and EQ___cell_0__cell_0(cell_x_c__BLANK_,
- cell_x_d__BLANK_) and EQ___cell_0__cell_0(cell_x_c__BLANK_,
- cell_x_e__BLANK_) and EQ___cell_0__cell_0(cell_x_d__BLANK_,
- cell_x_a__BLANK_) and EQ___cell_0__cell_0(cell_x_d__BLANK_,
- cell_x_b__BLANK_) a...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-27 23:53:32
|
Revision: 1575
http://toss.svn.sourceforge.net/toss/?rev=1575&view=rev
Author: lukaszkaiser
Date: 2011-09-27 23:53:22 +0000 (Tue, 27 Sep 2011)
Log Message:
-----------
Correcting parsing of let-in formulas, better GDL timeouting, full set of gdl examples.
Modified Paths:
--------------
trunk/Toss/Formula/BoolFunctionParser.mly
trunk/Toss/Formula/Formula.ml
trunk/Toss/Formula/FormulaParser.mly
trunk/Toss/Formula/Tokens.mly
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/GGP/examples/3pffa.gdl
trunk/Toss/GGP/examples/3pttc.gdl
trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.0.qdimacs.gdl
trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.2.qdimacs.SAT.gdl
trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.2.qdimacs.satlike.gdl
trunk/Toss/GGP/examples/4pttc.gdl
trunk/Toss/GGP/examples/8puzzle.gdl
trunk/Toss/GGP/examples/ad_game_2x2.gdl
trunk/Toss/GGP/examples/aipsrovers01.gdl
trunk/Toss/GGP/examples/asteroids.gdl
trunk/Toss/GGP/examples/asteroidsparallel.gdl
trunk/Toss/GGP/examples/asteroidsserial.gdl
trunk/Toss/GGP/examples/checkers.gdl
trunk/Toss/GGP/examples/chess.gdl
trunk/Toss/GGP/examples/connect4.gdl
trunk/Toss/GGP/examples/connect5.gdl
trunk/Toss/GGP/examples/pacman3p.gdl
trunk/Toss/GGP/examples/pawn_whopping.gdl
trunk/Toss/GGP/examples/tictactoe.gdl
trunk/Toss/Server/Server.ml
trunk/Toss/Solver/SolverTest.ml
Added Paths:
-----------
trunk/Toss/GGP/examples/BattleSnakes.gdl
trunk/Toss/GGP/examples/Catch-Me-If-You-Can.gdl
trunk/Toss/GGP/examples/Catch.Me.If.You.Can.gdl
trunk/Toss/GGP/examples/CatchMeIfYouCanTest.gdl
trunk/Toss/GGP/examples/CephalopodMicro.gdl
trunk/Toss/GGP/examples/DoubleAuctionDJ.gdl
trunk/Toss/GGP/examples/Guard_Intruder.gdl
trunk/Toss/GGP/examples/Nine_Mens_Morris_0.11_2p.gdl
trunk/Toss/GGP/examples/Nine_Mens_Morris_0.1_2p.gdl
trunk/Toss/GGP/examples/Qyshinsu.gdl
trunk/Toss/GGP/examples/RobinsonRoulete.gdl
trunk/Toss/GGP/examples/RobinsonRoulette.gdl
trunk/Toss/GGP/examples/RobinsonRoulette_no_white_peg.gdl
trunk/Toss/GGP/examples/Runners.gdl
trunk/Toss/GGP/examples/Thief_Police.gdl
trunk/Toss/GGP/examples/Zhadu.gdl
trunk/Toss/GGP/examples/battle.gdl
trunk/Toss/GGP/examples/battlesnakes1409.gdl
trunk/Toss/GGP/examples/battlesnakes1509.gdl
trunk/Toss/GGP/examples/battlesnakes2011.gdl
trunk/Toss/GGP/examples/beatmania.gdl
trunk/Toss/GGP/examples/bidding-tictactoe.gdl
trunk/Toss/GGP/examples/bidding-tictactoe_10coins.gdl
trunk/Toss/GGP/examples/blobwars.gdl
trunk/Toss/GGP/examples/blocker.gdl
trunk/Toss/GGP/examples/blockerparallel.gdl
trunk/Toss/GGP/examples/blockerserial.gdl
trunk/Toss/GGP/examples/blocks.gdl
trunk/Toss/GGP/examples/blocks2player.gdl
trunk/Toss/GGP/examples/blocksworldparallel.gdl
trunk/Toss/GGP/examples/blocksworldserial.gdl
trunk/Toss/GGP/examples/bomberman2p.gdl
trunk/Toss/GGP/examples/brain_teaser_extended.gdl
trunk/Toss/GGP/examples/brawl.gdl
trunk/Toss/GGP/examples/breakthroughsuicide.gdl
trunk/Toss/GGP/examples/breakthroughsuicide_v2.gdl
trunk/Toss/GGP/examples/bunk_t.gdl
trunk/Toss/GGP/examples/buttons.gdl
trunk/Toss/GGP/examples/capture_the_king.gdl
trunk/Toss/GGP/examples/catch_me.gdl
trunk/Toss/GGP/examples/catcha_mouse.gdl
trunk/Toss/GGP/examples/checkers-cylinder-mustjump.gdl
trunk/Toss/GGP/examples/checkers-mustjump-torus.gdl
trunk/Toss/GGP/examples/checkers-mustjump.gdl
trunk/Toss/GGP/examples/checkers-newgoals.gdl
trunk/Toss/GGP/examples/checkers-suicide-cylinder-mustjump.gdl
trunk/Toss/GGP/examples/chickentictactoe.gdl
trunk/Toss/GGP/examples/chickentoetictac.gdl
trunk/Toss/GGP/examples/chinesecheckers1.gdl
trunk/Toss/GGP/examples/chinesecheckers2.gdl
trunk/Toss/GGP/examples/chinesecheckers3.gdl
trunk/Toss/GGP/examples/chinesecheckers4.gdl
trunk/Toss/GGP/examples/chinesecheckers6-simultaneous.gdl
trunk/Toss/GGP/examples/chinesecheckers6.gdl
trunk/Toss/GGP/examples/chomp.gdl
trunk/Toss/GGP/examples/circlesolitaire.gdl
trunk/Toss/GGP/examples/coins.gdl
trunk/Toss/GGP/examples/conn4.gdl
trunk/Toss/GGP/examples/connectfour.gdl
trunk/Toss/GGP/examples/connectfoursuicide.gdl
trunk/Toss/GGP/examples/crisscross.gdl
trunk/Toss/GGP/examples/crissrace.gdl
trunk/Toss/GGP/examples/crossers3.gdl
trunk/Toss/GGP/examples/cubicup.gdl
trunk/Toss/GGP/examples/cubicup_3player.gdl
trunk/Toss/GGP/examples/cylinder-checkers.gdl
trunk/Toss/GGP/examples/double_tictactoe_dengji.gdl
trunk/Toss/GGP/examples/doubletictactoe.gdl
trunk/Toss/GGP/examples/doubletoetictac.gdl
trunk/Toss/GGP/examples/duplicatestatelarge.gdl
trunk/Toss/GGP/examples/duplicatestatemedium.gdl
trunk/Toss/GGP/examples/duplicatestatesmall.gdl
trunk/Toss/GGP/examples/endgame.gdl
trunk/Toss/GGP/examples/eotcatcit.gdl
trunk/Toss/GGP/examples/eotcitcit.gdl
trunk/Toss/GGP/examples/farmers.gdl
trunk/Toss/GGP/examples/firefighter.gdl
trunk/Toss/GGP/examples/four_way_battle.gdl
trunk/Toss/GGP/examples/gameofsquares.gdl
trunk/Toss/GGP/examples/ghostmaze2p.gdl
trunk/Toss/GGP/examples/god.gdl
trunk/Toss/GGP/examples/golden_rectangle.gdl
trunk/Toss/GGP/examples/grid_game.gdl
trunk/Toss/GGP/examples/grid_game2.gdl
trunk/Toss/GGP/examples/gt_attrition.gdl
trunk/Toss/GGP/examples/gt_centipede.gdl
trunk/Toss/GGP/examples/gt_chicken.gdl
trunk/Toss/GGP/examples/gt_prisoner.gdl
trunk/Toss/GGP/examples/gt_ultimatum.gdl
trunk/Toss/GGP/examples/guard_intruder.gdl
trunk/Toss/GGP/examples/guard_intruder_test.gdl
trunk/Toss/GGP/examples/guess.gdl
trunk/Toss/GGP/examples/hallway.gdl
trunk/Toss/GGP/examples/hanoi.gdl
trunk/Toss/GGP/examples/hanoi7.gdl
trunk/Toss/GGP/examples/hanoi7_bugfix.gdl
trunk/Toss/GGP/examples/hanoi_6_disks.gdl
trunk/Toss/GGP/examples/hitori.gdl
trunk/Toss/GGP/examples/incredible.gdl
trunk/Toss/GGP/examples/javastrike.gdl
trunk/Toss/GGP/examples/jkkj.gdl
trunk/Toss/GGP/examples/kalaha_2009.gdl
trunk/Toss/GGP/examples/kitten_escapes_from_fire.gdl
trunk/Toss/GGP/examples/knightazons.gdl
trunk/Toss/GGP/examples/knightfight.gdl
trunk/Toss/GGP/examples/knightmove.gdl
trunk/Toss/GGP/examples/knightstour.gdl
trunk/Toss/GGP/examples/knightthrough.gdl
trunk/Toss/GGP/examples/knightwar.gdl
trunk/Toss/GGP/examples/laikLee_hex.gdl
trunk/Toss/GGP/examples/latenttictactoe.gdl
trunk/Toss/GGP/examples/lightson2x2.gdl
trunk/Toss/GGP/examples/lightsout.gdl
trunk/Toss/GGP/examples/lightsout2.gdl
trunk/Toss/GGP/examples/mastermind448.gdl
trunk/Toss/GGP/examples/max_knights.gdl
trunk/Toss/GGP/examples/maze.gdl
trunk/Toss/GGP/examples/meier.gdl
trunk/Toss/GGP/examples/merrills.gdl
trunk/Toss/GGP/examples/minichess-evilconjuncts.gdl
trunk/Toss/GGP/examples/minichess.gdl
trunk/Toss/GGP/examples/mummymaze1p.gdl
trunk/Toss/GGP/examples/mummymaze2p-comp2007.gdl
trunk/Toss/GGP/examples/mummymaze2p.gdl
trunk/Toss/GGP/examples/nim1.gdl
trunk/Toss/GGP/examples/nim2.gdl
trunk/Toss/GGP/examples/nim3.gdl
trunk/Toss/GGP/examples/nim4.gdl
trunk/Toss/GGP/examples/nothello.gdl
trunk/Toss/GGP/examples/numbertictactoe.gdl
trunk/Toss/GGP/examples/oisters_farm.gdl
trunk/Toss/GGP/examples/othello-comp2007.gdl
trunk/Toss/GGP/examples/othello-cornercontrol.gdl
trunk/Toss/GGP/examples/othello-fourway-teamswitch.gdl
trunk/Toss/GGP/examples/othello-fourway-teamswitchA.gdl
trunk/Toss/GGP/examples/othello-fourway-teamswitchB.gdl
trunk/Toss/GGP/examples/othello-fourway.gdl
trunk/Toss/GGP/examples/othello-new-horse.gdl
trunk/Toss/GGP/examples/othello-new.gdl
trunk/Toss/GGP/examples/othello.gdl
trunk/Toss/GGP/examples/othello2.gdl
trunk/Toss/GGP/examples/othellooo.gdl
trunk/Toss/GGP/examples/othellosuicide.gdl
trunk/Toss/GGP/examples/pancakes.gdl
trunk/Toss/GGP/examples/pancakes6.gdl
trunk/Toss/GGP/examples/pancakes88.gdl
trunk/Toss/GGP/examples/pawn_whopping_wrong.gdl
trunk/Toss/GGP/examples/pawntoqueen.gdl
trunk/Toss/GGP/examples/peg.gdl
trunk/Toss/GGP/examples/peg_bugfixed.gdl
trunk/Toss/GGP/examples/pentago_2008.gdl
trunk/Toss/GGP/examples/point_grab.gdl
trunk/Toss/GGP/examples/quad.gdl
trunk/Toss/GGP/examples/quad_5x5.gdl
trunk/Toss/GGP/examples/quad_5x5_8_2.gdl
trunk/Toss/GGP/examples/quad_7x7.gdl
trunk/Toss/GGP/examples/quarto.gdl
trunk/Toss/GGP/examples/quartosuicide.gdl
trunk/Toss/GGP/examples/queens.gdl
trunk/Toss/GGP/examples/racer.gdl
trunk/Toss/GGP/examples/racer4.gdl
trunk/Toss/GGP/examples/racetrackcorridor.gdl
trunk/Toss/GGP/examples/roshambo2.gdl
trunk/Toss/GGP/examples/ruledepthexponential.gdl
trunk/Toss/GGP/examples/ruledepthlinear.gdl
trunk/Toss/GGP/examples/ruledepthquadratic.gdl
trunk/Toss/GGP/examples/sat_test_20v_91c.gdl
trunk/Toss/GGP/examples/sat_test_20v_91c_version2.gdl
trunk/Toss/GGP/examples/satlike_20v_91c_version2.gdl
trunk/Toss/GGP/examples/sheep_and_wolf.gdl
trunk/Toss/GGP/examples/skirmish.gdl
trunk/Toss/GGP/examples/skirmish2.gdl
trunk/Toss/GGP/examples/skirmish3.gdl
trunk/Toss/GGP/examples/skirmishfinal.gdl
trunk/Toss/GGP/examples/slidingpieces.gdl
trunk/Toss/GGP/examples/smallest.gdl
trunk/Toss/GGP/examples/smallest_4player.gdl
trunk/Toss/GGP/examples/snake_2008.gdl
trunk/Toss/GGP/examples/snake_2009.gdl
trunk/Toss/GGP/examples/snake_2009_big.gdl
trunk/Toss/GGP/examples/statespacelarge.gdl
trunk/Toss/GGP/examples/statespacemedium.gdl
trunk/Toss/GGP/examples/statespacesmall.gdl
trunk/Toss/GGP/examples/sudoku_simple.gdl
trunk/Toss/GGP/examples/sum15.gdl
trunk/Toss/GGP/examples/test6868.gdl
trunk/Toss/GGP/examples/ticblock.gdl
trunk/Toss/GGP/examples/tictactoe-init1.gdl
trunk/Toss/GGP/examples/tictactoe_3d_2player.gdl
trunk/Toss/GGP/examples/tictactoe_3d_6player.gdl
trunk/Toss/GGP/examples/tictactoe_3d_small_2player.gdl
trunk/Toss/GGP/examples/tictactoe_3d_small_6player.gdl
trunk/Toss/GGP/examples/tictactoe_3player.gdl
trunk/Toss/GGP/examples/tictactoe_orthogonal.gdl
trunk/Toss/GGP/examples/tictactoelarge.gdl
trunk/Toss/GGP/examples/tictactoelargesuicide.gdl
trunk/Toss/GGP/examples/tictactoeparallel.gdl
trunk/Toss/GGP/examples/tictactoeserial.gdl
trunk/Toss/GGP/examples/tictactoex9.gdl
trunk/Toss/GGP/examples/tictictoe.gdl
trunk/Toss/GGP/examples/toetictac.gdl
trunk/Toss/GGP/examples/tpeg.gdl
trunk/Toss/GGP/examples/troublemaker01.gdl
trunk/Toss/GGP/examples/troublemaker02.gdl
trunk/Toss/GGP/examples/tttcc4.gdl
trunk/Toss/GGP/examples/twisty-passages.gdl
trunk/Toss/GGP/examples/uf20-01.cnf.SAT.gdl
trunk/Toss/GGP/examples/uf20-010.cnf.SAT.gdl
trunk/Toss/GGP/examples/uf20-010.cnf.SAT.satlike.gdl
trunk/Toss/GGP/examples/uf20-020.cnf.SAT.gdl
trunk/Toss/GGP/examples/uf20-020.cnf.SAT.satlike.gdl
trunk/Toss/GGP/examples/wallmaze.gdl
trunk/Toss/GGP/examples/wargame01.gdl
trunk/Toss/toss
Modified: trunk/Toss/Formula/BoolFunctionParser.mly
===================================================================
--- trunk/Toss/Formula/BoolFunctionParser.mly 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/Formula/BoolFunctionParser.mly 2011-09-27 23:53:22 UTC (rev 1575)
@@ -47,9 +47,6 @@
{ Ex (vars, phi) }
| NOT bool_function_expr { Not ($2) }
| OPEN bool_function_expr CLOSE { $2 }
- | error
- { Lexer.report_parsing_error $startpos $endpos
- "Syntax error in Boolean function definition." }
parse_bool_function:
| bool_function_expr EOF { triv_simp $1 };
@@ -74,9 +71,6 @@
class_def:
| CLASS n = ID OPENCUR vars = id_sc_list CLOSECUR
{ (n, vars) }
- | error
- { Lexer.report_parsing_error $startpos $endpos
- "Syntax error in class parsing." }
bool_defs_expr:
| class_def SEMICOLON { [(Some $1, None)] }
@@ -84,9 +78,6 @@
| bool_def SEMICOLON { [(None, Some $1)] }
| bool_def { [(None, Some $1)] }
| bool_def SEMICOLON bool_defs_expr { (None, Some $1) :: $3 }
- | error
- { Lexer.report_parsing_error $startpos $endpos
- "Syntax error in parsing list of definitions." }
parse_bool_defs:
| dl = bool_defs_expr EOF
Modified: trunk/Toss/Formula/Formula.ml
===================================================================
--- trunk/Toss/Formula/Formula.ml 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/Formula/Formula.ml 2011-09-27 23:53:22 UTC (rev 1575)
@@ -214,7 +214,7 @@
(Aux.fprint_sep_list "," fprint_var) (Array.to_list vs)
(fprint_prec prec) fpphi
| Let (r, args, rphi, inphi) ->
- Format.fprintf f "@[<1>let %s(%s) = %a in %a@]" r (String.concat ", " args)
+ Format.fprintf f "@[<1>let %s(%s) = %a in@]@ %a" r (String.concat ", " args)
(fprint_prec prec) rphi (fprint_prec prec) inphi
Modified: trunk/Toss/Formula/FormulaParser.mly
===================================================================
--- trunk/Toss/Formula/FormulaParser.mly 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/Formula/FormulaParser.mly 2011-09-27 23:53:22 UTC (rev 1575)
@@ -121,7 +121,7 @@
| OPEN formula_expr CLOSE { $2 }
| LET_CMD rel = ID args = delimited (OPEN, separated_list (COMMA, ID), CLOSE)
EQ body = formula_expr IN phi = formula_expr
- { Let (rel, args, body, phi) }
+ { Let (rel, args, body, phi) } %prec LET_CMD
expr_eq_expr: /* only standard equations here for now (no differentials) */
Modified: trunk/Toss/Formula/Tokens.mly
===================================================================
--- trunk/Toss/Formula/Tokens.mly 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/Formula/Tokens.mly 2011-09-27 23:53:22 UTC (rev 1575)
@@ -14,6 +14,7 @@
%token MODEL_SPEC RULE_SPEC STATE_SPEC LEFT_SPEC RIGHT_SPEC CLASS LFP GFP EOF
/* List in order of increasing precedence. */
+%nonassoc LET_CMD
%nonassoc COND
%left LARR
%right RARR
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/GDL.ml 2011-09-27 23:53:22 UTC (rev 1575)
@@ -503,6 +503,7 @@
let instantiate_one tot_base cur_base irules =
Aux.concat_map (function
| (hrel, hargs as head), [], neg_body ->
+ check_timeout ~print:false ("GDL: saturate: instantiate_one: match1");
if (try Tuples.mem hargs (Aux.StrMap.find hrel tot_base)
with Not_found -> false)
then []
@@ -518,6 +519,7 @@
) neg_body then []
else [Aux.Left head]
| (hrel, hargs as head), (rel,args as pos_atom)::body, neg_body ->
+ check_timeout ~print:false ("GDL: saturate: instantiate_one: match2");
if (try Tuples.mem hargs (Aux.StrMap.find hrel tot_base)
with Not_found -> false)
then []
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-27 23:53:22 UTC (rev 1575)
@@ -367,15 +367,21 @@
(* failwith "generated"; *)
()
-let translate_file fname =
+let translate_file fname timeout =
try
+ let start = Unix.gettimeofday () in
+ (match timeout with
+ | None -> ()
+ | Some tout ->
+ TranslateGame.set_timeout
+ (fun () -> Unix.gettimeofday() -. start > float (tout)));
let descr = load_rules fname in
let gdl_data, result =
TranslateGame.translate_game ~playing_as:(GDL.Const "") descr in
(true, Arena.state_str result)
with
| Aux.Timeout msg -> (false, "Timeout: " ^ msg)
- | _ -> (false, "Failed")
+ | e -> (false, "Failed: " ^ (Printexc.to_string e))
let translate_dir_tests dirname timeout =
let is_gdl fn = (String.length fn > 4) &&
@@ -387,7 +393,7 @@
let start = Unix.gettimeofday () in
TranslateGame.set_timeout
(fun () -> Unix.gettimeofday() -. start > float (timeout));
- let res, msg = translate_file (dirname ^ fname) in
+ let res, msg = translate_file (dirname ^ fname) None in
let t = Unix.gettimeofday() -. start in
let final = if res then Printf.sprintf "Suceeded (%f sec.)\n%!" t else
Printf.sprintf "%s (%f sec)\n%!" msg t in
@@ -412,7 +418,7 @@
] in
Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
if !file <> "" then
- print_endline (snd (translate_file !file))
+ print_endline (snd (translate_file !file (Some !timeout)))
else if !testdir <> "" then
Aux.run_test_if_target "TranslateGameTest"
(translate_dir_tests !testdir !timeout)
Modified: trunk/Toss/GGP/examples/3pffa.gdl
===================================================================
--- trunk/Toss/GGP/examples/3pffa.gdl 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/examples/3pffa.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -198,6 +198,4 @@
(scoremap 7 70)
(scoremap 8 80)
(scoremap 9 90)
-(scoremap 10 100)
-
-
+(scoremap 10 100)
\ No newline at end of file
Modified: trunk/Toss/GGP/examples/3pttc.gdl
===================================================================
--- trunk/Toss/GGP/examples/3pttc.gdl 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/examples/3pttc.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -208,6 +208,3 @@
(stepcount 28 29)
(stepcount 29 30)
(stepcount 30 31)
-
-
-
Modified: trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.0.qdimacs.gdl
===================================================================
--- trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.0.qdimacs.gdl 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.0.qdimacs.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -373,6 +373,4 @@
(<= (goal exists 100) all_sat)
(<= (goal exists 0) (not all_sat))
(<= (goal forall 100) (not all_sat))
-(<= (goal forall 0) all_sat)
-
-
+(<= (goal forall 0) all_sat)
\ No newline at end of file
Modified: trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.2.qdimacs.SAT.gdl
===================================================================
--- trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.2.qdimacs.SAT.gdl 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.2.qdimacs.SAT.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -573,6 +573,4 @@
(<= (goal exists 100) all_sat)
(<= (goal exists 0) (not all_sat))
(<= (goal forall 100) (not all_sat))
-(<= (goal forall 0) all_sat)
-
-
+(<= (goal forall 0) all_sat)
\ No newline at end of file
Modified: trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.2.qdimacs.satlike.gdl
===================================================================
--- trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.2.qdimacs.satlike.gdl 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/examples/3qbf-5cnf-20var-40cl.2.qdimacs.satlike.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -580,6 +580,4 @@
(<= (goal forall 100) three_not_sat)
(<= one_not_sat (clause ?v86740) (not (true (sat ?v86740))))
(<= two_not_sat (clause ?v86751) (not (true (sat ?v86751))) (clause ?v86771) (not (true (sat ?v86771))) (distinct ?v86751 ?v86771))
-(<= three_not_sat (clause ?v86751) (not (true (sat ?v86751))) (clause ?v86771) (not (true (sat ?v86771))) (clause ?v86806) (not (true (sat ?v86806))) (distinct ?v86751 ?v86771) (distinct ?v86751 ?v86806) (distinct ?v86771 ?v86806))
-
-
+(<= three_not_sat (clause ?v86751) (not (true (sat ?v86751))) (clause ?v86771) (not (true (sat ?v86771))) (clause ?v86806) (not (true (sat ?v86806))) (distinct ?v86751 ?v86771) (distinct ?v86751 ?v86806) (distinct ?v86771 ?v86806))
\ No newline at end of file
Modified: trunk/Toss/GGP/examples/4pttc.gdl
===================================================================
--- trunk/Toss/GGP/examples/4pttc.gdl 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/examples/4pttc.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -274,6 +274,3 @@
(succ 30 31)
(succ 31 32)
(succ 32 33)
-
-
-
Modified: trunk/Toss/GGP/examples/8puzzle.gdl
===================================================================
--- trunk/Toss/GGP/examples/8puzzle.gdl 2011-09-27 09:43:50 UTC (rev 1574)
+++ trunk/Toss/GGP/examples/8puzzle.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -150,6 +150,3 @@
(successor 57 58)
(successor 58 59)
(successor 59 60)
-
-
-
Added: trunk/Toss/GGP/examples/BattleSnakes.gdl
===================================================================
--- trunk/Toss/GGP/examples/BattleSnakes.gdl (rev 0)
+++ trunk/Toss/GGP/examples/BattleSnakes.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -0,0 +1,345 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BattleSnakes
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Roles
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(role red)
+(role blue)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Initial State
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(init (snake 2 2 red 1))
+(init (snake 1 2 red 2))
+(init (snake 1 3 red 3))
+(init (snake 1 4 red 4))
+(init (snake 1 5 red 5))
+(init (snake 1 6 red 6))
+(init (snake 1 7 red 7))
+(init (snake 1 8 red 8))
+
+(init (snake 7 7 blue 1))
+(init (snake 8 7 blue 2))
+(init (snake 8 6 blue 3))
+(init (snake 8 5 blue 4))
+(init (snake 8 4 blue 5))
+(init (snake 8 3 blue 6))
+(init (snake 8 2 blue 7))
+(init (snake 8 1 blue 8))
+
+(init (step 0))
+
+(init (size red 8))
+(init (size blue 8))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Legal
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(<= (legal ?player (move ?x ?y ?x1 ?y))
+ (role ?player)
+ (true (snake ?x ?y ?player 1))
+ (adjacent ?x ?x1)
+)
+
+(<= (legal ?player (move ?x ?y ?x ?y1))
+ (role ?player)
+ (true (snake ?x ?y ?player 1))
+ (adjacent ?y ?y1)
+)
+
+(<= (adjacent ?x1 ?x2)
+ (boardSucc ?x1 ?x2)
+)
+
+(<= (adjacent ?x1 ?x2)
+ (boardSucc ?x2 ?x1)
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Next
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Stepper
+(<= (next (step ?y))
+ (true (step ?x))
+ (succ ?x ?y)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Moves
+
+;; Move Head ;;
+(<= (next (snake ?x1 ?y1 ?player 1))
+ (does ?player (move ?x ?y ?x1 ?y1))
+)
+
+;; Move Tail ;;
+;; No collision
+(<= (next (snake ?x ?y ?player ?newTail))
+ (true (snake ?x ?y ?player ?currTail))
+ (not (true (size ?player ?currTail)))
+ (succ ?currTail ?newTail)
+ (role ?player2)
+ (distinct ?player ?player2)
+ (not (collision ?player))
+ (not (collision ?player2))
+)
+
+;; Both collide
+(<= (next (snake ?x ?y ?player ?newTail))
+ (true (snake ?x ?y ?player ?currTail))
+ (not (true (size ?player ?currTail)))
+ (succ ?currTail ?newTail)
+ (role ?player2)
+ (distinct ?player ?player2)
+ (collision ?player)
+ (collision ?player2)
+)
+
+;; Player crashes
+(<= (next (snake ?x ?y ?player ?newTail))
+ (true (snake ?x ?y ?player ?currTail))
+ (true (size ?player ?size))
+ (succ ?size ?newsize)
+ (distinct ?currTail ?size)
+ (distinct ?currTail ?newsize)
+ (succ ?currTail ?newTail)
+ (role ?player2)
+ (distinct ?player ?player2)
+ (collision ?player)
+ (not (collision ?player2))
+)
+
+;; Other player crashes
+(<= (next (snake ?x ?y ?player ?newTail))
+ (true (snake ?x ?y ?player ?currTail))
+ (true (size ?player ?size))
+ (succ ?newsize ?size)
+ (distinct ?currTail ?newsize)
+ (succ ?currTail ?newTail)
+ (role ?player2)
+ (distinct ?player ?player2)
+ (collision ?player2)
+ (not (collision ?player))
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Size
+
+;; No collision
+(<= (next (size ?player ?size))
+ (true (size ?player ?size))
+ (role ?player2)
+ (distinct ?player ?player2)
+ (not (collision ?player))
+ (not (collision ?player2))
+)
+
+;; Both collide
+(<= (next (size ?player ?size))
+ (true (size ?player ?size))
+ (role ?player2)
+ (distinct ?player ?player2)
+ (collision ?player)
+ (collision ?player2)
+)
+
+;; Player crashes
+(<= (next (size ?player ?newsize))
+ (true (size ?player ?size))
+ (role ?player2)
+ (distinct ?player ?player2)
+ (collision ?player)
+ (not (collision ?player2))
+ (succ ?size ?newsize)
+)
+
+;; Other player crashes
+(<= (next (size ?player ?newsize))
+ (true (size ?player ?size))
+ (role ?player2)
+ (distinct ?player ?player2)
+ (collision ?player2)
+ (not (collision ?player))
+ (succ ?newsize ?size)
+)
+
+(<= (collision ?player)
+ (does ?player (move ?a ?b ?c ?d))
+ (true (snake ?c ?d ?anyplayer ?body))
+ (true (size ?anyplayer ?size))
+ (distinct ?size ?body)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Terminal States
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(score 1 100)
+(score 2 93)
+(score 3 86)
+(score 4 79)
+(score 5 72)
+(score 6 65)
+(score 7 58)
+(score 8 50)
+(score 9 42)
+(score 10 35)
+(score 11 28)
+(score 12 21)
+(score 13 14)
+(score 14 7)
+(score 15 0)
+
+(<= (goal ?player ?score)
+ (role ?player)
+ (true (size ?player ?size))
+ (score ?size ?score)
+)
+
+(<= (goal ?player1 100)
+ (role ?player1)
+ (role ?player2)
+ (true (size ?player2 15))
+ (true (size ?player1 1))
+)
+
+(<= (goal ?player2 0)
+ (role ?player1)
+ (role ?player2)
+ (true (size ?player2 15))
+ (true (size ?player1 1))
+)
+
+(<= terminal
+ (true (step 100))
+)
+
+(<= terminal
+ (true (size ?player1 1))
+ (true (size ?player2 15))
+ (distinct ?player1 ?player2)
+)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Successors
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(boardSucc 1 2)
+(boardSucc 2 3)
+(boardSucc 3 4)
+(boardSucc 4 5)
+(boardSucc 5 6)
+(boardSucc 6 7)
+(boardSucc 7 8)
+(boardSucc 8 1)
+
+(succ 0 1)
+(succ 1 2)
+(succ 2 3)
+(succ 3 4)
+(succ 4 5)
+(succ 5 6)
+(succ 6 7)
+(succ 7 8)
+(succ 8 9)
+(succ 9 10)
+(succ 10 11)
+(succ 11 12)
+(succ 12 13)
+(succ 13 14)
+(succ 14 15)
+(succ 15 16)
+(succ 16 17)
+(succ 17 18)
+(succ 18 19)
+(succ 19 20)
+(succ 20 21)
+(succ 21 22)
+(succ 22 23)
+(succ 23 24)
+(succ 24 25)
+(succ 25 26)
+(succ 26 27)
+(succ 27 28)
+(succ 28 29)
+(succ 29 30)
+(succ 30 31)
+(succ 31 32)
+(succ 32 33)
+(succ 33 34)
+(succ 34 35)
+(succ 35 36)
+(succ 36 37)
+(succ 37 38)
+(succ 38 39)
+(succ 39 40)
+(succ 40 41)
+(succ 41 42)
+(succ 42 43)
+(succ 43 44)
+(succ 44 45)
+(succ 45 46)
+(succ 46 47)
+(succ 47 48)
+(succ 48 49)
+(succ 49 50)
+(succ 50 51)
+(succ 51 52)
+(succ 52 53)
+(succ 53 54)
+(succ 54 55)
+(succ 55 56)
+(succ 56 57)
+(succ 57 58)
+(succ 58 59)
+(succ 59 60)
+(succ 60 61)
+(succ 61 62)
+(succ 62 63)
+(succ 63 64)
+(succ 64 65)
+(succ 65 66)
+(succ 66 67)
+(succ 67 68)
+(succ 68 69)
+(succ 69 70)
+(succ 70 71)
+(succ 71 72)
+(succ 72 73)
+(succ 73 74)
+(succ 74 75)
+(succ 75 76)
+(succ 76 77)
+(succ 77 78)
+(succ 78 79)
+(succ 79 80)
+(succ 80 81)
+(succ 81 82)
+(succ 82 83)
+(succ 83 84)
+(succ 84 85)
+(succ 85 86)
+(succ 86 87)
+(succ 87 88)
+(succ 88 89)
+(succ 89 90)
+(succ 90 91)
+(succ 91 92)
+(succ 92 93)
+(succ 93 94)
+(succ 94 95)
+(succ 95 96)
+(succ 96 97)
+(succ 97 98)
+(succ 98 99)
+(succ 99 100)
\ No newline at end of file
Added: trunk/Toss/GGP/examples/Catch-Me-If-You-Can.gdl
===================================================================
--- trunk/Toss/GGP/examples/Catch-Me-If-You-Can.gdl (rev 0)
+++ trunk/Toss/GGP/examples/Catch-Me-If-You-Can.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -0,0 +1,110 @@
+; still buggy
+
+(role guard)
+(role intruder)
+
+(init (at guard 1 1))
+(init (at intruder 5 5))
+
+
+(co 1)
+(co 2)
+(co 3)
+(co 4)
+(co 5)
+
+(succ 1 2)
+(succ 2 3)
+(succ 3 4)
+(succ 4 5)
+
+
+
+(<= (goal ?r 0)
+(role ?r)
+(not terminal))
+
+(<= (goal ?r 0)
+(role ?r)
+(distinct ?r intruder)
+terminal
+(not remain))
+
+(<= (goal ?r 100)
+(role ?r)
+(distinct ?r intruder)
+terminal
+(true (at intruder ?x ?y)))
+
+(<= (goal intruder 0)
+terminal
+(true (at intruder ?x ?y)))
+
+(<= (goal intruder 100)
+terminal
+(not remain))
+
+(<= terminal
+(true (at guard ?x ?y))
+(true (at intruder ?x ?y)))
+
+(<= terminal
+(not remain))
+
+(<= remain
+(true (at intruder ?x ?y)))
+
+(<= (legal ?r stay)
+(true (at ?r ?x ?y)))
+
+(<= (legal intruder exit)
+(not terminal)
+(true (at intruder 1 1)))
+
+(<= (legal intruder exit)
+(not terminal)
+(true (at intruder 1 5)))
+
+(<= (legal ?r (move ?d))
+(not terminal)
+(true (at ?r ?u ?v))
+(adjacent ?u ?v ?d ?x ?y))
+
+(<= (adjacent ?x ?y1 north ?x ?y2)
+(co ?x)
+(succ ?y1 ?y2))
+
+(<= (adjacent ?x ?y1 south ?x ?y2)
+(co ?x)
+(succ ?y2 ?y1))
+
+(<= (adjacent ?x1 ?y east ?x2 ?y)
+(co ?y)
+(succ ?x1 ?x2))
+
+(<= (adjacent ?x1 ?y west ?x2 ?y)
+(co ?y)
+(succ ?x2 ?x1))
+
+(<= (next (at ?r ?x ?y))
+(does ?r stay)
+(true (at ?r ?x ?y)))
+
+(<= (next (at ?r ?x ?y))
+(does ?r (move ?d))
+(true (at ?r ?u ?v))
+(adjacent ?u ?v ?d ?x ?y)
+(not (capture ?r)))
+
+(<= (next (at intruder ?x ?y))
+(true (at intruder ?x ?y))
+(capture intruder))
+
+(<= (capture intruder)
+(true (at intruder ?x ?y))
+(true (at ?r ?u ?v))
+(does intruder (move ?d1))
+(does ?r (move ?d2))
+(adjacent ?x ?y ?d1 ?u ?v)
+(adjacent ?u ?v ?d2 ?x ?y))
+
Added: trunk/Toss/GGP/examples/Catch.Me.If.You.Can.gdl
===================================================================
--- trunk/Toss/GGP/examples/Catch.Me.If.You.Can.gdl (rev 0)
+++ trunk/Toss/GGP/examples/Catch.Me.If.You.Can.gdl 2011-09-27 23:53:22 UTC (rev 1575)
@@ -0,0 +1,108 @@
+(role guard)
+(role intruder)
+
+(init (at guard 1 1))
+(init (at intruder 5 5))
+
+
+(co 1)
+(co 2)
+(co 3)
+(co 4)
+(co 5)
+
+(succ 1 2)
+(succ 2 3)
+(succ 3 4)
+(succ 4 5)
+
+
+
+(<= (goal ?r 0)
+(role ?r)
+(not terminal))
+
+(<= (goal ?r 0)
+(role ?r)
+(distinct ?r intruder)
+terminal
+(not remain))
+
+(<= (goal ?r 100)
+(role ?r)
+(distinct ?r intruder)
+terminal
+(true (at intruder ?x ?y)))
+
+(<= (goal intruder 0)
+terminal
+(true (at intruder ?x ?y)))
+
+(<= (goal intruder 100)
+terminal
+(not remain))
+
+(<= terminal
+(true (at guard ?x ?y))
+(true (at intruder ?x ?y)))
+
+(<= terminal
+(not remain))
+
+(<= remain
+(true (at intruder ?x ?y)))
+
+(<= (legal ?r stay)
+(true (at ?r ?x ?y)))
+
+(<= (legal intruder exit)
+(not terminal)
+(true (at intruder 1 1)))
+
+(<= (legal intruder exit)
+(not terminal)
+(true (at intruder 1 5)))
+
+(<= (legal ?r (move ?d))
+(not terminal)
+(true (at ?r ?u ?v))
+(adjacent ?u ?v ?d ?x ?y))
+
+(<=...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-29 16:34:20
|
Revision: 1578
http://toss.svn.sourceforge.net/toss/?rev=1578&view=rev
Author: lukstafi
Date: 2011-09-29 16:34:12 +0000 (Thu, 29 Sep 2011)
Log Message:
-----------
GDL translation: inlining defined relations; reintroduced elimination of ground arguments; simplification of redundant existential quantifications. Solver: GDL translation problem test.
Modified Paths:
--------------
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/GDLTest.ml
trunk/Toss/GGP/GameSimpl.ml
trunk/Toss/GGP/GameSimpl.mli
trunk/Toss/GGP/GameSimplTest.ml
trunk/Toss/GGP/TranslateFormula.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGame.mli
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/GGP/tests/tictactoe-raw.toss
trunk/Toss/GGP/tests/tictactoe-simpl.toss
trunk/Toss/Server/ReqHandler.ml
trunk/Toss/Solver/SolverTest.ml
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/GDL.ml 2011-09-29 16:34:12 UTC (rev 1578)
@@ -1069,9 +1069,8 @@
Aux.concat_map (elim_ground_arg_in_body rel arg grounding)
(renamed_brs @ clauses)
-let elim_ground_args rels1 rels2 clauses =
- let new_rels1 = ref [] and all_rels1 = ref [] in
- let new_rels2 = ref [] and all_rels2 = ref [] in
+let elim_ground_args rels clauses =
+ let new_rels = ref [] and all_rels = ref [] in
let rec aux new_rels all_rels clauses = function
| [] -> clauses
| rel::rels ->
@@ -1082,24 +1081,17 @@
all_rels := rel:: !all_rels;
aux new_rels all_rels clauses rels) in
let rec fix clauses =
- all_rels1 := !new_rels1 @ !all_rels1;
- new_rels1 := [];
- let clauses = aux new_rels1 all_rels1 clauses rels1 in
- all_rels2 := !new_rels2 @ !all_rels2;
- new_rels2 := [];
- let clauses = aux new_rels2 all_rels2 clauses rels2 in
- if !new_rels1 <> [] || !new_rels2 <> []
+ all_rels := !new_rels @ !all_rels;
+ new_rels := [];
+ let clauses = aux new_rels all_rels clauses rels in
+ if !new_rels <> []
then fix clauses
else
- let all_rels1 = List.filter
+ let all_rels = List.filter
(fun r->List.exists
(function ((rel,_),_) when r=rel -> true | _ -> false) clauses)
- (Aux.unique_sorted !all_rels1) in
- let all_rels2 = List.filter
- (fun r->List.exists
- (function ((rel,_),_) when r=rel -> true | _ -> false) clauses)
- (Aux.unique_sorted !all_rels2) in
- all_rels1, all_rels2, clauses in
+ (Aux.unique_sorted !all_rels) in
+ all_rels, clauses in
fix clauses
let elim_ground_distinct clauses =
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/GDL.mli 2011-09-29 16:34:12 UTC (rev 1578)
@@ -153,8 +153,7 @@
defining clause. Return the new clauses, and also the new
relation set. *)
val elim_ground_args :
- string list -> string list -> clause list ->
- string list * string list * clause list
+ string list -> clause list -> string list * clause list
val elim_ground_distinct : clause list -> clause list
Modified: trunk/Toss/GGP/GDLTest.ml
===================================================================
--- trunk/Toss/GGP/GDLTest.ml 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/GDLTest.ml 2011-09-29 16:34:12 UTC (rev 1578)
@@ -338,8 +338,8 @@
(nextcol ?d ?e)
(true (cell ?x ?e o)))
" in
- let _, defined_rels, result =
- elim_ground_args [] ["conn5"; "col"; "row"] descr in
+ let defined_rels, result =
+ elim_ground_args ["conn5"; "col"; "row"] descr in
let res_s =
(String.concat "\n" (List.map GDL.clause_str result)) in
assert_equal ~printer:(fun x->x)
Modified: trunk/Toss/GGP/GameSimpl.ml
===================================================================
--- trunk/Toss/GGP/GameSimpl.ml 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/GameSimpl.ml 2011-09-29 16:34:12 UTC (rev 1578)
@@ -124,7 +124,7 @@
(for example with {!FormulaOps.simplify} or
{!FormulaOps.remove_redundant} without the [implies] argument).
- (5) TODO: Remove redundant existential quantifiers in formulas of
+ (5) Remove redundant existential quantifiers in formulas of
the form "ex x. x = v and ...".
(6) TODO: Remove redundant stable predicate literals, where the
@@ -162,6 +162,28 @@
| Rel _ | Eq _ | In _ | SO _ | RealExpr _ | Lfp _ | Gfp _ -> 1, [] in
aux false phi
+(* 5 *)
+(* Remove redundant existential quantifiers in formulas of
+ the form "ex x. x = v and ...". *)
+let remove_exist phi =
+ let f_map = {FormulaMap.identity_map with
+ FormulaMap.map_Ex = fun vs -> function
+ | And conj | Or [And conj] ->
+ let sb, conj = Aux.partition_map
+ (function
+ | Eq (v1, v2) when List.mem (v1 :> var) vs ->
+ Aux.Left (Formula.var_str v1, Formula.var_str v2)
+ | Eq (v1, v2) when List.mem (v2 :> var) vs ->
+ Aux.Left (Formula.var_str v2, Formula.var_str v1)
+ | phi -> Aux.Right phi) conj in
+ if sb = [] then Ex (vs, And conj)
+ else
+ let vs =
+ List.filter (fun v -> not (List.mem_assoc (var_str v) sb)) vs in
+ let phi = FormulaSubst.subst_vars sb (And conj) in
+ if vs = [] then phi else Ex (vs, phi)
+ | phi -> phi} in
+ FormulaMap.map_formula f_map phi
(* A heuristic measure of how easy a formula is to solve or provide a
good heuristic. Very crude for now, not using the structure yet. *)
@@ -170,12 +192,8 @@
trunk - List.fold_left (+) 0 (List.map Formula.size univs)
module Tups = Structure.Tuples
-
-let map_all_formulas f more_formulas game =
- Aux.StrMap.map f more_formulas,
- Arena.map_to_formulas f game
-let simplify ?(keep_nonempty_predicates=true) ~more_formulas (game, state) =
+let simplify ?(keep_nonempty_predicates=true) (game, state) =
(* {{{ log entry *)
if !debug_level > 0 then (
Printf.printf "GameSimpl: defined_rels = %s\n%!"
@@ -204,8 +222,8 @@
fun rel args ->
if present_rel rel then Formula.Rel (rel, args)
else Formula.Or []} in
- let more_formulas, game =
- map_all_formulas remove_absent more_formulas game in
+ let game =
+ Arena.map_to_formulas remove_absent game in
(* 1 *)
(* TODO: clean up this part, i.e. how complement/equivalent/inverse
relations are handled *)
@@ -394,9 +412,9 @@
if neg then Not (Rel (orig, args)) else Rel (orig, args)
) else phi
| phi -> phi in
- let more_formulas, game =
- map_all_formulas (FormulaMap.map_to_atoms repl_equiv_and_inv)
- more_formulas game in
+ let game =
+ Arena.map_to_formulas (FormulaMap.map_to_atoms repl_equiv_and_inv)
+ game in
let state =
{state with Arena.struc = Structure.clear_rels struc removable} in
(* Also have to apply to LHS structures... Don't use
@@ -535,9 +553,9 @@
List.mem_assoc rel2 game.Arena.defined_rels) &&
included_in rel1 rel2
| _ -> false in
- let more_formulas, game =
- map_all_formulas (FormulaOps.remove_redundant ~implies)
- more_formulas game in
+ let game =
+ Arena.map_to_formulas (FormulaOps.remove_redundant ~implies)
+ game in
(* 3 *)
let intersect_rels struc grel rels =
@@ -759,8 +777,8 @@
let res = glue_phi (Formula.flatten_sort phi) in
if old_used_rels == !used_rels then res
else glue_fixpoint res in
- let more_formulas, game =
- map_all_formulas glue_fixpoint more_formulas game in
+ let game =
+ Arena.map_to_formulas glue_fixpoint game in
(* 3e *)
let more_data =
Aux.map_some (fun (crel, orig_rel) ->
@@ -1029,8 +1047,8 @@
fun rel args ->
if clear_rel rel then Formula.Or []
else Formula.Rel (rel, args)} in
- let more_formulas, game =
- map_all_formulas (!final_simplify -| remove_empty) more_formulas game in
+ let game = Arena.map_to_formulas
+ (!final_simplify -| remove_exist -| remove_empty) game in
let game, state =
Arena.map_to_structures
(fun struc ->
@@ -1039,4 +1057,4 @@
Structure.add_rel_name rel arity struc) struc signat in
Structure.clear_rels struc clear_rel)
(game, state) in
- more_formulas, (game, state)
+ (game, state)
Modified: trunk/Toss/GGP/GameSimpl.mli
===================================================================
--- trunk/Toss/GGP/GameSimpl.mli 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/GameSimpl.mli 2011-09-29 16:34:12 UTC (rev 1578)
@@ -10,8 +10,9 @@
good heuristic. Very crude for now, not using the structure yet. *)
val niceness : Formula.formula -> int
+val remove_exist : Formula.formula -> Formula.formula
+
val simplify :
?keep_nonempty_predicates:bool ->
- more_formulas:Formula.formula Aux.StrMap.t ->
Arena.game * Arena.game_state ->
- Formula.formula Aux.StrMap.t * (Arena.game * Arena.game_state)
+ Arena.game * Arena.game_state
Modified: trunk/Toss/GGP/GameSimplTest.ml
===================================================================
--- trunk/Toss/GGP/GameSimplTest.ml 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/GameSimplTest.ml 2011-09-29 16:34:12 UTC (rev 1578)
@@ -13,8 +13,7 @@
"connect5" >::
(fun () ->
let connect5 = state_of_file "./GGP/tests/connect5-raw.toss" in
- let _, res =
- GameSimpl.simplify ~more_formulas:Aux.StrMap.empty connect5 in
+ let res = GameSimpl.simplify connect5 in
let goal = state_of_file "./GGP/tests/connect5-simpl.toss" in
let resf = open_out "./GGP/tests/connect5-temp.toss" in
let res_str = Arena.state_str res in
@@ -31,8 +30,7 @@
"breakthrough" >::
(fun () ->
let breakthrough = state_of_file "./GGP/tests/breakthrough-raw.toss" in
- let _, res =
- GameSimpl.simplify ~more_formulas:Aux.StrMap.empty breakthrough in
+ let res = GameSimpl.simplify breakthrough in
let goal = state_of_file "./GGP/tests/breakthrough-simpl.toss" in
let resf = open_out "./GGP/tests/breakthrough-temp.toss" in
let res_str = Arena.state_str res in
@@ -69,8 +67,7 @@
let game = state_of_file ("./GGP/tests/"^game_name^"-raw.toss") in
Printf.printf "\nINPUT:\n%s\n%!" (Arena.state_str game);
(* GameSimpl.debug_level := 5; *)
- let _, res =
- GameSimpl.simplify ~more_formulas:Aux.StrMap.empty game in
+ let res = GameSimpl.simplify game in
let resf = open_out ("./GGP/tests/"^game_name^"-simpl.toss") in
let res_str = Arena.state_str res in
output_string resf res_str;
@@ -81,8 +78,7 @@
let a () =
GameSimpl.debug_level := 5;
let connect5 = state_of_file "./GGP/tests/connect5-raw.toss" in
- let _, res =
- GameSimpl.simplify ~more_formulas:Aux.StrMap.empty connect5 in
+ let res = GameSimpl.simplify connect5 in
let goal = state_of_file "./GGP/tests/connect5-simpl.toss" in
let resf = open_out "./GGP/tests/connect5-temp.toss" in
let res_str = Arena.state_str res in
Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/TranslateFormula.ml 2011-09-29 16:34:12 UTC (rev 1578)
@@ -380,35 +380,37 @@
let build_defrels data clauses =
let build_defrel drel =
- (* {{{ log entry *)
- if !debug_level > 1 then (
- Printf.printf "build_defrel: %s\n%!" drel
- );
- (* }}} *)
- let partition =
- match List.assoc drel data.argpaths with
- | Aux.Right partition -> partition
- | Aux.Left _ -> assert false in
- let r_clauses = Aux.map_some
- (fun ((rel,args),body) ->
- if rel=drel then Some (args,body) else None) clauses in
- let d_arity = List.length partition in
- let defvars =
- Array.init d_arity (fun i -> "v"^string_of_int i) in
- let tr_def_r (args, body) =
- let sterms = Aux.map_some
- (function Pos (True s) -> Some s | _ -> None) body in
- let s_l = List.map (find_rel_arg sterms args) partition in
- let v_l = List.map (var_of_term data) s_l in
- let eqs = List.map2
- (fun v sv -> Formula.Eq (`FO v, sv))
- (Array.to_list defvars) v_l in
- let def_phi = FormulaOps.del_vars_quant (v_l :> Formula.var list)
- (translate data [body]) in
- if v_l = [] then Formula.And (eqs @ [def_phi])
- else Formula.Ex ((v_l :> Formula.var list),
- Formula.And (eqs @ [def_phi])) in
- drel, (Array.to_list defvars,
- Formula.Or (List.map tr_def_r r_clauses)) in
+ try
+ (* {{{ log entry *)
+ if !debug_level > 1 then (
+ Printf.printf "build_defrel: %s\n%!" drel
+ );
+ (* }}} *)
+ let partition =
+ match List.assoc drel data.argpaths with
+ | Aux.Right partition -> partition
+ | Aux.Left _ -> assert false in
+ let r_clauses = Aux.map_some
+ (fun ((rel,args),body) ->
+ if rel=drel then Some (args,body) else None) clauses in
+ let d_arity = List.length partition in
+ let defvars =
+ Array.init d_arity (fun i -> "v"^string_of_int i) in
+ let tr_def_r (args, body) =
+ let sterms = Aux.map_some
+ (function Pos (True s) -> Some s | _ -> None) body in
+ let s_l = List.map (find_rel_arg sterms args) partition in
+ let v_l = List.map (var_of_term data) s_l in
+ let eqs = List.map2
+ (fun v sv -> Formula.Eq (`FO v, sv))
+ (Array.to_list defvars) v_l in
+ let def_phi = FormulaOps.del_vars_quant (v_l :> Formula.var list)
+ (translate data [body]) in
+ if v_l = [] then Formula.And (eqs @ [def_phi])
+ else Formula.Ex ((v_l :> Formula.var list),
+ Formula.And (eqs @ [def_phi])) in
+ drel, (Array.to_list defvars,
+ Formula.Or (List.map tr_def_r r_clauses))
+ with Not_found -> drel, ([], Formula.Or []) in
List.map build_defrel data.defined_rels
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-09-29 16:34:12 UTC (rev 1578)
@@ -61,6 +61,10 @@
less fluent paths.) *)
let propose_leaf_f_paths = ref true
+(** Whether to eliminate an argument of a relation when it is ground
+ in all clauses defining the relation. *)
+let perform_ground_arg_elim = ref true
+
(** two heuristics for selecting defined relations: select relations
with arity smaller than three; or, select relations that have ground
defining clauses (i.e. defining clauses with empty bodies). *)
@@ -90,8 +94,6 @@
(then ordered in the same way as players),
we call its parameters "fixed variables" as they are provided
externally *)
- precond : Formula.formula;
- (* the LHS match condition (the LHS structure and the precondition) *)
rhs_add : (string * string array) list;
struc_elems : string list;
(* the elements of LHS/RHS structures, corresponding to the "next"
@@ -682,13 +684,6 @@
with Not_found -> failwith
("in clause "^h_rel^", alien <distinct> argument "^term_str arg) in
Some (blank_outside_subterm term_arities path arg) in
- (* {{{ log entry *)
- if !debug_level > 3 then (
- Printf.printf
- "call_transform: rel=%s; clause=\n%s\n\n%!"
- rel (clause_str cl)
- );
- (* }}} *)
let add_sterms = Aux.concat_map
(fun args ->
if rel = "distinct" && h_rel <> "frame next" then
@@ -2087,7 +2082,6 @@
let fixvar_terms = Aux.collect fixvar_terms in
let tossrule_data = {
legal_tuple = Array.of_list legal_tuple;
- precond = precond;
rhs_add = rhs_add;
struc_elems = struc_elems;
fixvar_terms = fixvar_terms;
@@ -2545,6 +2539,9 @@
struc counters,
Some counter_e
+let inline_defined_rels def_rels game =
+ Arena.map_to_formulas (FormulaSubst.subst_rels def_rels) game
+
(* [playing_as] is only used for building move translation data, the
translation is independent of the selected player. *)
let translate_game ~playing_as clauses =
@@ -2618,6 +2615,20 @@
);
(* }}} *)
let clauses = elim_ground_distinct clauses in
+ let nonelim_static_rels, elim_static_rels = List.partition
+ (fun rel -> List.exists (fun ((r,_),b) -> r=rel && b=[]) clauses)
+ static_rels in
+ let elim_static_rels, clauses =
+ if !perform_ground_arg_elim
+ then elim_ground_args elim_static_rels clauses
+ else elim_static_rels, clauses in
+ let static_rels = elim_static_rels @ nonelim_static_rels in
+ let nonstatic_rels = Aux.list_diff nonstatic_rels ["goal"; "legal"] in
+ let nonstatic_rels, clauses =
+ if !perform_ground_arg_elim
+ then elim_ground_args nonstatic_rels clauses
+ else nonstatic_rels, clauses in
+ let nonstatic_rels = "goal"::"legal"::nonstatic_rels in
(* {{{ log entry *)
if !debug_level > 3 then (
Printf.printf
@@ -2777,8 +2788,6 @@
);
(* }}} *)
let tossrule_data = Aux.strmap_of_assoc tossrule_data in
- let tossrule_preconds =
- Aux.StrMap.map (fun rdata->rdata.precond) tossrule_data in
let playing_as =
try
Aux.array_argfind (fun x -> x = playing_as) players
@@ -2789,12 +2798,7 @@
let file = open_out ("./GGP/tests/"^game_name^"-raw.toss") in
output_string file (Arena.state_str result);
flush file; close_out file);
- let tossrule_preconds, result =
- GameSimpl.simplify ~more_formulas:tossrule_preconds result in
- let tossrule_data = Aux.StrMap.mapi
- (fun rname rdata->
- {rdata with precond = Aux.StrMap.find rname tossrule_preconds})
- tossrule_data in
+ let result = GameSimpl.simplify result in
let gdl_translation = {
(* map between structure elements and their term representations;
the reverse direction is by using element names *)
@@ -2827,7 +2831,10 @@
(Arena.sprint_state_full result)
);
(* }}} *)
- gdl_translation, result
+ let game, state = result in
+ let inl_game = Arena.map_to_formulas GameSimpl.remove_exist
+ (inline_defined_rels defined_rels game) in
+ gdl_translation, game, (inl_game, state)
@@ -2840,13 +2847,13 @@
performed by [player] (a number). Returns an option, since it can
be called for multiple candidate rules. *)
let translate_incoming_single_action
- fluents data rdata state player move rname =
+ fluents data rdata (game, state) player move rname =
let legal_term =
if Array.length rdata.legal_tuple > 1
then rdata.legal_tuple.(player)
else rdata.legal_tuple.(0) in
let fixed_inst = unify [] [move] [legal_term] in
- let struc = (snd state).Arena.struc in
+ let struc = state.Arena.struc in
let coords = Aux.concat_map (fun (v,t) ->
let state_terms = List.assoc v rdata.fixvar_terms in
List.map
@@ -2855,7 +2862,10 @@
Formula.Rel (pred, [|TranslateFormula.var_of_term data sterm|]))
state_terms
) fixed_inst in
- let precond = Formula.And (coords @ [rdata.precond]) in
+ let rule = (List.assoc rname game.Arena.rules).ContinuousRule.discrete in
+ let r_obj = (List.assoc rname game.Arena.rules).ContinuousRule.compiled in
+ let precond = r_obj.DiscreteRule.lhs_form in
+ let precond = Formula.And (coords @ [precond]) in
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf
@@ -2864,12 +2874,8 @@
);
(* }}} *)
- let signat = Structure.rel_signature struc in
- let rule =
- DiscreteRule.translate_from_precond ~precond ~add:rdata.rhs_add
- ~emb_rels:fluents ~signat ~struc_elems:rdata.struc_elems in
+ let r_obj = {r_obj with DiscreteRule.lhs_form = precond} in
let lhs_struc = rule.DiscreteRule.lhs_struc in
- let rule = DiscreteRule.compile_rule signat [] rule in
(* {{{ log entry *)
if !debug_level > 3 then (
Printf.printf
@@ -2877,8 +2883,9 @@
(Structure.str struc)
);
(* }}} *)
+ DiscreteRule.debug_level := 6;
let asgns =
- DiscreteRule.find_matchings struc rule in
+ DiscreteRule.find_matchings struc r_obj in
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf "found %s\n%!" (AssignmentSet.str asgns)
@@ -2889,7 +2896,7 @@
DiscreteRule.choose_match (snd state).Arena.struc rule asgns in *)
(* but we should check whether there's no ambiguity... *)
match
- DiscreteRule.enumerate_matchings struc rule asgns
+ DiscreteRule.enumerate_matchings struc r_obj asgns
with
| [] -> None
| [emb] -> Some (rname, emb, lhs_struc)
Modified: trunk/Toss/GGP/TranslateGame.mli
===================================================================
--- trunk/Toss/GGP/TranslateGame.mli 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/TranslateGame.mli 2011-09-29 16:34:12 UTC (rev 1578)
@@ -24,8 +24,6 @@
(then ordered in the same way as players),
we call its parameters "fixed variables" as they are provided
externally *)
- precond : Formula.formula;
- (* the LHS match condition (the LHS structure and the precondition) *)
rhs_add : (string * string array) list;
struc_elems : string list;
(* the elements of LHS/RHS structures, corresponding to the "next"
@@ -64,10 +62,11 @@
(* [playing_as] is only used for building move translation data, the
game translation is independent of the selected player (a dummy
- term can be provided). *)
+ term can be provided). Only the second [Arena.game] returned has
+ defined relations inlined. *)
val translate_game :
playing_as:GDL.term -> GDL.clause list ->
- gdl_translation * (Arena.game * Arena.game_state)
+ gdl_translation * Arena.game * (Arena.game * Arena.game_state)
(* Return a list of rewrites to apply, as triples: player number,
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-29 16:34:12 UTC (rev 1578)
@@ -48,13 +48,13 @@
~loc0_move ~loc0_noop ~loc1 ~loc1_rule_name ~loc1_emb ~loc1_noop
~loc1_move =
let game = load_rules ("./GGP/examples/"^game_name^".gdl") in
- let gdl, res =
+ let gdl, r_game, (r_inl_game, r_struc as res) =
TranslateGame.translate_game ~playing_as:(Const player) game in
let goal_name = game_name^"-simpl.toss" in
(* let goal = state_of_file ("./GGP/tests/"^goal_name) in *)
let goal_str = Aux.input_file (open_in ("./GGP/tests/"^goal_name)) in
let resf = open_out ("./GGP/tests/"^game_name^"-temp.toss") in
- let res_str = Arena.state_str res in
+ let res_str = Arena.state_str (r_game, r_struc) in
output_string resf res_str;
close_out resf;
(* let eq, msg = Arena.compare_diff goal res in *)
@@ -128,13 +128,13 @@
~own_rule_name ~own_emb ~own_move ~opp_rule_name ~opp_emb
~opp_move =
let game = load_rules ("./GGP/examples/"^game_name^".gdl") in
- let gdl, res =
+ let gdl, r_game, (r_inl_game, r_struc as res) =
TranslateGame.translate_game ~playing_as:(Const player) game in
let goal_name = game_name^"-simpl.toss" in
(* let goal = state_of_file ("./GGP/tests/"^goal_name) in *)
let goal_str = Aux.input_file (open_in ("./GGP/tests/"^goal_name)) in
let resf = open_out ("./GGP/tests/"^game_name^"-temp.toss") in
- let res_str = Arena.state_str res in
+ let res_str = Arena.state_str (r_game, r_struc) in
output_string resf res_str;
close_out resf;
(* let eq, msg = Arena.compare_diff goal res in *)
@@ -307,23 +307,22 @@
let a () =
set_debug_level 4;
- game_test_case ~game_name:"connect4" ~player:"white"
+ game_test_case ~game_name:"tictactoe" ~player:"xplayer"
~own_plnum:0 ~opponent_plnum:1
- ~loc0_rule_name:"drop_c11_noop"
+ ~loc0_rule_name:"mark_x6_y_noop"
~loc0_emb:[
- "cell_c11_h4__BLANK_", "cell_2_1__BLANK_";
+ "cell_x6_y__BLANK_", "cell_2_2__BLANK_";
"control__BLANK_", "control__BLANK_"]
- ~loc0_move:"(drop 2)" ~loc0_noop:"noop"
- ~loc1:1 ~loc1_rule_name:"noop_drop_c12"
+ ~loc0_move:"(mark 2 2)" ~loc0_noop:"noop"
+ ~loc1:1 ~loc1_rule_name:"noop_mark_x7_y0"
~loc1_emb:[
- "cell_c12_h6__BLANK_", "cell_2_2__BLANK_";
+ "cell_x7_y0__BLANK_", "cell_1_1__BLANK_";
"control__BLANK_", "control__BLANK_"]
- ~loc1_noop:"noop" ~loc1_move:"(drop 2)";
+ ~loc1_noop:"noop" ~loc1_move:"(mark 1 1)";
(* failwith "tested"; *)
()
-
let a () =
match test_filter
[(* "GDLBig:1:breakthrough" *) "GDLBig:0:connect5"]
@@ -357,14 +356,14 @@
TranslateGame.generate_test_case := None
let a () =
- (* regenerate ~debug:false ~game_name:"tictactoe" ~player:"xplayer"; *)
+ regenerate ~debug:false ~game_name:"tictactoe" ~player:"xplayer";
(* regenerate ~debug:false ~game_name:"connect5" ~player:"x"; *)
(* regenerate ~debug:false ~game_name:"breakthrough" ~player:"white"; *)
(* regenerate ~debug:true ~game_name:"pawn_whopping" ~player:"x"; *)
(* regenerate ~debug:false ~game_name:"connect4" ~player:"white"; *)
(* regenerate ~debug:false ~game_name:"2player_normal_form_2010" ~player:"row"; *)
(* regenerate ~debug:true ~game_name:"pacman3p" ~player:"pacman"; *)
- (* failwith "generated"; *)
+ failwith "generated";
()
let translate_file fname timeout =
@@ -376,9 +375,9 @@
TranslateGame.set_timeout
(fun () -> Unix.gettimeofday() -. start > float (tout)));
let descr = load_rules fname in
- let gdl_data, result =
+ let gdl_data, game, (_, struc) =
TranslateGame.translate_game ~playing_as:(GDL.Const "") descr in
- (true, Arena.state_str result)
+ (true, Arena.state_str (game, struc))
with
| Aux.Timeout msg -> (false, "Timeout: " ^ msg)
| e -> (false, "Failed: " ^ (Printexc.to_string e))
Modified: trunk/Toss/GGP/tests/tictactoe-raw.toss
===================================================================
--- trunk/Toss/GGP/tests/tictactoe-raw.toss 2011-09-29 09:46:30 UTC (rev 1577)
+++ trunk/Toss/GGP/tests/tictactoe-raw.toss 2011-09-29 16:34:12 UTC (rev 1578)
@@ -1,24 +1,6 @@
-REL line(v0) =
- ex val__x3
- (v0 = val__x3 and
- ex cell_m5__BLANK___BLANK_
- (row(cell_m5__BLANK___BLANK_, val__x3) and
- val___BLANK_(val__x3) and
- cell__BLANK___BLANK___BLANK_(cell_m5__BLANK___BLANK_))) or
- ex val__x4
- (v0 = val__x4 and
- ex cell__BLANK__m6__BLANK_
- (column(cell__BLANK__m6__BLANK_, val__x4) and
- val___BLANK_(val__x4) and
- cell__BLANK___BLANK___BLANK_(cell__BLANK__m6__BLANK_))) or
- ex val__x5 (v0 = val__x5 and diagonal(val__x5) and val___BLANK_(val__x5))
-REL terminal() =
- ex val__x (line(val__x) and val__0x(val__x) and val___BLANK_(val__x)) or
- ex val__o (line(val__o) and val__0o(val__o) and val___BLANK_(val__o)) or
- (not open() and true)
-REL column(v0, v1) =
- ex cell_1_n4__BLANK_, val__b
- (v0 = cell_1_n4__BLANK_ and v1 = val__b and
+REL column__b(v0) =
+ ex cell_1_n4__BLANK_
+ (v0 = cell_1_n4__BLANK_ and
ex cell_2_n4__BLANK_, cell_3_n4__BLANK_
(EQ___cell_1__cell_1(cell_1_n4__BLANK_, cell_2_n4__BLANK_) and
EQ___cell_1__cell_1(cell_1_n4__BLANK_, cell_3_n4__BLANK_) and
@@ -26,138 +8,145 @@
EQ___cell_1__cell_1(cell_2_n4__BLANK_, cell_3_n4__BLANK_) and
EQ___cell_1__cell_1(cell_3_n4__BLANK_, cell_1_n4__BLANK_) and
EQ___cell_1__cell_1(cell_3_n4__BLANK_, cell_2_n4__BLANK_) and
- val__0b(val__b) and val___BLANK_(val__b) and
- cell_01(cell_1_n4__BLANK_) and cell_2b(cell_1_n4__BLANK_) and
+ cell_01(cell_1_n4__BLANK_) and cell_2b(cell_1_n4__BLANK_) and
cell__BLANK___BLANK___BLANK_(cell_1_n4__BLANK_) and
cell_02(cell_2_n4__BLANK_) and cell_2b(cell_2_n4__BLANK_) and
cell__BLANK___BLANK___BLANK_(cell_2_n4__BLANK_) and
cell_03(cell_3_n4__BLANK_) and cell_2b(cell_3_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_n4__BLANK_))) or
- ex cell_1_n4__BLANK_, val__o
- (v0 = cell_1_n4__BLANK_ and v1 = val__o and
- ex cell_2_n4__BLANK_, cell_3_n4__BLANK_
- (EQ___cell_1__cell_1(cell_1_n4__BLANK_, cell_2_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_1_n4__BLANK_, cell_3_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_2_n4__BLANK_, cell_1_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_2_n4__BLANK_, cell_3_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_3_n4__BLANK_, cell_1_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_3_n4__BLANK_, cell_2_n4__BLANK_) and
- val__0o(val__o) and val___BLANK_(val__o) and
- cell_01(cell_1_n4__BLANK_) and cell_2o(cell_1_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_1_n4__BLANK_) and
- cell_02(cell_2_n4__BLANK_) and cell_2o(cell_2_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_2_n4__BLANK_) and
- cell_03(cell_3_n4__BLANK_) and cell_2o(cell_3_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_n4__BLANK_))) or
- ex cell_1_n4__BLANK_, val__x
- (v0 = cell_1_n4__BLANK_ and v1 = val__x and
- ex cell_2_n4__BLANK_, cell_3_n4__BLANK_
- (EQ___cell_1__cell_1(cell_1_n4__BLANK_, cell_2_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_1_n4__BLANK_, cell_3_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_2_n4__BLANK_, cell_1_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_2_n4__BLANK_, cell_3_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_3_n4__BLANK_, cell_1_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_3_n4__BLANK_, cell_2_n4__BLANK_) and
- val__0x(val__x) and val___BLANK_(val__x) and
- cell_01(cell_1_n4__BLANK_) and cell_2x(cell_1_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_1_n4__BLANK_) and
- cell_02(cell_2_n4__BLANK_) and cell_2x(cell_2_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_2_n4__BLANK_) and
- cell_03(cell_3_n4__BLANK_) and cell_2x(cell_3_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_n4__BLANK_)))
-REL diagonal(v0) =
- ex val__b
- (v0 = val__b and
- ex cell_1_1__BLAN...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-29 22:18:40
|
Revision: 1579
http://toss.svn.sourceforge.net/toss/?rev=1579&view=rev
Author: lukstafi
Date: 2011-09-29 22:18:32 +0000 (Thu, 29 Sep 2011)
Log Message:
-----------
GDL translation: bug fix in eliminating redundant existenital quantification; switched introducing relation complements off; fixes in translating incoming moves for concurrent games; regenerated tests.
Modified Paths:
--------------
trunk/Toss/Formula/FormulaOpsTest.ml
trunk/Toss/GGP/GameSimpl.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss
trunk/Toss/GGP/tests/breakthrough-raw.toss
trunk/Toss/GGP/tests/breakthrough-simpl.toss
trunk/Toss/GGP/tests/connect4-raw.toss
trunk/Toss/GGP/tests/connect4-simpl.toss
trunk/Toss/GGP/tests/connect5-raw.toss
trunk/Toss/GGP/tests/connect5-simpl.toss
trunk/Toss/GGP/tests/tictactoe-simpl.toss
Modified: trunk/Toss/Formula/FormulaOpsTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaOpsTest.ml 2011-09-29 16:34:12 UTC (rev 1578)
+++ trunk/Toss/Formula/FormulaOpsTest.ml 2011-09-29 22:18:32 UTC (rev 1579)
@@ -295,6 +295,7 @@
let rr_eq phi1 phi2 =
formula_eq id phi2 (FormulaOps.remove_redundant ~implies) phi1 in
rr_eq "P(x) and Q(x)" "P(x)";
+ rr_eq "R(x, y) and (Q(x) and P(x))" "R(x, y) and P(x)";
rr_eq "P(x) and (not Q(x) or R(x,y))" "P(x) and R(x,y)";
rr_eq "Q(x) and (not P(x) or R(x,y))"
"Q(x) and (R(x, y) or not P(x))";
Modified: trunk/Toss/GGP/GameSimpl.ml
===================================================================
--- trunk/Toss/GGP/GameSimpl.ml 2011-09-29 16:34:12 UTC (rev 1578)
+++ trunk/Toss/GGP/GameSimpl.ml 2011-09-29 22:18:32 UTC (rev 1579)
@@ -141,7 +141,7 @@
let debug_level = ref 0
-let introduce_complement = ref true
+let introduce_complement = ref false
let final_simplify =
ref (FormulaOps.remove_redundant ?implies:None)
@@ -176,11 +176,19 @@
| Eq (v1, v2) when List.mem (v2 :> var) vs ->
Aux.Left (Formula.var_str v2, Formula.var_str v1)
| phi -> Aux.Right phi) conj in
+ let more_conj = List.filter
+ (fun (elim, equated) -> List.tl equated <> [])
+ (Aux.collect sb) in
+ let more_conj = Aux.concat_map
+ (fun (_, equated) ->
+ let lhs = List.hd equated in
+ List.map (fun rhs -> Eq (`FO lhs, `FO rhs)) (List.tl equated))
+ more_conj in
if sb = [] then Ex (vs, And conj)
else
let vs =
List.filter (fun v -> not (List.mem_assoc (var_str v) sb)) vs in
- let phi = FormulaSubst.subst_vars sb (And conj) in
+ let phi = FormulaSubst.subst_vars sb (And (more_conj @ conj)) in
if vs = [] then phi else Ex (vs, phi)
| phi -> phi} in
FormulaMap.map_formula f_map phi
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-09-29 16:34:12 UTC (rev 1578)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-09-29 22:18:32 UTC (rev 1579)
@@ -650,7 +650,7 @@
terms. Remove "true" atoms that are "subsumed" by more specific
atoms (that have subterms instead of blanks). *)
let call_transform term_arities ground_at_c_paths
- rel partition ((h_rel,h_args as h),body as cl) =
+ rel partition ((h_rel,h_args as h),body) =
let r_atoms = if h_rel = rel then [h_args] else [] in
let r_atoms = r_atoms @ Aux.map_some
(function Rel (r, args) when r = rel -> Some args
@@ -2833,7 +2833,7 @@
(* }}} *)
let game, state = result in
let inl_game = Arena.map_to_formulas GameSimpl.remove_exist
- (inline_defined_rels defined_rels game) in
+ (inline_defined_rels game.Arena.defined_rels game) in
gdl_translation, game, (inl_game, state)
@@ -2869,8 +2869,11 @@
(* {{{ log entry *)
if !debug_level > 2 then (
Printf.printf
- "GDL.translate_incoming_move: rule=%s; trying precond=\n%s\n...%!"
- rname (Formula.sprint precond)
+ "GDL.translate_incoming_move: rule=%s; move=%s; coords=%s; precond=\n%s\n...%!"
+ rname (term_str move)
+ (*String.concat ", " (List.map term_str (Array.to_list rdata.legal_tuple))*)
+ (String.concat ", " (List.map Formula.sprint coords))
+ (Formula.sprint precond)
);
(* }}} *)
@@ -2883,7 +2886,6 @@
(Structure.str struc)
);
(* }}} *)
- DiscreteRule.debug_level := 6;
let asgns =
DiscreteRule.find_matchings struc r_obj in
(* {{{ log entry *)
@@ -2959,28 +2961,32 @@
(* We translate as a suite of moves, one for each player; after these
rules have been applied, the server should apply the environment rule. *)
-let translate_incoming_move_concurrent gdl state actions =
+let translate_incoming_move_concurrent gdl (game,state as gstate) actions =
(* there is only location 0; Environment is not among [actions] *)
+ let loc = game.Arena.graph.(0) in
let actions = Array.of_list actions in
- (* let location = (fst state).Arena.graph.(0) in *)
- let struc = (snd state).Arena.struc in
+ (* let location = state.Arena.graph.(0) in *)
+ let struc = state.Arena.struc in
(* the players actually start at 1, index 0 is the environment *)
let candidates = Array.mapi
(fun player_not_env move ->
let player = player_not_env + 1 in
+ let prules = loc.(player).Arena.moves in
+ let prules = List.map (fun (lb,_)->lb.Arena.lb_rule) prules in
let tossrules =
- Aux.strmap_filter (fun _ rdata ->
- rdata.legal_tuple <> [||] && (* not Environment rule *)
+ Aux.strmap_filter (fun rname rdata ->
+ List.mem rname prules &&
+ rdata.legal_tuple <> [||] && (* not Environment rule *)
let legal_term =
if Array.length rdata.legal_tuple > 1
- then rdata.legal_tuple.(player)
+ then rdata.legal_tuple.(player_not_env)
else rdata.legal_tuple.(0) in
try ignore (unify [] [move] [legal_term]); true
with Not_found -> false
) gdl.tossrule_data in
let candidates = Aux.map_some (fun (rname, rdata) ->
translate_incoming_single_action gdl.fluents gdl.transl_data
- rdata state player move rname
+ rdata gstate player move rname
) tossrules in
match candidates with
| [] ->
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-29 16:34:12 UTC (rev 1578)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-29 22:18:32 UTC (rev 1579)
@@ -95,14 +95,31 @@
(* COPIED FROM ReqHandler. *)
exception Found of int
(* The player applying the rewrite seems not to be used. *)
-(* Problem: are players indexed from 0 or from 1 in graph? *)
-let apply_rewrite state (player, (r_name, mtch)) =
+(* players are indexed from 1 in graph (0 is Environment) *)
+let apply_rewrite (game,state as gstate) (player, (r_name, mtch)) =
if r_name <> "" then (
- let {Arena.rules=rules; graph=graph} = fst state in
- let mv_loc = graph.((snd state).Arena.cur_loc).(player) in
+ let {Arena.rules=rules; graph=graph} = game in
+ let struc = state.Arena.struc in
+ let mv_loc = graph.(state.Arena.cur_loc).(player) in
let moves =
- Move.gen_moves Move.cGRID_SIZE rules
- (snd state).Arena.struc mv_loc in
+ Move.gen_moves Move.cGRID_SIZE rules struc mv_loc in
+ (* {{{ log entry *)
+ if !debug_level > 0 then (
+ let prules =
+ List.map (fun (lb,_)->lb.Arena.lb_rule) mv_loc.Arena.moves in
+ Printf.printf
+ "apply_rewrite: r_name=%s; mtch=%s; player=%d; prules=%s; moves= %s\n%!"
+ r_name
+ (ContinuousRule.embedding_str (List.assoc r_name rules) struc mtch)
+ player (String.concat ", " prules)
+ (String.concat "; "
+ (List.map (fun m->
+ let rul = List.assoc m.Arena.rule rules in
+ m.Arena.rule^":"^
+ ContinuousRule.embedding_str rul struc
+ m.Arena.embedding) (Array.to_list moves)))
+ );
+ (* }}} *)
let pos = (
try
for i = 0 to Array.length moves - 1 do
@@ -118,11 +135,11 @@
with Found pos ->
pos) in
let req = Arena.ApplyRuleInt (r_name, mtch, 0.1, []) in
- let (new_state_noloc, resp) = Arena.handle_request state req in
+ let (new_state_noloc, resp) = Arena.handle_request gstate req in
let new_loc = moves.(pos).Arena.next_loc in
(fst new_state_noloc,
{snd new_state_noloc with Arena.cur_loc = new_loc})
- ) else state
+ ) else gstate
let simult_test_case ~game_name ~player ~own_plnum ~opp_plnum
~own_rule_name ~own_emb ~own_move ~opp_rule_name ~opp_emb
@@ -289,7 +306,7 @@
~loc0_move:"(drop 2)" ~loc0_noop:"noop"
~loc1:1 ~loc1_rule_name:"noop_drop_c12"
~loc1_emb:[
- "cell_c12_h6__BLANK_", "cell_2_1__BLANK_";
+ "cell_c12_h6__BLANK_", "cell_2_2__BLANK_";
"control__BLANK_", "control__BLANK_"]
~loc1_noop:"noop" ~loc1_move:"(drop 2)"
);
@@ -307,18 +324,18 @@
let a () =
set_debug_level 4;
- game_test_case ~game_name:"tictactoe" ~player:"xplayer"
+ game_test_case ~game_name:"connect4" ~player:"white"
~own_plnum:0 ~opponent_plnum:1
- ~loc0_rule_name:"mark_x6_y_noop"
+ ~loc0_rule_name:"drop_c11_noop"
~loc0_emb:[
- "cell_x6_y__BLANK_", "cell_2_2__BLANK_";
+ "cell_c11_h4__BLANK_", "cell_2_1__BLANK_";
"control__BLANK_", "control__BLANK_"]
- ~loc0_move:"(mark 2 2)" ~loc0_noop:"noop"
- ~loc1:1 ~loc1_rule_name:"noop_mark_x7_y0"
+ ~loc0_move:"(drop 2)" ~loc0_noop:"noop"
+ ~loc1:1 ~loc1_rule_name:"noop_drop_c12"
~loc1_emb:[
- "cell_x7_y0__BLANK_", "cell_1_1__BLANK_";
+ "cell_c12_h6__BLANK_", "cell_2_2__BLANK_";
"control__BLANK_", "control__BLANK_"]
- ~loc1_noop:"noop" ~loc1_move:"(mark 1 1)";
+ ~loc1_noop:"noop" ~loc1_move:"(drop 2)";
(* failwith "tested"; *)
()
@@ -356,14 +373,14 @@
TranslateGame.generate_test_case := None
let a () =
- regenerate ~debug:false ~game_name:"tictactoe" ~player:"xplayer";
+ (* regenerate ~debug:false ~game_name:"tictactoe" ~player:"xplayer"; *)
(* regenerate ~debug:false ~game_name:"connect5" ~player:"x"; *)
(* regenerate ~debug:false ~game_name:"breakthrough" ~player:"white"; *)
(* regenerate ~debug:true ~game_name:"pawn_whopping" ~player:"x"; *)
(* regenerate ~debug:false ~game_name:"connect4" ~player:"white"; *)
(* regenerate ~debug:false ~game_name:"2player_normal_form_2010" ~player:"row"; *)
- (* regenerate ~debug:true ~game_name:"pacman3p" ~player:"pacman"; *)
- failwith "generated";
+ regenerate ~debug:true ~game_name:"pacman3p" ~player:"pacman";
+ (* failwith "generated"; *)
()
let translate_file fname timeout =
Modified: trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss
===================================================================
--- trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss 2011-09-29 16:34:12 UTC (rev 1578)
+++ trunk/Toss/GGP/tests/2player_normal_form_2010-simpl.toss 2011-09-29 22:18:32 UTC (rev 1579)
@@ -4,7 +4,6 @@
ex did__BLANK__m11
(did__BLANK___BLANK_(did__BLANK__m11) and did_0row(did__BLANK__m11))
PLAYERS Environment, row, column
-DATA C: C__val___BLANK_
RULE m:
[did__BLANK__m, synch_control_ |
_opt_column__SYNC {did__BLANK__m; synch_control_};
@@ -22,8 +21,9 @@
pre
(not terminal() and
ex val__r0, val__r, did__BLANK__m0
- (did__BLANK___BLANK_(did__BLANK__m0) and reward(did__BLANK__m,
- did__BLANK__m0, val__r, val__r0) and not C(val__r) and not C(val__r0)))
+ (did__BLANK___BLANK_(did__BLANK__m0) and val___BLANK_(val__r) and
+ val___BLANK_(val__r0) and reward(did__BLANK__m, did__BLANK__m0, val__r,
+ val__r0)))
RULE m2:
[did__BLANK__m2, synch_control_ |
_opt_column__SYNC (did__BLANK__m2);
@@ -41,9 +41,9 @@
pre
(not terminal() and
ex val__r2, val__r1, did__BLANK__m1
- (did__BLANK___BLANK_(did__BLANK__m1) and reward(did__BLANK__m1,
- did__BLANK__m2, val__r1, val__r2) and not C(val__r1) and
- not C(val__r2)))
+ (did__BLANK___BLANK_(did__BLANK__m1) and val___BLANK_(val__r1) and
+ val___BLANK_(val__r2) and reward(did__BLANK__m1, did__BLANK__m2,
+ val__r1, val__r2)))
RULE Environment:
[synch_control_ |
_opt_did_0column (synch_control_); _opt_did_0row (synch_control_);
@@ -61,9 +61,9 @@
ex val__r6, val__10, did__BLANK__m7, did__BLANK__m8
(did__BLANK___BLANK_(did__BLANK__m7) and
did__BLANK___BLANK_(did__BLANK__m8) and val__010(val__10) and
- reward(did__BLANK__m7, did__BLANK__m8, val__10, val__r6) and
- did_0row(did__BLANK__m7) and did_0column(did__BLANK__m8) and
- not C(val__10) and not C(val__r6))
+ val___BLANK_(val__r6) and reward(did__BLANK__m7, did__BLANK__m8,
+ val__10, val__r6) and did_0row(did__BLANK__m7) and
+ did_0column(did__BLANK__m8))
)
+
100. *
@@ -71,9 +71,9 @@
ex val__r6, val__100, did__BLANK__m7, did__BLANK__m8
(did__BLANK___BLANK_(did__BLANK__m7) and
did__BLANK___BLANK_(did__BLANK__m8) and val__0100(val__100) and
- reward(did__BLANK__m7, did__BLANK__m8, val__100, val__r6) and
- did_0row(did__BLANK__m7) and did_0column(did__BLANK__m8) and
- not C(val__100) and not C(val__r6))
+ val___BLANK_(val__r6) and reward(did__BLANK__m7, did__BLANK__m8,
+ val__100, val__r6) and did_0row(did__BLANK__m7) and
+ did_0column(did__BLANK__m8))
)
+
20. *
@@ -81,9 +81,9 @@
ex val__r6, val__20, did__BLANK__m7, did__BLANK__m8
(did__BLANK___BLANK_(did__BLANK__m7) and
did__BLANK___BLANK_(did__BLANK__m8) and val__020(val__20) and
- reward(did__BLANK__m7, did__BLANK__m8, val__20, val__r6) and
- did_0row(did__BLANK__m7) and did_0column(did__BLANK__m8) and
- not C(val__20) and not C(val__r6))
+ val___BLANK_(val__r6) and reward(did__BLANK__m7, did__BLANK__m8,
+ val__20, val__r6) and did_0row(did__BLANK__m7) and
+ did_0column(did__BLANK__m8))
)
+
30. *
@@ -91,9 +91,9 @@
ex val__r6, val__30, did__BLANK__m7, did__BLANK__m8
(did__BLANK___BLANK_(did__BLANK__m7) and
did__BLANK___BLANK_(did__BLANK__m8) and val__030(val__30) and
- reward(did__BLANK__m7, did__BLANK__m8, val__30, val__r6) and
- did_0row(did__BLANK__m7) and did_0column(did__BLANK__m8) and
- not C(val__30) and not C(val__r6))
+ val___BLANK_(val__r6) and reward(did__BLANK__m7, did__BLANK__m8,
+ val__30, val__r6) and did_0row(did__BLANK__m7) and
+ did_0column(did__BLANK__m8))
)
+
40. *
@@ -101,9 +101,9 @@
ex val__r6, val__40, did__BLANK__m7, did__BLANK__m8
(did__BLANK___BLANK_(did__BLANK__m7) and
did__BLANK___BLANK_(did__BLANK__m8) and val__040(val__40) and
- reward(did__BLANK__m7, did__BLANK__m8, val__40, val__r6) and
- did_0row(did__BLANK__m7) and did_0column(did__BLANK__m8) and
- not C(val__40) and not C(val__r6))
+ val___BLANK_(val__r6) and reward(did__BLANK__m7, did__BLANK__m8,
+ val__40, val__r6) and did_0row(did__BLANK__m7) and
+ did_0column(did__BLANK__m8))
)
+
50. *
@@ -111,9 +111,9 @@
ex val__r6, val__50, did__BLANK__m7, did__BLANK__m8
(did__BLANK___BLANK_(did__BLANK__m7) and
did__BLANK___BLANK_(did__BLANK__m8) and val__050(val__50) and
- reward(did__BLANK__m7, did__BLANK__m8, val__50, val__r6) and
- did_0row(did__BLANK__m7) and did_0column(did__BLANK__m8) and
- not C(val__50) and not C(val__r6))
+ val___BLANK_(val__r6) and reward(did__BLANK__m7, did__BLANK__m8,
+ val__50, val__r6) and did_0row(did__BLANK__m7) and
+ did_0column(did__BLANK__m8))
)
+
80. *
@@ -121,9 +121,9 @@
ex val__r6, val__80, did__BLANK__m7, did__BLANK__m8
(did__BLANK___BLANK_(did__BLANK__m7) and
did__BLANK___BLANK_(did__BLANK__m8) and val__080(val__80) and
- reward(did__BLANK__m7, did__BLANK__m8, val__80, val__r6) and
- did_0row(did__BLANK__m7) and did_0column(did__BLANK__m8) and
- not C(val__80) and not C(val__r6))
+ val___BLANK_(val__r6) and reward(did__BLANK__m7, did__BLANK__m8,
+ val__80, val__r6) and did_0row(did__BLANK__m7) and
+ did_0column(did__BLANK__m8))
)
+
90. *
@@ -131,9 +131,9 @@
ex val__r6, val__90, did__BLANK__m7, did__BLANK__m8
(did__BLANK___BLANK_(did__BLANK__m7) and
did__BLANK___BLANK_(did__BLANK__m8) and val__090(val__90) and
- reward(did__BLANK__m7, did__BLANK__m8, val__90, val__r6) and
- did_0row(did__BLANK__m7) and did_0column(did__BLANK__m8) and
- not C(val__90) and not C(val__r6))
+ val___BLANK_(val__r6) and reward(did__BLANK__m7, did__BLANK__m8,
+ val__90, val__r6) and did_0row(did__BLANK__m7) and
+ did_0column(did__BLANK__m8))
)
MOVES [m -> 0] }
PLAYER column {
@@ -143,9 +143,9 @@
ex val__10, val__r7, did__BLANK__m9, did__BLANK__m10
(did__BLANK___BLANK_(did__BLANK__m10) and
did__BLANK___BLANK_(did__BLANK__m9) and val__010(val__10) and
- reward(did__BLANK__m9, did__BLANK__m10, val__r7, val__10) and
- did_0column(did__BLANK__m10) and did_0row(did__BLANK__m9) and
- not C(val__10) and not C(val__r7))
+ val___BLANK_(val__r7) and reward(did__BLANK__m9, did__BLANK__m10,
+ val__r7, val__10) and did_0column(did__BLANK__m10) and
+ did_0row(did__BLANK__m9))
)
+
100. *
@@ -153,9 +153,9 @@
ex val__100, val__r7, did__BLANK__m9, did__BLANK__m10
(did__BLANK___BLANK_(did__BLANK__m10) and
did__BLANK___BLANK_(did__BLANK__m9) and val__0100(val__100) and
- reward(did__BLANK__m9, did__BLANK__m10, val__r7, val__100) and
- did_0column(did__BLANK__m10) and did_0row(did__BLANK__m9) and
- not C(val__100) and not C(val__r7))
+ val___BLANK_(val__r7) and reward(did__BLANK__m9, did__BLANK__m10,
+ val__r7, val__100) and did_0column(did__BLANK__m10) and
+ did_0row(did__BLANK__m9))
)
+
20. *
@@ -163,9 +163,9 @@
ex val__20, val__r7, did__BLANK__m9, did__BLANK__m10
(did__BLANK___BLANK_(did__BLANK__m10) and
did__BLANK___BLANK_(did__BLANK__m9) and val__020(val__20) and
- reward(did__BLANK__m9, did__BLANK__m10, val__r7, val__20) and
- did_0column(did__BLANK__m10) and did_0row(did__BLANK__m9) and
- not C(val__20) and not C(val__r7))
+ val___BLANK_(val__r7) and reward(did__BLANK__m9, did__BLANK__m10,
+ val__r7, val__20) and did_0column(did__BLANK__m10) and
+ did_0row(did__BLANK__m9))
)
+
30. *
@@ -173,9 +173,9 @@
ex val__30, val__r7, did__BLANK__m9, did__BLANK__m10
(did__BLANK___BLANK_(did__BLANK__m10) and
did__BLANK___BLANK_(did__BLANK__m9) and val__030(val__30) and
- reward(did__BLANK__m9, did__BLANK__m10, val__r7, val__30) and
- did_0column(did__BLANK__m10) and did_0row(did__BLANK__m9) and
- not C(val__30) and not C(val__r7))
+ val___BLANK_(val__r7) and reward(did__BLANK__m9, did__BLANK__m10,
+ val__r7, val__30) and did_0column(did__BLANK__m10) and
+ did_0row(did__BLANK__m9))
)
+
40. *
@@ -183,9 +183,9 @@
ex val__40, val__r7, did__BLANK__m9, did__BLANK__m10
(did__BLANK___BLANK_(did__BLANK__m10) and
did__BLANK___BLANK_(did__BLANK__m9) and val__040(val__40) and
- reward(did__BLANK__m9, did__BLANK__m10, val__r7, val__40) and
- did_0column(did__BLANK__m10) and did_0row(did__BLANK__m9) and
- not C(val__40) and not C(val__r7))
+ val___BLANK_(val__r7) and reward(did__BLANK__m9, did__BLANK__m10,
+ val__r7, val__40) and did_0column(did__BLANK__m10) and
+ did_0row(did__BLANK__m9))
)
+
50. *
@@ -193,9 +193,9 @@
ex val__50, val__r7, did__BLANK__m9, did__BLANK__m10
(did__BLANK___BLANK_(did__BLANK__m10) and
did__BLANK___BLANK_(did__BLANK__m9) and val__050(val__50) and
- reward(did__BLANK__m9, did__BLANK__m10, val__r7, val__50) and
- did_0column(did__BLANK__m10) and did_0row(did__BLANK__m9) and
- not C(val__50) and not C(val__r7))
+ val___BLANK_(val__r7) and reward(did__BLANK__m9, did__BLANK__m10,
+ val__r7, val__50) and did_0column(did__BLANK__m10) and
+ did_0row(did__BLANK__m9))
)
+
80. *
@@ -203,9 +203,9 @@
ex val__80, val__r7, did__BLANK__m9, did__BLANK__m10
(did__BLANK___BLANK_(did__BLANK__m10) and
did__BLANK___BLANK_(did__BLANK__m9) and val__080(val__80) and
- reward(did__BLANK__m9, did__BLANK__m10, val__r7, val__80) and
- did_0column(did__BLANK__m10) and did_0row(did__BLANK__m9) and
- not C(val__80) and not C(val__r7))
+ val___BLANK_(val__r7) and reward(did__BLANK__m9, did__BLANK__m10,
+ val__r7, val__80) and did_0column(did__BLANK__m10) and
+ did_0row(did__BLANK__m9))
)
+
90. *
@@ -213,9 +213,9 @@
ex val__90, val__r7, did__BLANK__m9, did__BLANK__m10
(did__BLANK___BLANK_(did__BLANK__m10) and
did__BLANK___BLANK_(did__BLANK__m9) and val__090(val__90) and
- reward(did__BLANK__m9, did__BLANK__m10, val__r7, val__90) and
- did_0column(did__BLANK__m10) and did_0row(did__BLANK__m9) and
- not C(val__90) and not C(val__r7))
+ val___BLANK_(val__r7) and reward(did__BLANK__m9, did__BLANK__m10,
+ val__r7, val__90) and did_0column(did__BLANK__m10) and
+ did_0row(did__BLANK__m9))
)
MOVES [m2 -> 0] }
}
@@ -224,10 +224,6 @@
did__BLANK__r2, did__BLANK__r3, val__0, val__10, val__100, val__20,
val__30, val__40, val__50, val__80, val__90, val__column, val__row,
synch_control_ |
- C {
- did__BLANK__c1; did__BLANK__c2; did__BLANK__c3; did__BLANK__r1;
- did__BLANK__r2; did__BLANK__r3; synch_control_
- };
column__SYNC:1 {}; did_0column:1 {}; did_0row:1 {};
did_1c1 (did__BLANK__c1); did_1c2 (did__BLANK__c2);
did_1c3 (did__BLANK__c3); did_1r1 (did__BLANK__r1);
@@ -251,6 +247,10 @@
synch_control_ (synch_control_); val__00 (val__0); val__010 (val__10);
val__0100 (val__100); val__020 (val__20); val__030 (val__30);
val__040 (val__40); val__050 (val__50); val__080 (val__80);
- val__090 (val__90); val__0column (val__column); val__0row (val__row)
+ val__090 (val__90); val__0column (val__column); val__0row (val__row);
+ val___BLANK_ {
+ val__0; val__10; val__100; val__20; val__30; val__40; val__50; val__80;
+ val__90; val__column; val__row
+ }
|
]
Modified: trunk/Toss/GGP/tests/breakthrough-raw.toss
===================================================================
--- trunk/Toss/GGP/tests/breakthrough-raw.toss 2011-09-29 16:34:12 UTC (rev 1578)
+++ trunk/Toss/GGP/tests/breakthrough-raw.toss 2011-09-29 22:18:32 UTC (rev 1579)
@@ -19,7 +19,6 @@
cellholds_x24_y26__BLANK_) and
cellholds__BLANK___BLANK___BLANK_(cellholds_x24_y26__BLANK_) and
cellholds__BLANK___BLANK___BLANK_(cellholds_x23_y25__BLANK_))
-REL terminal() = (whitewin() and true) or (blackwin() and true)
REL blackcell() =
ex cellholds_x28_y28__BLANK_
(cell(cellholds_x28_y28__BLANK_) and
@@ -43,6 +42,7 @@
cellholds__BLANK___BLANK___BLANK_(cellholds_x20_y22__BLANK_)) or
(cellholds_2black(cellholds_x20_y22__BLANK_) and
cellholds__BLANK___BLANK___BLANK_(cellholds_x20_y22__BLANK_)))))
+REL terminal() = (whitewin() and true) or (blackwin() and true)
REL whitecell() =
ex cellholds_x27_y27__BLANK_
(cell(cellholds_x27_y27__BLANK_) and
Modified: trunk/Toss/GGP/tests/breakthrough-simpl.toss
===================================================================
--- trunk/Toss/GGP/tests/breakthrough-simpl.toss 2011-09-29 16:34:12 UTC (rev 1578)
+++ trunk/Toss/GGP/tests/breakthrough-simpl.toss 2011-09-29 22:18:32 UTC (rev 1579)
@@ -1,39 +1,30 @@
-REL cell(v0) =
- ex cellholds_x19_y21__BLANK_
- (v0 = cellholds_x19_y21__BLANK_ and not C(cellholds_x19_y21__BLANK_))
-REL terminal() = blackwin() or whitewin()
+REL cell(v0) = index__cellholds_1(v0)
REL blackcell() =
ex cellholds_x28_y28__BLANK_
- (cell(cellholds_x28_y28__BLANK_) and
- cellholds_2black(cellholds_x28_y28__BLANK_) and
- not C(cellholds_x28_y28__BLANK_))
+ (index__cellholds_1(cellholds_x28_y28__BLANK_) and
+ cell(cellholds_x28_y28__BLANK_) and
+ cellholds_2black(cellholds_x28_y28__BLANK_))
REL blackwin() =
not whitecell() or
ex cellholds_x26_1__BLANK_
(cellholds_11(cellholds_x26_1__BLANK_) and
- cellholds_2black(cellholds_x26_1__BLANK_) and
- not C(cellholds_x26_1__BLANK_))
+ cellholds_2black(cellholds_x26_1__BLANK_))
REL cellempty(v0) =
- ex cellholds_x20_y22__BLANK_
- (cell(cellholds_x20_y22__BLANK_) and v0 = cellholds_x20_y22__BLANK_ and
- not C(cellholds_x20_y22__BLANK_) and
- not
- (cellholds_2black(cellholds_x20_y22__BLANK_) or
- cellholds_2white(cellholds_x20_y22__BLANK_)))
+ (index__cellholds_1(v0) and cell(v0) and
+ not (cellholds_2black(v0) or cellholds_2white(v0)))
+REL terminal() = blackwin() or whitewin()
REL whitecell() =
ex cellholds_x27_y27__BLANK_
- (cell(cellholds_x27_y27__BLANK_) and
- cellholds_2white(cellholds_x27_y27__BLANK_) and
- not C(cellholds_x27_y27__BLANK_))
+ (index__cellholds_1(cellholds_x27_y27__BLANK_) and
+ cell(cellholds_x27_y27__BLANK_) and
+ cellholds_2white(cellholds_x27_y27__BLANK_))
REL whitewin() =
not blackcell() or
ex cellholds_x25_8__BLANK_
(cellholds_18(cellholds_x25_8__BLANK_) and
- cellholds_2white(cellholds_x25_8__BLANK_) and
- not C(cellholds_x25_8__BLANK_))
+ cellholds_2white(cellholds_x25_8__BLANK_))
PLAYERS white, black
-DATA C: C__index__cellholds_1,
- R0: succ__cellholds_0__cellholds_0__AND__succ__cellholds_1__cellholds_1,
+DATA R0: succ__cellholds_0__cellholds_0__AND__succ__cellholds_1__cellholds_1,
R: EQ___cellholds_0__cellholds_0__AND__succ__cellholds_1__cellholds_1,
R1: succ__cellholds_0__cellholds_0__AND_INV__succ__cellholds_1__cellholds_1
RULE move_x_y_x_y0_noop:
@@ -47,7 +38,8 @@
_opt_control_0white {cellholds_x_y0__BLANK_; cellholds_x_y__BLANK_};
cellempty (cellholds_x_y0__BLANK_);
cellholds_2white (cellholds_x_y__BLANK_);
- control_0white (control__BLANK_); control__BLANK_ (control__BLANK_)
+ control_0white (control__BLANK_); control__BLANK_ (control__BLANK_);
+ index__cellholds_1 {cellholds_x_y0__BLANK_; cellholds_x_y__BLANK_}
|
] ->
[cellholds_x_y0__BLANK_, cellholds_x_y__BLANK_, control__BLANK_ |
@@ -66,7 +58,8 @@
cellholds_x0_y1__BLANK_; cellholds_x1_y2__BLANK_; control__BLANK_};
_opt_control_0white {cellholds_x0_y1__BLANK_; cellholds_x1_y2__BLANK_};
cellholds_2white (cellholds_x0_y1__BLANK_);
- control_0white (control__BLANK_); control__BLANK_ (control__BLANK_)
+ control_0white (control__BLANK_); control__BLANK_ (control__BLANK_);
+ index__cellholds_1 {cellholds_x0_y1__BLANK_; cellholds_x1_y2__BLANK_}
|
] ->
[cellholds_x0_y1__BLANK_, cellholds_x1_y2__BLANK_, control__BLANK_ |
@@ -85,7 +78,8 @@
cellholds_x2_y3__BLANK_; cellholds_x3_y4__BLANK_; control__BLANK_};
_opt_control_0white {cellholds_x2_y3__BLANK_; cellholds_x3_y4__BLANK_};
cellholds_2white (cellholds_x2_y3__BLANK_);
- control_0white (control__BLANK_); control__BLANK_ (control__BLANK_)
+ control_0white (control__BLANK_); control__BLANK_ (control__BLANK_);
+ index__cellholds_1 {cellholds_x2_y3__BLANK_; cellholds_x3_y4__BLANK_}
|
] ->
[cellholds_x2_y3__BLANK_, cellholds_x3_y4__BLANK_, control__BLANK_ |
@@ -105,7 +99,8 @@
cellholds_x4_y5__BLANK_; cellholds_x4_y6__BLANK_; control__BLANK_};
cellempty (cellholds_x4_y6__BLANK_);
cellholds_2black (cellholds_x4_y5__BLANK_);
- control_0black (control__BLANK_); control__BLANK_ (control__BLANK_)
+ control_0black (control__BLANK_); control__BLANK_ (control__BLANK_);
+ index__cellholds_1 {cellholds_x4_y5__BLANK_; cellholds_x4_y6__BLANK_}
|
] ->
[cellholds_x4_y5__BLANK_, cellholds_x4_y6__BLANK_, control__BLANK_ |
@@ -124,7 +119,8 @@
_opt_control_0white {
cellholds_x5_y7__BLANK_; cellholds_x6_y8__BLANK_; control__BLANK_};
cellholds_2black (cellholds_x5_y7__BLANK_);
- control_0black (control__BLANK_); control__BLANK_ (control__BLANK_)
+ control_0black (control__BLANK_); control__BLANK_ (control__BLANK_);
+ index__cellholds_1 {cellholds_x5_y7__BLANK_; cellholds_x6_y8__BLANK_}
|
] ->
[cellholds_x5_y7__BLANK_, cellholds_x6_y8__BLANK_, control__BLANK_ |
@@ -143,7 +139,8 @@
_opt_control_0white {
cellholds_x7_y9__BLANK_; cellholds_x8_y10__BLANK_; control__BLANK_};
cellholds_2black (cellholds_x7_y9__BLANK_);
- control_0black (control__BLANK_); control__BLANK_ (control__BLANK_)
+ control_0black (control__BLANK_); control__BLANK_ (control__BLANK_);
+ index__cellholds_1 {cellholds_x7_y9__BLANK_; cellholds_x8_y10__BLANK_}
|
] ->
[cellholds_x7_y9__BLANK_, cellholds_x8_y10__BLANK_, control__BLANK_ |
@@ -189,7 +186,6 @@
cellholds_8_2__BLANK_, cellholds_8_3__BLANK_, cellholds_8_4__BLANK_,
cellholds_8_5__BLANK_, cellholds_8_6__BLANK_, cellholds_8_7__BLANK_,
cellholds_8_8__BLANK_, val__black, val__white, control__BLANK_ |
- C {val__black; val__white; control__BLANK_};
R {
(cellholds_1_1__BLANK_, cellholds_1_2__BLANK_);
(cellholds_1_2__BLANK_, cellholds_1_3__BLANK_);
@@ -447,7 +443,32 @@
cellholds_8_2__BLANK_
};
control_0black:1 {}; control_0white (control__BLANK_);
- control__BLANK_ (control__BLANK_); val__0black (val__black);
- val__0white (val__white); val___BLANK_ {val__black; val__white}
+ control__BLANK_ (control__BLANK_);
+ index__cellholds_1 {
...
[truncated message content] |
|
From: <luk...@us...> - 2011-09-29 22:34:24
|
Revision: 1580
http://toss.svn.sourceforge.net/toss/?rev=1580&view=rev
Author: lukstafi
Date: 2011-09-29 22:34:18 +0000 (Thu, 29 Sep 2011)
Log Message:
-----------
Reminder to apply environment rules when playing against GDL server.
Modified Paths:
--------------
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/Server/ReqHandler.ml
trunk/Toss/Server/ReqHandler.mli
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-09-29 22:18:32 UTC (rev 1579)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-09-29 22:34:18 UTC (rev 1580)
@@ -94,8 +94,7 @@
(* COPIED FROM ReqHandler. *)
exception Found of int
-(* The player applying the rewrite seems not to be used. *)
-(* players are indexed from 1 in graph (0 is Environment) *)
+(* Players are indexed from 1 in graph (0 is Environment) *)
let apply_rewrite (game,state as gstate) (player, (r_name, mtch)) =
if r_name <> "" then (
let {Arena.rules=rules; graph=graph} = game in
Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml 2011-09-29 22:18:32 UTC (rev 1579)
+++ trunk/Toss/Server/ReqHandler.ml 2011-09-29 22:34:18 UTC (rev 1580)
@@ -52,15 +52,31 @@
exception Found of int
-(* The player applying the rewrite seems not to be used. *)
-(* FIXME: adapt to simultaneous moves. *)
-let apply_rewrite state (player, (r_name, mtch)) =
+(* Players are indexed from 1 in graph (0 is Environment) *)
+let apply_rewrite (game,state as gstate) (player, (r_name, mtch)) =
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 {Arena.rules=rules; graph=graph} = game in
+ let struc = state.Arena.struc in
+ let mv_loc = graph.(state.Arena.cur_loc).(player) in
let moves =
- Move.gen_moves Move.cGRID_SIZE rules
- (snd state).Arena.struc mv_loc in
+ Move.gen_moves Move.cGRID_SIZE rules struc mv_loc in
+ (* {{{ log entry *)
+ if !debug_level > 0 then (
+ let prules =
+ List.map (fun (lb,_)->lb.Arena.lb_rule) mv_loc.Arena.moves in
+ Printf.printf
+ "apply_rewrite: r_name=%s; mtch=%s; player=%d; prules=%s; moves= %s\n%!"
+ r_name
+ (ContinuousRule.embedding_str (List.assoc r_name rules) struc mtch)
+ player (String.concat ", " prules)
+ (String.concat "; "
+ (List.map (fun m->
+ let rul = List.assoc m.Arena.rule rules in
+ m.Arena.rule^":"^
+ ContinuousRule.embedding_str rul struc
+ m.Arena.embedding) (Array.to_list moves)))
+ );
+ (* }}} *)
let pos = (
try
for i = 0 to Array.length moves - 1 do
@@ -69,14 +85,18 @@
(fun (e, f) -> f = List.assoc e mov.Arena.embedding) mtch then
raise (Found i)
done;
+ Printf.printf
+ "apply_rewrite: failed for pl. num %d, r_name=%s\n%!"
+ player r_name;
failwith "GDL Play request: action mismatched with play state"
- with Found pos -> pos) in
+ with Found pos ->
+ pos) in
let req = Arena.ApplyRuleInt (r_name, mtch, 0.1, []) in
- let (new_state_noloc, resp) = Arena.handle_request state req in
+ let (new_state_noloc, resp) = Arena.handle_request gstate req in
let new_loc = moves.(pos).Arena.next_loc in
(fst new_state_noloc,
{snd new_state_noloc with Arena.cur_loc = new_loc})
- ) else state
+ ) else gstate
let req_handle (g_heur, game_modified, state, gdl_transl, playclock) = function
@@ -129,6 +149,7 @@
TranslateGame.translate_incoming_move gdl_transl state actions in
let state = List.fold_left apply_rewrite state rewrites in
+ (* FIXME: apply environment's rules here. *)
let state =
if rewrites = [] || TranslateGame.is_turnbased gdl_transl
then state
Modified: trunk/Toss/Server/ReqHandler.mli
===================================================================
--- trunk/Toss/Server/ReqHandler.mli 2011-09-29 22:18:32 UTC (rev 1579)
+++ trunk/Toss/Server/ReqHandler.mli 2011-09-29 22:34:18 UTC (rev 1580)
@@ -16,7 +16,7 @@
val apply_rewrite :
Arena.game * Arena.game_state ->
- (string * (string * DiscreteRule.matching)) ->
+ (int * (string * DiscreteRule.matching)) ->
Arena.game * Arena.game_state
type req_state =
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-09-29 23:05:52
|
Revision: 1581
http://toss.svn.sourceforge.net/toss/?rev=1581&view=rev
Author: lukaszkaiser
Date: 2011-09-29 23:05:45 +0000 (Thu, 29 Sep 2011)
Log Message:
-----------
Removing wrong test, trying out some (wrong?) protection against upper-case translated vars.
Modified Paths:
--------------
trunk/Toss/GGP/GDL.ml
trunk/Toss/Solver/SolverTest.ml
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-09-29 22:34:18 UTC (rev 1580)
+++ trunk/Toss/GGP/GDL.ml 2011-09-29 23:05:45 UTC (rev 1581)
@@ -74,14 +74,19 @@
"(" ^ f ^ " " ^
String.concat " " (Array.to_list (Array.map term_str args)) ^ ")"
-let rec term_to_name ?(nested=false) = 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)) ^
- (if nested then "_Z_" else "")
+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
+ | 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)) ^
+ (if nested then "_Z_" else "") in
+ if not_fo s then "t" ^ s else s
let rec term_vars = function
| Const _ -> Aux.Strings.empty
Modified: trunk/Toss/Solver/SolverTest.ml
===================================================================
--- trunk/Toss/Solver/SolverTest.ml 2011-09-29 22:34:18 UTC (rev 1580)
+++ trunk/Toss/Solver/SolverTest.ml 2011-09-29 23:05:45 UTC (rev 1581)
@@ -236,230 +236,6 @@
"Sum (x, y | R (x, y) : 1)" 2.;
);
-
- "eval: GDL translation tictactoe" >::
- (fun () ->
- let phi = "(cell_12(e) and cell_12(e) and
- cell_02(e) and cell_02(e) and
- control__BLANK_(ctrl) and cell_2b(e) and
- control_0xplayer(ctrl) and
- not
- (((ex cell_m5__BLANK___BLANK_
- (ex cell_m4_2__BLANK_, cell_m4_3__BLANK_
- (EQ___cell_0__cell_0(cell_m5__BLANK___BLANK_, cell_m4_2__BLANK_) and
- EQ___cell_0__cell_0(cell_m5__BLANK___BLANK_,
- cell_m4_3__BLANK_) and EQ___cell_0__cell_0(cell_m4_2__BLANK_,
- cell_m5__BLANK___BLANK_) and
- EQ___cell_0__cell_0(cell_m4_2__BLANK_, cell_m4_3__BLANK_) and
- EQ___cell_0__cell_0(cell_m4_3__BLANK_,
- cell_m5__BLANK___BLANK_) and
- EQ___cell_0__cell_0(cell_m4_3__BLANK_, cell_m4_2__BLANK_) and
- cell_11(cell_m5__BLANK___BLANK_) and
- cell_2x(cell_m5__BLANK___BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_m5__BLANK___BLANK_) and
- cell_12(cell_m4_2__BLANK_) and cell_2x(cell_m4_2__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_m4_2__BLANK_) and
- cell_13(cell_m4_3__BLANK_) and cell_2x(cell_m4_3__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_m4_3__BLANK_)) and
- cell__BLANK___BLANK___BLANK_(cell_m5__BLANK___BLANK_)) or
- ex cell__BLANK__m6__BLANK_
- (ex cell_2_n4__BLANK_, cell_3_n4__BLANK_
- (EQ___cell_1__cell_1(cell__BLANK__m6__BLANK_, cell_2_n4__BLANK_) and
- EQ___cell_1__cell_1(cell__BLANK__m6__BLANK_,
- cell_3_n4__BLANK_) and EQ___cell_1__cell_1(cell_2_n4__BLANK_,
- cell__BLANK__m6__BLANK_) and
- EQ___cell_1__cell_1(cell_2_n4__BLANK_, cell_3_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_3_n4__BLANK_,
- cell__BLANK__m6__BLANK_) and
- EQ___cell_1__cell_1(cell_3_n4__BLANK_, cell_2_n4__BLANK_) and
- cell_01(cell__BLANK__m6__BLANK_) and
- cell_2x(cell__BLANK__m6__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell__BLANK__m6__BLANK_) and
- cell_02(cell_2_n4__BLANK_) and cell_2x(cell_2_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_2_n4__BLANK_) and
- cell_03(cell_3_n4__BLANK_) and cell_2x(cell_3_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_n4__BLANK_)) and
- cell__BLANK___BLANK___BLANK_(cell__BLANK__m6__BLANK_)) or
- ((ex cell_1_1__BLANK_, cell_2_2__BLANK_, cell_3_3__BLANK_
- (true and
- cell_01(cell_1_1__BLANK_) and cell_11(cell_1_1__BLANK_) and
- cell_2x(cell_1_1__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_1_1__BLANK_) and
- cell_02(cell_2_2__BLANK_) and cell_12(cell_2_2__BLANK_) and
- cell_2x(cell_2_2__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_2_2__BLANK_) and
- cell_03(cell_3_3__BLANK_) and cell_13(cell_3_3__BLANK_) and
- cell_2x(cell_3_3__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_3__BLANK_)) or
- ex cell_1_3__BLANK_, cell_2_2__BLANK_, cell_3_1__BLANK_
- (true and
- cell_01(cell_1_3__BLANK_) and cell_13(cell_1_3__BLANK_) and
- cell_2x(cell_1_3__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_1_3__BLANK_) and
- cell_02(cell_2_2__BLANK_) and cell_12(cell_2_2__BLANK_) and
- cell_2x(cell_2_2__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_2_2__BLANK_) and
- cell_03(cell_3_1__BLANK_) and cell_11(cell_3_1__BLANK_) and
- cell_2x(cell_3_1__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_1__BLANK_))) and
- true)) and
- true) or
- ((ex cell_m5__BLANK___BLANK_
- (ex cell_m4_2__BLANK_, cell_m4_3__BLANK_
- (EQ___cell_0__cell_0(cell_m5__BLANK___BLANK_, cell_m4_2__BLANK_) and
- EQ___cell_0__cell_0(cell_m5__BLANK___BLANK_,
- cell_m4_3__BLANK_) and EQ___cell_0__cell_0(cell_m4_2__BLANK_,
- cell_m5__BLANK___BLANK_) and
- EQ___cell_0__cell_0(cell_m4_2__BLANK_, cell_m4_3__BLANK_) and
- EQ___cell_0__cell_0(cell_m4_3__BLANK_,
- cell_m5__BLANK___BLANK_) and
- EQ___cell_0__cell_0(cell_m4_3__BLANK_, cell_m4_2__BLANK_) and
- cell_11(cell_m5__BLANK___BLANK_) and
- cell_2o(cell_m5__BLANK___BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_m5__BLANK___BLANK_) and
- cell_12(cell_m4_2__BLANK_) and cell_2o(cell_m4_2__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_m4_2__BLANK_) and
- cell_13(cell_m4_3__BLANK_) and cell_2o(cell_m4_3__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_m4_3__BLANK_)) and
- cell__BLANK___BLANK___BLANK_(cell_m5__BLANK___BLANK_)) or
- ex cell__BLANK__m6__BLANK_
- (ex cell_2_n4__BLANK_, cell_3_n4__BLANK_
- (EQ___cell_1__cell_1(cell__BLANK__m6__BLANK_, cell_2_n4__BLANK_) and
- EQ___cell_1__cell_1(cell__BLANK__m6__BLANK_,
- cell_3_n4__BLANK_) and EQ___cell_1__cell_1(cell_2_n4__BLANK_,
- cell__BLANK__m6__BLANK_) and
- EQ___cell_1__cell_1(cell_2_n4__BLANK_, cell_3_n4__BLANK_) and
- EQ___cell_1__cell_1(cell_3_n4__BLANK_,
- cell__BLANK__m6__BLANK_) and
- EQ___cell_1__cell_1(cell_3_n4__BLANK_, cell_2_n4__BLANK_) and
- cell_01(cell__BLANK__m6__BLANK_) and
- cell_2o(cell__BLANK__m6__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell__BLANK__m6__BLANK_) and
- cell_02(cell_2_n4__BLANK_) and cell_2o(cell_2_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_2_n4__BLANK_) and
- cell_03(cell_3_n4__BLANK_) and cell_2o(cell_3_n4__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_n4__BLANK_)) and
- cell__BLANK___BLANK___BLANK_(cell__BLANK__m6__BLANK_)) or
- ((ex cell_1_1__BLANK_, cell_2_2__BLANK_, cell_3_3__BLANK_
- (true and
- cell_01(cell_1_1__BLANK_) and cell_11(cell_1_1__BLANK_) and
- cell_2o(cell_1_1__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_1_1__BLANK_) and
- cell_02(cell_2_2__BLANK_) and cell_12(cell_2_2__BLANK_) and
- cell_2o(cell_2_2__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_2_2__BLANK_) and
- cell_03(cell_3_3__BLANK_) and cell_13(cell_3_3__BLANK_) and
- cell_2o(cell_3_3__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_3__BLANK_)) or
- ex cell_1_3__BLANK_, cell_2_2__BLANK_, cell_3_1__BLANK_
- (true and
- cell_01(cell_1_3__BLANK_) and cell_13(cell_1_3__BLANK_) and
- cell_2o(cell_1_3__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_1_3__BLANK_) and
- cell_02(cell_2_2__BLANK_) and cell_12(cell_2_2__BLANK_) and
- cell_2o(cell_2_2__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_2_2__BLANK_) and
- cell_03(cell_3_1__BLANK_) and cell_11(cell_3_1__BLANK_) and
- cell_2o(cell_3_1__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_3_1__BLANK_))) and
- true)) and
- true) or
- (not
- ex cell_m7_n5__BLANK_
- (true and
- cell_2b(cell_m7_n5__BLANK_) and
- cell__BLANK___BLANK___BLANK_(cell_m7_n5__BLANK_)) and
- true)) and
- not C(e) and not e = ctrl)" in
- let struc = "[cell_1_1__BLANK_, cell_1_2__BLANK_, cell_1_3__BLANK_, cell_2_1__BLANK_,
- cell_2_2__BLANK_, cell_2_3__BLANK_, cell_3_1__BLANK_, cell_3_2__BLANK_,
- cell_3_3__BLANK_, val__b, val__o, val__oplayer, val__x, val__xplayer,
- control__BLANK_ |
- C {val__b; val__o; val__oplayer; val__x; val__xplayer; control__BLANK_};
- EQ___cell_0__cell_0 {
- (cell_1_1__BLANK_, cell_1_1__BLANK_);
- (cell_1_1__BLANK_, cell_1_2__BLANK_);
- (cell_1_1__BLANK_, cell_1_3__BLANK_);
- (cell_1_2__BLANK_, cell_1_1__BLANK_);
- (cell_1_2__BLANK_, cell_1_2__BLANK_);
- (cell_1_2__BLANK_, cell_1_3__BLANK_);
- (cell_1_3__BLANK_, cell_1_1__BLANK_);
- (cell_1_3__BLANK_, cell_1_2__BLANK_);
- (cell_1_3__BLANK_, cell_1_3__BLANK_);
- (cell_2_1__BLANK_, cell_2_1__BLANK_);
- (cell_2_1__BLANK_, cell_2_2__BLANK_);
- (cell_2_1__BLANK_, cell_2_3__BLANK_);
- (cell_2_2__BLANK_, cell_2_1__BLANK_);
- (cell_2_2__BLANK_, cell_2_2__BLANK_);
- (cell_2_2__BLANK_, cell_2_3__BLANK_);
- (cell_2_3__BLANK_, cell_2_1__BLANK_);
- (cell_2_3__BLANK_, cell_2_2__BLANK_);
- (cell_2_3__BLANK_, cell_2_3__BLANK_);
- (cell_3_1__BLANK_, cell_3_1__BLANK_);
- (cell_3_1__BLANK_, cell_3_2__BLANK_);
- (cell_3_1__BLANK_, cell_3_3__BLANK_);
- (cell_3_2__BLANK_, cell_3_1__BLANK_);
- (cell_3_2__BLANK_, cell_3_2__BLANK_);
- (cell_3_2__BLANK_, cell_3_3__BLANK_);
- (cell_3_3__BLANK_, cell_3_1__BLANK_);
- (cell_3_3__BLANK_, cell_3_2__BLANK_);
- (cell_3_3__BLANK_, cell_3_3__BLANK_)
- };
- EQ___cell_1__cell_1 {
- (cell_1_1__BLANK_, cell_1_1__BLANK_);
- (cell_1_1__BLANK_, cell_2_1__BLANK_);
- (cell_1_1__BLANK_, cell_3_1__BLANK_);
- (cell_1_2__BLANK_, cell_1_2__BLANK_);
- (cell_1_2__BLANK_, cell_2_2__BLANK_);
- (cell_1_2__BLANK_, cell_3_2__BLANK_);
- (cell_1_3__BLANK_, cell_1_3__BLANK_);
- (cell_1_3__BLANK_, cell_2_3__BLANK_);
- (cell_1_3__BLANK_, cell_3_3__BLANK_);
- (cell_2_1__BLANK_, cell_1_1__BLANK_);
- (cell_2_1__BLANK_, cell_2_1__BLANK_);
- (cell_2_1__BLANK_, cell_3_1__BLANK_);
- (cell_2_2__BLANK_, cell_1_2__BLANK_);
- (cell_2_2__BLANK_, cell_2_2__BLANK_);
- (cell_2_2__BLANK_, cell_3_2__BLANK_);
- (cell_2_3__BLANK_, cell_1_3__BLANK_);
- (cell_2_3__BLANK_, cell_2_3__BLANK_);
- (cell_2_3__BLANK_, cell_3_3__BLANK_);
- (cell_3_1__BLANK_, cell_1_1__BLANK_);
- (cell_3_1__BLANK_, cell_2_1__BLANK_);
- (cell_3_1__BLANK_, cell_3_1__BLANK_);
- (cell_3_2__BLANK_, cell_1_2__BLANK_);
- (cell_3_2__BLANK_, cell_2_2__BLANK_);
- (cell_3_2__BLANK_, cell_3_2__BLANK_);
- (cell_3_3__BLANK_, cell_1_3__BLANK_);
- (cell_3_3__BLANK_, cell_2_3__BLANK_);
- (cell_3_3__BLANK_, cell_3_3__BLANK_)
- };
- R (cell_1_1__BLANK_); R0 (cell_2_2__BLANK_); R1 (cell_3_3__BLANK_);
- R2 (cell_1_3__BLANK_); R3 (cell_3_1__BLANK_);
- cell_01 {cell_1_1__BLANK_; cell_1_2__BLANK_; cell_1_3__BLANK_};
- cell_02 {cell_2_1__BLANK_; cell_2_2__BLANK_; cell_2_3__BLANK_};
- cell_03 {cell_3_1__BLANK_; cell_3_2__BLANK_; cell_3_3__BLANK_};
- cell_11 {cell_1_1__BLANK_; cell_2_1__BLANK_; cell_3_1__BLANK_};
- cell_12 {cell_1_2__BLANK_; cell_2_2__BLANK_; cell_3_2__BLANK_};
- cell_13 {cell_1_3__BLANK_; cell_2_3__BLANK_; cell_3_3__BLANK_};
- cell_2b {
- cell_1_1__BLANK_; cell_1_2__BLANK_; cell_1_3__BLANK_; cell_2_1__BLANK_;
- cell_2_2__BLANK_; cell_2_3__BLANK_; cell_3_1__BLANK_; cell_3_2__BLANK_;
- cell_3_3__BLANK_
- };
- cell_2o:1 {}; cell_2x:1 {}; control_0oplayer:1 {};
- control_0xplayer (control__BLANK_); control__BLANK_ (control__BLANK_);
- role {val__oplayer; val__xplayer}; val__0b (val__b); val__0o (val__o);
- val__0oplayer (val__oplayer); val__0x (val__x);
- val__0xplayer (val__xplayer);
- val___BLANK_ {val__b; val__o; val__oplayer; val__x; val__xplayer}
- |
-]" in
-
- eval_eq struc phi
- "{ e->cell_2_2__BLANK_, ctrl->control__BLANK_ }";
- );
-
]
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-09-30 18:50:48
|
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.
|
|
From: <luk...@us...> - 2011-10-10 21:44:10
|
Revision: 1588
http://toss.svn.sourceforge.net/toss/?rev=1588&view=rev
Author: lukstafi
Date: 2011-10-10 21:44:01 +0000 (Mon, 10 Oct 2011)
Log Message:
-----------
GDL translation: unframed fluents; pacman3p test. DiscreteRule: extending rewrite rule semantics giving possibility to selectively weaken the embedding condition of rule matching to homomorphism condition, i.e. for some LHS elements not requiring distinct assignment. Solver: just pointing to potential problem with ordering real expression atoms before structural atoms (?).
Modified Paths:
--------------
trunk/Toss/Arena/DiscreteRule.ml
trunk/Toss/Arena/DiscreteRule.mli
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/AuxTest.ml
trunk/Toss/GGP/GameSimpl.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/Solver/Solver.ml
trunk/Toss/www/reference/reference.tex
Added Paths:
-----------
trunk/Toss/GGP/tests/pacman3p-raw.toss
trunk/Toss/GGP/tests/pacman3p-simpl.toss
Modified: trunk/Toss/Arena/DiscreteRule.ml
===================================================================
--- trunk/Toss/Arena/DiscreteRule.ml 2011-10-09 23:18:02 UTC (rev 1587)
+++ trunk/Toss/Arena/DiscreteRule.ml 2011-10-10 21:44:01 UTC (rev 1588)
@@ -343,7 +343,7 @@
String.sub rel (spec_end + 1) (String.length rel - spec_end - 1)
let special_rel_of rel =
- if rel.[0] <> '_' then None
+ if rel = "" || rel.[0] <> '_' then None
else
try
Some (String.sub rel 1 (String.index_from rel 1 '_' - 1))
@@ -529,7 +529,11 @@
model rule_obj.rhs_neg_tuples in
Structure.replace_names model elem_names inv_names
-(* Rewrite the model keeping the number and identity of elements. *)
+(* Rewrite the model keeping the number and identity of elements.
+
+ First remove, then add tuples to the model (only affects semantics
+ when the rule uses the "nondistinct" special relation,
+ i.e. violates the embedding condition). *)
let rewrite_nonstruct model rmmap pos_tuples neg_tuples rhs_elem_names =
let model = Structure.clear_rels model
(fun rel -> match special_rel_of rel with
@@ -544,25 +548,27 @@
Structure.add_rel model
("_right_"^elemname_of_elemvar re) [|me|]
) model rmmap in
+ (* Remove RHS-negated relations and add removal trace. *)
+ let model =
+ List.fold_left (fun model (org_rel, ctups) ->
+ let crel = "_del_"^org_rel in
+ List.fold_left (fun model ctup ->
+ let ntup = Array.map (fun e-> List.assoc e rmmap) ctup in
+ if Structure.check_rel model org_rel ntup then begin
+ let m1 = Structure.del_rel model org_rel ntup in
+ Structure.add_rel m1 crel ntup
+ end else model) model ctups) model neg_tuples in
(* Add the RHS-relations and their trace. *)
let model =
- List.fold_left (fun model (org_rel, ctups) ->
- let crel = "_new_"^org_rel in
- List.fold_left (fun model ctup ->
- let ntup = Array.map (fun e-> List.assoc e rmmap) ctup in
- if not (Structure.check_rel model org_rel ntup) then begin
- let m1 = Structure.add_rel model org_rel ntup in
+ List.fold_left (fun model (org_rel, ctups) ->
+ let crel = "_new_"^org_rel in
+ List.fold_left (fun model ctup ->
+ let ntup = Array.map (fun e-> List.assoc e rmmap) ctup in
+ if not (Structure.check_rel model org_rel ntup) then begin
+ let m1 = Structure.add_rel model org_rel ntup in
Structure.add_rel m1 crel ntup
- end else model) model ctups) model pos_tuples in
- (* Remove RHS-negated relations and add removal trace. *)
- List.fold_left (fun model (org_rel, ctups) ->
- let crel = "_del_"^org_rel in
- List.fold_left (fun model ctup ->
- let ntup = Array.map (fun e-> List.assoc e rmmap) ctup in
- if Structure.check_rel model org_rel ntup then begin
- let m1 = Structure.del_rel model org_rel ntup in
- Structure.add_rel m1 crel ntup
- end else model) model ctups) model neg_tuples
+ end else model) model ctups) model pos_tuples in
+ model
(* Rewrite the model using the rule at the given matching. Does not
@@ -655,16 +661,19 @@
_opt_R: if both are present over a tuple, _opt_R is ignored;
_diffthan_R does not override R.
- Special relations other than _opt_, _any_ and _diffthan_ are
- treated as ordinary relations. Special relation variants _opt_,
- _any_ and _diffthan_ of defined relations are expanded semantically
- (by looking for relations over whose tuples they hold). Additionally,
- special relation variants _new_ and _del_ of defined relations in
- the LHS and precondition are expanded syntactically by
- transforming names of embedded relations in definitions. Defined
- relations are expanded semantically but only do determine the
- effect of rewrite (they are included syntactically in the
- embedding condition).
+ Special relations other than _opt_, _any_, _diffthan_ and
+ _nondistinct_ are treated as ordinary relations. Special relation
+ variants _opt_, _any_ and _diffthan_ of defined relations are
+ expanded semantically (by looking for relations over whose tuples
+ they hold). Additionally, special relation variants _new_ and
+ _del_ of defined relations in the LHS and precondition are
+ expanded syntactically by transforming names of embedded relations
+ in definitions. Defined relations are expanded semantically but
+ only do determine the effect of rewrite (they are included
+ syntactically in the embedding condition).
+
+ Special relation _nondistinct_ eliminates distinctness conditions
+ for the specified pairs.
*)
let compile_rule signat defined_rels rule_src =
(* TODO: but these shouldn't get into the signature in the first
@@ -808,6 +817,9 @@
SSMap.fold (fun rel tups rels ->
(rel, List.map opt_map (STups.elements tups)) :: rels)
(Structure.relations rule_src.lhs_struc) [] in
+ let nondistinct, lhs_rels =
+ try Aux.pop_assoc "_nondistinct_" lhs_rels
+ with Not_found -> [], lhs_rels in
(* rename the corresponding variables in the precondition *)
let precond =
if rlmap = None then
@@ -892,8 +904,14 @@
);
(* }}} *)
(* injectivity checking *)
- let lhs_alldif_tups =
- triang_product 2 lhs_elem_vars in
+ let nondistinct = List.map
+ (Array.map lhs_name_of) nondistinct in
+ let lhs_alldif_tups = List.filter
+ (function [x; y] ->
+ not (List.mem [|x; y|] nondistinct)
+ && not (List.mem [|y; x|] nondistinct)
+ | _ -> assert false)
+ (triang_product 2 lhs_elem_vars) in
let varify_lhs tup =
Array.map (fun e -> `FO (lhs_name_of e)) tup in
(* summing up: the LHS structure embedding plus the precondition *)
@@ -1037,8 +1055,13 @@
The partition of embedded relations into positive and negative
tuples (literals) is extracted from the precondition. If the
- partition does not cover all tuples, fail. *)
-let translate_from_precond ~precond ~add ~emb_rels ~signat ~struc_elems =
+ partition does not cover all tuples, fail.
+
+ [nondistinct_pairs] connects elements that are potentially not
+ distinct, thus weakening the "embedding" requirement into
+ "homomorphism" requirement for matching a rule. *)
+let translate_from_precond ~precond ~add ~nondistinct ~emb_rels
+ ~signat ~struc_elems =
let rhs_names = Aux.unique_sorted
(Aux.concat_map (fun (_,arg) -> Array.to_list arg) add) in
assert (Aux.list_diff rhs_names struc_elems = []);
@@ -1129,6 +1152,8 @@
let rhs_struc = add_rels rhs_struc add in
let lhs_struc = add_rels lhs_struc posi_s in
let lhs_struc = add_rels lhs_struc opt_s in
+ let lhs_struc = add_rels lhs_struc
+ (List.map (fun tup-> "_nondistinct_", tup) nondistinct) in
(* {{{ log entry *)
if !debug_level > 4 then (
FormulaOps.set_debug_level 0;
Modified: trunk/Toss/Arena/DiscreteRule.mli
===================================================================
--- trunk/Toss/Arena/DiscreteRule.mli 2011-10-09 23:18:02 UTC (rev 1587)
+++ trunk/Toss/Arena/DiscreteRule.mli 2011-10-10 21:44:01 UTC (rev 1588)
@@ -141,9 +141,14 @@
The partition of embedded relations into positive and negative
tuples (literals) is extracted from the precondition. If the
- partition does not cover all tuples, fail. *)
+ partition does not cover all tuples, fail.
+
+ [nondistinct_pairs] connects elements that are potentially not
+ distinct, thus weakening the "embedding" requirement into
+ "homomorphism" requirement for matching a rule. *)
val translate_from_precond :
precond:Formula.formula -> add:(string * string array) list ->
+ nondistinct:string array list ->
(* del:(string * string array) list -> *)
emb_rels:string list -> signat:(string * int) list ->
struc_elems:string list -> rule
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-10-09 23:18:02 UTC (rev 1587)
+++ trunk/Toss/Formula/Aux.ml 2011-10-10 21:44:01 UTC (rev 1588)
@@ -594,7 +594,7 @@
for i = 0 to (String.length s) - 1 do
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]))
+ else res := !res ^ "c" ^ (string_of_int (Char.code s.[i]))
done;
!res
Modified: trunk/Toss/Formula/AuxTest.ml
===================================================================
--- trunk/Toss/Formula/AuxTest.ml 2011-10-09 23:18:02 UTC (rev 1587)
+++ trunk/Toss/Formula/AuxTest.ml 2011-10-10 21:44:01 UTC (rev 1588)
@@ -472,7 +472,7 @@
"ala" (Aux.clean_name "ala");
assert_equal ~printer:(fun x -> x)
- "_43_43" (Aux.clean_name "++");
+ "c43c43" (Aux.clean_name "++");
);
]
Modified: trunk/Toss/GGP/GameSimpl.ml
===================================================================
--- trunk/Toss/GGP/GameSimpl.ml 2011-10-09 23:18:02 UTC (rev 1587)
+++ trunk/Toss/GGP/GameSimpl.ml 2011-10-10 21:44:01 UTC (rev 1588)
@@ -201,6 +201,14 @@
module Tups = Structure.Tuples
+let get_orig_if_special rel =
+ let spec = DiscreteRule.special_rel_of rel in
+ match spec with
+ | None -> rel
+ | Some spec ->
+ let nonspec = DiscreteRule.orig_rel_of rel in
+ if nonspec = "" then rel else nonspec
+
let simplify ?(keep_nonempty_predicates=true) (game, state) =
(* {{{ log entry *)
if !debug_level > 0 then (
@@ -371,18 +379,15 @@
with Not_found -> rel1, (rel1, false)
) signat in
let removable rel =
- let spec = DiscreteRule.special_rel_of rel in
- let rel =
- match spec with
- | None -> rel
- | Some spec -> DiscreteRule.orig_rel_of rel in
+ let rel = get_orig_if_special rel in
(* {{{ log entry *)
if !debug_level > 4 then (
Printf.printf "removable: %s...%!" rel
);
(* }}} *)
- let res =
- rel <> "" &&
+ let res = rel <> "" &&
+ (* not a stand-alone special relation such as _any_ or _nondistinct_ *)
+ DiscreteRule.special_rel_of rel = None &&
not (Aux.Strings.mem rel fluents) &&
not (List.mem_assoc rel game.Arena.defined_rels) &&
not (List.exists
@@ -477,10 +482,13 @@
let lhs_struc =
Structure.StringMap.fold (fun rel tups lhs_struc ->
let spec = DiscreteRule.special_rel_of rel in
- let rel =
+ let spec, rel =
match spec with
- | None -> rel
- | Some spec -> DiscreteRule.orig_rel_of rel in
+ | None -> None, rel
+ | Some spec ->
+ let nonspec = DiscreteRule.orig_rel_of rel in
+ if nonspec = "" then None, rel
+ else Some spec, nonspec in
if not (removable rel) then lhs_struc
else
let is_inv = List.mem_assoc rel is_inverse in
@@ -1028,10 +1036,10 @@
let game = {game with Arena.defined_rels = defined_rels} in
(* 4b, 4e *)
let clear_rel rel =
- let rel =
- if DiscreteRule.special_rel_of rel = None then rel
- else DiscreteRule.orig_rel_of rel in
+ let rel = get_orig_if_special rel in
let res =
+ (* not a stand-alone special relation such as _any_ or _nondistinct_ *)
+ DiscreteRule.special_rel_of rel = None &&
(not keep_nonempty_predicates ||
(try List.assoc rel signat > 1 with Not_found -> false) ||
Structure.rel_size !struc rel = 0
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-10-09 23:18:02 UTC (rev 1587)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-10-10 21:44:01 UTC (rev 1588)
@@ -1,6 +1,6 @@
(** {2 Translating GDL definition: Toss rules and initial structure.}
- Some terminology -- try to comply.
+ Some terminology.
static relation: GDL relation not even indirectly depending on
"true" nor "does"
@@ -308,11 +308,17 @@
let arities = Aux.unique_sorted unused_roots @ arities in
let unused_roots = Aux.strings_of_list (List.map fst unused_roots) in
let static_rels = Aux.Strings.elements unused_roots @ static_rels in
+ (* later, we will need to somehow erase unframed fluents... *)
+ let framed_fluents = Aux.concat_map
+ (fun (head, _) -> map_paths (fun p subt -> p, subt) f_paths head)
+ frame_clauses in
(* {{{ log entry *)
if !debug_level > 2 then (
- Printf.printf "create_init_struc:\nused_roots=%s\nunused_roots=%s\nstatic_rels=%s\n%!"
+ Printf.printf "create_init_struc:\nused_roots=%s\nunused_roots=%s\nframed_fluents=%s; static_rels=%s\n%!"
(String.concat ", "(Aux.Strings.elements used_roots))
(String.concat ", "(Aux.Strings.elements unused_roots))
+ (String.concat ", " (List.map (fun (p, subt) ->
+ path_str p^"->"^term_str subt) framed_fluents))
(String.concat ", " static_rels)
);
(* }}} *)
@@ -434,6 +440,7 @@
);
(* }}} *)
static_base, init_state, c_paths, f_paths, element_reps, root_reps,
+ framed_fluents,
ground_state_terms, arities, term_arities, static_rels, nonstatic_rels,
frame_clauses, move_clauses, clauses
@@ -2005,11 +2012,12 @@
(fun acc c_upd -> Formula.Plus (acc, cond_update c_upd))
(cond_update c_upd) c_upds
-let build_toss_rule num_functions transl_data rule_names struc fluents
+let build_toss_rule num_functions transl_data rule_names
+ framed_fluents f_paths struc fluents
synch_elems synch_precond synch_postcond
(legal_tuple, case_rhs, counter_cls, case_cond) =
let rname =
- if legal_tuple = [] then "Environment"
+ if legal_tuple = [] then term_to_name env_player
else String.concat "_" (List.map term_to_name legal_tuple) in
let rname =
Aux.not_conflicting_name !rule_names rname in
@@ -2050,11 +2058,40 @@
let rhs_add = synch_postcond @ rhs_add in
(* let rhs_add = if counter_cls = [] then rhs_add else *)
let signat = Structure.rel_signature struc in
+ (* we find which rule results should have their old values erased,
+ in cases not covered by erasure clauses *)
+ let unframed_fluents = Aux.list_diff
+ (Aux.concat_map
+ (map_paths (fun p subt -> p, subt) f_paths) case_rhs)
+ framed_fluents in
+ let unframed_elems = List.filter
+ (fun st -> List.exists
+ (fun (p,subt) -> try at_path st p = subt with Not_found -> false)
+ unframed_fluents)
+ (Aux.list_diff (state_terms case_cond) case_rhs) in
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "build_toss_rule: unframed_fluents=%s; unframed_elems=%s\n%!"
+ (String.concat ", " (List.map (fun (p, subt) ->
+ path_str p^"->"^term_str subt) unframed_fluents))
+ (String.concat ", " (List.map term_str unframed_elems))
+ );
+ (* }}} *)
let struc_elems = List.map
(fun sterm -> term_to_name (blank_out transl_data sterm)) case_rhs in
+ let unframed_elems = List.map
+ (fun sterm -> term_to_name (blank_out transl_data sterm))
+ unframed_elems in
+ (* mark these pairs of elements as not necessarily distinct, thus
+ weakening the embedding into a homomorphism *)
+ let nondistinct =
+ List.map (fun tup -> Array.of_list tup)
+ (Aux.product [unframed_elems; struc_elems])
+ @ List.map (fun (x,y) -> [|x; y|]) (Aux.pairs unframed_elems) in
let rulevar_terms = Aux.strmap_of_assoc
(List.combine struc_elems case_rhs) in
- let struc_elems = Aux.unique_sorted (synch_elems @ struc_elems) in
+ let struc_elems = Aux.unique_sorted
+ (synch_elems @ unframed_elems @ struc_elems) in
let struc_elems =
if counter_cls = [] then struc_elems else counter_n::struc_elems in
let precond = FormulaOps.del_vars_quant
@@ -2073,7 +2110,7 @@
(* }}} *)
let discrete =
DiscreteRule.translate_from_precond ~precond
- ~add:rhs_add ~emb_rels:fluents ~signat ~struc_elems in
+ ~add:rhs_add ~nondistinct ~emb_rels:fluents ~signat ~struc_elems in
let updates = List.map
(fun (f, cond_updates) -> (f, counter_n),
transl_cond_updates transl_data num_functions cond_updates)
@@ -2585,6 +2622,7 @@
);
(* }}} *)
let static_base, init_state, c_paths, f_paths, element_reps, root_reps,
+ framed_fluents,
ground_state_terms, arities, term_arities, static_rels, nonstatic_rels,
frame_clauses, move_clauses, clauses =
prepare_paths_and_elems players_wo_env program ~playout_states clauses in
@@ -2759,20 +2797,22 @@
| Some (loc_players, loc_noops), Aux.Left cands ->
let build_rule =
build_toss_rule num_functions transl_data rule_names
- struc fluents [] [] [] in
+ framed_fluents f_paths struc fluents [] [] [] in
loc_graph_turn_based player_names payoffs
loc_players loc_noops build_rule
cands,
struc
| None, Aux.Right cands when is_concurrent ->
let build_rule =
- build_toss_rule num_functions transl_data rule_names in
+ build_toss_rule num_functions transl_data rule_names
+ framed_fluents f_paths in
(* add Environment's payoff *)
loc_graph_concurrent players_wo_env payoffs struc build_rule
fluents cands
| None, Aux.Right cands ->
let build_rule = (* TODO *)
- build_toss_rule num_functions transl_data rule_names in
+ build_toss_rule num_functions transl_data rule_names
+ framed_fluents f_paths in
loc_graph_general_int players_wo_env payoffs struc build_rule
fluents cands
| _ -> assert false
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-10-09 23:18:02 UTC (rev 1587)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-10-10 21:44:01 UTC (rev 1588)
@@ -140,9 +140,8 @@
{snd new_state_noloc with Arena.cur_loc = new_loc})
) else gstate
-let simult_test_case ~game_name ~player ~own_plnum ~opp_plnum
- ~own_rule_name ~own_emb ~own_move ~opp_rule_name ~opp_emb
- ~opp_move =
+let simult_test_case ~game_name ~player ~plnum ~moves
+ ~rules_and_embs =
let game = load_rules ("./GGP/examples/"^game_name^".gdl") in
let gdl, r_game, (r_inl_game, r_struc as res) =
TranslateGame.translate_game ~playing_as:(Const player) game in
@@ -160,21 +159,24 @@
", see GGP/tests/"^game_name^"-temp.toss: "^msg)
eq;
Sys.remove ("./GGP/tests/"^game_name^"-temp.toss");
- let rname = own_rule_name in
- let emb =
- Arena.emb_of_names res rname own_emb in
+ let embs = Array.map
+ (fun (rname, emb) -> Arena.emb_of_names res rname emb)
+ rules_and_embs in
+ (* skipping environment -- 0th -- not given in the input array *)
+ let own_rname, _ = rules_and_embs.(plnum-1) in
let transl =
- TranslateGame.translate_outgoing_move gdl res rname emb in
- assert_equal ~printer:(fun x->x) own_move transl;
+ TranslateGame.translate_outgoing_move gdl res
+ own_rname embs.(plnum-1) in
+ assert_equal ~printer:(fun x->x) moves.(plnum-1) transl;
let moves =
TranslateGame.translate_incoming_move gdl res
- [pte own_move; pte opp_move] in
- let move = List.assoc own_plnum moves in
+ (Array.to_list (Array.map pte moves)) in
+ let move = List.assoc plnum moves in
assert_equal ~msg:"own incoming move" ~printer:(emb_str res)
- (norm_move (rname, emb)) (norm_move move);
+ (norm_move (own_rname, embs.(plnum-1))) (norm_move move);
let res =
List.fold_left apply_rewrite res moves in
- (* TODO: perform a move by Environment once it is nicely provided
+ (* TODO: perform a move by environment once it is nicely provided
by for example ReqHandler. *)
ignore res;
()
@@ -199,15 +201,13 @@
"2player_normal_form_2010" >::
(fun () ->
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"
+ ~plnum:1 (* 0 is environment! *)
+ ~moves:[|"r1"; "c1"|]
+ ~rules_and_embs:[|
+ "m", ["did__BLANK__m", "did__BLANK__r1";
+ "synch_control_", "synch_control_"];
+ "m2", ["did__BLANK__m2", "did__BLANK__c1";
+ "synch_control_", "synch_control_"] |]
);
]
@@ -310,6 +310,28 @@
~loc1_noop:"noop" ~loc1_move:"(drop 2)"
);
+ "pacman3p" >::
+ (fun () ->
+ simult_test_case ~game_name:"pacman3p" ~player:"pacman"
+ ~plnum:1 (* 0 is environment! *)
+ ~moves:[|"(move east)"; "(move nowhere)"; "(move nowhere)"|]
+ ~rules_and_embs:[|
+ "move_east", [
+ "gdl__counter", "gdl__counter";
+ "location__BLANK__x10_y10", "location__BLANK__6_3";
+ "location__BLANK__x9_y9", "location__BLANK__5_3";
+ "location__BLANK__x_y", "location__BLANK__5_3";
+ "synch_control_", "synch_control_"];
+ "move_nowhere0", [
+ "location__BLANK__x11_y11", "location__BLANK__4_6";
+ "location__BLANK__x12_y12", "location__BLANK__4_6";
+ "synch_control_", "synch_control_"];
+ "move_nowhere1", [
+ "location__BLANK__x13_y13", "location__BLANK__5_6";
+ "location__BLANK__x14_y14", "location__BLANK__5_6";
+ "synch_control_", "synch_control_"]|];
+ );
+
]
let set_debug_level i =
@@ -323,17 +345,25 @@
let a () =
set_debug_level 4;
- 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";
+ simult_test_case ~game_name:"pacman3p" ~player:"pacman"
+ ~plnum:1 (* 0 is environment! *)
+ ~moves:[|"(move east)"; "(move nowhere)"; "(move nowhere)"|]
+ ~rules_and_embs:[|
+ "move_east", [
+ "gdl__counter", "gdl__counter";
+ "location__BLANK__x10_y10", "location__BLANK__6_3";
+ "location__BLANK__x9_y9", "location__BLANK__5_3";
+ "location__BLANK__x_y", "location__BLANK__5_3";
+ "synch_control_", "synch_control_"];
+ "move_nowhere0", [
+ "location__BLANK__x11_y11", "location__BLANK__4_6";
+ "location__BLANK__x12_y12", "location__BLANK__4_6";
+ "synch_control_", "synch_control_"];
+ "move_nowhere1", [
+ "location__BLANK__x13_y13", "location__BLANK__5_6";
+ "location__BLANK__x14_y14", "location__BLANK__5_6";
+ "synch_control_", "synch_control_"]|];
+ (* failwith "tested"; *)
()
Added: trunk/Toss/GGP/tests/pacman3p-raw.toss
===================================================================
--- trunk/Toss/GGP/tests/pacman3p-raw.toss (rev 0)
+++ trunk/Toss/GGP/tests/pacman3p-raw.toss 2011-10-10 21:44:01 UTC (rev 1588)
@@ -0,0 +1,7442 @@
+REL distinctcell(v0, v1) =
+ ex location__BLANK__x33_y33, location__BLANK__x34_y34
+ (v0 = location__BLANK__x33_y33 and v1 = location__BLANK__x34_y34 and
+ cell(location__BLANK__x33_y33) and cell(location__BLANK__x34_y34) and
+ not EQ___location_1__location_1(location__BLANK__x33_y33,
+ location__BLANK__x34_y34) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x34_y34) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x33_y33)) or
+ ex location__BLANK__x35_y35, location__BLANK__x36_y36
+ (v0 = location__BLANK__x35_y35 and v1 = location__BLANK__x36_y36 and
+ cell(location__BLANK__x35_y35) and cell(location__BLANK__x36_y36) and
+ not EQ___location_2__location_2(location__BLANK__x35_y35,
+ location__BLANK__x36_y36) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x36_y36) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x35_y35))
+REL nextcell__east(v0, v1) =
+ ex location__BLANK__x24_y24, location__BLANK__xnew1_y24
+ (v0 = location__BLANK__x24_y24 and v1 = location__BLANK__xnew1_y24 and
+ index__location_2(location__BLANK__xnew1_y24) and
+ index__location_2(location__BLANK__x24_y24) and
+ c43c43__location_1__location_1(location__BLANK__x24_y24,
+ location__BLANK__xnew1_y24) and
+ EQ___location_2__location_2(location__BLANK__xnew1_y24,
+ location__BLANK__x24_y24) and
+ EQ___location_2__location_2(location__BLANK__x24_y24,
+ location__BLANK__xnew1_y24) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__xnew1_y24) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x24_y24))
+REL nextcell__north(v0, v1) =
+ ex location__BLANK__x22_y22, location__BLANK__x22_ynew1
+ (v0 = location__BLANK__x22_y22 and v1 = location__BLANK__x22_ynew1 and
+ index__location_1(location__BLANK__x22_ynew1) and
+ index__location_1(location__BLANK__x22_y22) and
+ c43c43__location_2__location_2(location__BLANK__x22_y22,
+ location__BLANK__x22_ynew1) and
+ EQ___location_1__location_1(location__BLANK__x22_ynew1,
+ location__BLANK__x22_y22) and
+ EQ___location_1__location_1(location__BLANK__x22_y22,
+ location__BLANK__x22_ynew1) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x22_ynew1) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x22_y22))
+REL nextcell__nowhere(v0, v1) =
+ ex location__BLANK__x26_y26, location__BLANK__x26_y26
+ (v0 = location__BLANK__x26_y26 and v1 = location__BLANK__x26_y26 and
+ cell(location__BLANK__x26_y26) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x26_y26) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x26_y26))
+REL nextcell__south(v0, v1) =
+ ex location__BLANK__x23_y23, location__BLANK__x23_ynew2
+ (v0 = location__BLANK__x23_y23 and v1 = location__BLANK__x23_ynew2 and
+ index__location_1(location__BLANK__x23_ynew2) and
+ index__location_1(location__BLANK__x23_y23) and
+ c45c45__location_2__location_2(location__BLANK__x23_y23,
+ location__BLANK__x23_ynew2) and
+ EQ___location_1__location_1(location__BLANK__x23_ynew2,
+ location__BLANK__x23_y23) and
+ EQ___location_1__location_1(location__BLANK__x23_y23,
+ location__BLANK__x23_ynew2) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x23_ynew2) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x23_y23))
+REL nextcell__west(v0, v1) =
+ ex location__BLANK__x25_y25, location__BLANK__xnew2_y25
+ (v0 = location__BLANK__x25_y25 and v1 = location__BLANK__xnew2_y25 and
+ index__location_2(location__BLANK__xnew2_y25) and
+ index__location_2(location__BLANK__x25_y25) and
+ c45c45__location_1__location_1(location__BLANK__x25_y25,
+ location__BLANK__xnew2_y25) and
+ EQ___location_2__location_2(location__BLANK__xnew2_y25,
+ location__BLANK__x25_y25) and
+ EQ___location_2__location_2(location__BLANK__x25_y25,
+ location__BLANK__xnew2_y25) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__xnew2_y25) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x25_y25))
+REL blocked(v0, v1) =
+ ex location__BLANK__x27_y28, location__BLANK__x27_y27
+ (v0 = location__BLANK__x27_y28 and v1 = location__BLANK__x27_y27 and
+ blockednorth(location__BLANK__x27_y27) and
+ c43c43__location_2__location_2(location__BLANK__x27_y27,
+ location__BLANK__x27_y28) and
+ EQ___location_1__location_1(location__BLANK__x27_y27,
+ location__BLANK__x27_y28) and
+ EQ___location_1__location_1(location__BLANK__x27_y28,
+ location__BLANK__x27_y27) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x27_y27) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x27_y28)) or
+ ex location__BLANK__x28_y29, location__BLANK__x28_y30
+ (v0 = location__BLANK__x28_y29 and v1 = location__BLANK__x28_y30 and
+ blockednorth(location__BLANK__x28_y29) and
+ c43c43__location_2__location_2(location__BLANK__x28_y29,
+ location__BLANK__x28_y30) and
+ EQ___location_1__location_1(location__BLANK__x28_y30,
+ location__BLANK__x28_y29) and
+ EQ___location_1__location_1(location__BLANK__x28_y29,
+ location__BLANK__x28_y30) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x28_y30) and
+ location__BLANK___BLANK___BLANK_(location__BLANK__x28_y29)) or
+ ex location__BLANK__x29_y31, location__BLANK__x30_y31
+ (v0 = location__BLANK__x29_y31 and v1 = location__BLANK__x30_y31 and
+ blockedeast(location__BLANK__x29_y31) and
+ c43c43__location_1__location_1(location__BLANK__x29_y31,
+ location__BLANK__x30_y31) and
+ EQ___location_2__location_2(location__BLANK__x30_y31,
+ location__BLANK__x29_y31) and
+ EQ___location_2__location_2(location__BLANK__x29_y31,
+ lo...
[truncated message content] |
Thanks for helping keep SourceForge clean.
X