content: {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeOperators #-}
  module Numeric.Algebra.Involutive
    ( 
    -- * Involution
      InvolutiveMultiplication(..)
    , InvolutiveSemiring
    -- * Involutive Algebras
    , InvolutiveAlgebra(..)
    , InvolutiveCoalgebra(..)
    , InvolutiveBialgebra
    -- * Trivial Involution
    , TriviallyInvolutive
    , TriviallyInvolutiveAlgebra
    , TriviallyInvolutiveCoalgebra
    , TriviallyInvolutiveBialgebra
    ) where
  
  import Data.Int
  import Data.Word
  import Numeric.Algebra.Class
  import Numeric.Algebra.Commutative
  import Numeric.Algebra.Unital
  import Numeric.Natural
  
  -- | An semigroup with involution
  -- 
  -- > adjoint a * adjoint b = adjoint (b * a)
  class Multiplicative r => InvolutiveMultiplication r where
    adjoint :: r -> r
  
  instance InvolutiveMultiplication Int where adjoint = id
  instance InvolutiveMultiplication Integer where adjoint = id
  instance InvolutiveMultiplication Int8 where adjoint = id
  instance InvolutiveMultiplication Int16 where adjoint = id
  instance InvolutiveMultiplication Int32 where adjoint = id
  instance InvolutiveMultiplication Int64 where adjoint = id
  instance InvolutiveMultiplication Bool where adjoint = id
  instance InvolutiveMultiplication Word where adjoint = id
  instance InvolutiveMultiplication Natural where adjoint = id
  instance InvolutiveMultiplication Word8 where adjoint = id
  instance InvolutiveMultiplication Word16 where adjoint = id
  instance InvolutiveMultiplication Word32 where adjoint = id
  instance InvolutiveMultiplication Word64 where adjoint = id
  instance InvolutiveMultiplication () where adjoint = id
  
  instance 
    ( InvolutiveMultiplication a
    , InvolutiveMultiplication b
    ) => InvolutiveMultiplication (a,b) where
    adjoint (a,b) = (adjoint a, adjoint b)
  
  instance 
    ( InvolutiveMultiplication a
    , InvolutiveMultiplication b
    , InvolutiveMultiplication c
    ) => InvolutiveMultiplication (a,b,c) where
    adjoint (a,b,c) = (adjoint a, adjoint b, adjoint c)
  
  instance 
    ( InvolutiveMultiplication a
    , InvolutiveMultiplication b
    , InvolutiveMultiplication c
    , InvolutiveMultiplication d
    ) => InvolutiveMultiplication (a,b,c,d) where
    adjoint (a,b,c,d) = (adjoint a, adjoint b, adjoint c, adjoint d)
  
  instance 
    ( InvolutiveMultiplication a
    , InvolutiveMultiplication b
    , InvolutiveMultiplication c
    , InvolutiveMultiplication d
    , InvolutiveMultiplication e
    ) => InvolutiveMultiplication (a,b,c,d,e) where
    adjoint (a,b,c,d,e) = (adjoint a, adjoint b, adjoint c, adjoint d, adjoint e)
  
  instance InvolutiveAlgebra r h => InvolutiveMultiplication (h -> r) where
    adjoint = inv
  
  -- | adjoint (x + y) = adjoint x + adjoint y
  class (Semiring r, InvolutiveMultiplication r) => InvolutiveSemiring r
  
  instance InvolutiveSemiring ()
  instance InvolutiveSemiring Bool
  instance InvolutiveSemiring Integer
  instance InvolutiveSemiring Int
  instance InvolutiveSemiring Int8
  instance InvolutiveSemiring Int16
  instance InvolutiveSemiring Int32
  instance InvolutiveSemiring Int64
  instance InvolutiveSemiring Natural
  instance InvolutiveSemiring Word
  instance InvolutiveSemiring Word8
  instance InvolutiveSemiring Word16
  instance InvolutiveSemiring Word32
  instance InvolutiveSemiring Word64
  
  instance ( InvolutiveSemiring a
           , InvolutiveSemiring b
           ) => InvolutiveSemiring (a, b)
  
  instance ( InvolutiveSemiring a
           , InvolutiveSemiring b
           , InvolutiveSemiring c
           ) => InvolutiveSemiring (a, b, c)
  
  instance ( InvolutiveSemiring a
           , InvolutiveSemiring b
           , InvolutiveSemiring c
           , InvolutiveSemiring d
           ) => InvolutiveSemiring (a, b, c, d)
  
  instance ( InvolutiveSemiring a
           , InvolutiveSemiring b
           , InvolutiveSemiring c
           , InvolutiveSemiring d
           , InvolutiveSemiring e
           ) => InvolutiveSemiring (a, b, c, d, e)
  
  
  -- | 
  -- > adjoint = id
  class ( Commutative r
        , InvolutiveMultiplication r
        ) => TriviallyInvolutive r
  
  instance TriviallyInvolutive Bool
  instance TriviallyInvolutive Int
  instance TriviallyInvolutive Integer
  instance TriviallyInvolutive Int8
  instance TriviallyInvolutive Int16
  instance TriviallyInvolutive Int32
  instance TriviallyInvolutive Int64
  instance TriviallyInvolutive Word
  instance TriviallyInvolutive Natural
  instance TriviallyInvolutive Word8
  instance TriviallyInvolutive Word16
  instance TriviallyInvolutive Word32
  instance TriviallyInvolutive Word64
  instance TriviallyInvolutive ()
  
  instance ( TriviallyInvolutive a
           , TriviallyInvolutive b
           ) => TriviallyInvolutive (a,b)
  
  instance ( TriviallyInvolutive a
           , TriviallyInvolutive b
           , TriviallyInvolutive c
           ) => TriviallyInvolutive (a,b,c)
  
  instance ( TriviallyInvolutive a
           , TriviallyInvolutive b
           , TriviallyInvolutive c
           , TriviallyInvolutive d
           ) => TriviallyInvolutive (a,b,c,d)
  
  instance ( TriviallyInvolutive a
           , TriviallyInvolutive b
           , TriviallyInvolutive c
           , TriviallyInvolutive d
           , TriviallyInvolutive e
           ) => TriviallyInvolutive (a,b,c,d,e)
  
  instance ( TriviallyInvolutive r
           , TriviallyInvolutiveAlgebra r a
           ) => TriviallyInvolutive (a -> r)
  
  -- inv is an associative algebra homomorphism
  class (InvolutiveSemiring r, Algebra r a) => InvolutiveAlgebra r a where
    inv :: (a -> r) -> a -> r
  
  instance InvolutiveSemiring r => InvolutiveAlgebra r () where
    inv = (adjoint .)
  
  instance 
    ( InvolutiveAlgebra r a
    , InvolutiveAlgebra r b
    ) => InvolutiveAlgebra r (a, b) where
    inv f (a,b) = 
      inv (\a' -> 
      inv (\b' -> f (a',b')) b) a
  
  instance 
    ( InvolutiveAlgebra r a
    , InvolutiveAlgebra r b
    , InvolutiveAlgebra r c
    ) => InvolutiveAlgebra r (a, b, c) where
    inv f (a,b,c) =
      inv (\a' -> 
      inv (\b' ->
      inv (\c' -> f (a',b',c')) c) b) a
  
  instance 
    ( InvolutiveAlgebra r a
    , InvolutiveAlgebra r b
    , InvolutiveAlgebra r c
    , InvolutiveAlgebra r d
    ) => InvolutiveAlgebra r (a, b, c, d) where
    inv f (a,b,c,d) = 
      inv (\a' ->
      inv (\b' ->
      inv (\c' -> 
      inv (\d' -> f (a',b',c',d')) d) c) b) a
  
  instance 
    ( InvolutiveAlgebra r a
    , InvolutiveAlgebra r b
    , InvolutiveAlgebra r c
    , InvolutiveAlgebra r d
    , InvolutiveAlgebra r e
    ) => InvolutiveAlgebra r (a, b, c, d, e) where
    inv f (a,b,c,d,e) = 
      inv (\a' -> 
      inv (\b' -> 
      inv (\c' -> 
      inv (\d' -> 
      inv (\e' -> f (a',b',c',d',e')) e) d) c) b) a
  
  
  
  class ( CommutativeAlgebra r a
        , TriviallyInvolutive r
        , InvolutiveAlgebra r a
        ) => TriviallyInvolutiveAlgebra r a
  
  instance ( TriviallyInvolutive r
           , InvolutiveSemiring r
           ) => TriviallyInvolutiveAlgebra r ()
  
  instance ( TriviallyInvolutiveAlgebra r a
           , TriviallyInvolutiveAlgebra r b
           ) => TriviallyInvolutiveAlgebra r (a, b) where
  
  instance (TriviallyInvolutiveAlgebra r a
           , TriviallyInvolutiveAlgebra r b
           , TriviallyInvolutiveAlgebra r c
           ) => TriviallyInvolutiveAlgebra r (a, b, c) where
  
  instance ( TriviallyInvolutiveAlgebra r a
           , TriviallyInvolutiveAlgebra r b
           , TriviallyInvolutiveAlgebra r c
           , TriviallyInvolutiveAlgebra r d
           ) => TriviallyInvolutiveAlgebra r (a, b, c, d)
  
  instance ( TriviallyInvolutiveAlgebra r a
           , TriviallyInvolutiveAlgebra r b
           , TriviallyInvolutiveAlgebra r c
           , TriviallyInvolutiveAlgebra r d
           , TriviallyInvolutiveAlgebra r e
           ) => TriviallyInvolutiveAlgebra r (a, b, c, d, e)
  
  
  
  class ( InvolutiveSemiring r
        , Coalgebra r c
        ) => InvolutiveCoalgebra r c where
    coinv :: (c -> r) -> c -> r
  
  instance InvolutiveSemiring r => InvolutiveCoalgebra r () where
    coinv f c = adjoint (f c)
  
  instance 
    ( InvolutiveCoalgebra r a
    , InvolutiveCoalgebra r b
    ) => InvolutiveCoalgebra r (a, b) where
    coinv f (a,b) = 
      coinv (\a' -> 
      coinv (\b' -> f (a',b')) b) a
  
  instance 
    ( InvolutiveCoalgebra r a
    , InvolutiveCoalgebra r b
    , InvolutiveCoalgebra r c
    ) => InvolutiveCoalgebra r (a, b, c) where
    coinv f (a,b,c) = 
      coinv (\a' -> 
      coinv (\b' -> 
      coinv (\c' -> f (a',b',c')) c) b) a
  
  instance 
    ( InvolutiveCoalgebra r a
    , InvolutiveCoalgebra r b
    , InvolutiveCoalgebra r c
    , InvolutiveCoalgebra r d
    ) => InvolutiveCoalgebra r (a, b, c, d) where
    coinv f (a,b,c,d) = 
      coinv (\a' -> 
      coinv (\b' -> 
      coinv (\c' -> 
      coinv (\d' -> f (a',b',c',d')) d) c) b) a
  
  instance 
    ( InvolutiveCoalgebra r a
    , InvolutiveCoalgebra r b
    , InvolutiveCoalgebra r c
    , InvolutiveCoalgebra r d
    , InvolutiveCoalgebra r e
    ) => InvolutiveCoalgebra r (a, b, c, d, e) where
    coinv f (a,b,c,d,e) = 
      coinv (\a' -> 
      coinv (\b' -> 
      coinv (\c' -> 
      coinv (\d' -> 
      coinv (\e' -> f (a',b',c',d',e')) e) d) c) b) a
  
  
  
  class ( CocommutativeCoalgebra r a
        , TriviallyInvolutive r
        , InvolutiveCoalgebra r a
        ) => TriviallyInvolutiveCoalgebra r a
  
  instance ( TriviallyInvolutive r
           , InvolutiveSemiring r
           ) => TriviallyInvolutiveCoalgebra r ()
  
  instance ( TriviallyInvolutiveCoalgebra r a
           , TriviallyInvolutiveCoalgebra r b
           ) => TriviallyInvolutiveCoalgebra r (a, b)
  
  instance ( TriviallyInvolutiveCoalgebra r a
           , TriviallyInvolutiveCoalgebra r b
           , TriviallyInvolutiveCoalgebra r c
           ) => TriviallyInvolutiveCoalgebra r (a, b, c)
  
  instance ( TriviallyInvolutiveCoalgebra r a
           , TriviallyInvolutiveCoalgebra r b
           , TriviallyInvolutiveCoalgebra r c
           , TriviallyInvolutiveCoalgebra r d
           ) => TriviallyInvolutiveCoalgebra r (a, b, c, d)
  
  instance ( TriviallyInvolutiveCoalgebra r a
           , TriviallyInvolutiveCoalgebra r b
           , TriviallyInvolutiveCoalgebra r c
           , TriviallyInvolutiveCoalgebra r d
           , TriviallyInvolutiveCoalgebra r e
           ) => TriviallyInvolutiveCoalgebra r (a, b, c, d, e)
  
  
  
  class ( Bialgebra r h
        , InvolutiveAlgebra r h
        , InvolutiveCoalgebra r h
        ) => InvolutiveBialgebra r h
  
  instance ( Bialgebra r h
           , InvolutiveAlgebra r h
           , InvolutiveCoalgebra r h
           ) => InvolutiveBialgebra r h
  
  
  
  class ( InvolutiveBialgebra r h
        , TriviallyInvolutiveAlgebra r h
        , TriviallyInvolutiveCoalgebra r h
        ) => TriviallyInvolutiveBialgebra r h
  
  instance ( InvolutiveBialgebra r h
           , TriviallyInvolutiveAlgebra r h
           , TriviallyInvolutiveCoalgebra r h
           ) => TriviallyInvolutiveBialgebra r h
  