Skip to content

Commit 0276e29

Browse files
jkrivinejkrivine
committed
correcting unefficient use of ocaml compare
1 parent 57f417a commit 0276e29

File tree

7 files changed

+78
-53
lines changed

7 files changed

+78
-53
lines changed

‎.paths‎

Lines changed: 2 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -30,29 +30,20 @@ models/token
3030
pattern
3131
simulation
3232
siteGraphs
33-
models/cflows/link_passing/expected-output
3433
models/cflows/link_swapping
35-
models/cflows/link_swapping/expected-output
3634
models/cflows/none_only
37-
models/cflows/none_only/expected-output
3835
models/cflows/observables
3936
models/cflows/side-effects1
40-
models/cflows/side-effects1/expected-output
4137
models/cflows/side-effects2
42-
models/cflows/side-effects2/expected-output
4338
models/cflows/side-effects3
44-
models/cflows/side-effects3/expected-output
4539
models/cflows/side-effects4
46-
models/cflows/side-effects4/expected-output
4740
models/cflows/weak_only
48-
models/cflows/weak_only/expected-output
4941
models/debug/LFCI
5042
models/dna
5143
zarith
5244
zarith/trunk
5345
models/TP
5446
bin
55-
models/cflows/observables/expected-output
5647
Error
5748
bin
5849
cflow
@@ -64,33 +55,19 @@ man/img
6455
models
6556
models/cflows
6657
models/cflows/abc
67-
models/cflows/abc/expected-output
6858
models/cflows/abc-cflow
69-
models/cflows/abc-cflow/expected-output
7059
models/cflows/abc-pert
71-
models/cflows/abc-pert/expected-output
7260
models/cflows/agents_without_sites
73-
models/cflows/agents_without_sites/expected-output
7461
models/cflows/cube
75-
models/cflows/cube/expected-output
7662
models/cflows/link_passing
77-
models/cflows/link_passing/expected-output
7863
models/cflows/link_swapping
79-
models/cflows/link_swapping/expected-output
8064
models/cflows/none_only
81-
models/cflows/none_only/expected-output
8265
models/cflows/observables
83-
models/cflows/observables/expected-output
8466
models/cflows/side-effects1
85-
models/cflows/side-effects1/expected-output
8667
models/cflows/side-effects2
87-
models/cflows/side-effects2/expected-output
8868
models/cflows/side-effects3
89-
models/cflows/side-effects3/expected-output
9069
models/cflows/side-effects4
91-
models/cflows/side-effects4/expected-output
9270
models/cflows/weak_only
93-
models/cflows/weak_only/expected-output
9471
models/debug
9572
models/dna
9673
models/out
@@ -144,3 +121,5 @@ models/debug
144121
models/cflows/pseudo_inverse
145122
models/radius
146123
models/time
124+
bin
125+
bin/Nightly build

‎dataStructures/mods.ml‎

Lines changed: 18 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
1-
module StringMap = MapExt.Make (struct type t = string let compare = compare end)
2-
module IntMap = MapExt.Make (struct type t = int let compare = compare end)
3-
module IntSet = Set_patched.Make (struct type t = int let compare = compare end)
4-
module Int2Map = MapExt.Make (struct type t = int*int let compare = compare end)
1+
(*Optimisation de compare*)
2+
let int_compare (x: int) y = Pervasives.compare x y
3+
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
4+
5+
module StringMap = MapExt.Make (struct type t = string let compare= compare end)
6+
module IntMap = MapExt.Make (struct type t = int let compare = int_compare end)
7+
module IntSet = Set_patched.Make (struct type t = int let compare = int_compare end)
8+
module Int2Map = MapExt.Make (struct type t = int*int let compare = int_pair_compare end)
59
module StringSet = Set.Make (struct type t = string let compare = compare end)
6-
module Int2Set = Set.Make (struct type t = int*int let compare = compare end)
7-
module Int3Set = Set.Make (struct type t = int*int*int let compare = compare end)
10+
module Int2Set = Set.Make (struct type t = int*int let compare = int_pair_compare end)
11+
module Int3Set = Set.Make (struct type t = int*int*int let compare= compare end)
812

913
module DynArray = DynamicArray.DynArray(LargeArray.GenArray)
1014

@@ -151,14 +155,14 @@ module Injection =
151155
{phi with address = None ; coordinate = (var_id,cc_id)}
152156

