Removing core

ocaml/Random_variable.ml

@@ -73,6 +73,21 @@ end = struct
 end
 
 
+let hashtbl_to_alist table =
+  Hashtbl.fold (fun k v a ->  (k,v) :: a) table []
+
+let hashtbl_change table key f =
+  let elt =
+    try 
+      Some (Hashtbl.find table key)
+    with
+    | Not_found -> None
+  in
+  let new_elt = f elt in
+  match new_elt with
+    | None -> Hashtbl.remove table key
+    | Some value -> Hashtbl.replace table key value
+
 
 (** Build from raw data. Range values are given in percent. *)
 let of_raw_data ?(locked=true) ~range property =
@@ -260,7 +275,7 @@ let fold_blocks ~f { property ; data } =
       let block = List.hd data in
       Sample.to_float block.Block.value
     with
-    | Failure "hd" -> 0.
+    | Failure _ -> 0.
   in
   List.fold_left (fun accu block ->
     let x = Sample.to_float block.Block.value
@@ -347,13 +362,13 @@ let max_block =
 let create_hash ~create_key ?(update_block_id=(fun x->x)) 
     ?(update_value=(fun wc vc wb vb sw -> (wc *. vc +. wb *. vb) /. sw) )
     ?(update_weight=(fun wc wb -> wc +. wb) ) t =
-  let table = String.Table.create ()
+  let table = Hashtbl.create 63
   in
-  List.iter t.data ~f:(fun block ->
+  List.iter (fun block ->
     let key = create_key block
     in
     let open Block in
-      Hashtbl.change table key (function 
+      hashtbl_change table key (function 
       | Some current ->
           let wc, wb =
             Weight.to_float current.weight,
@@ -384,7 +399,7 @@ let create_hash ~create_key ?(update_block_id=(fun x->x))
             {  property = current.property ;
                weight   = Weight.of_float sw ;
                value    = 
-                 Array.init dim ~f:(fun i -> update_value wc vc.(i) wb vb.(i) sw)
+                 Array.init dim (fun i -> update_value wc vc.(i) wb vb.(i) sw)
                  |> Sample.of_float_array ~dim ;
                block_id = update_block_id block.block_id;
                pid      = block.pid ;
@@ -399,7 +414,7 @@ let create_hash ~create_key ?(update_block_id=(fun x->x))
             compute_node = block.compute_node;
           }
         )
-  );
+  ) t.data ;
   table
 
 
@@ -409,12 +424,12 @@ let merge ~create_key ?update_block_id ?update_value ?update_weight t =
   let table = create_hash ~create_key ?update_block_id ?update_value ?update_weight t
   in
   { property = t.property ;
-    data = Hashtbl.to_alist table
-    |>  List.sort ~cmp:(fun x y ->
+    data = hashtbl_to_alist table
+    |>  List.sort (fun x y ->
         if (x>y) then 1
         else if (x<y) then -1
         else 0)
-    |>  List.map ~f:(fun (x,y) -> y)
+    |>  List.map (fun (x,y) -> y)
   }
 
 
@@ -440,7 +455,7 @@ let merge_per_compute_node_and_pid =
    ~create_key:(fun block -> 
       Printf.sprintf "%s %10.10d" 
        (Compute_node.to_string block.Block.compute_node)
-       (Pid.to_int block.Block.pid) )
+       (block.Block.pid) )
 
 
 
@@ -453,9 +468,9 @@ let merge_per_compute_node_and_block_id =
        (Block_id.to_int block.Block.block_id) )
 
 let error_x_over_y = function
-| []    -> (Average.of_float 0., None)
-| (x,_)::[] -> (Average.of_float x, None)
-| (x,w)::tail ->
+  | []          -> (Average.of_float 0., None)
+  | (x,_)::[]   -> (Average.of_float x , None)
+  | (x,w)::tail ->
     begin
       let avcu0 = ref 0.
       and ansum = ref w
@@ -466,17 +481,17 @@ let error_x_over_y = function
       in
       let avcu  = ref !avbl
       in
-      List.iter tail ~f:(fun (x,w) ->
-        avcu0 := !avsum /. !ansum;
-        ansum := !ansum +. w;
-        avsum := !avsum +. x;
-        avbl  := x /. w ;
-        if (!ansum <> 0.) then
-          avcu := !avsum /. !ansum
-        else ();
-        avsq := !avsq +. (1. -. w /. !ansum) *. (!avbl -. !avcu0) *.  (!avbl -. !avcu0) *. w;
-        n := !n +. 1.
-      );
+      List.iter (fun (x,w) ->
+          avcu0 := !avsum /. !ansum;
+          ansum := !ansum +. w;
+          avsum := !avsum +. x;
+          avbl  := x /. w ;
+          if (!ansum <> 0.) then
+            avcu := !avsum /. !ansum
+          else ();
+          avsq := !avsq +. (1. -. w /. !ansum) *. (!avbl -. !avcu0) *.  (!avbl -. !avcu0) *. w;
+          n := !n +. 1.
+        ) tail ;
       let arg =
         abs_float (!avsq /.(!ansum *. (!n -. 1.)))
       in
@@ -490,7 +505,7 @@ let error_x_over_y = function
 (** Create float, variable operators *)
 let one_variable_operator ~update_value p f = 
     { p with 
-      data = List.map ~f:(fun b -> { b with 
+      data = List.map (fun b -> { b with 
         Block.value = Sample.of_float (update_value (Sample.to_float b.Block.value) ) }
       ) p.data }
 
@@ -515,7 +530,7 @@ let two_variable_operator ~update_value p1 p2 =
       Printf.sprintf "%s %10.10d %10.10d" 
        (Compute_node.to_string block.Block.compute_node)
        (Block_id.to_int block.Block.block_id) 
-       (Pid.to_int block.Block.pid) )
+       (block.Block.pid) )
   ~update_weight:(fun wc wb -> wc )
   { property = p1.property ;
     data = List.concat [ p1.data ; p2.data ] } 
@@ -555,13 +570,13 @@ let max_value_per_compute_node t =
   let create_key block =
       Printf.sprintf "%s %10.10d" 
        (Compute_node.to_string block.Block.compute_node)
-       (Pid.to_int block.Block.pid) 
+       (block.Block.pid) 
   in
-  List.iter t.data ~f:(fun block ->
+  List.iter (fun block ->
     let key = create_key block
     in
     let open Block in
-    Hashtbl.change table key (function 
+    hashtbl_change table key (function 
     | Some current ->
         let vc = Sample.to_float current.value
         and vb = Sample.to_float block.value
@@ -572,14 +587,14 @@ let max_value_per_compute_node t =
           Some block
     | None -> Some block
       )
-  );
+  ) t.data ;
   { property = t.property ;
-    data = Hashtbl.to_alist table
-    |>  List.sort ~cmp:(fun x y ->
+    data = hashtbl_to_alist table
+    |>  List.sort (fun x y ->
         if (x>y) then 1
         else if (x<y) then -1
         else 0)
-    |>  List.map ~f:(fun (x,y) -> y)
+    |>  List.map (fun (x,y) -> y)
   }
 
 
@@ -653,12 +668,12 @@ let compress_files () =
   in
   let files = 
     Sys.ls_dir dir_name
-    |> List.filter ~f:(fun x -> 
+    |> List.filter (fun x -> 
          match String.substr_index ~pattern:"locked" x with
          | Some x -> false
          | None -> true
        )
-    |> List.map ~f:(fun x -> dir_name^x)
+    |> List.map (fun x -> dir_name^x)
   in
 
   let out_channel_dir = 
@@ -670,7 +685,7 @@ let compress_files () =
       Lazy.force Qmcchem_config.hostname 
     and suffix =
      Unix.getpid ()
-     |> Pid.to_string 
+     |> string_of_int 
     in
     String.concat [ hostname ; "." ; suffix ]
   in
@@ -679,7 +694,7 @@ let compress_files () =
     Out_channel.create (out_channel_dir ^ out_channel_name)
   in
 
-  List.iter properties ~f:(fun p ->
+  List.iter (fun p ->
     let l = 
       match p with
         | Property.Cpu 
@@ -693,14 +708,14 @@ let compress_files () =
           of_raw_data ~locked:false ~range:(0.,100.) p
             |> merge_per_compute_node_and_block_id
     in
-    List.iter l.data ~f:(fun x ->
+    List.iter (fun x ->
       Out_channel.output_string block_channel (Block.to_string x);
       Out_channel.output_char   block_channel '\n';
-    );
-  ); 
+    ) l.data 
+  ) properties ; 
   Out_channel.close block_channel;
 
-  List.iter files ~f:Unix.remove ;
+  List.iter Unix.remove files ;
   Unix.rename ~src:(out_channel_dir^out_channel_name)  ~dst:(dir_name^out_channel_name);
   Unix.rmdir  out_channel_dir
 
@@ -716,20 +731,20 @@ let autocovariance { property ; data } =
     with { property ; data } -> Array.of_list data
   in
   let x_t = 
-     Array.map ~f:(fun x -> (Sample.to_float x.Block.value) -. ave) data
+     Array.map (fun x -> (Sample.to_float x.Block.value) -. ave) data
   in
   let f i = 
     let denom = 
       if (i > 1) then (float_of_int i) else 1.
     in
     let r = 
-      Array.sub ~pos:0 ~len:i x_t
-      |> Array.fold_left ~init:0. ~f:(fun accu x ->
-        accu +. x *. x_t.(i)) 
+      Array.sub 0 i x_t
+      |> Array.fold_left (fun accu x ->
+        accu +. x *. x_t.(i)) 0. 
     in
     r /. denom
   in
-  Array.init ~f (Array.length data)
+  Array.init (Array.length data) f
   |> Array.to_list