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 ]
+  let rec do_work accu = function
-  | 1L -> [ Bit.One ]
+  | 0L -> Bit.Zero :: accu |> List.rev
-  | i -> let b =
+  | 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 b:: ( do_work (Int64.shift_right_logical i 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
+  List.fold_left b ~init:0 ~f:(fun accu -> function
-    | [] -> accu
+    | Bit.One -> accu+1
-    | Bit.One::rest -> popcnt (accu+1) rest
+    | Bit.Zero -> accu
-    | Bit.Zero::rest -> popcnt (accu) rest
+  ) 
-  in popcnt 0 b
 
 
 

ocaml/Bitlist.mli

@@ -6,9 +6,12 @@ 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
@@ -16,6 +19,7 @@ val to_int64 : t -> int64
 
 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 of_bitlist_couple ?n_int ~alpha ~beta (xa,xb) =
-  let ba = Bitlist.to_int64_list xa in
+  let ba, bb =
-  let bb = Bitlist.to_int64_list xb in
+    Bitlist.to_int64_array xa ,
-  let n_int = Bitlist.n_int_of_mo_tot_num (List.length xa) in
+    Bitlist.to_int64_array xb 
-  of_int64_array ~n_int:n_int ~alpha:alpha ~beta:beta (Array.of_list (ba@bb))
+  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 () 
+      let n_int = 
-    and n_alpha = Ezfio.get_electrons_elec_alpha_num ()
+        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 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)
+            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 n_beta)
+            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) @ 
+            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 n_int_i =
-    let psi_det_array = Ezfio.get_determinants_psi_det () in
+          N_int_number.to_int n_int in
-    let dim = psi_det_array.Ezfio.dim
+      let psi_det_array =
-    and data =  Ezfio.flattened_ezfio psi_det_array
+          Ezfio.get_determinants_psi_det ()
       in
-    assert (n_int = dim.(0));
+      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 ())));
-    List.init dim.(2) ~f:(fun i ->
+      let len = 
-      Array.sub ~pos:(2*n_int*i) ~len:(2*n_int) data)
+        2 * n_int_i
-    |> List.map ~f:(Determinant.of_int64_array
+      in
-      ~n_int:(N_int_number.of_int n_int)
+      Array.init dim.(2) ~f:(fun i ->
-      ~alpha:n_alpha ~beta:n_beta )
+         Array.sub ~pos:(len * i) ~len data
-    |> Array.of_list
+         |> Determinant.of_int64_array ~n_int ~alpha ~beta 
+      )
   ;;
 
   let write_psi_det ~n_int ~n_det d =
@@ -380,35 +394,49 @@ psi_det                = %s
           let i = 
             i-1
           in
-          List.map ~f:(fun x -> Det_coef.to_string x.(i)) buffer
+          List.map ~f:(fun x -> x.(i)) buffer
-          |> String.concat ~sep:" "
         in
-        let rec build_result = function
+        let rec build_result accu = function
-        | 1 -> extract_state 1
+        | 0 -> accu
-        | i -> (build_result (i-1))^" "^(extract_state i)
+        | i -> 
+            let new_accu =
+               (extract_state i) :: accu
             in
-        build_result nstates 
+            build_result new_accu (i-1)
         in
-      "(psi_coef ("^a^"))"
+        build_result [] nstates 
       in
+      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 -> 
+      | ""::_::alpha_str::beta_str::tail -> 
           begin
             let newdet =
-               (Bitlist.of_string ~zero:'-' ~one:'+' alpha ,
+               (Bitlist.of_string_mp alpha_str, Bitlist.of_string_mp beta_str)
-               Bitlist.of_string ~zero:'-' ~one:'+' beta)
+               |> Determinant.of_bitlist_couple ~n_int ~alpha ~beta
-               |> Determinant.of_bitlist_couple  ~alpha:n_alpha ~beta:n_beta 
-               |> Determinant.sexp_of_t
-               |> Sexplib.Sexp.to_string
             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
+      |> Array.of_list
+    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 =
+      [ header ; bitkind ; n_int ; "(psi_coef ())" ; "(psi_det ())"]
       |> String.concat 
     in
-      Gc.set control;
+    let result = 
-      "(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
-
       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