Commits

Sébastien Ferré committed 7c44fa1

Add of utime, heap_size, probabilities, and ordered insertion.

Comments (0)

Files changed (1)

+(* time and space *)
+
+let utime () : float = (Unix.times ()).Unix.tms_utime (* in seconds *)
+
+let heap_size () : float = float_of_int (Gc.stat ()).Gc.heap_words *. float_of_int (Sys.word_size / 8)  (* in bytes *)
 
 (* extensions a Weak *)
 
     | None -> e
     | Some e' -> fold_while f e'
 
+let rec insert : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list =
+  fun order x ->
+    function
+    | [] -> [x]
+    | y::ys ->
+       if order x y
+       then x::y::ys
+       else y::insert order x ys
+
 (* fold on all ordered pairs of a list *)
 let rec fold_pair : ('a -> 'a -> 'b -> 'b) -> 'a list -> 'b -> 'b =
   fun f l e ->
 
 (* for profiling *)
 
-let tbl_prof : (string,(int * float)) Hashtbl.t = Hashtbl.create 100
+let tbl_prof : (string,(int * float * float)) Hashtbl.t = Hashtbl.create 100
 
 let prof : string -> (unit -> 'a) -> 'a =
   fun s f ->
+(* print_string ("<"^s^":"); flush stdout; *)
     let t1 = (Unix.times ()).Unix.tms_utime in
+    let m1 = Gc.allocated_bytes () (* float_of_int (Gc.stat ()).Gc.live_words *) in
     let y = f () in
     let t2 = (Unix.times ()).Unix.tms_utime in
-    let n, t = try Hashtbl.find tbl_prof s with Not_found -> 0, 0. in
-    Hashtbl.replace tbl_prof s (n+1, t +. (t2 -. t1));
+    let m2 = Gc.allocated_bytes () (* float_of_int (Gc.stat ()).Gc.live_words *) in
+    let n, t, m = try Hashtbl.find tbl_prof s with Not_found -> 0, 0., 0. in
+    Hashtbl.replace tbl_prof s (n+1, t +. (t2 -. t1), m +. (m2 -. m1));
+(* print_string (s^">\n"); flush stdout; *)
     y
+
+(* probabilities *)
+
+open Num
+
+let comb_tbl : (int*int,num) Hashtbl.t = Hashtbl.create 10000
+let rec comb (k,n) =
+  if k > n or n < 0 then Int 0
+  else if k = n or k = 0 then Int 1
+  else if k > n / 2 then comb (n-k,n)
+  else
+    try Hashtbl.find comb_tbl (k,n)
+    with Not_found ->
+      let res = comb (k,n-1) +/ comb (k-1,n-1) in
+      Hashtbl.add comb_tbl (k,n) res;
+      res
+
+let chance_eq_num (r,w) (k,n) =
+  comb (k,r) */ comb (n-k,w-r) // comb (n,w)
+
+let chance_eq (r,w) (k,n) = prof "chance_eq" (fun () ->
+  float_of_num (chance_eq_num (r,w) (k,n)))
+
+let chance_ge_num (r,w) (k,n) =
+  let res = ref (Int 0) in
+  for i = k to n do
+    res := !res +/ chance_eq_num (r,w) (i,n)
+  done;
+  !res
+
+let chance_ge (r,w) (k,n) = prof "chance_ge" (fun () ->
+  float_of_num (chance_ge_num (r,w) (k,n)))
+
+
+(* mutex on global data structures *)
+
+    let m = Mutex.create ()
+
+    let owner = ref None
+
+    let mutex f =
+      match !owner with
+      | Some id when id = Thread.self () -> f ()
+      |	_ ->
+	  Mutex.lock m;
+	  owner := Some (Thread.self ());
+	  let res =
+            try f ()
+	    with e -> owner := None; Mutex.unlock m; raise e in
+	  owner := None;
+	  Mutex.unlock m;
+	  res