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
1
.merlin
1
.merlin
@ -7,4 +7,5 @@ S Utils
|
|||||||
S Basis
|
S Basis
|
||||||
S SCF
|
S SCF
|
||||||
S MOBasis
|
S MOBasis
|
||||||
|
S CI
|
||||||
B _build/**
|
B _build/**
|
||||||
|
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 k ->
|
||||||
List.iter (fun j ->
|
List.iter (fun j ->
|
||||||
incr jk;
|
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)
|
|> Array.iteri (fun i x -> o.{i+1,!jk} <- x)
|
||||||
) range_ao
|
) range_ao
|
||||||
) range_ao;
|
) range_ao;
|
||||||
@ -116,10 +116,10 @@ let four_index_transform ~mo_coef eri_ao =
|
|||||||
List.iter (fun alpha ->
|
List.iter (fun alpha ->
|
||||||
let x = u.{alpha,beta,gamma} in
|
let x = u.{alpha,beta,gamma} in
|
||||||
if x <> 0. then
|
if x <> 0. then
|
||||||
ERI.set_phys eri_mo alpha beta gamma delta x
|
ERI.set_chem eri_mo alpha beta gamma delta x
|
||||||
) range_mo
|
) (list_range ~start:1 beta)
|
||||||
) range_mo
|
) range_mo
|
||||||
) range_mo
|
) (list_range ~start:1 delta)
|
||||||
) range_mo;
|
) range_mo;
|
||||||
Printf.eprintf "\n%!";
|
Printf.eprintf "\n%!";
|
||||||
|
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
.NOPARALLEL:
|
.NOPARALLEL:
|
||||||
|
|
||||||
INCLUDE_DIRS=Nuclei,Utils,Basis,SCF,MOBasis
|
INCLUDE_DIRS=Nuclei,Utils,Basis,SCF,MOBasis,CI
|
||||||
LIBS=
|
LIBS=
|
||||||
PKGS=
|
PKGS=
|
||||||
OCAMLBUILD=ocamlbuild -j 0 -cflags $(ocamlcflags) -lflags $(ocamlcflags) $(ocamldocflags) -Is $(INCLUDE_DIRS) -ocamlopt $(ocamloptflags)
|
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
|
<*.byte> : linkdep(Utils/math_functions.o), custom
|
||||||
<*.native>: linkdep(Utils/math_functions.o)
|
<*.native>: linkdep(Utils/math_functions.o)
|
||||||
<odoc-ltxhtml>: not_hygienic
|
<odoc-ltxhtml>: not_hygienic
|
||||||
|
@ -15,6 +15,7 @@ let test_water_dz () =
|
|||||||
Alcotest.run "Water, cc-pVDZ" [
|
Alcotest.run "Water, cc-pVDZ" [
|
||||||
"AO_Basis", AOBasis.test_case ao_basis;
|
"AO_Basis", AOBasis.test_case ao_basis;
|
||||||
"Guess", Guess.test_case ao_basis;
|
"Guess", Guess.test_case ao_basis;
|
||||||
|
"Determinant", Determinant.test_case ();
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user