From 13005634fbcc67c027799807ba091a743510e586 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 15 Feb 2019 16:25:47 +0100 Subject: [PATCH] Creation/Annihilation operators --- CI/Phase.ml | 10 ++++ CI/Phase.mli | 3 + CI/Spindeterminant.ml | 131 ++++++++++++++++++++++++++++++++++-------- 3 files changed, 121 insertions(+), 23 deletions(-) diff --git a/CI/Phase.ml b/CI/Phase.ml index d4febb2..643a7bc 100644 --- a/CI/Phase.ml +++ b/CI/Phase.ml @@ -6,6 +6,16 @@ let of_nperm nperm = if (nperm land 1) = 1 then Neg else Pos +let add_nperm phase = function + | 0 -> phase + | nperm -> + begin + match (phase, of_nperm nperm) with + | (Pos,Pos) | (Neg,Neg) -> Pos + | _ -> Neg + end + + let pp_phase ppf = function | Pos -> Format.fprintf ppf "@[+1@]" | Neg -> Format.fprintf ppf "@[-1@]" diff --git a/CI/Phase.mli b/CI/Phase.mli index 5aaeec7..2a24180 100644 --- a/CI/Phase.mli +++ b/CI/Phase.mli @@ -5,6 +5,9 @@ type t = val of_nperm : int -> t (** Returns the phase obtained by a given number of permuations. *) +val add_nperm : t -> int -> t +(** Add to an existing phase a given number of permutations. *) + (** Formatters *) val pp_phase : Format.formatter -> t -> unit diff --git a/CI/Spindeterminant.ml b/CI/Spindeterminant.ml index 02b6c66..76220d6 100644 --- a/CI/Spindeterminant.ml +++ b/CI/Spindeterminant.ml @@ -4,29 +4,57 @@ type 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 rec aux accu nperm = function - | [] -> { bitstring = accu; - phase = Phase.of_nperm nperm; } - | i :: rest -> - let i = pred i in - let x = Z.(shift_left one i) in - let accu = Z.logor accu x in - let nperm = - let mask = Z.(x-one) in - let r = Z.logand accu mask in - if r = Z.zero then - nperm - else - nperm + (Z.popcount r) - in - aux accu nperm rest + let result = + List.rev l + |> List.fold_left (fun accu p -> creation p accu) vac in - List.rev l - |> aux Z.zero 0 + match result with + | None -> raise (Invalid_argument "Can't create determinant from list") + | Some x -> x + -(* TODO Phase *) let rec to_list spindet = let rec aux accu z = if z <> Z.zero then @@ -50,15 +78,72 @@ 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" (to_list det.bitstring) l_a; - Alcotest.(check bool) "phase" (det.phase = Phase.Pos) true; + 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" (to_list det.bitstring) l_a; - Alcotest.(check bool) "phase" (det.phase = Phase.Neg) true; + 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; ]