From 507c83b87b7bb12bc1ada63b67d0995422658ee0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 14 Mar 2018 17:02:52 +0100 Subject: [PATCH] Modern OCaml --- ocaml/Block.ml | 4 +-- ocaml/Launcher.ml | 2 +- ocaml/Qmcchem_debug.ml | 2 +- ocaml/Qmcchem_edit.ml | 10 +++--- ocaml/Qmcchem_forwarder.ml | 2 +- ocaml/Qmcchem_info.ml | 2 +- ocaml/Qmcchem_md5.ml | 12 +++---- ocaml/Qmcchem_result.ml | 16 +++------ ocaml/Qmcchem_run.ml | 2 +- ocaml/Qmcchem_stop.ml | 2 +- ocaml/Random_variable.ml | 74 ++++++++++++++++++++++++-------------- 11 files changed, 71 insertions(+), 57 deletions(-) diff --git a/ocaml/Block.ml b/ocaml/Block.ml index a26c1f8..afb181c 100644 --- a/ocaml/Block.ml +++ b/ocaml/Block.ml @@ -68,7 +68,7 @@ let dir_name = lazy( Lazy.force Qputils.ezfio_filename in let md5 = - Md5.hash () + QmcMd5.hash () in List.fold_right ~init:"" ~f:Filename.concat [ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ] @@ -142,7 +142,7 @@ let raw_data ?(locked=true) () = let properties = lazy ( - let set = Set.empty ~comparator:Comparator.Poly.comparator in + let set = Set.Poly.empty in List.fold (raw_data ()) ~init:set ~f:(fun s x -> Set.add s x.property) |> Set.to_list ) diff --git a/ocaml/Launcher.ml b/ocaml/Launcher.ml index 7b4066d..2c03b70 100644 --- a/ocaml/Launcher.ml +++ b/ocaml/Launcher.ml @@ -40,7 +40,7 @@ let create_nodefile () = in let h = - Hashtbl.create ~hashable:String.hashable ~size:1000 () + String.Table.create ~size:1000 () in let in_channel = diff --git a/ocaml/Qmcchem_debug.ml b/ocaml/Qmcchem_debug.ml index 887d90d..e04f5f2 100644 --- a/ocaml/Qmcchem_debug.ml +++ b/ocaml/Qmcchem_debug.ml @@ -74,7 +74,7 @@ let spec = let command = - Command.basic + Command.basic_spec ~summary: "Debug ZeroMQ communications" ~readme:(fun () -> "Gets debug information from the ZMQ debug sockets.") spec diff --git a/ocaml/Qmcchem_edit.ml b/ocaml/Qmcchem_edit.ml index 8a757f3..d3f9832 100644 --- a/ocaml/Qmcchem_edit.ml +++ b/ocaml/Qmcchem_edit.ml @@ -95,10 +95,10 @@ let create_temp_file ?temp_filename ezfio_filename fields = (** Write the input file corresponding to the MD5 key *) let write_input_in_ezfio ezfio_filename fields = let dirname = - Lazy.force Md5.input_directory + Lazy.force QmcMd5.input_directory in let temp_filename = - Md5.hash () + QmcMd5.hash () |> Filename.concat dirname in let input_filename = @@ -246,7 +246,7 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename = if c then begin let dirname = - Filename.concat (Filename.concat ezfio_filename "blocks") (Md5.hash ()) + Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.hash ()) in let rec clean_dir y = match Sys.is_directory y with @@ -268,7 +268,7 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename = ; Input.validate (); - Md5.reset_hash (); + QmcMd5.reset_hash (); write_input_in_ezfio ezfio_filename fields @@ -308,7 +308,7 @@ let spec = ;; let command = - Command.basic + Command.basic_spec ~summary: "Edit input data" ~readme:(fun () -> " diff --git a/ocaml/Qmcchem_forwarder.ml b/ocaml/Qmcchem_forwarder.ml index b5807d3..7e1dd5c 100644 --- a/ocaml/Qmcchem_forwarder.ml +++ b/ocaml/Qmcchem_forwarder.ml @@ -20,7 +20,7 @@ let bind_socket ~socket_type ~socket ~address = let run ezfio_filename dataserver = let dataserver_address, dataserver_port = - Substring.create ~pos:6 dataserver + Substring.create ~pos:6 (Bytes.of_string dataserver) |> Substring.to_string |> String.lsplit2_exn ~on:':' and qmc = diff --git a/ocaml/Qmcchem_info.ml b/ocaml/Qmcchem_info.ml index a293791..6360c4e 100644 --- a/ocaml/Qmcchem_info.ml +++ b/ocaml/Qmcchem_info.ml @@ -20,7 +20,7 @@ let spec = +> anon ("ezfio_file" %: string) let command = - Command.basic + Command.basic_spec ~summary: "Display info on an EZFIO database" ~readme:(fun () -> " diff --git a/ocaml/Qmcchem_md5.ml b/ocaml/Qmcchem_md5.ml index 2f728cd..4287af9 100644 --- a/ocaml/Qmcchem_md5.ml +++ b/ocaml/Qmcchem_md5.ml @@ -5,13 +5,13 @@ let run ?c ?d ~l ~update ezfio_filename = Qputils.set_ezfio_filename ezfio_filename; let input_directory = - Lazy.force Md5.input_directory + Lazy.force QmcMd5.input_directory in let handle_options () = let current_md5 = - Md5.hash () + QmcMd5.hash () in let filename_of_key key = @@ -30,9 +30,9 @@ let run ?c ?d ~l ~update ezfio_filename = Printf.printf "Updating\n%!" ; let update_one old_key = Qmcchem_edit.run ~c:false ~input:(filename_of_key old_key) ezfio_filename; - Md5.reset_hash (); + QmcMd5.reset_hash (); let new_key = - Md5.hash () + QmcMd5.hash () in if (old_key <> new_key) then @@ -118,7 +118,7 @@ let run ?c ?d ~l ~update ezfio_filename = match (c,d,l,update) with | (None,None,false,false) -> - Printf.printf "Current key :\n%s\n" (Md5.hash ()) + Printf.printf "Current key :\n%s\n" (QmcMd5.hash ()) | _ -> handle_options () @@ -138,7 +138,7 @@ let spec = let command = - Command.basic + Command.basic_spec ~summary: "Manipulate input MD5 keys" ~readme:(fun () -> " diff --git a/ocaml/Qmcchem_result.ml b/ocaml/Qmcchem_result.ml index de93ec5..926af1a 100644 --- a/ocaml/Qmcchem_result.ml +++ b/ocaml/Qmcchem_result.ml @@ -3,8 +3,9 @@ open Qptypes (** Display a table that can be plotted by gnuplot *) let display_table ~range property = - let p = Property.of_string property - |> Random_variable.of_raw_data ~range + let p = + Property.of_string property + |> Random_variable.of_raw_data ~range in let conv = Random_variable.convergence p and rconv = Random_variable.rev_convergence p @@ -145,15 +146,6 @@ let display_summary ~range = in List.iter properties ~f:print_property ; -(* - let open Random_variable in - let p = (of_raw_data ~range Property.E_loc) - +! (of_raw_data ~range Property.E_loc_zv) - in - Printf.printf "%20s : %s\n" - ("E_loc_zv(+)") - (Random_variable.to_string p); - *) let cpu = Random_variable.of_raw_data ~range Property.Cpu @@ -244,7 +236,7 @@ let spec = ;; let command = - Command.basic + Command.basic_spec ~summary: "Displays the results computed in an EZFIO directory." ~readme:(fun () -> "Displays the results computed in an EZFIO directory.") spec diff --git a/ocaml/Qmcchem_run.ml b/ocaml/Qmcchem_run.ml index 368695c..fd22d38 100644 --- a/ocaml/Qmcchem_run.ml +++ b/ocaml/Qmcchem_run.ml @@ -204,7 +204,7 @@ let spec = let command = - Command.basic + Command.basic_spec ~summary: "Run a calculation" ~readme:(fun () -> " diff --git a/ocaml/Qmcchem_stop.ml b/ocaml/Qmcchem_stop.ml index 2607eac..595084e 100644 --- a/ocaml/Qmcchem_stop.ml +++ b/ocaml/Qmcchem_stop.ml @@ -12,7 +12,7 @@ let spec = +> anon ("ezfio_file" %: string) let command = - Command.basic + Command.basic_spec ~summary: "Stop a running calculation" ~readme:(fun () -> " diff --git a/ocaml/Random_variable.ml b/ocaml/Random_variable.ml index b8e8a26..549838d 100644 --- a/ocaml/Random_variable.ml +++ b/ocaml/Random_variable.ml @@ -344,10 +344,10 @@ let max_block = (** Create a hash table for merging *) -let create_hash ~hashable ~create_key ?(update_block_id=(fun x->x)) +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 = Hashtbl.create ~hashable:hashable () + let table = String.Table.create () in List.iter t.data ~f:(fun block -> let key = create_key block @@ -405,8 +405,8 @@ let create_hash ~hashable ~create_key ?(update_block_id=(fun x->x)) (** Genergic merge function *) -let merge ~hashable ~create_key ?update_block_id ?update_value ?update_weight t = - let table = create_hash ~hashable ~create_key ?update_block_id ?update_value ?update_weight t +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 @@ -422,14 +422,12 @@ let merge ~hashable ~create_key ?update_block_id ?update_value ?update_weight t (** Merge per block id *) let merge_per_block_id = merge - ~hashable:Int.hashable - ~create_key:(fun block -> Block_id.to_int block.Block.block_id) + ~create_key:(fun block -> Block_id.to_string block.Block.block_id) (** Merge per compute_node *) let merge_per_compute_node = merge - ~hashable:String.hashable ~create_key:(fun block -> Printf.sprintf "%s" (Compute_node.to_string block.Block.compute_node) ) @@ -439,7 +437,6 @@ let merge_per_compute_node = (** Merge per Compute_node and PID *) let merge_per_compute_node_and_pid = merge - ~hashable:String.hashable ~create_key:(fun block -> Printf.sprintf "%s %10.10d" (Compute_node.to_string block.Block.compute_node) @@ -450,44 +447,70 @@ let merge_per_compute_node_and_pid = (** Merge per Compute_node and BlockId *) let merge_per_compute_node_and_block_id = merge - ~hashable:String.hashable ~create_key:(fun block -> Printf.sprintf "%s %10.10d" (Compute_node.to_string block.Block.compute_node) (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 -> + begin + let avcu0 = ref 0. + and ansum = ref w + and avsum = ref x + and avbl = ref (x /. w) + and avsq = ref 0. + and n = ref 1. + 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. + ); + let arg = + Float.abs (!avsq /.(!ansum *. (!n -. 1.))) + in + let error = + sqrt arg + in + (Average.of_float !avcu, Some (Error.of_float error) ) + end + (** Create float, variable operators *) let one_variable_operator ~update_value p f = - merge - ~update_value - ~hashable:String.hashable - ~create_key:(fun block -> - 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) ) - ~update_weight:(fun wc wb -> wc ) - p + { p with + data = List.map ~f:(fun b -> { b with + Block.value = Sample.of_float (update_value (Sample.to_float b.Block.value) ) } + ) p.data } let ( +@ ) p f = one_variable_operator p f - ~update_value: (fun wc vc wb vb sw -> f +. (wc *. vc +. wb *. vb) /. sw) + ~update_value: (fun x -> x +. f ) let ( *@ ) p f = one_variable_operator p f - ~update_value: (fun wc vc wb vb sw -> f *. (wc *. vc +. wb *. vb) /. sw) + ~update_value: (fun x -> x *. f ) let ( -@ ) p f = one_variable_operator p f - ~update_value: (fun wc vc wb vb sw -> (wc *. vc +. wb *. vb) /. sw -. f) + ~update_value: (fun x -> x -. f ) let ( /@ ) p f = one_variable_operator p f - ~update_value: (fun wc vc wb vb sw -> (wc *. vc +. wb *. vb) /. sw /. f) + ~update_value: (fun x -> x /. f ) (** Create two variable operators *) let two_variable_operator ~update_value p1 p2 = merge ~update_value - ~hashable:String.hashable ~create_key:(fun block -> Printf.sprintf "%s %10.10d %10.10d" (Compute_node.to_string block.Block.compute_node) @@ -515,7 +538,6 @@ let ( /! ) = two_variable_operator (** Merge two consecutive blocks *) let compress = merge - ~hashable:String.hashable ~create_key:(fun block -> Printf.sprintf "%s %10.10d" (Compute_node.to_string block.Block.compute_node) (((Block_id.to_int block.Block.block_id)+1)/2)) @@ -528,7 +550,7 @@ let compress = (** Last value on each compute node (for wall_time) *) let max_value_per_compute_node t = - let table = Hashtbl.create ~hashable:String.hashable () + let table = String.Table.create () in let create_key block = Printf.sprintf "%s %10.10d"