module Math.Algebras.Structures where
import Math.Algebras.VectorSpace
import Math.Algebras.TensorProduct
class Mon m where
munit :: m
mmult :: m -> m -> m
class Algebra k b where
unit :: k -> Vect k b
mult :: Vect k (Tensor b b) -> Vect k b
class Coalgebra k b where
counit :: Vect k b -> k
comult :: Vect k b -> Vect k (Tensor b b)
class (Algebra k b, Coalgebra k b) => Bialgebra k b where {}
class Bialgebra k b => HopfAlgebra k b where
antipode :: Vect k b -> Vect k b
instance (Eq k, Num k, Eq b, Ord b, Show b, Algebra k b) => Num (Vect k b) where
x+y = x <+> y
negate x = neg x
x*y = mult (x `te` y)
fromInteger n = unit (fromInteger n)
abs _ = error "Prelude.Num.abs: inappropriate abstraction"
signum _ = error "Prelude.Num.signum: inappropriate abstraction"
instance (Eq k, Num k) => Algebra k () where
unit = wrap
mult = linear mult' where mult' ((),()) = return ()
instance (Eq k, Num k) => Coalgebra k () where
counit = unwrap
comult = linear comult' where comult' () = return ((),())
unit' :: (Eq k, Num k, Algebra k b) => Trivial k -> Vect k b
unit' = unit . unwrap
counit' :: (Eq k, Num k, Coalgebra k b) => Vect k b -> Trivial k
counit' = wrap . counit
instance (Eq k, Num k, Ord a, Ord b, Algebra k a, Algebra k b) => Algebra k (DSum a b) where
unit k = i1 (unit k) <+> i2 (unit k)
mult = linear mult'
where mult' (Left a1, Left a2) = i1 $ mult $ return (a1,a2)
mult' (Right b1, Right b2) = i2 $ mult $ return (b1,b2)
mult' _ = zero
instance (Eq k, Num k, Ord a, Ord b, Coalgebra k a, Coalgebra k b) => Coalgebra k (DSum a b) where
counit = unwrap . linear counit'
where counit' (Left a) = (wrap . counit) (return a)
counit' (Right b) = (wrap . counit) (return b)
comult = linear comult' where
comult' (Left a) = fmap (\(a1,a2) -> (Left a1, Left a2)) $ comult $ return a
comult' (Right b) = fmap (\(b1,b2) -> (Right b1, Right b2)) $ comult $ return b
instance (Eq k, Num k, Ord a, Ord b, Algebra k a, Algebra k b) => Algebra k (Tensor a b) where
unit x = x *> (unit 1 `te` unit 1)
mult = linear m where
m ((a,b),(a',b')) = (mult $ return (a,a')) `te` (mult $ return (b,b'))
instance (Eq k, Num k, Ord a, Ord b, Coalgebra k a, Coalgebra k b) => Coalgebra k (Tensor a b) where
counit = counit . (counit' `tf` counit')
comult = assocL . (id `tf` assocR) . (id `tf` (twist `tf` id))
. (id `tf` assocL) . assocR . (comult `tf` comult)
instance (Eq k, Num k) => Coalgebra k EBasis where
counit (V ts) = sum [x | (ei,x) <- ts]
comult = fmap ( \ei -> (ei,ei) )
newtype SetCoalgebra b = SC b deriving (Eq,Ord,Show)
instance (Eq k, Num k) => Coalgebra k (SetCoalgebra b) where
counit (V ts) = sum [x | (m,x) <- ts]
comult = fmap ( \m -> (m,m) )
newtype MonoidCoalgebra m = MC m deriving (Eq,Ord,Show)
instance (Eq k, Num k, Ord m, Mon m) => Coalgebra k (MonoidCoalgebra m) where
counit (V ts) = sum [if m == MC munit then x else 0 | (m,x) <- ts]
comult = linear cm
where cm m = if m == MC munit then return (m,m) else return (m, MC munit) <+> return (MC munit, m)
class Algebra k a => Module k a m where
action :: Vect k (Tensor a m) -> Vect k m
r *. m = action (r `te` m)
class Coalgebra k c => Comodule k c n where
coaction :: Vect k n -> Vect k (Tensor c n)
instance Algebra k a => Module k a a where
action = mult
instance Coalgebra k c => Comodule k c c where
coaction = comult
instance (Eq k, Num k, Ord a, Ord u, Ord v, Algebra k a, Module k a u, Module k a v)
=> Module k (Tensor a a) (Tensor u v) where
action = linear action'
where action' ((a,a'), (u,v)) = (action $ return (a,u)) `te` (action $ return (a',v))
instance (Eq k, Num k, Ord a, Ord u, Ord v, Bialgebra k a, Module k a u, Module k a v)
=> Module k a (Tensor u v) where
action = linear action'
where action' (a,(u,v)) = action $ (comult $ return a) `te` (return (u,v))
instance (Eq k, Num k, Ord a, Ord m, Ord n, Bialgebra k a, Comodule k a m, Comodule k a n)
=> Comodule k a (Tensor m n) where
coaction = (mult `tf` id) . twistm . (coaction `tf` coaction)
where twistm x = nf $ fmap ( \((h,m), (h',n)) -> ((h,h'), (m,n)) ) x