10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-25 22:52:15 +02:00

Determinants are read from rst file

This commit is contained in:
Anthony Scemama 2014-11-03 15:37:02 +01:00
parent 90ccf82824
commit 57b3a7702b
8 changed files with 130 additions and 50 deletions

View File

@ -1,4 +1,5 @@
open Qptypes;;
open Core.Std;;
(*
Type for bits strings
@ -20,6 +21,13 @@ let to_string b =
do_work "" b
;;
let of_string ?(zero='0') ?(one='1') s =
String.to_list s
|> List.rev_map ~f:( fun c ->
if (c = zero) then Bit.Zero
else if (c = one) then Bit.One
else (failwith ("Error in string "^s) ) )
;;
(* Create a bit list from an int64 *)
let of_int64 i =
@ -27,7 +35,7 @@ let of_int64 i =
| 0L -> [ Bit.Zero ]
| 1L -> [ Bit.One ]
| i -> let b =
match (Int64.logand i 1L ) with
match (Int64.bit_and i 1L ) with
| 0L -> Bit.Zero
| 1L -> Bit.One
| _ -> raise (Failure "i land 1 not in (0,1)")
@ -51,15 +59,14 @@ let to_int64 l =
let rec do_work accu = function
| [] -> accu
| Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail
| Bit.One::tail -> do_work Int64.(logor one (shift_left accu 1)) tail
| Bit.One::tail -> do_work Int64.(bit_or one (shift_left accu 1)) tail
in do_work Int64.zero (List.rev l)
;;
(* Create a bit list from a list of int64 *)
let of_int64_list l =
let list_of_lists = List.map of_int64 l in
(* let result = List.rev list_of_lists in *)
List.flatten list_of_lists
List.map ~f:of_int64 l
|> List.concat
;;
(* Compute n_int *)
@ -92,15 +99,15 @@ let to_int64_list l =
in
let l = do_work [] [] 1 l
in
List.rev_map to_int64 l
List.rev_map ~f:to_int64 l
;;
(* Create a bit list from a list of MO indices *)
let of_mo_number_list n_int l =
let n_int = N_int_number.to_int n_int in
let length = n_int*64 in
let a = Array.make length (Bit.Zero) in
List.iter (fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l;
let a = Array.create length (Bit.Zero) in
List.iter ~f:(fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l;
Array.to_list a
;;
@ -162,30 +169,4 @@ let popcnt b =
in popcnt 0 b
;;
let test_module () =
let test = of_int64_list ([-1231L;255L]) in
print_string (to_string test);
print_newline ();
print_string (string_of_int (String.length (to_string test)));
print_newline ();
print_string ( Bit.to_string Bit.One );
let a = of_int64_list ([-1L;0L])
and b = of_int64_list ([128L;127L])
in begin
print_newline ();
print_newline ();
print_string (to_string a);
print_newline ();
print_string (to_string b);
print_newline ();
print_string (to_string (and_operator a b));
print_newline ();
print_string (to_string (or_operator a b));
print_newline ();
print_string (to_string (xor_operator a b));
print_string (to_string a);
print_int (popcnt a);
end
;;

View File

@ -6,6 +6,9 @@ val zero : Qptypes.N_int_number.t -> t
(** Convert to a string for printing *)
val to_string : t -> string
(** Convert to a string for printing *)
val of_string : ?zero:char -> ?one:char -> string -> t
(** int64 conversion functions *)
val of_int64 : int64 -> t

View File

@ -23,6 +23,7 @@ module Determinants : sig
val read : unit -> t
val to_string : t -> string
val to_rst : t -> Rst_string.t
val of_rst : Rst_string.t -> t
end = struct
type t =
{ n_int : N_int_number.t;
@ -251,7 +252,7 @@ end = struct
let mo_tot_num = MO_number.of_int mo_tot_num ~max:mo_tot_num in
let det_text =
List.map2_exn ~f:(fun coef det ->
Printf.sprintf " %f\n%s\n"
Printf.sprintf " %F\n%s\n"
(Det_coef.to_float coef)
(Determinant.to_string ~mo_tot_num:mo_tot_num det
|> String.split ~on:'\n'
@ -273,27 +274,27 @@ Label of the MOs on which the determinants were computed ::
Force the selected wave function to be an eigenfunction of S^2.
If true, input the expected value of S^2 ::
s2_eig = %s
expected_s2 = %s
s2_eig = %s
expected_s2 = %s
Thresholds on generators and selectors (fraction of the norm) ::
threshold_generators = %s
threshold_selectors = %s
threshold_generators = %s
threshold_selectors = %s
Number of requested states, and number of states used for the
Davidson diagonalization ::
n_states = %s
n_states_diag = %s
n_states = %s
n_states_diag = %s
Maximum size of the Hamiltonian matrix that will be fully diagonalized ::
n_det_max_jacobi = %s
n_det_max_jacobi = %s
Number of determinants ::
n_det = %s
n_det = %s
Determinants ::
@ -350,6 +351,89 @@ psi_det = %s
~mo_tot_num:mo_tot_num) |> String.concat ~sep:"\n\n")
;;
let of_rst r =
let r = Rst_string.to_string r
in
(* Split into header and determinants data *)
let idx = String.substr_index_exn r ~pos:0 ~pattern:"\nDeterminants"
in
let (header, dets) =
(String.prefix r idx, String.suffix r ((String.length r)-idx) )
in
(* Handle header *)
let header = r
|> String.split ~on:'\n'
|> List.filter ~f:(fun line ->
if (line = "") then
false
else
( (String.contains line '=') && (line.[0] = ' ') )
)
|> List.map ~f:(fun line ->
"("^(
String.tr line ~target:'=' ~replacement:' '
|> String.strip
)^")" )
|> String.concat
in
(* Handle determinant coefs *)
let dets = match ( dets
|> String.split ~on:'\n'
|> List.map ~f:(String.strip)
) with
| _::lines -> lines
| _ -> failwith "Error in determinants"
in
let psi_coef =
let rec read_coefs accu = function
| [] -> List.rev accu
| ""::c::tail ->
read_coefs (c::accu) tail
| _::tail -> read_coefs accu tail
in
let a = read_coefs [] dets
|> String.concat ~sep:" "
in
"(psi_coef ("^a^"))"
in
(* Handle determinants *)
let psi_det =
let rec read_dets accu = function
| [] -> List.rev accu
| ""::c::alpha::beta::tail ->
begin
let alpha = String.rev alpha |> Bitlist.of_string ~zero:'-' ~one:'+'
and beta = String.rev beta |> Bitlist.of_string ~zero:'-' ~one:'+'
in
let newdet = Determinant.of_bitlist_couple (alpha,beta)
|> Determinant.sexp_of_t |> Sexplib.Sexp.to_string
in
read_dets (newdet::accu) tail
end
| _::tail -> read_dets accu tail
in
let a = read_dets [] dets
|> String.concat
in
"(psi_det ("^a^"))"
in
let bitkind = Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind
|> Bit_kind.to_int)
and n_int = Printf.sprintf "(n_int %d)" (N_int_number.get_max ()) in
let s = String.concat [ header ; bitkind ; n_int ; psi_coef ; psi_det]
in
("("^s^")")
|> print_endline ;
Sexp.of_string ("("^s^")")
|> t_of_sexp
;;
end

View File

@ -5,6 +5,7 @@ type t =
| Canonical
| Natural
| Localized
| Orthonormalized
| None
with sexp
;;
@ -12,6 +13,7 @@ with sexp
let to_string = function
| Guess -> "Guess"
| Canonical -> "Canonical"
| Orthonormalized -> "Orthonormalized"
| Natural -> "Natural"
| Localized -> "Localized"
| None -> "None"
@ -23,7 +25,8 @@ let of_string s =
| "canonical" -> Canonical
| "natural" -> Natural
| "localized" -> Localized
| "orthonormalized" -> Orthonormalized
| "none" -> None
| _ -> failwith "MO_label should be one of:
Guess | Canonical | Natural | Localized | None."
Guess | Orthonormalized | Canonical | Natural | Localized | None."
;;

View File

@ -3,6 +3,7 @@ type t =
| Canonical
| Natural
| Localized
| Orthonormalized
| None
with sexp

View File

@ -10,8 +10,8 @@ endif
LIBS=
PKGS=
OCAMLCFLAGS=-g
OCAMLBUILD=ocamlbuild -j 0 -syntax camlp4o -cflags $(OCAMLCFLAGS) -lflags -g
OCAMLCFLAGS="-g"
OCAMLBUILD=ocamlbuild -j 0 -syntax camlp4o -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS)
MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml
MLIFILES=$(wildcard *.mli)
ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml))

