Added sign in determinants

This commit is contained in:
Anthony Scemama 2018-07-20 19:02:56 +02:00
parent 4f41af9e31
commit 9ff27d2639
6 changed files with 125 additions and 6 deletions

View File

@ -7,4 +7,5 @@ S Utils
S Basis
S SCF
S MOBasis
S CI
B _build/**

117
CI/Determinant.ml Normal file
View 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;
]

View File

@ -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
ERI.set_chem eri_mo alpha beta gamma delta x
) (list_range ~start:1 beta)
) range_mo
) range_mo
) (list_range ~start:1 delta)
) range_mo;
Printf.eprintf "\n%!";

View File

@ -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
View File

@ -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

View File

@ -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 ();
]