content: {-# LANGUAGE MultiParamTypeClasses
             , FlexibleInstances
             , TypeFamilies
             , UndecidableInstances
             , DeriveDataTypeable
             , TypeOperators #-}
  module Numeric.Coalgebra.Trigonometric 
    ( Trigonometric(..)
    , TrigBasis(..)
    , Trig(..)
    ) where
  
  import Control.Applicative
  import Control.Monad.Reader.Class
  import Data.Data
  import Data.Distributive
  import Data.Functor.Bind
  import Data.Functor.Rep
  import Data.Foldable
  import Data.Ix
  import Data.Semigroup.Traversable
  import Data.Semigroup.Foldable
  import Data.Semigroup
  import Data.Traversable
  import Numeric.Algebra
  import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, sin, cos)
  import Numeric.Algebra.Distinguished.Class
  import Numeric.Algebra.Complex.Class
  import Numeric.Coalgebra.Trigonometric.Class
  
  -- the dual complex basis
  data TrigBasis = Cos | Sin deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
  data Trig a = Trig a a deriving (Eq,Show,Read,Data,Typeable)
  
  instance Distinguished TrigBasis where
    e = Cos
  
  instance Complicated TrigBasis where
    i = Sin
  
  instance Trigonometric TrigBasis where
    cos = Cos
    sin = Sin
  
  instance Rig r => Distinguished (Trig r) where
    e = Trig one zero
  
  instance Rig r => Complicated (Trig r) where
    i = Trig zero one
  
  instance Rig r => Trigonometric (Trig r) where
    cos = Trig one zero
    sin = Trig zero one
  
  instance Rig r => Distinguished (TrigBasis -> r) where
    e = cos
  
  instance Rig r => Complicated (TrigBasis -> r) where
    i = sin
    
  instance Rig r => Trigonometric (TrigBasis -> r) where
    cos Sin = zero
    cos Cos = one
  
    sin Sin = one
    sin Cos = zero
  
  instance Representable Trig where
    type Rep Trig = TrigBasis
    tabulate f = Trig (f Cos) (f Sin)
    index (Trig a _ ) Cos = a
    index (Trig _ b ) Sin = b
  
  instance Distributive Trig where
    distribute = distributeRep 
  
  instance Functor Trig where
    fmap f (Trig a b) = Trig (f a) (f b)
  
  instance Apply Trig where
    (<.>) = apRep
  
  instance Applicative Trig where
    pure = pureRep
    (<*>) = apRep 
  
  instance Bind Trig where
    (>>-) = bindRep
  
  instance Monad Trig where
    return = pureRep
    (>>=) = bindRep
  
  instance MonadReader TrigBasis Trig where
    ask = askRep
    local = localRep
  
  instance Foldable Trig where
    foldMap f (Trig a b) = f a `mappend` f b
  
  instance Traversable Trig where
    traverse f (Trig a b) = Trig <$> f a <*> f b
  
  instance Foldable1 Trig where
    foldMap1 f (Trig a b) = f a <> f b
  
  instance Traversable1 Trig where
    traverse1 f (Trig a b) = Trig <$> f a <.> f b
  
  instance Additive r => Additive (Trig r) where
    (+) = addRep 
    sinnum1p = sinnum1pRep
  
  instance LeftModule r s => LeftModule r (Trig s) where
    r .* Trig a b = Trig (r .* a) (r .* b)
  
  instance RightModule r s => RightModule r (Trig s) where
    Trig a b *. r = Trig (a *. r) (b *. r)
  
  instance Monoidal r => Monoidal (Trig r) where
    zero = zeroRep
    sinnum = sinnumRep
  
  instance Group r => Group (Trig r) where
    (-) = minusRep
    negate = negateRep
    subtract = subtractRep
    times = timesRep
  
  instance Abelian r => Abelian (Trig r)
  
  instance Idempotent r => Idempotent (Trig r)
  
  instance Partitionable r => Partitionable (Trig r) where
    partitionWith f (Trig a b) = id =<<
      partitionWith (\a1 a2 -> 
      partitionWith (\b1 b2 -> f (Trig a1 b1) (Trig a2 b2)) b) a
  
  -- the diagonal algebra
  instance (Commutative k, Rng k) => Algebra k TrigBasis where
    mult f = f' where
      fc = f Cos Cos
      fs = f Sin Sin
      f' Cos = fc
      f' Sin = fs
  
  -- 
  instance (Commutative k, Rng k) => UnitalAlgebra k TrigBasis where
    unit = const
  
  -- The trigonometric coalgebra
  instance (Commutative k, Rng k) => Coalgebra k TrigBasis where
    comult f = f' where
       fs = f Sin
       fc = f Cos
       fc' = negate fc
       f' Sin Sin = fc'
       f' Sin Cos = fs 
       f' Cos Sin = fs
       f' Cos Cos = fc
  
  instance (Commutative k, Rng k) => Bialgebra k TrigBasis
  
  instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k TrigBasis where
    inv f = f' where
      afc = adjoint (f Cos)
      nfs = negate (f Sin)
      f' Cos = afc
      f' Sin = nfs
  
  instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k TrigBasis where
    coinv = inv
  
  instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k TrigBasis where
    antipode = inv
  
  instance (Commutative k, Rng k) => CounitalCoalgebra k TrigBasis where
    counit f = f Cos
  
  instance (Commutative k, Rng k) => Multiplicative (Trig k) where
    (*) = mulRep
  
  instance (Commutative k, Rng k) => Commutative (Trig k)
  
  instance (Commutative k, Rng k) => Semiring (Trig k)
  
  instance (Commutative k, Ring k) => Unital (Trig k) where
    one = Trig one zero
  
  instance (Commutative r, Ring r) => Rig (Trig r) where
    fromNatural n = Trig (fromNatural n) zero
  
  instance (Commutative r, Ring r) => Ring (Trig r) where
    fromInteger n = Trig (fromInteger n) zero
  
  instance (Commutative r, Rng r) => LeftModule (Trig r) (Trig r) where (.*) = (*)
  instance (Commutative r, Rng r) => RightModule (Trig r) (Trig r) where (*.) = (*)
  
  instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Trig r) where
    adjoint (Trig a b) = Trig (adjoint a) (negate b)
  
  instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Trig r)
  