module Math.Combinatorics.Species.Algebra
(
SpeciesAlgT(..)
, SpeciesAlg(..)
, needsZT, needsZ
, reify
, reflectT
, reflect
) where
import Math.Combinatorics.Species.Class
import Math.Combinatorics.Species.Types
import qualified Algebra.Additive as Additive
import qualified Algebra.Ring as Ring
import qualified Algebra.Differential as Differential
import NumericPrelude
import PreludeBase hiding (cycle)
data SpeciesAlgT s where
O :: SpeciesAlgT Z
I :: SpeciesAlgT (S Z)
X :: SpeciesAlgT X
(:+:) :: (ShowF (StructureF f), ShowF (StructureF g))
=> SpeciesAlgT f -> SpeciesAlgT g -> SpeciesAlgT (f :+: g)
(:*:) :: (ShowF (StructureF f), ShowF (StructureF g))
=> SpeciesAlgT f -> SpeciesAlgT g -> SpeciesAlgT (f :*: g)
(:.:) :: (ShowF (StructureF f), ShowF (StructureF g))
=> SpeciesAlgT f -> SpeciesAlgT g -> SpeciesAlgT (f :.: g)
Der :: (ShowF (StructureF f))
=> SpeciesAlgT f -> SpeciesAlgT (Der f)
E :: SpeciesAlgT E
C :: SpeciesAlgT C
OfSize :: SpeciesAlgT f -> (Integer -> Bool) -> SpeciesAlgT f
OfSizeExactly :: SpeciesAlgT f -> Integer -> SpeciesAlgT f
instance Show (SpeciesAlgT s) where
show O = "0"
show I = "1"
show X = "X"
show (f :+: g) = "(" ++ show f ++ " + " ++ show g ++ ")"
show (f :*: g) = "(" ++ show f ++ " * " ++ show g ++ ")"
show (f :.: g) = "(" ++ show f ++ " . " ++ show g ++ ")"
show (Der f) = show f ++ "'"
show E = "E"
show C = "C"
show (OfSize f p) = "<" ++ show f ++ ">"
show (OfSizeExactly f n) = show f ++ "_" ++ show n
needsZT :: SpeciesAlgT s -> Bool
needsZT (f :+: g) = needsZT f || needsZT g
needsZT (f :*: g) = needsZT f || needsZT g
needsZT (_ :.: _) = True
needsZT (Der _) = True
needsZT (OfSize f _) = needsZT f
needsZT (OfSizeExactly f _) = needsZT f
needsZT _ = False
data SpeciesAlg where
SA :: (ShowF (StructureF s)) => SpeciesAlgT s -> SpeciesAlg
needsZ :: SpeciesAlg -> Bool
needsZ (SA s) = needsZT s
instance Show SpeciesAlg where
show (SA f) = show f
instance Additive.C SpeciesAlg where
zero = SA O
(SA f) + (SA g) = SA (f :+: g)
negate = error "negation is not implemented yet! wait until virtual species..."
instance Ring.C SpeciesAlg where
(SA f) * (SA g) = SA (f :*: g)
one = SA I
instance Differential.C SpeciesAlg where
differentiate (SA f) = SA (Der f)
instance Species SpeciesAlg where
singleton = SA X
set = SA E
cycle = SA C
o (SA f) (SA g) = SA (f :.: g)
ofSize (SA f) p = SA (OfSize f p)
ofSizeExactly (SA f) n = SA (OfSizeExactly f n)
reify :: SpeciesAlg -> SpeciesAlg
reify = id
reflectT :: Species s => SpeciesAlgT f -> s
reflectT O = zero
reflectT I = one
reflectT X = singleton
reflectT (f :+: g) = reflectT f + reflectT g
reflectT (f :*: g) = reflectT f * reflectT g
reflectT (f :.: g) = reflectT f `o` reflectT g
reflectT (Der f) = oneHole (reflectT f)
reflectT E = set
reflectT C = cycle
reflectT (OfSize f p) = ofSize (reflectT f) p
reflectT (OfSizeExactly f n) = ofSizeExactly (reflectT f) n
reflect :: Species s => SpeciesAlg -> s
reflect (SA f) = reflectT f