9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-10-06 08:05:58 +02:00
qp2/ocaml/Excitation.ml
2019-03-13 14:08:02 +01:00

72 lines
2.0 KiB
OCaml

open Qptypes
module Hole = struct
type t = MO_class.t [@@deriving sexp]
let of_mo_class x = x
let to_mo_class x = x
end
module Particle = struct
type t = MO_class.t [@@deriving sexp]
let of_mo_class x = x
let to_mo_class x = x
end
type t =
| Single of Hole.t*Particle.t
| Double of Hole.t*Particle.t*Hole.t*Particle.t
[@@deriving sexp]
let create_single ~hole ~particle =
MO_class.(
match (hole,particle) with
| ( Core _, _ ) -> failwith "Holes can not be in core MOs"
| ( _, Core _ ) -> failwith "Particles can not be in core MOs"
| ( Deleted _, _ ) -> failwith "Holes can not be in deleted MOs"
| ( _, Deleted _ ) -> failwith "Particles can not be in deleted MOs"
| ( Virtual _, _ ) -> failwith "Holes can not be in virtual MOs"
| ( _, Inactive _ ) -> failwith "Particles can not be in virtual MOs"
| (h, p) -> Single ( (Hole.of_mo_class h), (Particle.of_mo_class p) )
)
let double_of_singles s1 s2 =
let (h1,p1) = match s1 with
| Single (h,p) -> (h,p)
| _ -> assert false
and (h2,p2) = match s2 with
| Single (h,p) -> (h,p)
| _ -> assert false
in
Double (h1,p1,h2,p2)
let create_double ~hole1 ~particle1 ~hole2 ~particle2 =
let s1 = create_single ~hole:hole1 ~particle:particle1
and s2 = create_single ~hole:hole2 ~particle:particle2
in
double_of_singles s1 s2
let to_string = function
| Single (h,p) ->
[ "Single Exc. : [" ;
(MO_class.to_string (Hole.to_mo_class h));
"," ;
(MO_class.to_string (Particle.to_mo_class p));
"]"]
|> String.concat " "
| Double (h1,p1,h2,p2) ->
[ "Double Exc. : [" ;
(MO_class.to_string (Hole.to_mo_class h1));
"," ;
(MO_class.to_string (Particle.to_mo_class p1));
";" ;
(MO_class.to_string (Hole.to_mo_class h2));
"," ;
(MO_class.to_string (Particle.to_mo_class p2));
"]"]
|> String.concat " "