diff --git a/ocaml/Bitlist.ml b/ocaml/Bitlist.ml index 4648ef6b..c1dc66d9 100644 --- a/ocaml/Bitlist.ml +++ b/ocaml/Bitlist.ml @@ -28,20 +28,30 @@ let of_string ?(zero='0') ?(one='1') s = else if (c = one) then Bit.One else (failwith ("Error in bitstring ") ) ) +let of_string_mp s = + String.to_list s + |> List.rev_map ~f:(function + | '-' -> Bit.Zero + | '+' -> Bit.One + | _ -> failwith ("Error in bitstring ") ) (* Create a bit list from an int64 *) let of_int64 i = - let rec do_work = function - | 0L -> [ Bit.Zero ] - | 1L -> [ Bit.One ] - | i -> let b = - match (Int64.bit_and i 1L ) with - | 0L -> Bit.Zero - | 1L -> Bit.One - | _ -> raise (Failure "i land 1 not in (0,1)") - in b:: ( do_work (Int64.shift_right_logical i 1) ) + + let rec do_work accu = function + | 0L -> Bit.Zero :: accu |> List.rev + | 1L -> Bit.One :: accu |> List.rev + | i -> + let b = + match (Int64.bit_and i 1L ) with + | 0L -> Bit.Zero + | 1L -> Bit.One + | _ -> raise (Failure "i land 1 not in (0,1)") + in + do_work (b :: accu) (Int64.shift_right_logical i 1) in + let adjust_length result = let rec do_work accu = function | 64 -> List.rev accu @@ -51,7 +61,7 @@ let of_int64 i = in do_work (List.rev result) (List.length result) in - adjust_length (do_work i) + adjust_length (do_work [] i) (* Create an int64 from a bit list *) @@ -102,6 +112,10 @@ let to_int64_list l = in List.rev_map ~f:to_int64 l +(* Create an array of int64 from a bit list *) +let to_int64_array l = + to_int64_list l + |> Array.of_list (* Create a bit list from a list of MO indices *) let of_mo_number_list n_int l = @@ -163,11 +177,10 @@ let not_operator b = logical_operator1 Bit.not_operator b let popcnt b = - let rec popcnt accu = function - | [] -> accu - | Bit.One::rest -> popcnt (accu+1) rest - | Bit.Zero::rest -> popcnt (accu) rest - in popcnt 0 b + List.fold_left b ~init:0 ~f:(fun accu -> function + | Bit.One -> accu+1 + | Bit.Zero -> accu + ) diff --git a/ocaml/Bitlist.mli b/ocaml/Bitlist.mli index c733712c..69019920 100644 --- a/ocaml/Bitlist.mli +++ b/ocaml/Bitlist.mli @@ -6,16 +6,20 @@ 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 *) +(** Read from a string *) val of_string : ?zero:char -> ?one:char -> string -> t +(** Read from a string with the ++-- notation *) +val of_string_mp : string -> t + (** int64 conversion functions *) val of_int64 : int64 -> t val to_int64 : t -> int64 -val of_int64_list : int64 list -> t -val to_int64_list : t -> int64 list +val of_int64_list : int64 list -> t +val to_int64_list : t -> int64 list +val to_int64_array : t -> int64 array (** Get the number of needed int64 elements to encode the bit list *) val n_int_of_mo_tot_num : int -> Qptypes.N_int_number.t diff --git a/ocaml/Determinant.ml b/ocaml/Determinant.ml index 63dab9b9..13df7b38 100644 --- a/ocaml/Determinant.ml +++ b/ocaml/Determinant.ml @@ -55,12 +55,18 @@ let of_int64_array ~n_int ~alpha ~beta x = end; x +let of_int64_array_no_check x = x -let of_bitlist_couple ~alpha ~beta (xa,xb) = - let ba = Bitlist.to_int64_list xa in - let bb = Bitlist.to_int64_list xb in - let n_int = Bitlist.n_int_of_mo_tot_num (List.length xa) in - of_int64_array ~n_int:n_int ~alpha:alpha ~beta:beta (Array.of_list (ba@bb)) +let of_bitlist_couple ?n_int ~alpha ~beta (xa,xb) = + let ba, bb = + Bitlist.to_int64_array xa , + Bitlist.to_int64_array xb + and n_int = + match n_int with + | Some x -> x + | None -> Bitlist.n_int_of_mo_tot_num (List.length xa) + in + of_int64_array ~n_int ~alpha ~beta (Array.concat [ba;bb]) let to_string ~mo_tot_num x = diff --git a/ocaml/Determinant.mli b/ocaml/Determinant.mli index f01e49d9..da9fe02e 100644 --- a/ocaml/Determinant.mli +++ b/ocaml/Determinant.mli @@ -24,7 +24,8 @@ val to_alpha_beta : t -> (int64 array)*(int64 array) val to_bitlist_couple : t -> Bitlist.t * Bitlist.t (** Create from a bit list *) -val of_bitlist_couple : alpha:Qptypes.Elec_alpha_number.t -> +val of_bitlist_couple : ?n_int:Qptypes.N_int_number.t -> + alpha:Qptypes.Elec_alpha_number.t -> beta:Qptypes.Elec_beta_number.t -> Bitlist.t * Bitlist.t -> t diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index ff9eb520..13e05719 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -157,44 +157,58 @@ end = struct let read_psi_det () = - let n_int = read_n_int () - and n_alpha = Ezfio.get_electrons_elec_alpha_num () + let n_int = + read_n_int () + and alpha = + Ezfio.get_electrons_elec_alpha_num () |> Elec_alpha_number.of_int - and n_beta = Ezfio.get_electrons_elec_beta_num () + and beta = + Ezfio.get_electrons_elec_beta_num () |> Elec_beta_number.of_int - in - if not (Ezfio.has_determinants_psi_det ()) then - begin - let mo_tot_num = MO_number.get_max () in - let rec build_data accu = function - | 0 -> accu - | n -> build_data ((MO_number.of_int ~max:mo_tot_num n)::accu) (n-1) - in - let det_a = build_data [] (Elec_alpha_number.to_int n_alpha) - |> Bitlist.of_mo_number_list n_int - and det_b = build_data [] (Elec_beta_number.to_int n_beta) - |> Bitlist.of_mo_number_list n_int - in - let data = ( (Bitlist.to_int64_list det_a) @ - (Bitlist.to_int64_list det_b) ) - in - Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; 1 |] ~data:data - |> Ezfio.set_determinants_psi_det ; - end ; - let n_int = N_int_number.to_int n_int in - let psi_det_array = Ezfio.get_determinants_psi_det () in - let dim = psi_det_array.Ezfio.dim - and data = Ezfio.flattened_ezfio psi_det_array - in - assert (n_int = dim.(0)); - assert (dim.(1) = 2); - assert (dim.(2) = (Det_number.to_int (read_n_det ()))); - List.init dim.(2) ~f:(fun i -> - Array.sub ~pos:(2*n_int*i) ~len:(2*n_int) data) - |> List.map ~f:(Determinant.of_int64_array - ~n_int:(N_int_number.of_int n_int) - ~alpha:n_alpha ~beta:n_beta ) - |> Array.of_list + in + if not (Ezfio.has_determinants_psi_det ()) then + begin + let mo_tot_num = + MO_number.get_max () + in + let rec build_data accu = function + | 0 -> accu + | n -> build_data ((MO_number.of_int ~max:mo_tot_num n)::accu) (n-1) + in + let det_a = + build_data [] (Elec_alpha_number.to_int alpha) + |> Bitlist.of_mo_number_list n_int + and det_b = + build_data [] (Elec_beta_number.to_int beta) + |> Bitlist.of_mo_number_list n_int + in + let data = + ( (Bitlist.to_int64_list det_a) @ + (Bitlist.to_int64_list det_b) ) + in + Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; 1 |] ~data:data + |> Ezfio.set_determinants_psi_det ; + end ; + let n_int_i = + N_int_number.to_int n_int in + let psi_det_array = + Ezfio.get_determinants_psi_det () + in + let dim = + psi_det_array.Ezfio.dim + and data = + Ezfio.flattened_ezfio psi_det_array + in + assert (n_int_i = dim.(0)); + assert (dim.(1) = 2); + assert (dim.(2) = (Det_number.to_int (read_n_det ()))); + let len = + 2 * n_int_i + in + Array.init dim.(2) ~f:(fun i -> + Array.sub ~pos:(len * i) ~len data + |> Determinant.of_int64_array ~n_int ~alpha ~beta + ) ;; let write_psi_det ~n_int ~n_det d = @@ -358,15 +372,15 @@ psi_det = %s let psi_coef = let rec read_coefs accu = function | [] -> List.rev accu - | ""::""::tail -> read_coefs accu tail - | ""::c::tail -> + | "" :: "" :: tail -> read_coefs accu tail + | "" :: c :: tail -> let c = String.split ~on:'\t' c |> List.map ~f:(fun x -> Det_coef.of_float (Float.of_string x)) |> Array.of_list in - read_coefs (c::accu) tail - | _::tail -> read_coefs accu tail + read_coefs (c :: accu) tail + | _ :: tail -> read_coefs accu tail in let a = let buffer = @@ -380,35 +394,49 @@ psi_det = %s let i = i-1 in - List.map ~f:(fun x -> Det_coef.to_string x.(i)) buffer - |> String.concat ~sep:" " + List.map ~f:(fun x -> x.(i)) buffer in - let rec build_result = function - | 1 -> extract_state 1 - | i -> (build_result (i-1))^" "^(extract_state i) + let rec build_result accu = function + | 0 -> accu + | i -> + let new_accu = + (extract_state i) :: accu + in + build_result new_accu (i-1) in - build_result nstates + build_result [] nstates in - "(psi_coef ("^a^"))" + List.concat a + |> Array.of_list in +(* + let dets = match ( dets + |> String.split ~on:'\n' + |> List.map ~f:(String.strip) + ) with + | _::lines -> lines + | _ -> failwith "Error in determinants" + in +*) + (* Handle determinants *) let psi_det = - let n_alpha = Ezfio.get_electrons_elec_alpha_num () + let alpha = Ezfio.get_electrons_elec_alpha_num () |> Elec_alpha_number.of_int - and n_beta = Ezfio.get_electrons_elec_beta_num () + and beta = Ezfio.get_electrons_elec_beta_num () |> Elec_beta_number.of_int + and n_int = + N_int_number.get_max () + |> N_int_number.of_int in let rec read_dets accu = function - | [] -> List.rev accu - | ""::_::alpha::beta::tail -> + | [] -> List.rev accu + | ""::_::alpha_str::beta_str::tail -> begin let newdet = - (Bitlist.of_string ~zero:'-' ~one:'+' alpha , - Bitlist.of_string ~zero:'-' ~one:'+' beta) - |> Determinant.of_bitlist_couple ~alpha:n_alpha ~beta:n_beta - |> Determinant.sexp_of_t - |> Sexplib.Sexp.to_string + (Bitlist.of_string_mp alpha_str, Bitlist.of_string_mp beta_str) + |> Determinant.of_bitlist_couple ~n_int ~alpha ~beta in read_dets (newdet::accu) tail end @@ -417,29 +445,26 @@ psi_det = %s let dets = List.map ~f:String.rev dets in - let sze = - List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) dets - in - let control = - Gc.get () - in - Gc.tune ~minor_heap_size:(sze) ~space_overhead:(sze/10) - ~max_overhead:100000 ~major_heap_increment:(sze/10) (); - let a = - read_dets [] dets - |> String.concat - in - Gc.set control; - "(psi_det ("^a^"))" + read_dets [] dets + |> Array.of_list in - let bitkind = Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind + 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] + and n_int = + Printf.sprintf "(n_int %d)" (N_int_number.get_max ()) in - - Generic_input_of_rst.evaluate_sexp t_of_sexp s + let s = + [ header ; bitkind ; n_int ; "(psi_coef ())" ; "(psi_det ())"] + |> String.concat + in + let result = + Generic_input_of_rst.evaluate_sexp t_of_sexp s + in + match result with + | Some x -> Some { x with psi_coef ; psi_det } + | None -> None ;; end diff --git a/ocaml/_tags b/ocaml/_tags index 112ee73f..fd4c4804 100644 --- a/ocaml/_tags +++ b/ocaml/_tags @@ -1,2 +1,3 @@ true: package(core,sexplib.syntax,cryptokit,ZMQ) true: thread +false: profile