[Toss-devel-svn] SF.net SVN: toss:[1470] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1470] trunk/Toss
|
From: <luk...@us...> - 2011-06-05 21:15:41
|
Revision: 1470
http://toss.svn.sourceforge.net/toss/?rev=1470&view=rev
Author: lukaszkaiser
Date: 2011-06-05 21:15:35 +0000 (Sun, 05 Jun 2011)
Log Message:
-----------
Replacing incidence maps with arrays over elements in Structure ml.
Modified Paths:
--------------
trunk/Toss/Arena/Arena.ml
trunk/Toss/Solver/Assignments.ml
trunk/Toss/Solver/Assignments.mli
trunk/Toss/Solver/Solver.ml
trunk/Toss/Solver/Structure.ml
trunk/Toss/Solver/Structure.mli
Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml 2011-06-03 20:24:22 UTC (rev 1469)
+++ trunk/Toss/Arena/Arena.ml 2011-06-05 21:15:35 UTC (rev 1470)
@@ -738,7 +738,7 @@
with Not_found -> false)
then (state_game, state), "SET ARITY"
else
- let s = Structure.force_add_rel_name rel ar struc in
+ let s = Structure.add_rel_name rel ar struc in
((state_game, { state with struc = s }), "SET ARITY")
| GetArity (rel) -> (
if rel = "" then ((state_game, state), sig_str state) else
Modified: trunk/Toss/Solver/Assignments.ml
===================================================================
--- trunk/Toss/Solver/Assignments.ml 2011-06-03 20:24:22 UTC (rev 1469)
+++ trunk/Toss/Solver/Assignments.ml 2011-06-05 21:15:35 UTC (rev 1470)
@@ -482,13 +482,13 @@
match aset with (* TODO: better use of incidence map? *)
| Empty -> Empty
| FO (v, map) when Aux.array_mem v vars ->
- let tps e =
- try IntMap.find e incidence_map with Not_found -> Tuples.empty in
- let aset_tuples =
- List.fold_left (fun s (e,_)-> Tuples.union s (tps e)) Tuples.empty map
- in
- if aset_tuples = Tuples.empty then Empty else
- full_join_rel aset vars aset_tuples all_elems
+ let tps e =
+ if e < Array.length incidence_map then incidence_map.(e) else
+ Tuples.empty in
+ let aset_tuples =
+ List.fold_left (fun s (e,_)->Tuples.union s (tps e)) Tuples.empty map in
+ if aset_tuples = Tuples.empty then Empty else
+ full_join_rel aset vars aset_tuples all_elems
| _ -> full_join_rel aset vars tuples_set all_elems
and full_join_rel aset vars tuples_set all_elems =
Modified: trunk/Toss/Solver/Assignments.mli
===================================================================
--- trunk/Toss/Solver/Assignments.mli 2011-06-03 20:24:22 UTC (rev 1469)
+++ trunk/Toss/Solver/Assignments.mli 2011-06-05 21:15:35 UTC (rev 1470)
@@ -98,7 +98,7 @@
val join_rel : assignment_set -> Formula.fo_var array -> Structure.Tuples.t ->
- Structure.Tuples.t Structure.IntMap.t -> set_list ref -> assignment_set
+ Structure.Tuples.t array -> set_list ref -> assignment_set
val full_join_rel : assignment_set -> Formula.fo_var array ->
Structure.Tuples.t -> set_list ref -> assignment_set
Modified: trunk/Toss/Solver/Solver.ml
===================================================================
--- trunk/Toss/Solver/Solver.ml 2011-06-03 20:24:22 UTC (rev 1469)
+++ trunk/Toss/Solver/Solver.ml 2011-06-05 21:15:35 UTC (rev 1470)
@@ -133,9 +133,7 @@
let tuples_s =
try Structure.rel_find relname model
with Not_found -> Tuples.empty in
- let inc_map =
- try Structure.rel_incidence relname model
- with Not_found -> IntMap.empty in
+ let inc_map = Structure.rel_incidence relname model in
report (join_rel aset vl tuples_s inc_map elems)
| Eq (x, y) -> report (equal_vars elems x y aset)
| SO (v, vl) ->
Modified: trunk/Toss/Solver/Structure.ml
===================================================================
--- trunk/Toss/Solver/Structure.ml 2011-06-03 20:24:22 UTC (rev 1469)
+++ trunk/Toss/Solver/Structure.ml 2011-06-05 21:15:35 UTC (rev 1470)
@@ -30,12 +30,30 @@
let tuples_of_list nes =
add_tuples nes Tuples.empty
+module TIntMap = struct
+ type t = Tuples.t array
+ let empty = Array.make 4 Tuples.empty
+ let is_empty a =
+ let res = ref true in
+ Array.iter (fun t -> if not (Tuples.is_empty t) then res := false) a;
+ !res
+ let find i a = if i < 0 || i+1 > Array.length a then Tuples.empty else a.(i)
+ let add i tuples a =
+ let l = Array.length a in
+ if i < l then let b = Array.copy a in b.(i) <- tuples; b else
+ let b = Array.make (max (i-l+1) l) Tuples.empty in
+ let c = Array.append a b in c.(i) <- tuples; c
+ let remove i a =
+ if i < 0 || i+1 > Array.length a || Tuples.is_empty a.(i) then a else
+ let b = Array.copy a in b.(i) <- Tuples.empty; b
+end
+
type structure = {
rel_signature : int StringMap.t ;
elements : Elems.t ;
relations : Tuples.t StringMap.t ;
functions : (float IntMap.t) StringMap.t ;
- incidence : (Tuples.t IntMap.t) StringMap.t ;
+ incidence : (TIntMap.t) StringMap.t ;
names : int StringMap.t ;
inv_names : string IntMap.t ;
}
@@ -104,11 +122,9 @@
(* Return the list of relation tuples incident to an element [e] in [struc]. *)
let incident struc e =
let acc_incident rname inc_map acc =
- try
- (rname, Tuples.elements (IntMap.find e inc_map)) :: acc
- with Not_found -> acc
- in
- StringMap.fold acc_incident struc.incidence []
+ let tps = TIntMap.find e inc_map in
+ if Tuples.is_empty tps then acc else (rname, Tuples.elements tps) :: acc in
+ StringMap.fold acc_incident struc.incidence []
(* Check if a relation holds for a tuple. *)
@@ -132,7 +148,8 @@
let rel_find relname model = StringMap.find relname model.relations
(* Incidences of a relation in a model, throw Not_found if not found. *)
-let rel_incidence relname model = StringMap.find relname model.incidence
+let rel_incidence relname model =
+ try StringMap.find relname model.incidence with Not_found -> TIntMap.empty
@@ -208,7 +225,7 @@
{ struc with
rel_signature = StringMap.add rn arity struc.rel_signature;
relations = StringMap.add rn Tuples.empty struc.relations;
- incidence = StringMap.add rn IntMap.empty struc.incidence; }
+ incidence = StringMap.add rn TIntMap.empty struc.incidence; }
let empty_with_signat signat =
List.fold_right (fun (rn,ar) -> add_rel_name rn ar) signat
@@ -220,7 +237,7 @@
{ struc with
rel_signature = StringMap.add rn arity struc.rel_signature;
relations = StringMap.add rn Tuples.empty struc.relations;
- incidence = StringMap.add rn IntMap.empty struc.incidence; }
+ incidence = StringMap.add rn TIntMap.empty struc.incidence; }
(* Add tuple [tp] to relation [rn] in structure [struc]. *)
let add_rel struc rn tp =
@@ -233,14 +250,14 @@
let new_rel = add_to_relmap new_struc.relations in
let add_to_imap imap e =
try
- IntMap.add e (Tuples.add tp (IntMap.find e imap)) imap
+ TIntMap.add e (Tuples.add tp (TIntMap.find e imap)) imap
with Not_found ->
- IntMap.add e (Tuples.singleton tp) imap in
+ TIntMap.add e (Tuples.singleton tp) imap in
let new_incidence_imap =
try
Array.fold_left add_to_imap (StringMap.find rn new_struc.incidence) tp
with Not_found ->
- Array.fold_left add_to_imap IntMap.empty tp in
+ Array.fold_left add_to_imap TIntMap.empty tp in
let new_incidence = StringMap.add rn new_incidence_imap new_struc.incidence in
{ new_struc with relations = new_rel ; incidence = new_incidence }
@@ -260,14 +277,14 @@
StringMap.add rn (Tuples.add tp tps) struc.relations in
let add_to_imap imap e =
try
- IntMap.add e (Tuples.add tp (IntMap.find e imap)) imap
+ TIntMap.add e (Tuples.add tp (TIntMap.find e imap)) imap
with Not_found ->
- IntMap.add e (Tuples.singleton tp) imap in
+ TIntMap.add e (Tuples.singleton tp) imap in
let new_incidence_imap =
try
Array.fold_left add_to_imap (StringMap.find rn struc.incidence) tp
with Not_found ->
- Array.fold_left add_to_imap IntMap.empty tp in
+ Array.fold_left add_to_imap TIntMap.empty tp in
let new_incidence = StringMap.add rn new_incidence_imap struc.incidence in
{ struc with relations = new_rel ; incidence = new_incidence }
@@ -365,7 +382,7 @@
with Not_found -> rmap in
let new_rel = del_rmap struc.relations in
let del_imap imap e =
- try IntMap.add e (Tuples.remove tp (IntMap.find e imap)) imap
+ try TIntMap.add e (Tuples.remove tp (TIntMap.find e imap)) imap
with Not_found -> imap in
let new_incidence =
let imap=Array.fold_left del_imap (StringMap.find rn struc.incidence) tp in
@@ -431,7 +448,7 @@
let gc_elems =
List.filter
(fun e -> StringMap.fold (fun _ incmap empty ->
- empty && try Tuples.is_empty (IntMap.find e incmap)
+ empty && try Tuples.is_empty (TIntMap.find e incmap)
with Not_found -> true) struc.incidence true) all_elems in
let gc_elems =
if ignore_funs then gc_elems
@@ -939,9 +956,9 @@
Tuples.mem tup tmap &&
let rmap =
try StringMap.find pred !ret.incidence
- with Not_found -> IntMap.empty in
+ with Not_found -> TIntMap.empty in
not (Tuples.is_empty (
- try IntMap.find elem rmap
+ try TIntMap.find elem rmap
with Not_found -> Tuples.empty)))
all_predicates in
let up_line = String.make 3 ' '
@@ -1155,7 +1172,7 @@
let diff_elems s1 s2 =
let rels, _ = List.split (rel_signature s1) in
let elems = Elems.elements s1.elements in
- let inc s r e = try IntMap.find e (StringMap.find r s.incidence) with
+ let inc s r e = try TIntMap.find e (StringMap.find r s.incidence) with
Not_found -> Tuples.empty in
let diff_elem_rel e r = not (Tuples.equal (inc s1 r e) (inc s2 r e)) in
let diff_rels e = (e, List.filter (diff_elem_rel e) rels) in
Modified: trunk/Toss/Solver/Structure.mli
===================================================================
--- trunk/Toss/Solver/Structure.mli 2011-06-03 20:24:22 UTC (rev 1469)
+++ trunk/Toss/Solver/Structure.mli 2011-06-05 21:15:35 UTC (rev 1470)
@@ -62,7 +62,7 @@
val rel_find : string -> structure -> Tuples.t
(** Incidences of a relation in a model, throw Not_found if not found. *)
-val rel_incidence : string -> structure -> Tuples.t IntMap.t
+val rel_incidence : string -> structure -> Tuples.t array
(** Return the value of function [f] on [e] in [struc]. *)
val fun_val : structure -> string -> int -> float
@@ -164,10 +164,6 @@
(** Ensure relation named [rn] exists in [struc], add if needed. *)
val add_rel_name : string -> int -> structure -> structure
-(** Add relation named [rn] to [struc], with given arity, regardless of
- whether it already existed. *)
-val force_add_rel_name : string -> int -> structure -> structure
-
(** Add tuple [tp] to relation [rn] in structure [struc]. *)
val add_rel : structure -> string -> int array -> structure
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
