10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-12-22 20:33:36 +01:00
QCaml/ci/lib/spindeterminant.ml
2024-06-24 14:28:30 +02:00

145 lines
3.5 KiB
OCaml

open Common
type s =
{
bitstring : Bitstring.t;
phase : Phase.t ;
}
type t = s option
type hole = int
type particle = int
let phase = function
| Some s -> s.phase
| None -> Phase.Pos
let is_none = function
| None -> true
| _ -> false
let bitstring = function
| Some s -> s.bitstring
| None -> invalid_arg "Spindeterminant is None"
let vac n =
Some { bitstring = Bitstring.zero n;
phase = Phase.Pos; }
let creation p = function
| None -> None
| Some spindet ->
let i = pred p in
if Bitstring.testbit spindet.bitstring i then
None
else
begin
let numbits = Bitstring.numbits spindet.bitstring in
let x = Bitstring.shift_left_one numbits i in
let bitstring = Bitstring.logor spindet.bitstring x in
let mask = Bitstring.minus_one x in
let r = Bitstring.logand bitstring mask in
let phase = Phase.add_nperm spindet.phase (Bitstring.popcount r) in
Some { bitstring ; phase }
end
let annihilation h = function
| None -> None
| Some spindet ->
let i = pred h in
if not (Bitstring.testbit spindet.bitstring i) then
None
else
begin
let numbits = Bitstring.numbits spindet.bitstring in
let x = Bitstring.shift_left_one numbits i in
let mask = Bitstring.minus_one x in
let r = Bitstring.logand spindet.bitstring mask in
let phase = Phase.add_nperm spindet.phase (Bitstring.popcount r) in
let bitstring = Bitstring.logand spindet.bitstring (Bitstring.lognot x) in
Some { bitstring ; phase }
end
let single_excitation_reference h p spindet =
creation p @@ annihilation h @@ spindet
let single_excitation h p =
single_excitation_reference h p
let double_excitation_reference h' p' h p spindet =
creation p' @@ creation p @@ annihilation h @@ annihilation h' @@ spindet
let double_excitation h' p' h p =
double_excitation_reference h' p' h p
let excitation_level t t' =
Bitstring.hamdist (bitstring t) (bitstring t') / 2
let holes_of t t' =
Bitstring.logand (bitstring t) (Bitstring.logxor (bitstring t) (bitstring t'))
|> Bitstring.to_list
let particles_of t t' =
Bitstring.logand (bitstring t') (Bitstring.logxor (bitstring t) (bitstring t'))
|> Bitstring.to_list
let holes_particles_of t t' =
let x = Bitstring.logxor (bitstring t) (bitstring t') in
let holes = Bitstring.logand (bitstring t) x |> Bitstring.to_list
and particles = Bitstring.logand (bitstring t') x |> Bitstring.to_list
in
List.rev_map2 (fun h p -> (h,p)) holes particles
|> List.rev
let set_phase p = function
| Some t -> Some { t with phase = p }
| None -> None
let negate_phase = function
| Some t -> Some { t with phase = Phase.neg t.phase }
| None -> None
let of_bitstring ?(phase=Phase.Pos) bitstring =
Some { bitstring ; phase }
let of_list n l =
List.rev l
|> List.fold_left (fun accu p -> creation p accu) (vac n)
let to_list = function
| None -> []
| Some spindet ->
let rec aux accu z =
if not (Bitstring.is_zero z) then
let element = ((Bitstring.trailing_zeros z)+1) in
(aux [@tailcall]) (element::accu) (Bitstring.logand z (Bitstring.minus_one z) )
else List.rev accu
in aux [] spindet.bitstring
let to_array t =
to_list t
|> Array.of_list
let n_electrons = function
| Some t -> Bitstring.popcount t.bitstring
| None -> 0
let pp ppf = function
| None -> Format.fprintf ppf "@[<h>None@]"
| Some s ->
Format.fprintf ppf "@[<h>%a %a@]" Phase.pp s.phase Bitstring.pp
s.bitstring