10
1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-11-18 12:03:39 +01:00
qmcchem/ocaml/Qmcchem_edit.ml
2016-05-03 09:01:05 +02:00

324 lines
10 KiB
OCaml

open Core.Std
let file_header filename = Printf.sprintf
"
+----------------------------------------------------------------+
| QMC=Chem |
+----------------------------------------------------------------+
Editing file `%s`
" filename
let make_header s =
let l = String.length s in
"\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n"
type field =
| Block_time
| Walk_num
| Walk_num_tot
| Stop_time
| Fitcusp_factor
| Method
| Sampling
| Ref_energy
| Trial_wf_energy
| CI_threshold
| Time_step
| SRMC_projection_time
| Jastrow_type
| Properties
let get field =
let option_to_string read to_string doc =
let value =
read () |> to_string
in
Printf.sprintf "%s ::\n\n %s\n\n" doc value
in
let option_to_string_prop read to_string doc =
let value =
read () |> to_string
in
Printf.sprintf "%s :\n\n%s\n\n" doc value
in
let open Input in
match field with
| Block_time ->
option_to_string Block_time.read Block_time.to_string Block_time.doc
| Walk_num ->
option_to_string Walk_num.read Walk_num.to_string Walk_num.doc
| Walk_num_tot ->
option_to_string Walk_num_tot.read Walk_num_tot.to_string Walk_num_tot.doc
| Stop_time ->
option_to_string Stop_time.read Stop_time.to_string Stop_time.doc
| Fitcusp_factor ->
option_to_string Fitcusp_factor.read Fitcusp_factor.to_string Fitcusp_factor.doc
| Method ->
option_to_string Method.read Method.to_string Method.doc
| Sampling ->
option_to_string Sampling.read Sampling.to_string Sampling.doc
| Ref_energy ->
option_to_string Ref_energy.read Ref_energy.to_string Ref_energy.doc
| Trial_wf_energy ->
option_to_string Trial_wf_energy.read Trial_wf_energy.to_string Trial_wf_energy.doc
| CI_threshold ->
option_to_string CI_threshold.read CI_threshold.to_string CI_threshold.doc
| Time_step ->
option_to_string Time_step.read Time_step.to_string Time_step.doc
| SRMC_projection_time ->
option_to_string SRMC_projection_time.read SRMC_projection_time.to_string SRMC_projection_time.doc
| Jastrow_type ->
option_to_string Jastrow_type.read Jastrow_type.to_string Jastrow_type.doc
| Properties ->
option_to_string_prop Properties.read Properties.to_string Properties.doc
let create_temp_file ?temp_filename ezfio_filename fields =
let filename =
match temp_filename with
| None -> Filename.temp_file "qmcchem_edit_" ".rst"
| Some name -> name
in
Out_channel.with_file filename ~f:(fun out_channel ->
(file_header ezfio_filename) :: (List.map ~f:get fields)
|> String.concat ~sep:"\n"
|> Out_channel.output_string out_channel
)
; filename
(** Write the input file corresponding to the MD5 key *)
let write_input_in_ezfio ezfio_filename fields =
let dirname =
Lazy.force Md5.input_directory
in
let temp_filename =
Md5.hash ()
|> Filename.concat dirname
in
let input_filename =
create_temp_file ~temp_filename ezfio_filename fields
in
assert (Sys.file_exists_exn input_filename)
(** Run the edit command *)
let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
let interactive = ref (
if c then
false
else
true
)
in
(* Open EZFIO *)
Qputils.set_ezfio_filename ezfio_filename;
let handle_option (type_conv, write) x =
let () =
match x with
| Some x ->
begin
type_conv x |> write;
interactive := false;
end
| None -> ()
in ();
in
handle_option Input.Ref_energy.(of_float , write) e;
handle_option Input.Trial_wf_energy.(of_float , write) et;
handle_option Input.Jastrow_type.(of_string, write) j;
handle_option Input.Block_time.(of_int , write) l;
handle_option Input.Method.(of_string, write) m;
handle_option Input.Stop_time.(of_int , write) t;
handle_option Input.Sampling.(of_string, write) s;
handle_option Input.Fitcusp_factor.(of_float , write) f;
handle_option Input.Time_step.(of_float , write) ts;
handle_option Input.Walk_num.(of_int , write) w;
handle_option Input.Walk_num_tot.(of_int , write) wt;
handle_option Input.CI_threshold.(of_float , write) n;
handle_option Input.SRMC_projection_time.(of_float , write) p;
let fields =
[
Stop_time ;
Block_time ;
Method ;
Sampling ;
Time_step ;
SRMC_projection_time ;
Ref_energy ;
Trial_wf_energy ;
Walk_num ;
Walk_num_tot ;
Fitcusp_factor ;
CI_threshold ;
Jastrow_type ;
Properties ;
]
in
if (!interactive) then
begin
let temp_filename =
create_temp_file ezfio_filename fields
in
let () =
match input with
| Some filename ->
begin
if (not !interactive) then
failwith "Input file not allowed with command line arguments"
else
begin
Printf.sprintf "cp %s %s" filename temp_filename
|> Sys.command_exn ;
end
end
| None ->
begin
(* Open the temp file with external editor *)
let editor =
match Sys.getenv "EDITOR" with
| Some editor -> editor
| None -> "vi"
in
Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename
|> Sys.command_exn
end
in
(* Re-read the temp file *)
let re_data =
Str.regexp " .+ *$"
and re_prop =
Str.regexp "([ xX]) .*$"
and raw_data =
In_channel.with_file temp_filename ~f:In_channel.input_lines
in
let data =
( List.filter raw_data ~f:(fun x -> Str.string_match re_data x 0)
|> List.map ~f:String.strip ) @
[
List.filter raw_data ~f:(fun x -> Str.string_match re_prop x 0)
|> List.map ~f:String.strip
|> String.concat ~sep:"\n" ]
in
let open Input in
List.iter2_exn data fields ~f:(fun s f ->
try
begin
match f with
| Stop_time -> Stop_time.(of_string s |> write)
| Fitcusp_factor -> Fitcusp_factor.(of_string s |> write)
| Block_time -> Block_time.(of_string s |> write)
| Method -> Method.(of_string s |> write)
| Ref_energy -> Ref_energy.(of_string s |> write)
| Sampling -> Sampling.(of_string s |> write)
| Time_step -> Time_step.(of_string s |> write)
| SRMC_projection_time -> SRMC_projection_time.(of_string s |> write)
| Walk_num -> Walk_num.(of_string s |> write)
| Walk_num_tot -> Walk_num_tot.(of_string s |> write)
| CI_threshold -> CI_threshold.(of_string s |> write)
| Jastrow_type -> Jastrow_type.(of_string s |> write)
| Trial_wf_energy -> Trial_wf_energy.(of_string s |> write)
| Properties -> Properties.(of_string s |> write)
end
with
| Failure msg -> Printf.eprintf "%s\n" msg
);
(* Remove temp_file *)
Sys.remove temp_filename;
end
;
if c then
begin
let dirname =
Filename.concat (Filename.concat ezfio_filename "blocks") (Md5.hash ())
in
let rec clean_dir y =
match Sys.is_directory y with
| `Yes ->
Sys.ls_dir y
|> List.map ~f:(Filename.concat y)
|> List.iter ~f:(function x ->
match ( Sys.is_directory x, Sys.is_file x ) with
| (`Yes, _) -> clean_dir x
| (_, `Yes) -> Sys.remove x
| (_,_) -> ()
);
Unix.rmdir y
| `Unknown
| `No -> ()
in clean_dir dirname;
Printf.printf "Blocks cleared\n"
end
;
Input.validate ();
Md5.reset_hash ();
write_input_in_ezfio ezfio_filename fields
let spec =
let open Command.Spec in
empty
+> flag "c" no_arg
~doc:(" Clear blocks")
+> flag "f" (optional float)
~doc:("float "^Input.Fitcusp_factor.doc)
+> flag "t" (optional int)
~doc:("seconds "^Input.Stop_time.doc)
+> flag "l" (optional int)
~doc:("seconds "^Input.Block_time.doc)
+> flag "m" (optional string)
~doc:("method "^Input.Method.doc)
+> flag "e" (optional float)
~doc:("energy "^Input.Ref_energy.doc)
+> flag "et" (optional float)
~doc:("energy "^Input.Trial_wf_energy.doc)
+> flag "s" (optional string)
~doc:("sampling "^Input.Sampling.doc)
+> flag "ts" (optional float)
~doc:("time_step "^Input.Time_step.doc)
+> flag "w" (optional int)
~doc:("walk_num "^Input.Walk_num.doc)
+> flag "wt" (optional int)
~doc:("walk_num_tot "^Input.Walk_num_tot.doc)
+> flag "n" (optional float)
~doc:("norm "^Input.CI_threshold.doc)
+> flag "j" (optional string)
~doc:("jastrow_type "^Input.Jastrow_type.doc)
+> flag "p" (optional float)
~doc:("projection_time "^Input.SRMC_projection_time.doc)
+> anon ("ezfio_file" %: string)
+> anon (maybe ("input" %: string))
;;
let command =
Command.basic
~summary: "Edit input data"
~readme:(fun () ->
"
Edit input data
")
spec
(fun c f t l m e et s ts w wt n j p ezfio_file input () ->
run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file )