correcting unefficient use of ocaml compare

.paths

@@ -30,29 +30,20 @@ models/token
 pattern
 simulation
 siteGraphs
-models/cflows/link_passing/expected-output
 models/cflows/link_swapping
-models/cflows/link_swapping/expected-output
 models/cflows/none_only
-models/cflows/none_only/expected-output
 models/cflows/observables
 models/cflows/side-effects1
-models/cflows/side-effects1/expected-output
 models/cflows/side-effects2
-models/cflows/side-effects2/expected-output
 models/cflows/side-effects3
-models/cflows/side-effects3/expected-output
 models/cflows/side-effects4
-models/cflows/side-effects4/expected-output
 models/cflows/weak_only
-models/cflows/weak_only/expected-output
 models/debug/LFCI
 models/dna
 zarith
 zarith/trunk
 models/TP
 bin
-models/cflows/observables/expected-output
 Error
 bin
 cflow
@@ -64,33 +55,19 @@ man/img
 models
 models/cflows
 models/cflows/abc
-models/cflows/abc/expected-output
 models/cflows/abc-cflow
-models/cflows/abc-cflow/expected-output
 models/cflows/abc-pert
-models/cflows/abc-pert/expected-output
 models/cflows/agents_without_sites
-models/cflows/agents_without_sites/expected-output
 models/cflows/cube
-models/cflows/cube/expected-output
 models/cflows/link_passing
-models/cflows/link_passing/expected-output
 models/cflows/link_swapping
-models/cflows/link_swapping/expected-output
 models/cflows/none_only
-models/cflows/none_only/expected-output
 models/cflows/observables
-models/cflows/observables/expected-output
 models/cflows/side-effects1
-models/cflows/side-effects1/expected-output
 models/cflows/side-effects2
-models/cflows/side-effects2/expected-output
 models/cflows/side-effects3
-models/cflows/side-effects3/expected-output
 models/cflows/side-effects4
-models/cflows/side-effects4/expected-output
 models/cflows/weak_only
-models/cflows/weak_only/expected-output
 models/debug
 models/dna
 models/out
@@ -144,3 +121,5 @@ models/debug
 models/cflows/pseudo_inverse
 models/radius
 models/time
+bin
+bin/Nightly build

dataStructures/mods.ml

@@ -1,10 +1,14 @@
-module StringMap = MapExt.Make (struct type t = string let compare = compare end)   
-module IntMap = MapExt.Make (struct type t = int let compare = compare end)
-module IntSet = Set_patched.Make (struct type t = int let compare = compare end)
-module Int2Map = MapExt.Make (struct type t = int*int let compare = compare end)
+(*Optimisation de compare*)
+let int_compare (x: int) y = Pervasives.compare x y
+let int_pair_compare (p, q) (p',q') = let c= Pervasives.compare p p' in if c=0 then Pervasives.compare q q' else c
+
+module StringMap = MapExt.Make (struct type t = string let compare= compare end)
+module IntMap = MapExt.Make (struct type t = int let compare = int_compare end)
+module IntSet = Set_patched.Make (struct type t = int let compare = int_compare end)
+module Int2Map = MapExt.Make (struct type t = int*int let compare = int_pair_compare end)
 module StringSet = Set.Make (struct type t = string let compare = compare end)
-module Int2Set = Set.Make (struct type t = int*int let compare = compare end)
-module Int3Set = Set.Make (struct type t = int*int*int let compare = compare end)
+module Int2Set = Set.Make (struct type t = int*int let compare = int_pair_compare end)
+module Int3Set = Set.Make (struct type t = int*int*int let compare= compare end)
 
 module DynArray = DynamicArray.DynArray(LargeArray.GenArray)
 
@@ -151,14 +155,14 @@ module Injection =
 			{phi with address = None ; coordinate = (var_id,cc_id)}
 
 		let compare phi psi = 
