mirror of
https://github.com/LCPQ/quantum_package
synced 2024-11-19 04:22:36 +01:00
Merge branch 'master' of github.com:scemama/quantum_package
This commit is contained in:
commit
996f46d630
@ -1,4 +1,3 @@
|
||||
open Core.Std
|
||||
|
||||
module Tcp : sig
|
||||
type t
|
||||
@ -8,7 +7,7 @@ module Tcp : sig
|
||||
end = struct
|
||||
type t = string
|
||||
let of_string x =
|
||||
if not (String.is_prefix ~prefix:"tcp://" x) then
|
||||
if not (String_ext.is_prefix ~prefix:"tcp://" x) then
|
||||
invalid_arg "Address Invalid"
|
||||
;
|
||||
x
|
||||
@ -26,7 +25,7 @@ module Ipc : sig
|
||||
end = struct
|
||||
type t = string
|
||||
let of_string x =
|
||||
assert (String.is_prefix ~prefix:"ipc://" x);
|
||||
assert (String_ext.is_prefix ~prefix:"ipc://" x);
|
||||
x
|
||||
let create name =
|
||||
Printf.sprintf "ipc://%s" name
|
||||
@ -41,7 +40,7 @@ module Inproc : sig
|
||||
end = struct
|
||||
type t = string
|
||||
let of_string x =
|
||||
assert (String.is_prefix ~prefix:"inproc://" x);
|
||||
assert (String_ext.is_prefix ~prefix:"inproc://" x);
|
||||
x
|
||||
let create name =
|
||||
Printf.sprintf "inproc://%s" name
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
exception AtomError of string
|
||||
|
||||
@ -6,7 +6,7 @@ type t =
|
||||
{ element : Element.t ;
|
||||
charge : Charge.t ;
|
||||
coord : Point3d.t ;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
(** Read xyz coordinates of the atom *)
|
||||
let of_string ~units s =
|
||||
|
@ -1,7 +1,7 @@
|
||||
open Core.Std
|
||||
open Sexplib.Std
|
||||
open Qptypes
|
||||
|
||||
type t = (Gto.t * Nucl_number.t) list with sexp
|
||||
type t = (Gto.t * Nucl_number.t) list [@@deriving sexp]
|
||||
|
||||
(** Read all the basis functions of an element *)
|
||||
let read in_channel at_number =
|
||||
@ -16,7 +16,7 @@ let read in_channel at_number =
|
||||
|
||||
(** Find an element in the basis set file *)
|
||||
let find in_channel element =
|
||||
In_channel.seek in_channel 0L;
|
||||
seek_in in_channel 0;
|
||||
let element_read = ref Element.X in
|
||||
while !element_read <> element
|
||||
do
|
||||
@ -56,13 +56,13 @@ let to_string_general ~fmt ~atom_sep ?ele_array b =
|
||||
do_work ((Gto.to_string ~fmt g)::accu) n tail
|
||||
in
|
||||
do_work [new_nucleus 1] 1 b
|
||||
|> String.concat ~sep:"\n"
|
||||
|> String.concat "\n"
|
||||
|
||||
let to_string_gamess ?ele_array =
|
||||
to_string_general ?ele_array ~fmt:Gto.Gamess ~atom_sep:""
|
||||
|
||||
let to_string_gaussian ?ele_array b =
|
||||
String.concat ~sep:"\n"
|
||||
String.concat "\n"
|
||||
[ to_string_general ?ele_array ~fmt:Gto.Gaussian ~atom_sep:"****" b ; "****" ]
|
||||
|
||||
let to_string ?(fmt=Gto.Gamess) =
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
(*
|
||||
Type for bits
|
||||
@ -11,7 +11,7 @@ Zero | One
|
||||
type t =
|
||||
| One
|
||||
| Zero
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
let to_string = function
|
||||
| Zero -> "0"
|
||||
|
@ -1,4 +1,4 @@
|
||||
type t = One | Zero with sexp
|
||||
type t = One | Zero [@@deriving sexp]
|
||||
|
||||
(** String conversions for printing *)
|
||||
val to_string : t -> string
|
||||
|
@ -1,5 +1,5 @@
|
||||
open Qptypes
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
(*
|
||||
Type for bits strings
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
type t = float with sexp
|
||||
type t = float [@@deriving sexp]
|
||||
|
||||
let of_float x = x
|
||||
let of_int i = Float.of_int i
|
||||
|
@ -1,4 +1,4 @@
|
||||
type t = float with sexp
|
||||
type t = float [@@deriving sexp]
|
||||
|
||||
(** Float conversion functions *)
|
||||
val to_float : t -> float
|
||||
|
@ -1,7 +1,7 @@
|
||||
open Core.Std;;
|
||||
open Qptypes;;
|
||||
open Qptypes
|
||||
open Sexplib.Std
|
||||
|
||||
type t = int64 array with sexp
|
||||
type t = int64 array [@@deriving sexp]
|
||||
|
||||
let to_int64_array (x:t) = (x:int64 array)
|
||||
|
||||
@ -9,8 +9,8 @@ let to_int64_array (x:t) = (x:int64 array)
|
||||
let to_alpha_beta x =
|
||||
let x = to_int64_array x in
|
||||
let n_int = (Array.length x)/2 in
|
||||
( Array.init n_int ~f:(fun i -> x.(i)) ,
|
||||
Array.init n_int ~f:(fun i -> x.(i+n_int)) )
|
||||
( Array.init n_int (fun i -> x.(i)) ,
|
||||
Array.init n_int (fun i -> x.(i+n_int)) )
|
||||
|
||||
|
||||
let to_bitlist_couple x =
|
||||
@ -28,12 +28,14 @@ let bitlist_to_string ~mo_tot_num x =
|
||||
let len =
|
||||
MO_number.to_int mo_tot_num
|
||||
in
|
||||
List.map x ~f:(function
|
||||
| Bit.Zero -> "-"
|
||||
| Bit.One -> "+"
|
||||
)
|
||||
|> String.concat
|
||||
|> String.sub ~pos:0 ~len
|
||||
let s =
|
||||
List.map (function
|
||||
| Bit.Zero -> "-"
|
||||
| Bit.One -> "+"
|
||||
) x
|
||||
|> String.concat ""
|
||||
in
|
||||
String.sub s 0 len
|
||||
|
||||
|
||||
|
||||
@ -77,6 +79,6 @@ let to_string ~mo_tot_num x =
|
||||
let (xa,xb) = to_bitlist_couple x in
|
||||
[ " " ; bitlist_to_string ~mo_tot_num xa ; "\n" ;
|
||||
" " ; bitlist_to_string ~mo_tot_num xb ]
|
||||
|> String.concat
|
||||
|> String.concat ""
|
||||
|
||||
|
||||
|
@ -5,7 +5,7 @@
|
||||
* where each int64 is a list of 64 MOs. When the bit is set
|
||||
* to 1, the MO is occupied.
|
||||
*)
|
||||
type t = int64 array with sexp
|
||||
type t = int64 array [@@deriving sexp]
|
||||
|
||||
(** Transform to an int64 array *)
|
||||
val to_int64_array : t -> int64 array
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qptypes
|
||||
|
||||
exception ElementError of string
|
||||
@ -11,7 +11,7 @@ type t =
|
||||
|K |Ca|Sc|Ti|V |Cr|Mn|Fe|Co|Ni|Cu|Zn|Ga|Ge|As|Se|Br|Kr
|
||||
|Rb|Sr|Y |Zr|Nb|Mo|Tc|Ru|Rh|Pd|Ag|Cd|In|Sn|Sb|Te|I |Xe
|
||||
|Pt
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
let of_string x =
|
||||
match (String.capitalize (String.lowercase x)) with
|
||||
|
@ -8,7 +8,7 @@ type t =
|
||||
|K |Ca|Sc|Ti|V |Cr|Mn|Fe|Co|Ni|Cu|Zn|Ga|Ge|As|Se|Br|Kr
|
||||
|Rb|Sr|Y |Zr|Nb|Mo|Tc|Ru|Rh|Pd|Ag|Cd|In|Sn|Sb|Te|I |Xe
|
||||
|Pt
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
(** String conversion functions *)
|
||||
val of_string : string -> t
|
||||
|
@ -1,14 +1,14 @@
|
||||
open Core.Std;;
|
||||
open Qptypes;;
|
||||
open Core
|
||||
open Qptypes
|
||||
|
||||
module Hole = struct
|
||||
type t = MO_class.t with sexp
|
||||
type t = MO_class.t [@@deriving sexp]
|
||||
let of_mo_class x = x
|
||||
let to_mo_class x = x
|
||||
end
|
||||
|
||||
module Particle = struct
|
||||
type t = MO_class.t with sexp
|
||||
type t = MO_class.t [@@deriving sexp]
|
||||
let of_mo_class x = x
|
||||
let to_mo_class x = x
|
||||
end
|
||||
@ -16,7 +16,7 @@ end
|
||||
type t =
|
||||
| Single of Hole.t*Particle.t
|
||||
| Double of Hole.t*Particle.t*Hole.t*Particle.t
|
||||
with sexp;;
|
||||
[@@deriving sexp]
|
||||
|
||||
let create_single ~hole ~particle =
|
||||
MO_class.(
|
||||
@ -29,7 +29,7 @@ let create_single ~hole ~particle =
|
||||
| ( _, Inactive _ ) -> failwith "Particles can not be in virtual MOs"
|
||||
| (h, p) -> Single ( (Hole.of_mo_class h), (Particle.of_mo_class p) )
|
||||
)
|
||||
;;
|
||||
|
||||
|
||||
let double_of_singles s1 s2 =
|
||||
let (h1,p1) = match s1 with
|
||||
@ -40,14 +40,14 @@ let double_of_singles s1 s2 =
|
||||
| _ -> assert false
|
||||
in
|
||||
Double (h1,p1,h2,p2)
|
||||
;;
|
||||
|
||||
|
||||
let create_double ~hole1 ~particle1 ~hole2 ~particle2 =
|
||||
let s1 = create_single ~hole:hole1 ~particle:particle1
|
||||
and s2 = create_single ~hole:hole2 ~particle:particle2
|
||||
in
|
||||
double_of_singles s1 s2
|
||||
;;
|
||||
|
||||
|
||||
let to_string = function
|
||||
| Single (h,p) ->
|
||||
@ -68,5 +68,5 @@ let to_string = function
|
||||
(MO_class.to_string (Particle.to_mo_class p2));
|
||||
"]"]
|
||||
|> String.concat ~sep:" "
|
||||
;;
|
||||
|
||||
|
||||
|
@ -18,7 +18,7 @@ module Particle :
|
||||
type t =
|
||||
| Single of Hole.t * Particle.t
|
||||
| Double of Hole.t * Particle.t * Hole.t * Particle.t
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
val create_single : hole:MO_class.t -> particle:MO_class.t -> t
|
||||
|
||||
|
@ -1,10 +1,10 @@
|
||||
open Qptypes
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
type t =
|
||||
{ sym : Symmetry.t ;
|
||||
expo : AO_expo.t ;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
let to_string p =
|
||||
let { sym = s ; expo = e } = p in
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
open Qptypes;;
|
||||
|
||||
|
||||
|
27
ocaml/Gto.ml
27
ocaml/Gto.ml
@ -1,5 +1,5 @@
|
||||
open Core.Std
|
||||
open Qptypes
|
||||
open Sexplib.Std
|
||||
|
||||
exception GTO_Read_Failure of string
|
||||
exception End_Of_Basis
|
||||
@ -11,11 +11,11 @@ type fmt =
|
||||
type t =
|
||||
{ sym : Symmetry.t ;
|
||||
lc : ((GaussianPrimitive.t * AO_coef.t) list)
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
|
||||
let of_prim_coef_list pc =
|
||||
let (p,c) = List.hd_exn pc in
|
||||
let (p,c) = List.hd pc in
|
||||
let sym = p.GaussianPrimitive.sym in
|
||||
let rec check = function
|
||||
| [] -> `OK
|
||||
@ -37,12 +37,12 @@ let of_prim_coef_list pc =
|
||||
let read_one in_channel =
|
||||
(* Fetch number of lines to read on first line *)
|
||||
let buffer = input_line in_channel in
|
||||
if ( (String.strip buffer) = "" ) then
|
||||
if ( (String_ext.strip buffer) = "" ) then
|
||||
raise End_Of_Basis;
|
||||
let sym_str = String.sub buffer 0 2 in
|
||||
let n_str = String.sub buffer 2 ((String.length buffer)-2) in
|
||||
let sym = Symmetry.of_string (String.strip sym_str) in
|
||||
let n = Int.of_string (String.strip n_str) in
|
||||
let sym = Symmetry.of_string (String_ext.strip sym_str) in
|
||||
let n = int_of_string (String_ext.strip n_str) in
|
||||
(* Read all the primitives *)
|
||||
let rec read_lines result = function
|
||||
| 0 -> result
|
||||
@ -50,18 +50,19 @@ let read_one in_channel =
|
||||
begin
|
||||
let line_buffer = input_line in_channel in
|
||||
let buffer = line_buffer
|
||||
|> String.split ~on:' '
|
||||
|> List.filter ~f:(fun x -> x <> "")
|
||||
|> String_ext.split ~on:' '
|
||||
|> List.filter (fun x -> x <> "")
|
||||
in
|
||||
match buffer with
|
||||
| [ j ; expo ; coef ] ->
|
||||
begin
|
||||
let coef = String.tr ~target:'D' ~replacement:'e' coef
|
||||
let coef =
|
||||
Str.global_replace (Str.regexp "D") "e" coef
|
||||
in
|
||||
let p =
|
||||
GaussianPrimitive.of_sym_expo sym
|
||||
(AO_expo.of_float (Float.of_string expo) )
|
||||
and c = AO_coef.of_float (Float.of_string coef) in
|
||||
(AO_expo.of_float (float_of_string expo) )
|
||||
and c = AO_coef.of_float (float_of_string coef) in
|
||||
read_lines ( (p,c)::result) (i-1)
|
||||
end
|
||||
| _ -> raise (GTO_Read_Failure line_buffer)
|
||||
@ -89,7 +90,7 @@ let to_string_gamess { sym = sym ; lc = lc } =
|
||||
do_work (result::accu) (i+1) tail
|
||||
in
|
||||
(do_work [result] 1 lc)
|
||||
|> String.concat ~sep:"\n"
|
||||
|> String.concat "\n"
|
||||
|
||||
|
||||
(** Write the GTO in Gaussian format *)
|
||||
@ -109,7 +110,7 @@ let to_string_gaussian { sym = sym ; lc = lc } =
|
||||
do_work (result::accu) (i+1) tail
|
||||
in
|
||||
(do_work [result] 1 lc)
|
||||
|> String.concat ~sep:"\n"
|
||||
|> String.concat "\n"
|
||||
|
||||
|
||||
(** Transform the gto to a string *)
|
||||
|
@ -7,7 +7,7 @@ type fmt =
|
||||
type t =
|
||||
{ sym : Symmetry.t ;
|
||||
lc : (GaussianPrimitive.t * Qptypes.AO_coef.t) list;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
(** Create from a list of GaussianPrimitive.t * Qptypes.AO_coef.t *)
|
||||
val of_prim_coef_list :
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qputils;;
|
||||
open Qptypes;;
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
include Input_ao_basis;;
|
||||
include Input_bitmasks;;
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qptypes;;
|
||||
open Qputils;;
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
module Ao_basis : sig
|
||||
type t =
|
||||
@ -13,7 +13,7 @@ module Ao_basis : sig
|
||||
ao_coef : AO_coef.t array;
|
||||
ao_expo : AO_expo.t array;
|
||||
ao_cartesian : bool;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
val read : unit -> t option
|
||||
val to_string : t -> string
|
||||
@ -32,7 +32,7 @@ end = struct
|
||||
ao_coef : AO_coef.t array;
|
||||
ao_expo : AO_expo.t array;
|
||||
ao_cartesian : bool;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "ao_basis";;
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qptypes;;
|
||||
open Qputils;;
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
module Bielec_integrals : sig
|
||||
type t =
|
||||
@ -11,7 +11,7 @@ module Bielec_integrals : sig
|
||||
threshold_ao : Threshold.t;
|
||||
threshold_mo : Threshold.t;
|
||||
direct : bool;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
val read : unit -> t option
|
||||
val write : t -> unit
|
||||
@ -27,7 +27,7 @@ end = struct
|
||||
threshold_ao : Threshold.t;
|
||||
threshold_mo : Threshold.t;
|
||||
direct : bool;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "bielec_integrals";;
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qptypes;;
|
||||
open Qputils;;
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
module Bitmasks : sig
|
||||
type t =
|
||||
@ -10,7 +10,7 @@ module Bitmasks : sig
|
||||
generators : int64 array;
|
||||
n_mask_cas : Bitmask_number.t;
|
||||
cas : int64 array;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
val read : unit -> t option
|
||||
val to_string : t -> string
|
||||
@ -22,7 +22,7 @@ end = struct
|
||||
generators : int64 array;
|
||||
n_mask_cas : Bitmask_number.t;
|
||||
cas : int64 array;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "bitmasks";;
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qptypes;;
|
||||
open Qputils;;
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
module Determinants_by_hand : sig
|
||||
type t =
|
||||
@ -11,7 +11,7 @@ module Determinants_by_hand : sig
|
||||
expected_s2 : Positive_float.t;
|
||||
psi_coef : Det_coef.t array;
|
||||
psi_det : Determinant.t array;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
val read : unit -> t
|
||||
val read_maybe : unit -> t option
|
||||
val write : t -> unit
|
||||
@ -30,7 +30,7 @@ end = struct
|
||||
expected_s2 : Positive_float.t;
|
||||
psi_coef : Det_coef.t array;
|
||||
psi_det : Determinant.t array;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "determinants";;
|
||||
|
@ -1,12 +1,12 @@
|
||||
open Qptypes;;
|
||||
open Qputils;;
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
module Electrons : sig
|
||||
type t =
|
||||
{ elec_alpha_num : Elec_alpha_number.t;
|
||||
elec_beta_num : Elec_beta_number.t;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
val read : unit -> t option
|
||||
val write : t -> unit
|
||||
@ -18,7 +18,7 @@ end = struct
|
||||
type t =
|
||||
{ elec_alpha_num : Elec_alpha_number.t;
|
||||
elec_beta_num : Elec_beta_number.t;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "electrons";;
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qptypes
|
||||
open Qputils
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
type t_mo =
|
||||
{ mo_tot_num : MO_number.t ;
|
||||
@ -9,7 +9,7 @@ type t_mo =
|
||||
mo_occ : MO_occ.t array;
|
||||
mo_coef : (MO_coef.t array) array;
|
||||
ao_md5 : MD5.t;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
module Mo_basis : sig
|
||||
type t = t_mo
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qptypes;;
|
||||
open Qputils;;
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
module Nuclei_by_hand : sig
|
||||
type t =
|
||||
@ -8,7 +8,7 @@ module Nuclei_by_hand : sig
|
||||
nucl_label : Element.t array;
|
||||
nucl_charge : Charge.t array;
|
||||
nucl_coord : Point3d.t array;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
val read : unit -> t option
|
||||
val write : t -> unit
|
||||
@ -22,7 +22,7 @@ end = struct
|
||||
nucl_label : Element.t array;
|
||||
nucl_charge : Charge.t array;
|
||||
nucl_coord : Point3d.t array;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "nuclei";;
|
||||
|
24
ocaml/Io_ext.ml
Normal file
24
ocaml/Io_ext.ml
Normal file
@ -0,0 +1,24 @@
|
||||
let input_lines filename =
|
||||
let in_channel =
|
||||
open_in filename
|
||||
in
|
||||
let rec aux accu =
|
||||
try
|
||||
let newline =
|
||||
input_line in_channel
|
||||
in
|
||||
aux (newline::accu)
|
||||
with End_of_file -> accu
|
||||
in
|
||||
let result =
|
||||
List.rev (aux [])
|
||||
in
|
||||
close_in in_channel;
|
||||
result
|
||||
|
||||
|
||||
|
||||
let read_all filename =
|
||||
input_lines filename
|
||||
|> String.concat "\n"
|
||||
|
@ -1,7 +1,7 @@
|
||||
open Core.Std;;
|
||||
open Qptypes;;
|
||||
open Qptypes
|
||||
open Sexplib.Std
|
||||
|
||||
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t ) list with sexp
|
||||
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t ) list [@@deriving sexp]
|
||||
|
||||
let of_basis b =
|
||||
let rec do_work accu = function
|
||||
@ -10,14 +10,14 @@ let of_basis b =
|
||||
begin
|
||||
let new_accu =
|
||||
Symmetry.Xyz.of_symmetry g.Gto.sym
|
||||
|> List.rev_map ~f:(fun x-> (x,g,n))
|
||||
|> List.rev_map (fun x-> (x,g,n))
|
||||
in
|
||||
do_work (new_accu@accu) tail
|
||||
end
|
||||
in
|
||||
do_work [] b
|
||||
|> List.rev
|
||||
;;
|
||||
|
||||
|
||||
let to_basis b =
|
||||
let rec do_work accu = function
|
||||
@ -25,7 +25,7 @@ let to_basis b =
|
||||
| (s,g,n)::tail ->
|
||||
let first_sym =
|
||||
Symmetry.Xyz.of_symmetry g.Gto.sym
|
||||
|> List.hd_exn
|
||||
|> List.hd
|
||||
in
|
||||
let new_accu =
|
||||
if ( s = first_sym ) then
|
||||
@ -36,19 +36,19 @@ let to_basis b =
|
||||
do_work new_accu tail
|
||||
in
|
||||
do_work [] b
|
||||
;;
|
||||
|
||||
|
||||
let to_string b =
|
||||
let middle = List.map ~f:(fun (x,y,z) ->
|
||||
"( "^((Int.to_string (Nucl_number.to_int z)))^", "^
|
||||
let middle = List.map (fun (x,y,z) ->
|
||||
"( "^((string_of_int (Nucl_number.to_int z)))^", "^
|
||||
(Symmetry.Xyz.to_string x)^", "^(Gto.to_string y)
|
||||
^" )"
|
||||
) b
|
||||
|> String.concat ~sep:",\n"
|
||||
|> String.concat ",\n"
|
||||
in "("^middle^")"
|
||||
;;
|
||||
|
||||
include To_md5;;
|
||||
|
||||
include To_md5
|
||||
let to_md5 = to_md5 sexp_of_t
|
||||
;;
|
||||
|
||||
|
||||
|
@ -5,7 +5,7 @@ open Qptypes;;
|
||||
* all the D orbitals are converted to xx, xy, xz, yy, yx
|
||||
* etc
|
||||
*)
|
||||
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t) list with sexp
|
||||
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t) list [@@deriving sexp]
|
||||
|
||||
(** Transform a basis to a long basis *)
|
||||
val of_basis :
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qptypes
|
||||
|
||||
type t =
|
||||
@ -7,7 +7,7 @@ type t =
|
||||
| Active of MO_number.t list
|
||||
| Virtual of MO_number.t list
|
||||
| Deleted of MO_number.t list
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
|
||||
let to_string x =
|
||||
|
@ -4,7 +4,7 @@ type t =
|
||||
| Active of Qptypes.MO_number.t list
|
||||
| Virtual of Qptypes.MO_number.t list
|
||||
| Deleted of Qptypes.MO_number.t list
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
|
||||
(** Create different excitation classes *)
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
type t =
|
||||
| Guess
|
||||
@ -7,7 +7,7 @@ type t =
|
||||
| Localized
|
||||
| Orthonormalized
|
||||
| None
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
;;
|
||||
|
||||
let to_string = function
|
||||
|
@ -5,7 +5,7 @@ type t =
|
||||
| Localized
|
||||
| Orthonormalized
|
||||
| None
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
(** String representation *)
|
||||
val to_string : t -> string
|
||||
|
@ -11,8 +11,8 @@ endif
|
||||
|
||||
LIBS=
|
||||
PKGS=
|
||||
OCAMLCFLAGS="-g -warn-error A"
|
||||
OCAMLBUILD=ocamlbuild -j 0 -syntax camlp4o -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS)
|
||||
OCAMLCFLAGS="-g"
|
||||
OCAMLBUILD=ocamlbuild -j 0 -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS)
|
||||
MLLFILES=$(wildcard *.mll)
|
||||
MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml Input_auto_generated.ml qp_edit.ml
|
||||
MLIFILES=$(wildcard *.mli) git
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qptypes
|
||||
|
||||
(** New job : Request to create a new multi-tasked job *)
|
||||
|
@ -1,14 +1,14 @@
|
||||
open Core.Std ;;
|
||||
open Qptypes ;;
|
||||
open Qptypes
|
||||
open Sexplib.Std
|
||||
|
||||
exception MultiplicityError of string;;
|
||||
exception XYZError ;;
|
||||
exception MultiplicityError of string
|
||||
exception XYZError
|
||||
|
||||
type t = {
|
||||
nuclei : Atom.t list ;
|
||||
elec_alpha : Elec_alpha_number.t ;
|
||||
elec_beta : Elec_beta_number.t ;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
let get_charge { nuclei ; elec_alpha ; elec_beta } =
|
||||
let result =
|
||||
@ -19,7 +19,7 @@ let get_charge { nuclei ; elec_alpha ; elec_beta } =
|
||||
| a::rest -> (Charge.to_float a.Atom.charge) +. nucl_charge rest
|
||||
| [] -> 0.
|
||||
in
|
||||
Charge.of_float (nucl_charge nuclei -. (Float.of_int result))
|
||||
Charge.of_float (nucl_charge nuclei -. (float_of_int result))
|
||||
|
||||
|
||||
let get_multiplicity m =
|
||||
@ -59,9 +59,10 @@ let name m =
|
||||
| a::rest ->
|
||||
begin
|
||||
let e = a.Atom.element in
|
||||
match (List.Assoc.find accu e) with
|
||||
| None -> build_list (List.Assoc.add accu e 1) rest
|
||||
| Some i -> build_list (List.Assoc.add accu e (i+1)) rest
|
||||
try
|
||||
let i = List.assoc e accu in
|
||||
build_list ( (e,i+1)::(List.remove_assoc e accu) ) rest
|
||||
with Not_found -> build_list ( (e,1)::accu ) rest
|
||||
end
|
||||
| [] -> accu
|
||||
in
|
||||
@ -83,7 +84,7 @@ let name m =
|
||||
let result =
|
||||
build_list [] nuclei |> build_name [c ; ", " ; mult]
|
||||
in
|
||||
String.concat (result)
|
||||
String.concat "" result
|
||||
|
||||
|
||||
let to_string_general ~f m =
|
||||
@ -95,8 +96,8 @@ let to_string_general ~f m =
|
||||
let title =
|
||||
name m
|
||||
in
|
||||
[ Int.to_string n ; title ] @ (List.map ~f nuclei)
|
||||
|> String.concat ~sep:"\n"
|
||||
[ string_of_int n ; title ] @ (List.map f nuclei)
|
||||
|> String.concat "\n"
|
||||
|
||||
let to_string =
|
||||
to_string_general ~f:(fun x -> Atom.to_string Units.Angstrom x)
|
||||
@ -109,9 +110,9 @@ let of_xyz_string
|
||||
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
|
||||
?(units=Units.Angstrom)
|
||||
s =
|
||||
let l = String.split s ~on:'\n'
|
||||
|> List.filter ~f:(fun x -> x <> "")
|
||||
|> List.map ~f:(fun x -> Atom.of_string units x)
|
||||
let l = String_ext.split s ~on:'\n'
|
||||
|> List.filter (fun x -> x <> "")
|
||||
|> List.map (fun x -> Atom.of_string units x)
|
||||
in
|
||||
let ne = ( get_charge {
|
||||
nuclei=l ;
|
||||
@ -145,25 +146,28 @@ let of_xyz_file
|
||||
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
|
||||
?(units=Units.Angstrom)
|
||||
filename =
|
||||
let (x,buffer) = In_channel.read_all filename
|
||||
|> String.lsplit2_exn ~on:'\n'
|
||||
let lines =
|
||||
match Io_ext.input_lines filename with
|
||||
| natoms :: title :: rest ->
|
||||
begin
|
||||
try
|
||||
if (int_of_string @@ String_ext.strip natoms) <= 0 then
|
||||
raise XYZError
|
||||
with
|
||||
| _ -> raise XYZError
|
||||
end;
|
||||
String.concat "\n" rest
|
||||
| _ -> failwith ("Problem in xyz file "^filename)
|
||||
in
|
||||
let result =
|
||||
try
|
||||
(int_of_string @@ String.strip x) > 0
|
||||
with
|
||||
| Failure "int_of_string" -> false
|
||||
in
|
||||
if not result then raise XYZError;
|
||||
let (_,buffer) = String.lsplit2_exn buffer ~on:'\n' in
|
||||
of_xyz_string ~charge ~multiplicity ~units buffer
|
||||
of_xyz_string ~charge:charge ~multiplicity:multiplicity
|
||||
~units:units lines
|
||||
|
||||
|
||||
let of_zmt_file
|
||||
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
|
||||
?(units=Units.Angstrom)
|
||||
filename =
|
||||
In_channel.read_all filename
|
||||
Io_ext.read_all filename
|
||||
|> Zmatrix.of_string
|
||||
|> Zmatrix.to_xyz_string
|
||||
|> of_xyz_string ~charge ~multiplicity ~units
|
||||
@ -182,14 +186,14 @@ let of_file
|
||||
let distance_matrix molecule =
|
||||
let coord =
|
||||
molecule.nuclei
|
||||
|> List.map ~f:(fun x -> x.Atom.coord)
|
||||
|> List.map (fun x -> x.Atom.coord)
|
||||
|> Array.of_list
|
||||
in
|
||||
let n =
|
||||
Array.length coord
|
||||
in
|
||||
let result =
|
||||
Array.make_matrix ~dimx:n ~dimy:n 0.
|
||||
Array.make_matrix n n 0.
|
||||
in
|
||||
for i = 0 to (n-1)
|
||||
do
|
||||
@ -203,6 +207,7 @@ let distance_matrix molecule =
|
||||
|
||||
|
||||
|
||||
open Core ;;
|
||||
include To_md5
|
||||
let to_md5 = to_md5 sexp_of_t
|
||||
|
||||
|
@ -4,7 +4,7 @@ type t = {
|
||||
nuclei : Atom.t list;
|
||||
elec_alpha : Qptypes.Elec_alpha_number.t;
|
||||
elec_beta : Qptypes.Elec_beta_number.t;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
(** Returns the charge of the molecule *)
|
||||
val get_charge : t -> Charge.t
|
||||
|
@ -1,7 +1,7 @@
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
open Qptypes ;;
|
||||
|
||||
type t = Strictly_positive_int.t with sexp
|
||||
type t = Strictly_positive_int.t [@@deriving sexp]
|
||||
|
||||
let of_int = Strictly_positive_int.of_int ;;
|
||||
let to_int = Strictly_positive_int.to_int ;;
|
||||
|
@ -1,4 +1,4 @@
|
||||
type t = Qptypes.Strictly_positive_int.t with sexp
|
||||
type t = Qptypes.Strictly_positive_int.t [@@deriving sexp]
|
||||
|
||||
(** Conversion from int *)
|
||||
val of_int : int -> t
|
||||
|
@ -1,11 +1,11 @@
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
open Qptypes;;
|
||||
|
||||
type t = {
|
||||
x : float ;
|
||||
y : float ;
|
||||
z : float ;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
let of_tuple ~units (x,y,z) =
|
||||
let f = match units with
|
||||
|
@ -2,7 +2,7 @@ type t =
|
||||
{ x : float;
|
||||
y : float;
|
||||
z : float;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
(** Create from a tuple of floats *)
|
||||
val of_tuple : units:Units.units -> float*float*float -> t
|
||||
|
@ -1,7 +1,7 @@
|
||||
type t =
|
||||
{ sym : Symmetry.t;
|
||||
expo : Qptypes.AO_expo.t;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
(** Conversion to string for printing *)
|
||||
val to_string : t -> string
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
type t =
|
||||
{
|
||||
@ -53,13 +53,13 @@ let display_tty bar =
|
||||
in
|
||||
let stop_time =
|
||||
let x =
|
||||
Time.Span.to_float running_time
|
||||
Time.Span.to_sec running_time
|
||||
in
|
||||
if (percent > 0.) then
|
||||
x *. 100. /. percent -. x
|
||||
|> Time.Span.of_float
|
||||
|> Time.Span.of_sec
|
||||
else
|
||||
Time.Span.of_float 0.
|
||||
Time.Span.of_sec 0.
|
||||
in
|
||||
Printf.eprintf "%s : [%s] %4.1f%% | %10s, ~%10s left\r%!"
|
||||
bar.title
|
||||
@ -67,7 +67,7 @@ let display_tty bar =
|
||||
percent
|
||||
(Time.Span.to_string running_time)
|
||||
(stop_time |> Time.Span.to_string );
|
||||
{ bar with dirty = false ; next = Time.add now (Time.Span.of_float 0.1) }
|
||||
{ bar with dirty = false ; next = Time.add now (Time.Span.of_sec 0.1) }
|
||||
|
||||
|
||||
let display_file bar =
|
||||
@ -80,19 +80,19 @@ let display_file bar =
|
||||
in
|
||||
let stop_time =
|
||||
let x =
|
||||
Time.Span.to_float running_time
|
||||
Time.Span.to_sec running_time
|
||||
in
|
||||
if (percent > 0.) then
|
||||
x *. 100. /. percent -. x
|
||||
|> Time.Span.of_float
|
||||
|> Time.Span.of_sec
|
||||
else
|
||||
Time.Span.of_float 0.
|
||||
Time.Span.of_sec 0.
|
||||
in
|
||||
Printf.eprintf "%5.2f %% in %20s, ~%20s left\n%!"
|
||||
percent
|
||||
(Time.Span.to_string running_time)
|
||||
(Time.Span.to_string stop_time);
|
||||
{ bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_float 2.) }
|
||||
{ bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_sec 2.) }
|
||||
|
||||
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qptypes
|
||||
|
||||
|
||||
@ -7,7 +7,7 @@ module GaussianPrimitive_local : sig
|
||||
type t = {
|
||||
expo : AO_expo.t ;
|
||||
r_power : R_power.t ;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
val of_expo_r_power : AO_expo.t -> R_power.t -> t
|
||||
val to_string : t -> string
|
||||
@ -17,7 +17,7 @@ end = struct
|
||||
type t = {
|
||||
expo : AO_expo.t ;
|
||||
r_power : R_power.t ;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
let of_expo_r_power dz n =
|
||||
{ expo = dz ; r_power = n }
|
||||
@ -35,7 +35,7 @@ module GaussianPrimitive_non_local : sig
|
||||
expo : AO_expo.t ;
|
||||
r_power : R_power.t ;
|
||||
proj : Positive_int.t
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
val of_proj_expo_r_power : Positive_int.t -> AO_expo.t -> R_power.t -> t
|
||||
val to_string : t -> string
|
||||
@ -46,7 +46,7 @@ end = struct
|
||||
expo : AO_expo.t ;
|
||||
r_power : R_power.t ;
|
||||
proj : Positive_int.t
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
let of_proj_expo_r_power p dz n =
|
||||
{ expo = dz ; r_power = n ; proj = p }
|
||||
@ -66,7 +66,7 @@ type t = {
|
||||
n_elec : Positive_int.t ;
|
||||
local : (GaussianPrimitive_local.t * AO_coef.t ) list ;
|
||||
non_local : (GaussianPrimitive_non_local.t * AO_coef.t ) list
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
let empty e =
|
||||
{ element = e;
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
open Qptypes;;
|
||||
open Qputils;;
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Sexplib
|
||||
|
||||
(*
|
||||
let rec transpose = function
|
||||
@ -14,12 +14,12 @@ let rec transpose = function
|
||||
|
||||
let input_to_sexp s =
|
||||
let result =
|
||||
String.split_lines s
|
||||
|> List.filter ~f:(fun x->
|
||||
(String.strip x) <> "")
|
||||
|> List.map ~f:(fun x->
|
||||
"("^(String.tr '=' ' ' x)^")")
|
||||
|> String.concat
|
||||
String_ext.split ~on:'\n' s
|
||||
|> List.filter (fun x-> (String_ext.strip x) <> "")
|
||||
|> List.map (fun x-> "("^
|
||||
(Str.global_replace (Str.regexp "=") " " x)
|
||||
^")")
|
||||
|> String.concat ""
|
||||
in
|
||||
print_endline ("("^result^")");
|
||||
"("^result^")"
|
||||
@ -29,10 +29,10 @@ let rmdir dirname =
|
||||
let rec remove_one dir =
|
||||
Sys.chdir dir;
|
||||
Sys.readdir "."
|
||||
|> Array.iter ~f:(fun x ->
|
||||
match (Sys.is_directory x, Sys.is_file x) with
|
||||
| (`Yes, _) -> remove_one x
|
||||
| (_, `Yes) -> Sys.remove x
|
||||
|> Array.iter (fun x ->
|
||||
match (Sys.is_directory x, Sys.file_exists x) with
|
||||
| (true, _) -> remove_one x
|
||||
| (_, true) -> Sys.remove x
|
||||
| _ -> failwith ("Unable to remove file "^x^".")
|
||||
);
|
||||
Sys.chdir "..";
|
||||
|
@ -19,7 +19,7 @@ of the block.
|
||||
r_y : Y_type.t
|
||||
...
|
||||
last_r : bool
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
val read : unit -> t
|
||||
val write : t -> unit
|
||||
@ -31,7 +31,7 @@ of the block.
|
||||
r_y : Y_type.t
|
||||
...
|
||||
last_r : bool
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "new_keyword";;
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std;;
|
||||
open Sexplib.Std
|
||||
|
||||
(* A range is a string of the type:
|
||||
*
|
||||
@ -12,14 +12,14 @@ open Core.Std;;
|
||||
*)
|
||||
|
||||
|
||||
type t = int list with sexp
|
||||
type t = int list [@@deriving sexp]
|
||||
|
||||
let expand_range r =
|
||||
match String.lsplit2 ~on:'-' r with
|
||||
match String_ext.lsplit2 ~on:'-' r with
|
||||
| Some (s, f) ->
|
||||
begin
|
||||
let start = Int.of_string s
|
||||
and finish = Int.of_string f
|
||||
let start = int_of_string s
|
||||
and finish = int_of_string f
|
||||
in
|
||||
assert (start <= finish) ;
|
||||
let rec do_work = function
|
||||
@ -31,9 +31,9 @@ let expand_range r =
|
||||
begin
|
||||
match r with
|
||||
| "" -> []
|
||||
| _ -> [Int.of_string r]
|
||||
| _ -> [int_of_string r]
|
||||
end
|
||||
;;
|
||||
|
||||
|
||||
let of_string s =
|
||||
match s.[0] with
|
||||
@ -43,36 +43,37 @@ let of_string s =
|
||||
assert (s.[0] = '[') ;
|
||||
assert (s.[(String.length s)-1] = ']') ;
|
||||
let s = String.sub s 1 ((String.length s) - 2) in
|
||||
let l = String.split ~on:',' s in
|
||||
let l = List.map ~f:expand_range l in
|
||||
List.concat l |> List.dedup ~compare:Int.compare |> List.sort ~cmp:Int.compare
|
||||
;;
|
||||
let l = String_ext.split ~on:',' s in
|
||||
let l = List.map expand_range l in
|
||||
List.concat l
|
||||
|> List.sort_uniq compare
|
||||
|
||||
|
||||
let to_string l =
|
||||
let rec do_work buf symbol = function
|
||||
| [] -> buf
|
||||
| a::([] as t) ->
|
||||
do_work (buf^symbol^(Int.to_string a)) "" t
|
||||
do_work (buf^symbol^(string_of_int a)) "" t
|
||||
| a::(b::q as t) ->
|
||||
if (b-a = 1) then
|
||||
do_work buf "-" t
|
||||
else
|
||||
do_work (buf^symbol^(Int.to_string a)^","^(Int.to_string b)) "" t
|
||||
do_work (buf^symbol^(string_of_int a)^","^(string_of_int b)) "" t
|
||||
in
|
||||
let result =
|
||||
match l with
|
||||
| [] ->
|
||||
"[]"
|
||||
| h::t ->
|
||||
do_work ("["^(Int.to_string h)) "" l in
|
||||
do_work ("["^(string_of_int h)) "" l in
|
||||
(String.sub result 0 ((String.length result)))^"]"
|
||||
;;
|
||||
|
||||
|
||||
let test_module () =
|
||||
let s = "[72-107,36-53,126-131]" in
|
||||
let l = of_string s in
|
||||
print_string s ; print_newline () ;
|
||||
List.iter ~f:(fun x -> Printf.printf "%d, " x) l ; print_newline () ;
|
||||
to_string l |> print_string ; print_newline () ;
|
||||
;;
|
||||
List.iter (fun x -> Printf.printf "%d, " x) l ; print_newline () ;
|
||||
to_string l |> print_string ; print_newline ();
|
||||
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
type t = int list with sexp
|
||||
type t = int list [@@deriving sexp]
|
||||
|
||||
(** A range is a sorted list of ints in an interval.
|
||||
It is created using a string :
|
||||
|
142
ocaml/String_ext.ml
Normal file
142
ocaml/String_ext.ml
Normal file
@ -0,0 +1,142 @@
|
||||
include String
|
||||
|
||||
(** Split a string on a given character *)
|
||||
let split ?(on=' ') str =
|
||||
split_on_char on str
|
||||
(*
|
||||
let rec do_work ?(accu=[]) ?(left="") = function
|
||||
| "" -> List.rev (left::accu)
|
||||
| s ->
|
||||
let new_s =
|
||||
(length s) - 1
|
||||
|> sub s 1
|
||||
in
|
||||
if (s.[0] = on) then
|
||||
let new_accu =
|
||||
left :: accu
|
||||
in
|
||||
do_work ~accu:new_accu new_s
|
||||
else
|
||||
let new_left =
|
||||
concat "" [ left ; make 1 s.[0] ]
|
||||
in
|
||||
do_work ~accu ~left:new_left new_s
|
||||
in
|
||||
do_work str
|
||||
*)
|
||||
|
||||
|
||||
(** Strip blanks on the left of a string *)
|
||||
let ltrim s =
|
||||
let rec do_work s l =
|
||||
match s.[0] with
|
||||
| '\n'
|
||||
| ' ' -> do_work (sub s 1 (l-1)) (l-1)
|
||||
| _ -> s
|
||||
in
|
||||
let l =
|
||||
length s
|
||||
in
|
||||
if (l > 0) then
|
||||
do_work s l
|
||||
else
|
||||
s
|
||||
|
||||
(** Strip blanks on the right of a string *)
|
||||
let rtrim s =
|
||||
let rec do_work s l =
|
||||
let newl =
|
||||
l-1
|
||||
in
|
||||
match s.[newl] with
|
||||
| '\n'
|
||||
| ' ' -> do_work (sub s 0 (newl)) (newl)
|
||||
| _ -> s
|
||||
in
|
||||
let l =
|
||||
length s
|
||||
in
|
||||
if (l > 0) then
|
||||
do_work s l
|
||||
else
|
||||
s
|
||||
|
||||
|
||||
(** Strip blanks on the right and left of a string *)
|
||||
let strip = String.trim
|
||||
|
||||
|
||||
(** Split a string in two pieces when a character is found the 1st time from the left *)
|
||||
let lsplit2_exn ?(on=' ') s =
|
||||
let length =
|
||||
String.length s
|
||||
in
|
||||
let rec do_work i =
|
||||
if (i = length) then
|
||||
begin
|
||||
raise Not_found
|
||||
end
|
||||
else if (s.[i] = on) then
|
||||
( String.sub s 0 i,
|
||||
String.sub s (i+1) (length-i-1) )
|
||||
else
|
||||
do_work (i+1)
|
||||
in
|
||||
do_work 0
|
||||
|
||||
|
||||
(** Split a string in two pieces when a character is found the 1st time from the right *)
|
||||
let rsplit2_exn ?(on=' ') s =
|
||||
let length =
|
||||
String.length s
|
||||
in
|
||||
let rec do_work i =
|
||||
if (i = -1) then
|
||||
begin
|
||||
raise Not_found
|
||||
end
|
||||
else if (s.[i] = on) then
|
||||
( String.sub s 0 i,
|
||||
String.sub s (i+1) (length-i-1) )
|
||||
else
|
||||
do_work (i-1)
|
||||
in
|
||||
do_work length
|
||||
|
||||
|
||||
let lsplit2 ?(on=' ') s =
|
||||
try
|
||||
Some (lsplit2_exn ~on s)
|
||||
with
|
||||
| Not_found -> None
|
||||
|
||||
|
||||
let rsplit2 ?(on=' ') s =
|
||||
try
|
||||
Some (rsplit2_exn ~on s)
|
||||
with
|
||||
| Not_found -> None
|
||||
|
||||
|
||||
let to_list s =
|
||||
Array.init (String.length s) (fun i -> s.[i])
|
||||
|> Array.to_list
|
||||
|
||||
|
||||
let fold ~init ~f s =
|
||||
to_list s
|
||||
|> List.fold_left f init
|
||||
|
||||
|
||||
let is_prefix ~prefix s =
|
||||
let len =
|
||||
String.length prefix
|
||||
in
|
||||
if len > String.length s then
|
||||
false
|
||||
else
|
||||
prefix = String.sub s 0 len
|
||||
|
||||
|
||||
let of_char c =
|
||||
String.make 1 c
|
@ -1,7 +1,7 @@
|
||||
open Qptypes
|
||||
open Core.Std
|
||||
open Sexplib.Std
|
||||
|
||||
type t = S|P|D|F|G|H|I|J|K|L with sexp
|
||||
type t = S|P|D|F|G|H|I|J|K|L [@@deriving sexp]
|
||||
|
||||
let to_string = function
|
||||
| S -> "S"
|
||||
@ -77,7 +77,7 @@ type st = t
|
||||
module Xyz = struct
|
||||
type t = { x: Positive_int.t ;
|
||||
y: Positive_int.t ;
|
||||
z: Positive_int.t } with sexp
|
||||
z: Positive_int.t } [@@deriving sexp]
|
||||
type state_type = Null | X | Y | Z
|
||||
|
||||
(** Builds an XYZ triplet from a string.
|
||||
@ -86,7 +86,7 @@ module Xyz = struct
|
||||
let flush state accu number =
|
||||
let n =
|
||||
if (number = "") then 1
|
||||
else (Int.of_string number)
|
||||
else (int_of_string number)
|
||||
in
|
||||
match state with
|
||||
| X -> { x= Positive_int.(of_int ( (to_int accu.x) +n));
|
||||
@ -111,10 +111,9 @@ module Xyz = struct
|
||||
| 'Z'::rest | 'z'::rest ->
|
||||
let new_accu = flush state accu number in
|
||||
do_work Z new_accu "" rest
|
||||
| c::rest -> do_work state accu (number^(String.of_char c)) rest
|
||||
| c::rest -> do_work state accu (number^(String_ext.of_char c)) rest
|
||||
in
|
||||
String.to_list_rev s
|
||||
|> List.rev
|
||||
String_ext.to_list s
|
||||
|> do_work Null
|
||||
{ x=Positive_int.of_int 0 ;
|
||||
y=Positive_int.of_int 0 ;
|
||||
|
@ -1,4 +1,4 @@
|
||||
type t = S | P | D | F | G | H | I | J | K | L with sexp
|
||||
type t = S | P | D | F | G | H | I | J | K | L [@@deriving sexp]
|
||||
|
||||
(** Creatio from strings *)
|
||||
val to_string : t -> string
|
||||
@ -16,7 +16,7 @@ module Xyz :
|
||||
x : Qptypes.Positive_int.t;
|
||||
y : Qptypes.Positive_int.t;
|
||||
z : Qptypes.Positive_int.t;
|
||||
} with sexp
|
||||
} [@@deriving sexp]
|
||||
|
||||
(** The string format contains the powers of x,y and z in a
|
||||
format like "x2z3" *)
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qptypes
|
||||
|
||||
|
||||
@ -63,7 +63,7 @@ let bind_socket ~socket_type ~socket ~port =
|
||||
ZMQ.Socket.bind socket @@ Printf.sprintf "tcp://*:%d" port;
|
||||
loop (-1)
|
||||
with
|
||||
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_float 1. ; loop (i-1) )
|
||||
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_sec 1. ; loop (i-1) )
|
||||
| other_exception -> raise other_exception
|
||||
in loop 60
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
open Core.Std;;
|
||||
open Qptypes;;
|
||||
open Qptypes
|
||||
open Sexplib
|
||||
|
||||
let to_md5 sexp_of_t t =
|
||||
sexp_of_t t
|
||||
|
@ -1,3 +1,3 @@
|
||||
true: package(core,cryptokit,ZMQ,sexplib.syntax,str)
|
||||
true: package(core,cryptokit,ZMQ,str,ppx_sexp_conv,ppx_deriving)
|
||||
true: thread
|
||||
false: profile
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
let filenames =
|
||||
let dir_name = Qpackage.root^"/data/basis/"
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qputils
|
||||
open Qptypes
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
let spec =
|
||||
let open Command.Spec in
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qputils
|
||||
open Qptypes
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
let run ~multiplicity ezfio_file =
|
||||
if (not (Sys.file_exists_exn ezfio_file)) then
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qputils;;
|
||||
open Qptypes;;
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
|
||||
type input_action =
|
||||
| Basis
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qptypes
|
||||
|
||||
let basis () =
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qputils
|
||||
|
||||
(* Environment variables :
|
||||
@ -132,7 +132,7 @@ let run slave exe ezfio_file =
|
||||
Sys.remove qp_run_address_filename;
|
||||
|
||||
let duration = Time.diff (Time.now()) time_start
|
||||
|> Core.Span.to_string in
|
||||
|> Time.Span.to_string in
|
||||
Printf.printf "Wall time : %s\n\n" duration;
|
||||
if (exit_code <> 0) then
|
||||
exit exit_code
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Qputils
|
||||
open Qptypes
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
(*
|
||||
* Command-line arguments
|
||||
|
@ -1,4 +1,10 @@
|
||||
open Core.Std;;
|
||||
let global_replace x =
|
||||
x
|
||||
|> Str.global_replace (Str.regexp "Float.to_string") "string_of_float"
|
||||
|> Str.global_replace (Str.regexp "Float.of_string") "float_of_string"
|
||||
|> Str.global_replace (Str.regexp "Int.to_string") "string_of_int"
|
||||
|> Str.global_replace (Str.regexp "Int.of_string") "int_of_string"
|
||||
|> Str.global_replace (Str.regexp "String.\(to\|of\)_string") ""
|
||||
|
||||
let input_data = "
|
||||
* Positive_float : float
|
||||
@ -118,8 +124,12 @@ let input_data = "
|
||||
|
||||
* MD5 : string
|
||||
assert ((String.length x) = 32);
|
||||
assert (String.fold x ~init:true ~f:(fun accu x ->
|
||||
accu && (x < 'g')));
|
||||
assert (
|
||||
let a =
|
||||
Array.init (String.length x) (fun i -> x.[i])
|
||||
in
|
||||
Array.fold_left (fun accu x -> accu && (x < 'g')) true a
|
||||
);
|
||||
|
||||
* Rst_string : string
|
||||
|
||||
@ -127,7 +137,7 @@ let input_data = "
|
||||
assert (x <> \"\") ;
|
||||
|
||||
"
|
||||
;;
|
||||
|
||||
|
||||
let input_ezfio = "
|
||||
* MO_number : int
|
||||
@ -156,18 +166,18 @@ let input_ezfio = "
|
||||
More than 10 billion of determinants
|
||||
|
||||
"
|
||||
;;
|
||||
|
||||
|
||||
let untouched = "
|
||||
module MO_guess : sig
|
||||
type t with sexp
|
||||
type t [@@deriving sexp]
|
||||
val to_string : t -> string
|
||||
val of_string : string -> t
|
||||
end = struct
|
||||
type t =
|
||||
| Huckel
|
||||
| HCore
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
let to_string = function
|
||||
| Huckel -> \"Huckel\"
|
||||
@ -182,7 +192,7 @@ end = struct
|
||||
end
|
||||
|
||||
module Disk_access : sig
|
||||
type t with sexp
|
||||
type t [@@deriving sexp]
|
||||
val to_string : t -> string
|
||||
val of_string : string -> t
|
||||
end = struct
|
||||
@ -190,7 +200,7 @@ end = struct
|
||||
| Read
|
||||
| Write
|
||||
| None
|
||||
with sexp
|
||||
[@@deriving sexp]
|
||||
|
||||
let to_string = function
|
||||
| Read -> \"Read\"
|
||||
@ -206,62 +216,63 @@ end = struct
|
||||
end
|
||||
"
|
||||
|
||||
;;
|
||||
|
||||
|
||||
let template = format_of_string "
|
||||
module %s : sig
|
||||
type t with sexp
|
||||
type t [@@deriving sexp]
|
||||
val to_%s : t -> %s
|
||||
val of_%s : %s %s -> t
|
||||
val to_string : t -> string
|
||||
end = struct
|
||||
type t = %s with sexp
|
||||
type t = %s [@@deriving sexp]
|
||||
let to_%s x = x
|
||||
let of_%s %s x = ( %s x )
|
||||
let to_string x = %s.to_string x
|
||||
end
|
||||
|
||||
"
|
||||
;;
|
||||
|
||||
|
||||
let parse_input input=
|
||||
print_string "open Core.Std;;\nlet warning = print_string;;\n" ;
|
||||
print_string "open Sexplib.Std\nlet warning = print_string\n" ;
|
||||
let rec parse result = function
|
||||
| [] -> result
|
||||
| ( "" , "" )::tail -> parse result tail
|
||||
| ( t , text )::tail ->
|
||||
let name,typ,params,params_val =
|
||||
match String.split ~on:':' t with
|
||||
match String_ext.split ~on:':' t with
|
||||
| [name;typ] -> (name,typ,"","")
|
||||
| name::typ::params::params_val -> (name,typ,params,
|
||||
(String.concat params_val ~sep:":") )
|
||||
(String.concat ":" params_val) )
|
||||
| _ -> assert false
|
||||
in
|
||||
let typ = String.strip typ
|
||||
and name = String.strip name in
|
||||
let typ = String_ext.strip typ
|
||||
and name = String_ext.strip name in
|
||||
let typ_cap = String.capitalize typ in
|
||||
let newstring = Printf.sprintf template name typ typ typ params_val typ typ
|
||||
typ typ params ( String.strip text ) typ_cap
|
||||
typ typ params ( String_ext.strip text ) typ_cap
|
||||
in
|
||||
List.rev (parse (newstring::result) tail )
|
||||
in
|
||||
String.split ~on:'*' input
|
||||
|> List.map ~f:(String.lsplit2_exn ~on:'\n')
|
||||
String_ext.split ~on:'*' input
|
||||
|> List.map (String_ext.lsplit2_exn ~on:'\n')
|
||||
|> parse []
|
||||
|> String.concat
|
||||
|> String.concat ""
|
||||
|> global_replace
|
||||
|> print_string
|
||||
;;
|
||||
|
||||
|
||||
|
||||
let ezfio_template = format_of_string "
|
||||
module %s : sig
|
||||
type t with sexp
|
||||
type t [@@deriving sexp]
|
||||
val to_%s : t -> %s
|
||||
val get_max : unit -> %s
|
||||
val of_%s : ?min:%s -> ?max:%s -> %s -> t
|
||||
val to_string : t -> string
|
||||
end = struct
|
||||
type t = %s with sexp
|
||||
type t = %s [@@deriving sexp]
|
||||
let to_string x = %s.to_string x
|
||||
let get_max () =
|
||||
if (Ezfio.has_%s ()) then
|
||||
@ -287,24 +298,24 @@ end = struct
|
||||
end
|
||||
end
|
||||
"
|
||||
;;
|
||||
|
||||
|
||||
let parse_input_ezfio input=
|
||||
let parse s =
|
||||
match (
|
||||
String.split s ~on:'\n'
|
||||
|> List.filter ~f:(fun x -> (String.strip x) <> "")
|
||||
String_ext.split s ~on:'\n'
|
||||
|> List.filter (fun x -> (String_ext.strip x) <> "")
|
||||
) with
|
||||
| [] -> ""
|
||||
| a :: b :: c :: d :: [] ->
|
||||
begin
|
||||
let (name,typ) = String.lsplit2_exn ~on:':' a
|
||||
let (name,typ) = String_ext.lsplit2_exn ~on:':' a
|
||||
and ezfio_func = b
|
||||
and (min, max) = String.lsplit2_exn ~on:':' c
|
||||
and (min, max) = String_ext.lsplit2_exn ~on:':' c
|
||||
and msg = d
|
||||
in
|
||||
let (name, typ, ezfio_func, min, max, msg) =
|
||||
match (List.map [ name ; typ ; ezfio_func ; min ; max ; msg ] ~f:String.strip) with
|
||||
match List.map String_ext.strip [ name ; typ ; ezfio_func ; min ; max ; msg ] with
|
||||
| [ name ; typ ; ezfio_func ; min ; max ; msg ] -> (name, typ, ezfio_func, min, max, msg)
|
||||
| _ -> assert false
|
||||
in
|
||||
@ -314,16 +325,17 @@ let parse_input_ezfio input=
|
||||
end
|
||||
| _ -> failwith "Error in input_ezfio"
|
||||
in
|
||||
String.split ~on:'*' input
|
||||
|> List.map ~f:parse
|
||||
|> String.concat
|
||||
String_ext.split ~on:'*' input
|
||||
|> List.map parse
|
||||
|> String.concat ""
|
||||
|> global_replace
|
||||
|> print_string
|
||||
;;
|
||||
|
||||
|
||||
let () =
|
||||
parse_input input_data ;
|
||||
parse_input_ezfio input_ezfio;
|
||||
print_endline untouched;
|
||||
print_endline untouched
|
||||
|
||||
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std;;
|
||||
open Core;;
|
||||
open Qputils;;
|
||||
open Qptypes;;
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qptypes
|
||||
|
||||
let test_prim () =
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
let () =
|
||||
Message.of_string "new_job ao_integrals tcp://127.0.0.1 inproc://ao_ints:12345"
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std ;;
|
||||
open Core ;;
|
||||
open Qptypes ;;
|
||||
|
||||
let test_molecule () =
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
open Qputils
|
||||
open Qptypes
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
let () =
|
||||
|
||||
|
@ -1,15 +1,13 @@
|
||||
open Core.Std
|
||||
open Qputils
|
||||
open Qptypes
|
||||
open Symmetry
|
||||
|
||||
let () =
|
||||
"SPDFGHIJKL"
|
||||
|> String.to_list_rev
|
||||
|> List.rev
|
||||
|> List.map ~f:of_char
|
||||
|> List.map ~f:Xyz.of_symmetry
|
||||
|> List.iter ~f:(fun x -> List.iter x ~f:(fun y -> Xyz.to_string y |> print_endline) ;
|
||||
|> String_ext.to_list
|
||||
|> List.map of_char
|
||||
|> List.map Xyz.of_symmetry
|
||||
|> List.iter (fun x -> List.iter (fun y -> Xyz.to_string y |> print_endline) x ;
|
||||
print_newline ();)
|
||||
|
||||
|
||||
|
@ -1,5 +1,3 @@
|
||||
open Core
|
||||
|
||||
let () =
|
||||
TaskServer.run 12345
|
||||
|
||||
|
@ -170,7 +170,7 @@ class EZFIO_ocaml(object):
|
||||
else:
|
||||
l_template += [" {0:<30} : {1};".format(p, t.ocaml)]
|
||||
|
||||
l_template += [" } with sexp",
|
||||
l_template += [" } [@@deriving sexp]",
|
||||
";;"]
|
||||
|
||||
# ~#~#~#~#~#~ #
|
||||
|
@ -4,7 +4,7 @@
|
||||
|
||||
open Qputils
|
||||
open Qptypes
|
||||
open Core.Std
|
||||
open Core
|
||||
|
||||
(** Interactive editing of the input.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user