diff --git a/ocaml/Random_variable.ml b/ocaml/Random_variable.ml index 09e816a..1d35097 100644 --- a/ocaml/Random_variable.ml +++ b/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 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 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