-			try
-				let a = get_address phi
-				and a'= get_address psi
-				and (m,c) = get_coordinate phi
-				and (m',c') = get_coordinate psi
-				in
-					compare (m,c,a) (m',c',a') (*might be better to compare a bit rep of this triple*)
-			with Not_found -> invalid_arg "Injection.compare"
+			let p1 = get_coordinate phi in
+			let p2 = get_coordinate psi in
+                        let c = int_pair_compare p1 p2 in
+                        if c=0 then 
+                                match phi.address,psi.address with
+                                | Some a,Some b -> int_compare a b 
+                                | _,_ ->  invalid_arg "Injection.compare"
+                               else c 
 
 		let fold f phi cont = Hashtbl.fold f phi.map cont
 

dataStructures/tools.ml

@@ -85,12 +85,53 @@ let list_of_string str =
 		with Stream.Failure -> (acc::cont)
 	in
 	parse stream "" []
-
-let find_available_name nme ext = 
-	let v = ref 0 in
-	let fic = ref nme in
-	while (Sys.file_exists (!fic^ext)) do
-		fic := nme^"~"^(string_of_int !v) ;
-		v := !v+1 ;
-	done;
-	(!fic^ext)
+
+
+let array_fold_left_mapi f x a =
+  let y = ref x in
+  let o = Array.init (Array.length a)
+		     (fun i -> let (y',out) = f i !y a.(i) in
+			       let () = y := y' in
+			       out) in
+  (!y,o)
+
+let array_map_of_list f l =
+  let len = List.length l in
+  let rec fill i v = function
+    | [] -> ()
+    | x :: l ->
+       Array.unsafe_set v i (f x);
+       fill (succ i) v l
+  in
+  match l with
+  | [] -> [||]
+  | x :: l ->
+     let ans = Array.make len (f x) in
+     let () = fill 1 ans l in
+     ans
+
+let iteri f i =
+  let rec aux j =
+  if j < i then let () = f j in aux (succ j)
+  in aux 0
+
+let find_available_name name ext =
+  let base = try Filename.chop_extension name with _ -> name in
+  if Sys.file_exists (base^"."^ext) then
+          let v = ref 0 in
+          let () =
+            while Sys.file_exists (base^"~"^(string_of_int !v)^"."^ext) do incr v; done
+          in base^"~"^(string_of_int !v)^"."^ext
+   else
+        (base^"."^ext)
+
+(**[build_fresh_filename base_name l ext] returns a filename that does 
+not exists in the working directory using [base_name] appended to strings 
+in [l] and adding the extension [ext] at the end*)
+let build_fresh_filename base_name concat_list ext =
+        let tmp_name = 
+                try Filename.chop_extension base_name with _ -> base_name
+        in
+        let base_name = String.concat "_" (tmp_name::concat_list) in
+        find_available_name base_name ext
+

main/main.ml

@@ -3,7 +3,7 @@ open Mods
 open State
 open Random_tree
 
-let version = "3.5-190914"
+let version = "3.5-061114"
 
 let usage_msg = "KaSim "^version^": \n"^"Usage is KaSim -i input_file [-e events | -t time] [-p points] [-o output_file]\n"
 let version_msg = "Kappa Simulator: "^version^"\n"

models/abc-cflow.ka

@@ -40,8 +40,8 @@
  $SNAPSHOT <"snap".[int]([E+]/1000).".ka">) \
  until [false]
 
-%mod: [T]>5 do $ADD 10000 C()
-%mod: [T]>10 do ($TRACK 'Cpp' [true] ; $UPDATE 'cflow' 'Cpp')
+%mod: [T]=5 do $ADD 1000 C()
+%mod: [T]=10 do ($TRACK 'Cpp' [true] ; $UPDATE 'cflow' 'Cpp')
 %mod: [T]>10 && ('Cpp' - 'cflow' = 10) do ($TRACK 'Cpp' [false])
 
 

models/abc.ka

@@ -7,7 +7,7 @@
 
 #### Rules 
 'a.b' A(x),B(x) <-> A(x!1),B(x!1) @ 'on_rate','off_rate' #A binds B 
-#'a..b' A(x!1),B(x!1) -> A(x),B(x) @ 'off_rate' #AB dissociation
+'a..b' A(x!1),B(x!1) -> A(x),B(x) @ 'off_rate' #AB dissociation
 'ab.c' A(x!_,c),C(x1~u) ->A(x!_,c!2),C(x1~u!2) @ 'on_rate' #AB binds C 
 'mod x1' C(x1~u!1),A(c!1) ->C(x1~p),A(c) @ 'mod_rate' #AB modifies x1
 'a.c' A(x,c),C(x1~p,x2~u) -> A(x,c!1),C(x1~p,x2~u!1) @ 'on_rate' #A binds C on x2 
@@ -23,9 +23,9 @@
 %obs: 'Cpp' C(x1~p?,x2~p?) 
 
 
-%var: 'n_a' 100000	   
+%var: 'n_a' 1000	   
 %obs: 'n_b' 'n_a'
-%var: 'n_c' 100000
+%var: 'n_c' 1000
 
 
 
@@ -34,4 +34,3 @@
 %init: 'n_b' B()
 %init: 'n_c' C()
 
-#%mod: [true] do $TRACK 'Cpp' [true]

models/poly.ka

@@ -19,5 +19,7 @@
 %var: 'n'  1000
 ##
 %init: 'n'  A(),B(),C()
+
+
 %mod: [E] > 10000 do $STOP 
 %def: "dotSnapshots" "true"