153157
let compare phi psi =
154-
try
155-
let a = get_address phi
156-
and a'= get_address psi
157-
and (m,c) = get_coordinate phi
158-
and (m',c') = get_coordinate psi
159-
in
160-
compare (m,c,a) (m',c',a') (*might be better to compare a bit rep of this triple*)
161-
with Not_found -> invalid_arg "Injection.compare"
158+
let p1 = get_coordinate phi in
159+
let p2 = get_coordinate psi in
160+
let c = int_pair_compare p1 p2 in
161+
if c=0 then
162+
match phi.address,psi.address with
163+
| Some a,Some b -> int_compare a b
164+
| _,_ -> invalid_arg "Injection.compare"
165+
else c
162166

163167
let fold f phi cont = Hashtbl.fold f phi.map cont
164168

‎dataStructures/tools.ml‎

Lines changed: 50 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -85,12 +85,53 @@ let list_of_string str =
8585
with Stream.Failure -> (acc::cont)
8686
in
8787
parse stream "" []
88-
89-
let find_available_name nme ext =
90-
let v = ref 0 in
91-
let fic = ref nme in
92-
while (Sys.file_exists (!fic^ext)) do
93-
fic := nme^"~"^(string_of_int !v) ;
94-
v := !v+1 ;
95-
done;
96-
(!fic^ext)
88+
89+
90+
let array_fold_left_mapi f x a =
91+
let y = ref x in
92+
let o = Array.init (Array.length a)
93+
(fun i -> let (y',out) = f i !y a.(i) in
94+
let () = y := y' in
95+
out) in
96+
(!y,o)
97+
98+
let array_map_of_list f l =
99+
let len = List.length l in
100+
let rec fill i v = function
101+
| [] -> ()
102+
| x :: l ->
103+
Array.unsafe_set v i (f x);
104+
fill (succ i) v l
105+
in
106+
match l with
107+
| [] -> [||]
108+
| x :: l ->
109+
let ans = Array.make len (f x) in
110+
let () = fill 1 ans l in
111+
ans
112+
113+
let iteri f i =
114+
let rec aux j =
115+
if j < i then let () = f j in aux (succ j)
116+
in aux 0
117+
118+
let find_available_name name ext =
119+
let base = try Filename.chop_extension name with _ -> name in
120+
if Sys.file_exists (base^"."^ext) then
121+
let v = ref 0 in
122+
let () =
123+
while Sys.file_exists (base^"~"^(string_of_int !v)^"."^ext) do incr v; done
124+
in base^"~"^(string_of_int !v)^"."^ext
125+
else
126+
(base^"."^ext)
127+
128+
(**[build_fresh_filename base_name l ext] returns a filename that does
129+
not exists in the working directory using [base_name] appended to strings
130+
in [l] and adding the extension [ext] at the end*)
131+
let build_fresh_filename base_name concat_list ext =
132+
let tmp_name =
133+
try Filename.chop_extension base_name with _ -> base_name
134+
in
135+
let base_name = String.concat "_" (tmp_name::concat_list) in
136+
find_available_name base_name ext
137+

‎main/main.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ open Mods
33
open State
44
open Random_tree
55

6-
let version = "3.5-190914"
6+
let version = "3.5-061114"
77

88
let usage_msg = "KaSim "^version^": \n"^"Usage is KaSim -i input_file [-e events | -t time] [-p points] [-o output_file]\n"
99
let version_msg = "Kappa Simulator: "^version^"\n"

‎models/abc-cflow.ka‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,8 +40,8 @@
4040
$SNAPSHOT <"snap".[int]([E+]/1000).".ka">) \
4141
until [false]
4242

43-
%mod: [T]>5 do $ADD 10000 C()
44-
%mod: [T]>10 do ($TRACK 'Cpp' [true] ; $UPDATE 'cflow' 'Cpp')
43+
%mod: [T]=5 do $ADD 1000 C()
44+
%mod: [T]=10 do ($TRACK 'Cpp' [true] ; $UPDATE 'cflow' 'Cpp')
4545
%mod: [T]>10 && ('Cpp' - 'cflow' = 10) do ($TRACK 'Cpp' [false])
4646

4747

‎models/abc.ka‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77

88
#### Rules
99
'a.b' A(x),B(x) <-> A(x!1),B(x!1) @ 'on_rate','off_rate' #A binds B
10-
#'a..b' A(x!1),B(x!1) -> A(x),B(x) @ 'off_rate' #AB dissociation
10+
'a..b' A(x!1),B(x!1) -> A(x),B(x) @ 'off_rate' #AB dissociation
1111
'ab.c' A(x!_,c),C(x1~u) ->A(x!_,c!2),C(x1~u!2) @ 'on_rate' #AB binds C
1212
'mod x1' C(x1~u!1),A(c!1) ->C(x1~p),A(c) @ 'mod_rate' #AB modifies x1
1313
'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 @@
2323
%obs: 'Cpp' C(x1~p?,x2~p?)
2424

2525

26-
%var: 'n_a' 100000
26+
%var: 'n_a' 1000
2727
%obs: 'n_b' 'n_a'
28-
%var: 'n_c' 100000
28+
%var: 'n_c' 1000
2929

3030

3131

@@ -34,4 +34,3 @@
3434
%init: 'n_b' B()
3535
%init: 'n_c' C()
3636

37-
#%mod: [true] do $TRACK 'Cpp' [true]

‎models/poly.ka‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,5 +19,7 @@
1919
%var: 'n' 1000
2020
##
2121
%init: 'n' A(),B(),C()
22+
23+
2224
%mod: [E] > 10000 do $STOP
2325
%def: "dotSnapshots" "true"

0 commit comments

Comments
 (0)