LCPQ
/
qmcchem
mirror of https://gitlab.com/scemama/qmcchem.git
10
1
Fork 1
Code Releases Activity

Modern OCaml

This commit is contained in:
Anthony Scemama 2018-03-14 17:02:52 +01:00
parent 06e68216fb
commit 507c83b87b
11 changed files with 71 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ocaml/Block.ml
View File

@ -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
)

2
ocaml/Launcher.ml
View File

@ -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 =

2
ocaml/Qmcchem_debug.ml
View File

@ -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

10
ocaml/Qmcchem_edit.ml
View File

@ -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 () ->
"

2
ocaml/Qmcchem_forwarder.ml
View File

@ -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 =

2
ocaml/Qmcchem_info.ml
View File

@ -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 () ->
"

12
ocaml/Qmcchem_md5.ml
View File

@ -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 () ->
"

16
ocaml/Qmcchem_result.ml
View File

@ -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

2
ocaml/Qmcchem_run.ml
View File

@ -204,7 +204,7 @@ let spec =
let command =
Command.basic
Command.basic_spec
~summary: "Run a calculation"
~readme:(fun () ->
"

2
ocaml/Qmcchem_stop.ml
View File

@ -12,7 +12,7 @@ let spec =
+> anon ("ezfio_file" %: string)
let command =
Command.basic
Command.basic_spec
~summary: "Stop a running calculation"
~readme:(fun () ->
"

74
ocaml/Random_variable.ml
View File

@ -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"