mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-06-29 08:24:43 +02:00
267 lines
7.4 KiB
OCaml
267 lines
7.4 KiB
OCaml
type t =
|
|
| One of int
|
|
| Many of Z.t
|
|
|
|
|
|
(*
|
|
let of_int x = One x
|
|
*)
|
|
let of_int x = Many (Z.of_int x)
|
|
|
|
let of_z x = if (Z.lt x (Z.of_int max_int)) then One (Z.to_int x) else Many x
|
|
|
|
(*
|
|
let zero = One 0
|
|
*)
|
|
let zero = Many Z.zero
|
|
|
|
|
|
let is_zero = function
|
|
| One x -> assert false (* x = 0 *)
|
|
| Many x -> x = Z.zero
|
|
|
|
|
|
let shift_left x i =
|
|
match x with
|
|
| One x -> assert false (*
|
|
let y = x lsl i in
|
|
if y lsr i = x then
|
|
One y
|
|
else
|
|
Many (Z.shift_left (Z.of_int x) i)
|
|
*)
|
|
| Many x -> Many (Z.shift_left x i)
|
|
|
|
|
|
let shift_right x i =
|
|
match x with
|
|
| One x -> assert false (* One (x lsr i) *)
|
|
| Many x -> Z.shift_right x i |> of_z
|
|
|
|
|
|
let shift_left_one =
|
|
let memo =
|
|
Array.init 512 (fun i ->
|
|
(*
|
|
if i < 63 then
|
|
One (1 lsl i)
|
|
else
|
|
*)
|
|
Many (Z.(shift_left one i)))
|
|
in
|
|
fun i ->
|
|
if i < 512 then
|
|
memo.(i)
|
|
else
|
|
Many (Z.(shift_left one i))
|
|
|
|
|
|
let testbit bs i =
|
|
match bs with
|
|
| One one -> assert false (* (one lsr i) land 1 = 1 *)
|
|
| Many z -> Z.testbit z i
|
|
|
|
|
|
let logor a b =
|
|
match a,b with
|
|
| One a, One b -> assert false (* One (a lor b) *)
|
|
| One a, Many b -> Many (Z.logor (Z.of_int a) b)
|
|
| Many a, One b -> Many (Z.logor a (Z.of_int b))
|
|
| Many a, Many b -> Many (Z.logor a b)
|
|
|
|
|
|
let logxor a b =
|
|
match a,b with
|
|
| One a, One b -> assert false (* One (a lxor b) *)
|
|
| One a, Many b -> Many (Z.logxor (Z.of_int a) b)
|
|
| Many a, One b -> Many (Z.logxor a (Z.of_int b))
|
|
| Many a, Many b -> Many (Z.logxor a b)
|
|
|
|
|
|
let logand a b =
|
|
match a,b with
|
|
| One a, One b -> assert false (* One (a land b) *)
|
|
| One a, Many b -> Many (Z.logand (Z.of_int a) b)
|
|
| Many a, One b -> Many (Z.logand a (Z.of_int b))
|
|
| Many a, Many b -> Many (Z.logand a b)
|
|
|
|
|
|
let lognot = function
|
|
| One a -> Many ( Z.(lognot @@ of_int a) )
|
|
| Many a -> Many ( Z.lognot a )
|
|
|
|
|
|
let minus_one = function
|
|
| One a -> assert false (* One ( a-1 ) *)
|
|
| Many a -> Many ( Z.(a-one) )
|
|
|
|
|
|
let plus_one = function
|
|
| One a -> assert false (* One ( a+1 ) *)
|
|
| Many a -> Many ( Z.(a+one) )
|
|
|
|
|
|
let popcount = function
|
|
| One r -> assert false (* Util.popcnt (Int64.of_int r) *)
|
|
| Many r when r = Z.zero -> 0
|
|
| Many r -> Z.popcount r
|
|
|
|
|
|
let trailing_zeros = function
|
|
| One r -> assert false (* Util.trailz (Int64.of_int r) *)
|
|
| Many r -> Z.trailing_zeros r
|
|
|
|
|
|
let hamdist a b =
|
|
match a,b with
|
|
| One a, One b -> assert false (* a lxor b |> Int64.of_int |> Util.popcnt *)
|
|
| One a, Many b -> Z.hamdist (Z.of_int a) b
|
|
| Many a, One b -> Z.hamdist a (Z.of_int b)
|
|
| Many a, Many b -> Z.hamdist a b
|
|
|
|
|
|
let rec to_list accu = function
|
|
| t when (t = Many Z.zero || t = One 0) -> List.rev accu
|
|
| t -> let newlist =
|
|
(trailing_zeros t + 1)::accu
|
|
in
|
|
to_list newlist (logand t (minus_one t))
|
|
|
|
|
|
(** [permtutations m n] generates the list of all possible [n]-bit
|
|
strings with [m] bits set to 1.
|
|
Algorithm adapted from
|
|
{{:https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation}
|
|
Bit twiddling hacks}.
|
|
Example:
|
|
{[
|
|
bit_permtutations 2 4 = [ 0011 ; 0101 ; 0110 ; 1001 ; 1010 ; 1100 ]
|
|
]}
|
|
*)
|
|
let permtutations m n =
|
|
|
|
let rec aux k u rest =
|
|
if k=1 then
|
|
List.rev (u :: rest)
|
|
else
|
|
let t = (logor u (minus_one u)) in
|
|
let t' = plus_one t in
|
|
let t'' = shift_right (minus_one (logand (lognot t) t')) (trailing_zeros u + 1) in
|
|
aux (k-1) (logor t' t'') (u :: rest)
|
|
in
|
|
aux (Util.binom n m) (minus_one (shift_left_one m)) []
|
|
|
|
|
|
|
|
let pp_bitstring n ppf s =
|
|
Format.fprintf ppf "@[%a@]" (Util.pp_bitstring n) (
|
|
match s with
|
|
| Many b -> b
|
|
| One b -> Z.of_int b )
|
|
|
|
|
|
|
|
|
|
(*-----------------------------------------------------------------------------------*)
|
|
(* TODO
|
|
|
|
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" l_a (to_list det);
|
|
Alcotest.(check bool) "phase 2" true (phase det = Phase.Pos);
|
|
let l_b = [ 1 ; 3 ; 2 ; 5 ] in
|
|
let det = of_list l_b in
|
|
Alcotest.(check (list int )) "bitstring 2" l_a (to_list det);
|
|
Alcotest.(check bool) "phase 2" true (phase det = Phase.Neg);
|
|
in
|
|
|
|
let test_a_operators () =
|
|
let det =
|
|
creation 5 @@ creation 2 @@ creation 2 @@ creation 1 @@ vac
|
|
in
|
|
Alcotest.(check bool) "none 1" true (is_none det);
|
|
|
|
let det =
|
|
creation 5 @@ creation 3 @@ creation 2 @@ creation 1 @@ vac
|
|
in
|
|
let l_a = [ 1 ; 2 ; 3 ; 5 ] in
|
|
Alcotest.(check (list int )) "bitstring 1" l_a (to_list det);
|
|
Alcotest.(check bool) "phase 1" true (phase det = Phase.Pos);
|
|
|
|
let det =
|
|
creation 1 @@ creation 3 @@ creation 2 @@ creation 5 @@ vac
|
|
in
|
|
Alcotest.(check (list int )) "bitstring 2" l_a (to_list det);
|
|
Alcotest.(check bool) "phase 2" true (phase det = 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);
|
|
Alcotest.(check bool) "phase 3" true (phase det = Phase.Neg);
|
|
|
|
Alcotest.(check bool) "none 1" true (annihilation 4 det |> is_none);
|
|
|
|
let det =
|
|
annihilation 1 det
|
|
in
|
|
Alcotest.(check (list int )) "bitstring 4" (List.tl l_a) (to_list det);
|
|
Alcotest.(check bool) "phase 4" true (phase det = Phase.Neg);
|
|
|
|
let det =
|
|
annihilation 3 det
|
|
in
|
|
Alcotest.(check (list int )) "bitstring 5" [ 2 ; 5 ] (to_list det);
|
|
Alcotest.(check bool) "phase 5" true (phase det = Phase.Pos);
|
|
|
|
let det =
|
|
annihilation 5 @@ annihilation 2 det
|
|
in
|
|
Alcotest.(check (list int )) "bitstring 6" [] (to_list det);
|
|
Alcotest.(check bool) "phase 6" true (phase det = Phase.Pos);
|
|
|
|
in
|
|
|
|
let test_exc_operators () =
|
|
let l_a = [ 1 ; 2 ; 3 ; 5 ] in
|
|
let det = of_list l_a in
|
|
let l_b = [ 1 ; 7 ; 3 ; 5 ] in
|
|
let det2 = of_list l_b in
|
|
Alcotest.(check bool) "single 1" true (single_excitation_reference 2 7 det = det2);
|
|
Alcotest.(check bool) "single 2" true (single_excitation 2 7 det = single_excitation_reference 2 7 det);
|
|
Alcotest.(check bool) "single 3" true (single_excitation_reference 4 7 det |> is_none);
|
|
Alcotest.(check bool) "single 4" true (single_excitation 4 7 det |> is_none);
|
|
|
|
let l_c = [ 1 ; 7 ; 6 ; 5 ] in
|
|
let det3 = of_list l_c in
|
|
Alcotest.(check bool) "double 1" true (double_excitation_reference 2 7 3 6 det = det3);
|
|
Alcotest.(check bool) "double 2" true (double_excitation 2 7 3 6 det = double_excitation_reference 2 7 3 6 det);
|
|
Alcotest.(check bool) "double 3" true (double_excitation_reference 4 7 3 6 det |> is_none);
|
|
Alcotest.(check bool) "double 4" true (double_excitation 4 7 3 6 det |> is_none);
|
|
in
|
|
|
|
let test_exc_spindet () =
|
|
let l_a = [ 1 ; 2 ; 3 ; 5 ] in
|
|
let det = of_list l_a in
|
|
let l_b = [ 1 ; 7 ; 3 ; 5 ] in
|
|
let det2 = of_list l_b in
|
|
Alcotest.(check int) "single" 1 (degree det det2);
|
|
Alcotest.(check (list int)) "holes" [2] (holes_of det det2);
|
|
Alcotest.(check (list int)) "particles" [7] (particles_of det det2);
|
|
let l_b = [ 1 ; 7 ; 3 ; 6 ] in
|
|
let det2 = of_list l_b in
|
|
Alcotest.(check int) "double" 2 (degree det det2);
|
|
Alcotest.(check (list int)) "holes" [2 ; 5] (holes_of det det2);
|
|
Alcotest.(check (list int)) "particles" [6 ; 7] (particles_of det det2);
|
|
in
|
|
[
|
|
"Creation", `Quick, test_creation;
|
|
"Creation/Annihilation Operators", `Quick, test_a_operators;
|
|
"Excitation Operators", `Quick, test_exc_operators;
|
|
"Excitation of spindet", `Quick, test_exc_spindet;
|
|
]
|
|
|
|
*)
|