Accelerated qp_edit with large multi-determinant wave functions

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
+  ) 
 
 
 

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

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 = 

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
 

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

ocaml/_tags

@@ -1,2 +1,3 @@
 true: package(core,sexplib.syntax,cryptokit,ZMQ)
 true: thread
+false: profile