View File

@ -229,8 +229,9 @@ let parse_input_ezfio input=
and msg = d
in
let name :: typ :: ezfio_func :: min :: max :: msg :: [] =
name :: typ :: ezfio_func :: min :: max :: msg :: []
|> List.map ~f:String.strip
match (name :: typ :: ezfio_func :: min :: max :: msg :: []) with
| l -> List.map ~f:String.strip l
| _ -> assert false
in
Printf.sprintf ezfio_template
name typ typ typ typ typ typ typ typ (String.capitalize typ)

View File

@ -41,7 +41,14 @@ let test_dets () =
Ezfio.set_file "F2.ezfio" ;
let b = Input.Determinants.read ()
in
print_endline (Input.Determinants.to_string b);
print_endline (Input.Determinants.to_rst b |> Rst_string.to_string ) ;
print_endline (Input.Determinants.sexp_of_t b |> Sexplib.Sexp.to_string ) ;
let r = Input.Determinants.to_rst b in
let b2 = Input.Determinants.of_rst r in
if (b2 = b) then
print_endline "OK"
else
print_endline "Failed"
;;
let test_cisd_sc2 () =
@ -130,5 +137,5 @@ test_nucl ();
test_bielec_intergals ();;
test_electrons();
*)
test_dets ();
test_ao();