From 57b3a7702be0082d581410192a89b4ddced461ba Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 3 Nov 2014 15:37:02 +0100 Subject: [PATCH] Determinants are read from rst file --- ocaml/Bitlist.ml | 49 ++++++----------- ocaml/Bitlist.mli | 3 ++ ocaml/Input_determinants.ml | 102 ++++++++++++++++++++++++++++++++---- ocaml/MO_label.ml | 5 +- ocaml/MO_label.mli | 1 + ocaml/Makefile | 4 +- ocaml/qptypes_generator.ml | 5 +- ocaml/test_input.ml | 11 +++- 8 files changed, 130 insertions(+), 50 deletions(-) diff --git a/ocaml/Bitlist.ml b/ocaml/Bitlist.ml index 20c2a17a..80efd2b2 100644 --- a/ocaml/Bitlist.ml +++ b/ocaml/Bitlist.ml @@ -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 -;; diff --git a/ocaml/Bitlist.mli b/ocaml/Bitlist.mli index b8d87c7c..c733712c 100644 --- a/ocaml/Bitlist.mli +++ b/ocaml/Bitlist.mli @@ -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 diff --git a/ocaml/Input_determinants.ml b/ocaml/Input_determinants.ml index 8b308807..cc99c93a 100644 --- a/ocaml/Input_determinants.ml +++ b/ocaml/Input_determinants.ml @@ -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 diff --git a/ocaml/MO_label.ml b/ocaml/MO_label.ml index 0b8b81dd..f8de6210 100644 --- a/ocaml/MO_label.ml +++ b/ocaml/MO_label.ml @@ -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." ;; diff --git a/ocaml/MO_label.mli b/ocaml/MO_label.mli index a0702049..d5061095 100644 --- a/ocaml/MO_label.mli +++ b/ocaml/MO_label.mli @@ -3,6 +3,7 @@ type t = | Canonical | Natural | Localized + | Orthonormalized | None with sexp diff --git a/ocaml/Makefile b/ocaml/Makefile index 360ab525..61e531a3 100644 --- a/ocaml/Makefile +++ b/ocaml/Makefile @@ -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)) diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index b1c33d85..63a53775 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -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) diff --git a/ocaml/test_input.ml b/ocaml/test_input.ml index ab663dfa..613f3b1a 100644 --- a/ocaml/test_input.ml +++ b/ocaml/test_input.ml @@ -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();