QCaml/CI/Excitation.ml

type single_exc =
  {
    hole     : int    ;
    particle : int    ;
    spin     : Spin.t ;
    phase    : Phase.t;
  }

type t =
| Identity
| Single    of single_exc
| Double    of single_exc * single_exc
| Multiple  of single_exc list

let single_of_spindet t t' =
  assert (Spindeterminant.degree t t' = 1);
  let d  = Spindeterminant.bitstring t
  and d' = Spindeterminant.bitstring t'
  in
  let tmp = Z.logxor d d' in
  let hole_z     = Z.logand (Spindeterminant.bitstring t ) tmp
  and particle_z = Z.logand (Spindeterminant.bitstring t') tmp
  in
  let hole     = 1 + Z.trailing_zeros hole_z
  and particle = 1 + Z.trailing_zeros particle_z
  in
  (* Phase calculation *)
  let low, high = 
    if particle > hole then hole, particle
    else particle, hole
  in
  let mask =
    let h = high-1 in
    let mask_up = Z.(shift_left one h - one)
    and mask_dn = Z.(neg (shift_left one low) + one)
    in Z.logand mask_up mask_dn
  in
  let phase = 
    Phase.to_nperm (Spindeterminant.phase t ) +
    Phase.to_nperm (Spindeterminant.phase t') + 
    Z.(popcount @@ logand d mask )
    |> Phase.of_nperm
  in
  (hole, particle, phase)


let single_of_det t t' =
  if Determinant.(beta t = beta t') then
    let hole, particle, phase =
      single_of_spindet (Determinant.alfa t) (Determinant.alfa t') 
    in
    { hole ; particle ; phase ; spin=Spin.Alfa }
  else
    let hole, particle, phase =
      single_of_spindet (Determinant.beta t) (Determinant.beta t') 
    in
    { hole ; particle ; phase ; spin=Spin.Beta }

(*

let double_of_spindet t t' =
  assert (Spindeterminant.degree t t' = 2);
  let d  = Spindeterminant.bitstring t
  and d' = Spindeterminant.bitstring t'
  in
  let tmp = Z.logxor d d' in
  let hole_z     = Z.logand (Spindeterminant.bitstring t ) tmp
  and particle_z = Z.logand (Spindeterminant.bitstring t') tmp
  in
  let hole     = 1 + Z.trailing_zeros hole_z
  and particle = 1 + Z.trailing_zeros particle_z
  in
  (* Phase calculation *)
  let low, high = 
    if particle > hole then hole, particle
    else particle, hole
  in
  let mask =
    let mask_up = Z.(shift_left one (high-1) - one) 
    and mask_dn = Z.(neg (shift_left one low) + one)
    in Z.logand mask_up mask_dn
  in
  let phase = 
    Phase.(to_nperm d + to_nperm d') + Z.(popcount @@ logand d mask )
    |> Phase.of_nperm
  in
  (hole, particle, phase)
*)

let pp_exc ppf t =
  Format.fprintf ppf "@[%cT^{%s}_{%d->%d}@]"
    (match t.phase with
      | Phase.Pos -> '+'
      | Phase.Neg -> '-' )
    (match t.spin with
      | Spin.Alfa -> "\\alpha"
      | Spin.Beta -> "\\beta " )
    t.hole t.particle


let test_case () =

  let test_single () =
    let l_a = [ 1 ; 2 ; 3 ; 5 ; 64 ]
    and l_b = [ 2 ; 3 ; 5 ; 65 ] in
    let det1 = Determinant.of_lists l_a l_b in
    let det2 = Determinant.single_excitation Spin.Alfa 3 7 det1 in 
    let t = single_of_det det1 det2 in
    Alcotest.(check bool) "single 1" (t = { hole=3 ; particle=7 ; spin=Spin.Alfa ; phase=Phase.Neg} ) true;
    let det2 = Determinant.single_excitation Spin.Alfa 2 7 det1 in 
    let t = single_of_det det1 det2 in
    Alcotest.(check bool) "single 2" (t = { hole=2 ; particle=7 ; spin=Spin.Alfa ; phase=Phase.Neg} ) true;
    let det2 = Determinant.single_excitation Spin.Beta 2 7 det1 in 
    let t = single_of_det det1 det2 in
    Alcotest.(check bool) "single 3" (t = { hole=2 ; particle=7 ; spin=Spin.Beta ; phase=Phase.Pos} ) true;
    let det2 = Determinant.single_excitation Spin.Beta 3 256 det1 in 
    let t = single_of_det det1 det2 in
    Alcotest.(check bool) "single 4" (t = { hole=3 ; particle=256 ; spin=Spin.Beta ; phase=Phase.Pos} ) true;
  in
  [
    "Single", `Quick, test_single;
    (*
    "Double", `Quick, test_single;
    *)
  ]