{-# LANGUAGE MultiParamTypeClasses, NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE IncoherentInstances #-}

-- |A module defining various algebraic structures that can be defined on vector spaces
-- - specifically algebra, coalgebra, bialgebra, Hopf algebra, module, comodule
module Math.Algebras.Structures where

import Math.Algebras.VectorSpace
import Math.Algebras.TensorProduct

-- MONOID

-- |Monoid
class Mon m where
munit :: m
mmult :: m -> m -> m

-- ALGEBRAS, COALGEBRAS, BIALGEBRAS, HOPF ALGEBRAS

-- |Caution: If we declare an instance Algebra k b, then we are saying that the vector space Vect k b is a k-algebra.
-- In other words, we are saying that b is the basis for a k-algebra. So a more accurate name for this class
-- would have been AlgebraBasis.
class Algebra k b where
unit :: k -> Vect k b
mult :: Vect k (Tensor b b) -> Vect k b

-- |An instance declaration for Coalgebra k b is saying that the vector space Vect k b is a k-algebra.
class Coalgebra k b where
counit :: Vect k b -> k
comult :: Vect k b -> Vect k (Tensor b b)

-- |A bialgebra is an algebra which is also a coalgebra, subject to some compatibility conditions
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 (Num k, Eq b, Ord b, Show b, Algebra k b) => Num (Vect k b) where
negate (V ts) = V \$ map (\(b,x) -> (b, negate x)) ts
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"

-- This is the Frobenius form, provided some conditions are met
-- pairing = counit . mult

{-
-- A class to be used to declare that a type b should be given the set coalgebra structure
class SetCoalgebra b where {}

instance (Num k, SetCoalgebra b) => Coalgebra k b where
counit (V ts) = sum [x | (m,x) <- ts] -- trace
comult = fmap (\m -> T m m) -- diagonal
-}

instance Num k => Algebra k () where
unit 0 = zero -- V []
unit x = V [( (),x)]
mult (V [( ((),()), x)]) = V [( (),x)]

instance Num k => Coalgebra k () where
counit (V []) = 0
counit (V [( (),x)]) = x
comult (V [( (),x)]) = V [( ((),()), x)]

-- |Trivial k is the field k considered as a k-vector space. In maths, we would not normally make a distinction here,
-- but in the code, we need this if we want to be able to put k as one side of a tensor product.
type Trivial k = Vect k ()

unit' :: (Num k, Algebra k b) => Trivial k -> Vect k b
unit' = unit . unwrap where unwrap = counit :: Num k => Trivial k -> k

counit' :: (Num k, Coalgebra k b) => Vect k b -> Trivial k
counit' = wrap . counit where wrap = unit :: Num k => k -> Trivial k

-- unit' and counit' enable us to form tensors of these functions

-- Kassel p32
instance (Num k, Ord a, Ord b, Algebra k a, Algebra k b) => Algebra k (Tensor a b) where
unit 0 = V []
unit x = x `smultL` (unit 1 `te` unit 1)
-- mult x = nf \$ x >>= m where
mult = linear m where
m ((a,b),(a',b')) = (mult \$ return (a,a')) `te` (mult \$ return (b,b'))

-- Kassel p42
instance (Num k, Ord a, Ord b, Coalgebra k a, Coalgebra k b) => Coalgebra k (Tensor a b) where
counit = counit . (counit' `tf` counit')
-- counit = counit . linear (\(T x y) -> counit' (return x) * counit' (return y))
comult = assocL . (id `tf` assocR) . (id `tf` (twist `tf` id))
. (id `tf` assocL) . assocR . (comult `tf` comult)

newtype SetCoalgebra b = SC b deriving (Eq,Ord,Show)

instance Num k => Coalgebra k (SetCoalgebra b) where
counit (V ts) = sum [x | (m,x) <- ts] -- trace
comult = fmap ( \m -> (m,m) )           -- diagonal

newtype MonoidCoalgebra m = MC m deriving (Eq,Ord,Show)

instance (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)
-- Brzezinski and Wisbauer, Corings and Comodules, p5

-- Both of the above can be used to define coalgebra structure on polynomial algebras
-- by using the definitions above on the generators (ie the indeterminates) and then extending multiplicatively
-- They are then guaranteed to be algebra morphisms?

-- MODULES AND COMODULES

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

-- module and comodule instances for tensor products

-- Kassel p57-8

instance (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 x = nf \$ x >>= action'
action = linear action'
where action' ((a,a'), (u,v)) = (action \$ return (a,u)) `te` (action \$ return (a',v))

instance (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 x = nf \$ x >>= action'
action = linear action'
where action' (a,(u,v)) = action \$ (comult \$ return a) `te` (return (u,v))
-- !! Overlapping instances
-- If a == Tensor b b, then we have overlapping instance with the previous definition
-- On the other hand, if a == Tensor u v, then we have overlapping instance with the earlier instance

-- Kassel p63
instance (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