mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-28 23:42:00 +02:00
Added sign in determinants
This commit is contained in:
parent
4f41af9e31
commit
9ff27d2639
117
CI/Determinant.ml
Normal file
117
CI/Determinant.ml
Normal file
@ -0,0 +1,117 @@
|
||||
type sign_type =
|
||||
| Plus
|
||||
| Minus
|
||||
|
||||
type spin_determinant_type = Z.t
|
||||
|
||||
type determinant_type =
|
||||
{
|
||||
alpha : spin_determinant_type ;
|
||||
beta : spin_determinant_type ;
|
||||
sign : sign_type;
|
||||
}
|
||||
|
||||
|
||||
type t = determinant_type
|
||||
|
||||
|
||||
let spindet_of_list l =
|
||||
let rec aux accu nperm = function
|
||||
| [] -> accu, if nperm mod 2 = 0 then Plus else Minus
|
||||
| i :: rest ->
|
||||
let i = pred i in
|
||||
let x = Z.(one lsl i) in
|
||||
let accu = Z.(x lor accu) in
|
||||
let nperm =
|
||||
let mask = Z.(x-one) in
|
||||
let r = Z.(accu land mask) in
|
||||
if r = Z.zero then
|
||||
nperm
|
||||
else
|
||||
nperm + (Z.popcount r)
|
||||
in
|
||||
aux accu nperm rest
|
||||
in
|
||||
List.rev l
|
||||
|> aux Z.zero 0
|
||||
|
||||
|
||||
|
||||
(* TODO Phase *)
|
||||
let rec to_list spindet =
|
||||
let rec aux accu z =
|
||||
if z <> Z.zero then
|
||||
let element = (Z.(trailing_zeros z)+1) in
|
||||
aux (element::accu) Z.(z land (pred z))
|
||||
else List.rev accu
|
||||
in aux [] spindet
|
||||
|
||||
|
||||
let of_lists a b =
|
||||
let alpha, sign_a =
|
||||
spindet_of_list a
|
||||
in
|
||||
let beta, sign_b =
|
||||
spindet_of_list b
|
||||
in
|
||||
let sign =
|
||||
match sign_a, sign_b with
|
||||
| Plus , Plus -> Plus
|
||||
| Minus, Minus-> Plus
|
||||
| _ -> Minus
|
||||
in
|
||||
{ alpha ; beta ; sign }
|
||||
|
||||
let alpha det = det.alpha
|
||||
let beta det = det.beta
|
||||
|
||||
let sgn det =
|
||||
match det.sign with
|
||||
| Plus -> 1.
|
||||
| Minus -> -1.
|
||||
|
||||
let pp_spindet ppf spindet =
|
||||
String.init (Z.numbits spindet) (fun i -> if (Z.testbit spindet i) then '+' else '-')
|
||||
|> Format.fprintf ppf "@[<v> @[<h> %s @]@]"
|
||||
|
||||
|
||||
let pp_det ppf det =
|
||||
Format.fprintf ppf "@[<v> a: %a @; b: %a @]@." pp_spindet det.alpha pp_spindet det.beta
|
||||
|
||||
let test_case () =
|
||||
|
||||
let test_creation () =
|
||||
let l_a = [ 1 ; 2 ; 3 ; 5 ; 64 ]
|
||||
and l_b = [ 2 ; 3 ; 5 ; 65 ] in
|
||||
let det = of_lists l_a l_b in
|
||||
let z_a = alpha det
|
||||
and z_b = beta det in
|
||||
Alcotest.(check (list int )) "alpha" (to_list z_a) l_a;
|
||||
Alcotest.(check (list int )) "beta" (to_list z_b) l_b;
|
||||
Alcotest.(check bool) "phase" (sgn det = 1.) true;
|
||||
in
|
||||
let test_phase () =
|
||||
let l_a = [ 1 ; 2 ; 3 ; 64 ; 5 ]
|
||||
and l_b = [ 2 ; 3 ; 5 ; 65 ] in
|
||||
let det = of_lists l_a l_b in
|
||||
Alcotest.(check bool) "phase" (sgn det = -1.) true;
|
||||
let l_a = [ 1 ; 2 ; 3 ; 64 ; 5 ]
|
||||
and l_b = [ 3 ; 2 ; 5 ; 65 ] in
|
||||
let det = of_lists l_a l_b in
|
||||
Alcotest.(check bool) "phase" (sgn det = 1.) true;
|
||||
let l_a = [ 1 ; 3 ; 2 ; 64 ; 5 ]
|
||||
and l_b = [ 3 ; 2 ; 5 ; 65 ] in
|
||||
let det = of_lists l_a l_b in
|
||||
Alcotest.(check bool) "phase" (sgn det = -1.) true;
|
||||
let l_a = [ 1 ; 3 ; 2 ; 64 ; 5 ]
|
||||
and l_b = [ 3 ; 2 ; 65 ; 5 ] in
|
||||
let det = of_lists l_a l_b in
|
||||
Alcotest.(check bool) "phase" (sgn det = 1.) true;
|
||||
in
|
||||
[
|
||||
"Creation", `Quick, test_creation;
|
||||
"Phase" , `Quick, test_phase;
|
||||
]
|
||||
|
||||
|
||||
|
@ -76,7 +76,7 @@ let four_index_transform ~mo_coef eri_ao =
|
||||
List.iter (fun k ->
|
||||
List.iter (fun j ->
|
||||
incr jk;
|
||||
ERI.get_phys_all_i eri_ao ~j ~k ~l
|
||||
ERI.get_chem_all_i eri_ao ~j ~k ~l
|
||||
|> Array.iteri (fun i x -> o.{i+1,!jk} <- x)
|
||||
) range_ao
|
||||
) range_ao;
|
||||
@ -116,10 +116,10 @@ let four_index_transform ~mo_coef eri_ao =
|
||||
List.iter (fun alpha ->
|
||||
let x = u.{alpha,beta,gamma} in
|
||||
if x <> 0. then
|
||||
ERI.set_phys eri_mo alpha beta gamma delta x
|
||||
) range_mo
|
||||
) range_mo
|
||||
ERI.set_chem eri_mo alpha beta gamma delta x
|
||||
) (list_range ~start:1 beta)
|
||||
) range_mo
|
||||
) (list_range ~start:1 delta)
|
||||
) range_mo;
|
||||
Printf.eprintf "\n%!";
|
||||
|
||||
|
@ -1,6 +1,6 @@
|
||||
.NOPARALLEL:
|
||||
|
||||
INCLUDE_DIRS=Nuclei,Utils,Basis,SCF,MOBasis
|
||||
INCLUDE_DIRS=Nuclei,Utils,Basis,SCF,MOBasis,CI
|
||||
LIBS=
|
||||
PKGS=
|
||||
OCAMLBUILD=ocamlbuild -j 0 -cflags $(ocamlcflags) -lflags $(ocamlcflags) $(ocamldocflags) -Is $(INCLUDE_DIRS) -ocamlopt $(ocamloptflags)
|
||||
|
2
_tags
2
_tags
@ -1,4 +1,4 @@
|
||||
true: package(str,unix,bigarray,lacaml,alcotest)
|
||||
true: package(str,unix,bigarray,lacaml,alcotest,zarith)
|
||||
<*.byte> : linkdep(Utils/math_functions.o), custom
|
||||
<*.native>: linkdep(Utils/math_functions.o)
|
||||
<odoc-ltxhtml>: not_hygienic
|
||||
|
@ -15,6 +15,7 @@ let test_water_dz () =
|
||||
Alcotest.run "Water, cc-pVDZ" [
|
||||
"AO_Basis", AOBasis.test_case ao_basis;
|
||||
"Guess", Guess.test_case ao_basis;
|
||||
"Determinant", Determinant.test_case ();
|
||||
]
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user