QCaml/CI/Spindeterminant.ml

type t =
  {
    bitstring : Z.t ;
    phase     : Phase.t ;
  }


let vac = 
  Some  { bitstring = Z.zero;
          phase     = Phase.Pos;
        }


let creation p = function
  | None -> None
  | Some spindet ->
    let i = pred p in
    if Z.testbit spindet.bitstring i then
      None
    else
      begin
        let x = Z.(shift_left one i) in
        let bitstring = Z.logor spindet.bitstring x in
        let mask = Z.(x-one) in
        let r = Z.logand bitstring mask in
        let phase = Phase.add_nperm spindet.phase (Z.popcount r) in
        Some { bitstring ; phase }
      end


let annihilation q = function
  | None -> None
  | Some spindet ->
    let i = pred q in
    if not (Z.testbit spindet.bitstring i) then
      None
    else
      begin
        let x = Z.(shift_left one i) in
        let mask = Z.(x-one) in
        let r = Z.logand spindet.bitstring mask in
        let phase = Phase.add_nperm spindet.phase (Z.popcount r) in
        let bitstring = Z.logand spindet.bitstring (Z.lognot x) in
        Some { bitstring ; phase }
      end

let of_list l = 
  let result = 
    List.rev l
    |> List.fold_left (fun accu p -> creation p accu) vac
  in
  match result with
  | None -> raise (Invalid_argument "Can't create determinant from list")
  | Some x -> x



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 pp_bitstring ppf bs =
  String.init (Z.numbits bs) (fun i -> if (Z.testbit bs i) then '+' else '-')
  |> Format.fprintf ppf "@[<h>%s@]"

let pp_spindet ppf s =
  Format.fprintf ppf "@[<h>%a %a@]" Phase.pp_phase s.phase pp_bitstring s.bitstring



let test_case () =

  let test_creation () =
      let l_a = [ 1 ; 2 ; 3 ; 5 ] in
      let det = of_list l_a in
      Alcotest.(check (list int )) "bitstring 1" (to_list det.bitstring) l_a;
      Alcotest.(check bool) "phase 2" true (det.phase = Phase.Pos);
      let l_b = [ 1 ; 3 ; 2 ; 5 ] in
      let det = of_list l_b in
      Alcotest.(check (list int )) "bitstring 2" (to_list det.bitstring) l_a;
      Alcotest.(check bool) "phase 2" true (det.phase = Phase.Neg);
  in

  let test_operators () =
      let det = 
        creation 5 @@ creation 2 @@ creation 2 @@ creation 1 @@ vac
      in
      Alcotest.(check bool) "none 1" true (det = None);

      let det = 
        match (creation 5 @@ creation 3 @@ creation 2 @@ creation 1 @@ vac) with
        | Some x -> x
        | None -> assert false
      in
      let l_a = [ 1 ; 2 ; 3 ; 5 ] in
      Alcotest.(check (list int )) "bitstring 1" l_a (to_list det.bitstring);
      Alcotest.(check bool) "phase 1" true (det.phase = Phase.Pos);

      let det = 
        match (creation 1 @@ creation 3 @@ creation 2 @@ creation 5 @@ vac) with
        | Some x -> x
        | None -> assert false
      in
      Alcotest.(check (list int )) "bitstring 2" l_a (to_list det.bitstring);
      Alcotest.(check bool) "phase 2" true (det.phase = Phase.Neg);

      let l_b = [ 1 ; 3 ; 2 ; 5 ] in
      let det = of_list l_b in
      Alcotest.(check (list int )) "bitstring 3" l_a (to_list det.bitstring);
      Alcotest.(check bool) "phase 3" true (det.phase = Phase.Neg);

      Alcotest.(check bool) "none 1" true (annihilation 4 (Some det) = None);

      let det = 
        match annihilation 1 (Some det) with
        | Some x -> x
        | None -> assert false
      in
      Alcotest.(check (list int )) "bitstring 4" (List.tl l_a) (to_list det.bitstring);
      Alcotest.(check bool) "phase 4" true (det.phase = Phase.Neg);

      let det = 
        match annihilation 3 (Some det) with
        | Some x -> x
        | None -> assert false
      in
      Alcotest.(check (list int )) "bitstring 5" [ 2 ; 5 ] (to_list det.bitstring);
      Alcotest.(check bool) "phase 5" true (det.phase = Phase.Pos);

      let det = 
        match annihilation 5 @@ annihilation 2 (Some det) with
        | Some x -> x
        | None -> assert false
      in
      Alcotest.(check (list int )) "bitstring 6" [] (to_list det.bitstring);
      Alcotest.(check bool) "phase 6" true (det.phase = Phase.Pos);

  in
  [
    "Creation", `Quick, test_creation;
    "Operators", `Quick, test_operators;
  ]