Creation/Annihilation operators

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 "@[<h>+1@]"
   | Neg -> Format.fprintf ppf "@[<h>-1@]"

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

CI/Spindeterminant.ml

@@ -4,29 +4,57 @@ type t =
     phase     : Phase.t ;
   }
 
-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
+
+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
-        nperm + (Z.popcount r)
-    in
-    aux accu nperm rest
-  in
+      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
-  |> aux Z.zero 0
+    |> 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
+
 
 
-(* 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;
   ]