Modern OCaml

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
 )

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 =

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

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

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 = 

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

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

ocaml/Qmcchem_result.ml

@@ -3,7 +3,8 @@ open Qptypes
 
 (** Display a table that can be plotted by gnuplot *)
 let display_table ~range property =
-  let p = Property.of_string property
+  let p =
+    Property.of_string property
     |> Random_variable.of_raw_data ~range
   in
   let  conv = Random_variable.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

ocaml/Qmcchem_run.ml

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

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

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 merge ~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 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_string block.Block.block_id)
-   ~create_key:(fun block -> Block_id.to_int 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
+    { p with 
-  ~update_value
+      data = List.map ~f:(fun b -> { b with 
-  ~hashable:String.hashable
+        Block.value = Sample.of_float (update_value (Sample.to_float b.Block.value) ) }
-  ~create_key:(fun block ->
+      ) p.data }
-      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
 
 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"