algebra 0.5.0 → 0.6.0

raw patch · 15 files changed

+1533/−683 lines, 15 filesdep ~representable-functorsdep ~representable-triesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: representable-functors, representable-tries

API changes (from Hackage documentation)

Files

• Numeric/Additive/Class.hs +13/−2
• Numeric/Algebra.hs +1/−1
• Numeric/Algebra/Class.hs +158/−49
• Numeric/Algebra/Commutative.hs +147/−45
• Numeric/Algebra/Complex.hs +215/−0
• Numeric/Algebra/Division.hs +0/−13
• Numeric/Algebra/Geometric.hs +10/−11
• Numeric/Algebra/Hyperbolic.hs +205/−0
• Numeric/Algebra/Involutive.hs +276/−65
• Numeric/Algebra/Quaternion.hs +293/−0
• Numeric/Algebra/Trigonometric.hs +206/−0
• Numeric/Covector.hs +1/−1
• Numeric/Module/Complex.hs +0/−215
• Numeric/Module/Quaternion.hs +0/−275
• algebra.cabal +8/−6

@@ -1,3 +1,4 @@+{-# LANGUAGE TypeOperators #-} module Numeric.Additive.Class   (    -- * Additive Semigroups@@ -15,9 +16,12 @@ import Data.Int import Data.Word import Data.Semigroup.Foldable-import Data.Foldable hiding (concat)+import Data.Key hiding (concat)+import Data.Functor.Representable+import Data.Functor.Representable.Trie+-- import Data.Foldable hiding (concat) import Numeric.Natural.Internal-import Prelude ((-),Bool(..),($),id,(>>=),fromIntegral,(*),otherwise,quot,maybe,error,even,Maybe(..),(==),(.),($!),Integer,(||),toInteger,Integral)+import Prelude (fmap,(-),Bool(..),($),id,(>>=),fromIntegral,(*),otherwise,quot,maybe,error,even,Maybe(..),(==),(.),($!),Integer,(||),toInteger,Integral) import qualified Prelude import Data.List.NonEmpty (NonEmpty(..), fromList) @@ -57,6 +61,11 @@   replicate1p n f e = replicate1p n (f e)   sumWith1 f xs e = sumWith1 (`f` e) xs +instance (HasTrie b, Additive r) => Additive (b :->: r) where+  (+) = zipWith (+)+  replicate1p = fmap . replicate1p+  sumWith1 f xs = tabulate $ \e -> sumWith1 (\a -> index (f a) e) xs+ instance Additive Bool where   (+) = (||)   replicate1p _ a = a@@ -177,6 +186,7 @@ class Additive r => Abelian r  instance Abelian r => Abelian (e -> r)+instance (HasTrie e, Abelian r) => Abelian (e :->: r) instance Abelian () instance Abelian Bool instance Abelian Integer@@ -208,6 +218,7 @@ instance Idempotent () instance Idempotent Bool instance Idempotent r => Idempotent (e -> r)+instance (HasTrie e, Idempotent r) => Idempotent (e :->: r) instance (Idempotent a, Idempotent b) => Idempotent (a,b) instance (Idempotent a, Idempotent b, Idempotent c) => Idempotent (a,b,c) instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d) => Idempotent (a,b,c,d)

@@ -79,7 +79,7 @@   -- ** commutative algebras   , CommutativeAlgebra   , CommutativeBialgebra-  , CommutativeCoalgebra+  , CocommutativeCoalgebra   -- ** division algebras   , DivisionAlgebra(..)   -- ** Hopf alegebras

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeOperators #-} module Numeric.Algebra.Class    (   -- * Multiplicative Semigroups@@ -21,25 +21,29 @@   , Coalgebra(..)   ) where -import  Numeric.Additive.Class+import Control.Applicative+import Data.Foldable hiding (sum, concat)+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Int+import Data.IntMap (IntMap)+import Data.IntSet (IntSet)+import Data.Key hiding (sum)+import Data.Map (Map) import Data.Monoid (mappend)+-- import Data.Semigroup.Foldable+import Data.Sequence hiding (reverse,replicate,index) import Data.Set (Set)-import qualified Data.Set as Set-import Data.IntSet (IntSet)+import Data.Word+import Numeric.Additive.Class+import Numeric.Natural.Internal+import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)+import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet-import Data.Map (Map) import qualified Data.Map as Map-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-import Data.Sequence hiding (reverse,replicate) import qualified Data.Sequence as Seq-import Data.Foldable hiding (sum, concat)-import Data.Semigroup.Foldable-import Data.Int-import Data.Word-import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)+import qualified Data.Set as Set import qualified Prelude-import Numeric.Natural.Internal  infixr 8 `pow1p` infixl 7 *, .*, *.@@ -142,6 +146,11 @@ instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d, Multiplicative e) => Multiplicative (a,b,c,d,e) where   (a,b,c,d,e) * (i,j,k,l,m) = (a * i, b * j, c * k, d * l, e * m) +instance Algebra r a => Multiplicative (a -> r) where+  f * g = mult $ \a b -> f a * g b+instance (HasTrie a, Algebra r a) => Multiplicative (a :->: r) where+  f * g = tabulate $ mult $ \a b -> index f a * index g b+ -- | A pair of an additive abelian semigroup, and a multiplicative semigroup, with the distributive laws: --  -- > a(b + c) = ab + ac -- left distribution (we are a LeftNearSemiring)@@ -175,6 +184,8 @@ instance (Semiring a, Semiring b, Semiring c) => Semiring (a, b, c) instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a, b, c, d) instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a, b, c, d, e)+instance Algebra r a => Semiring (a -> r) +instance (HasTrie a, Algebra r a) => Semiring (a :->: r)   -- | An associative algebra built with a free module over a semiring class Semiring r => Algebra r a where@@ -231,11 +242,6 @@ -- incoherent -- instance (Algebra r b, Algebra r a) => Algebra (b -> r) a where mult f a b = mult (\a1 a2 -> f a1 a2 b) a -instance Algebra r a => Multiplicative (a -> r) where-  f * g = mult $ \a b -> f a * g b--instance Algebra r a => Semiring (a -> r) - -- A coassociative coalgebra over a semiring using class Semiring r => Coalgebra r c where   comult :: (c -> r) -> c -> c -> r@@ -247,10 +253,10 @@ instance Algebra r m => Coalgebra r (m -> r) where   comult k f g = k (f * g) --- incoherent--- instance Coalgebra () c where comult _ _ _ = ()+instance (HasTrie m, Algebra r m) => Coalgebra r (m :->: r) where+  comult k f g = k (f * g) --- incoherent+-- instance Coalgebra () c where comult _ _ _ = () -- instance (Algebra r b, Coalgebra r c) => Coalgebra (b -> r) c where comult f c1 c2 b = comult (`f` b) c1 c2   instance Semiring r => Coalgebra r () where@@ -298,89 +304,186 @@ instance LeftModule Natural Bool where    0 .* _ = False   _ .* a = a-instance LeftModule Natural Natural where (.*) = (*)-instance LeftModule Natural Integer where Natural n .* m = n * m-instance LeftModule Integer Integer where (.*) = (*) -instance LeftModule Natural Int where (.*) = (*) . fromIntegral-instance LeftModule Integer Int where (.*) = (*) . fromInteger-instance LeftModule Natural Int8 where (.*) = (*) . fromIntegral-instance LeftModule Integer Int8 where (.*) = (*) . fromInteger-instance LeftModule Natural Int16 where (.*) = (*) . fromIntegral-instance LeftModule Integer Int16 where (.*) = (*) . fromInteger-instance LeftModule Natural Int32 where (.*) = (*) . fromIntegral-instance LeftModule Integer Int32 where (.*) = (*) . fromInteger-instance LeftModule Natural Int64 where (.*) = (*) . fromIntegral-instance LeftModule Integer Int64 where (.*) = (*) . fromInteger-instance LeftModule Natural Word where (.*) = (*) . fromIntegral-instance LeftModule Integer Word where (.*) = (*) . fromInteger-instance LeftModule Natural Word8 where (.*) = (*) . fromIntegral-instance LeftModule Integer Word8 where (.*) = (*) . fromInteger-instance LeftModule Natural Word16 where (.*) = (*) . fromIntegral-instance LeftModule Integer Word16 where (.*) = (*) . fromInteger-instance LeftModule Natural Word32 where (.*) = (*) . fromIntegral-instance LeftModule Integer Word32 where (.*) = (*) . fromInteger-instance LeftModule Natural Word64 where (.*) = (*) . fromIntegral-instance LeftModule Integer Word64 where (.*) = (*) . fromInteger-instance Semiring r => LeftModule r () where _ .* _ = ()-instance LeftModule r m => LeftModule r (e -> m) where (.*) m f e = m .* f e +instance LeftModule Natural Natural where +  (.*) = (*)++instance LeftModule Natural Integer where +  Natural n .* m = n * m++instance LeftModule Integer Integer where +  (.*) = (*) ++instance LeftModule Natural Int where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Int where+  (.*) = (*) . fromInteger++instance LeftModule Natural Int8 where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Int8 where+  (.*) = (*) . fromInteger++instance LeftModule Natural Int16 where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Int16 where+  (.*) = (*) . fromInteger++instance LeftModule Natural Int32 where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Int32 where+  (.*) = (*) . fromInteger++instance LeftModule Natural Int64 where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Int64 where+  (.*) = (*) . fromInteger++instance LeftModule Natural Word where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Word where+  (.*) = (*) . fromInteger++instance LeftModule Natural Word8 where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Word8 where+  (.*) = (*) . fromInteger++instance LeftModule Natural Word16 where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Word16 where+  (.*) = (*) . fromInteger++instance LeftModule Natural Word32 where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Word32 where+  (.*) = (*) . fromInteger++instance LeftModule Natural Word64 where+  (.*) = (*) . fromIntegral++instance LeftModule Integer Word64 where+  (.*) = (*) . fromInteger++instance Semiring r => LeftModule r () where +  _ .* _ = ()++instance LeftModule r m => LeftModule r (e -> m) where +  (.*) m f e = m .* f e++instance (HasTrie e, LeftModule r m) => LeftModule r (e :->: m) where +  (.*) m f = tabulate $ \e -> m .* index f e+ instance Additive m => LeftModule () m where    _ .* a = a+ instance (LeftModule r a, LeftModule r b) => LeftModule r (a, b) where   n .* (a, b) = (n .* a, n .* b)+ instance (LeftModule r a, LeftModule r b, LeftModule r c) => LeftModule r (a, b, c) where   n .* (a, b, c) = (n .* a, n .* b, n .* c)+ instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d) => LeftModule r (a, b, c, d) where   n .* (a, b, c, d) = (n .* a, n .* b, n .* c, n .* d)+ instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d, LeftModule r e) => LeftModule r (a, b, c, d, e) where   n .* (a, b, c, d, e) = (n .* a, n .* b, n .* c, n .* d, n .* e) ++ class (Semiring r, Additive m) => RightModule r m where   (*.) :: m -> r -> m  instance RightModule Natural Bool where    _ *. 0 = False   a *. _ = a+ instance RightModule Natural Natural where (*.) = (*)+ instance RightModule Natural Integer where n *. Natural m = n * m+ instance RightModule Integer Integer where (*.) = (*) + instance RightModule Natural Int where m *. n = m * fromIntegral n+ instance RightModule Integer Int where m *. n = m * fromInteger n+ instance RightModule Natural Int8 where m *. n = m * fromIntegral n+ instance RightModule Integer Int8 where m *. n = m * fromInteger n+ instance RightModule Natural Int16 where m *. n = m * fromIntegral n+ instance RightModule Integer Int16 where m *. n = m * fromInteger n+ instance RightModule Natural Int32 where m *. n = m * fromIntegral n+ instance RightModule Integer Int32 where m *. n = m * fromInteger n+ instance RightModule Natural Int64 where m *. n = m * fromIntegral n+ instance RightModule Integer Int64 where m *. n = m * fromInteger n+ instance RightModule Natural Word where m *. n = m * fromIntegral n+ instance RightModule Integer Word where m *. n = m * fromInteger n+ instance RightModule Natural Word8 where m *. n = m * fromIntegral n+ instance RightModule Integer Word8 where m *. n = m * fromInteger n+ instance RightModule Natural Word16 where m *. n = m * fromIntegral n+ instance RightModule Integer Word16 where m *. n = m * fromInteger n+ instance RightModule Natural Word32 where m *. n = m * fromIntegral n+ instance RightModule Integer Word32 where m *. n = m * fromInteger n+ instance RightModule Natural Word64 where m *. n = m * fromIntegral n+ instance RightModule Integer Word64 where m *. n = m * fromInteger n-instance Semiring r => RightModule r () where _ *. _ = ()-instance RightModule r m => RightModule r (e -> m) where (*.) f m e = f e *. m++instance Semiring r => RightModule r () where +  _ *. _ = ()++instance RightModule r m => RightModule r (e -> m) where +  (*.) f m e = f e *. m++instance (HasTrie e, RightModule r m) => RightModule r (e :->: m) where +  (*.) f m = tabulate $ \e -> index f e *. m+ instance Additive m => RightModule () m where    (*.) = const+ instance (RightModule r a, RightModule r b) => RightModule r (a, b) where   (a, b) *. n = (a *. n, b *. n)+ instance (RightModule r a, RightModule r b, RightModule r c) => RightModule r (a, b, c) where   (a, b, c) *. n = (a *. n, b *. n, c *. n)+ instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d) => RightModule r (a, b, c, d) where   (a, b, c, d) *. n = (a *. n, b *. n, c *. n, d *. n)+ instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d, RightModule r e) => RightModule r (a, b, c, d, e) where   (a, b, c, d, e) *. n = (a *. n, b *. n, c *. n, d *. n, e *. n) ++ class (LeftModule r m, RightModule r m) => Module r m instance (LeftModule r m, RightModule r m) => Module r m  + -- | An additive monoid -- -- > zero + a = a = a + zero@@ -468,6 +571,11 @@   sumWith f xs e = sumWith (`f` e) xs   replicate n r e = replicate n (r e) +instance (HasTrie e, Monoidal r) => Monoidal (e :->: r) where+  zero = pure zero+  sumWith f xs = tabulate $ \e -> sumWith (\a -> index (f a) e) xs+  replicate n r = tabulate $ replicate n . index r+ instance Monoidal () where    zero = ()   replicate _ () = ()@@ -488,3 +596,4 @@ instance (Monoidal a, Monoidal b, Monoidal c, Monoidal d, Monoidal e) => Monoidal (a,b,c,d,e) where   zero = (zero,zero,zero,zero,zero)   replicate n (a,b,c,d,e) = (replicate n a, replicate n b, replicate n c, replicate n d, replicate n e)+

@@ -1,27 +1,26 @@-{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances, TypeOperators #-} module Numeric.Algebra.Commutative    ( Commutative   , CommutativeAlgebra-  , CommutativeCoalgebra+  , CocommutativeCoalgebra   , CommutativeBialgebra   ) where +import Data.Functor.Representable.Trie+import Data.Int+import Data.IntSet (IntSet)+import Data.IntMap (IntMap)+import Data.Set (Set)+import Data.Map (Map)+import Data.Word import Numeric.Additive.Class import Numeric.Algebra.Class import Numeric.Algebra.Unital-import Prelude (Bool, Ord, Integer)-import Data.Int-import Data.Word import Numeric.Natural-import Data.Set (Set)--- import qualified Data.Set as Set-import Data.IntSet (IntSet)--- import qualified Data.IntSet as IntSet-import Data.Map (Map)--- import qualified Data.Map as Map-import Data.IntMap (IntMap)--- import qualified Data.IntMap as IntMap+import Prelude (Bool, Ord, Integer) ++ -- | A commutative multiplicative semigroup class Multiplicative r => Commutative r @@ -39,47 +38,150 @@ instance Commutative Word16 instance Commutative Word32 instance Commutative Word64-instance (Commutative a, Commutative b) => Commutative (a,b) -instance (Commutative a, Commutative b, Commutative c) => Commutative (a,b,c) -instance (Commutative a, Commutative b, Commutative c, Commutative d) => Commutative (a,b,c,d) -instance (Commutative a, Commutative b, Commutative c, Commutative d, Commutative e) => Commutative (a,b,c,d,e) -class Algebra r a => CommutativeAlgebra r a+instance ( Commutative a+         , Commutative b+         ) => Commutative (a,b)  -instance (Commutative r, Semiring r) => CommutativeAlgebra r ()-instance (CommutativeAlgebra r a, CommutativeAlgebra r b) => CommutativeAlgebra r (a,b)-instance (CommutativeAlgebra r a, CommutativeAlgebra r b, CommutativeAlgebra r c) => CommutativeAlgebra r (a,b,c)-instance (CommutativeAlgebra r a, CommutativeAlgebra r b, CommutativeAlgebra r c, CommutativeAlgebra r d) => CommutativeAlgebra r (a,b,c,d)-instance (CommutativeAlgebra r a, CommutativeAlgebra r b, CommutativeAlgebra r c, CommutativeAlgebra r d, CommutativeAlgebra r e) => CommutativeAlgebra r (a,b,c,d,e)+instance ( Commutative a+         , Commutative b+         , Commutative c+         ) => Commutative (a,b,c)  --- incoherent--- instance (Algebra r a, CommutativeAlgebra r b) => CommutativeAlgebra (a -> r) b--- instance CommutativeAlgebra () a+instance ( Commutative a+         , Commutative b+         , Commutative c+         , Commutative d+         ) => Commutative (a,b,c,d)  -instance (Commutative r, Semiring r, Ord a) => CommutativeAlgebra r (Set a)-instance (Commutative r, Semiring r) => CommutativeAlgebra r IntSet-instance (Commutative r, Monoidal r, Semiring r, Ord a, Abelian b, Partitionable b) => CommutativeAlgebra r (Map a b)-instance (Commutative r, Monoidal r, Semiring r, Abelian b, Partitionable b) => CommutativeAlgebra r (IntMap b)+instance ( Commutative a+         , Commutative b+         , Commutative c+         , Commutative d+         , Commutative e+         ) => Commutative (a,b,c,d,e)  instance CommutativeAlgebra r a => Commutative (a -> r) -class Coalgebra r c => CommutativeCoalgebra r c+instance ( HasTrie a+         , CommutativeAlgebra r a+         ) => Commutative (a :->: r)   -instance CommutativeAlgebra r m => CommutativeCoalgebra r (m -> r)-instance (CommutativeCoalgebra r a, CommutativeCoalgebra r b) => CommutativeCoalgebra r (a,b)-instance (CommutativeCoalgebra r a, CommutativeCoalgebra r b, CommutativeCoalgebra r c) => CommutativeCoalgebra r (a,b,c)-instance (CommutativeCoalgebra r a, CommutativeCoalgebra r b, CommutativeCoalgebra r c, CommutativeCoalgebra r d) => CommutativeCoalgebra r (a,b,c,d)-instance (CommutativeCoalgebra r a, CommutativeCoalgebra r b, CommutativeCoalgebra r c, CommutativeCoalgebra r d, CommutativeCoalgebra r e) => CommutativeCoalgebra r (a,b,c,d,e) -instance (Commutative r, Semiring r, Ord a) => CommutativeCoalgebra r (Set a)-instance (Commutative r, Semiring r) => CommutativeCoalgebra r IntSet-instance (Commutative r, Semiring r, Ord a, Abelian b) => CommutativeCoalgebra r (Map a b)-instance (Commutative r, Semiring r, Abelian b) => CommutativeCoalgebra r (IntMap b)+class Algebra r a => CommutativeAlgebra r a --- incoherent--- instance (Algebra r a, CommutativeCoalgebra r c) => CommutativeCoalgebra (a -> r) c -- TODO: check this instance!--- instance CommutativeCoalgebra () a+instance ( Commutative r+         , Semiring r+         ) => CommutativeAlgebra r () -class    (Bialgebra r h, CommutativeAlgebra r h, CommutativeCoalgebra r h) => CommutativeBialgebra r h-instance (Bialgebra r h, CommutativeAlgebra r h, CommutativeCoalgebra r h) => CommutativeBialgebra r h+instance ( CommutativeAlgebra r a+         , CommutativeAlgebra r b+         ) => CommutativeAlgebra r (a,b)++instance ( CommutativeAlgebra r a+         , CommutativeAlgebra r b+         , CommutativeAlgebra r c+         ) => CommutativeAlgebra r (a,b,c)++instance ( CommutativeAlgebra r a+         , CommutativeAlgebra r b+         , CommutativeAlgebra r c+         , CommutativeAlgebra r d+         ) => CommutativeAlgebra r (a,b,c,d)++instance ( CommutativeAlgebra r a+         , CommutativeAlgebra r b+         , CommutativeAlgebra r c+         , CommutativeAlgebra r d+         , CommutativeAlgebra r e+         ) => CommutativeAlgebra r (a,b,c,d,e)++instance ( Commutative r+         , Semiring r+         , Ord a+         ) => CommutativeAlgebra r (Set a)++instance (Commutative r+         , Semiring r+         ) => CommutativeAlgebra r IntSet++instance (Commutative r+         , Monoidal r+         , Semiring r+         , Ord a+         , Abelian b+         , Partitionable b+         ) => CommutativeAlgebra r (Map a b)++instance ( Commutative r+         , Monoidal r+         , Semiring r+         , Abelian b+         , Partitionable b+         ) => CommutativeAlgebra r (IntMap b)++++class Coalgebra r c => CocommutativeCoalgebra r c++instance CommutativeAlgebra r m => CocommutativeCoalgebra r (m -> r)++instance ( HasTrie m+         , CommutativeAlgebra r m+         ) => CocommutativeCoalgebra r (m :->: r)++instance (Commutative r, Semiring r) => CocommutativeCoalgebra r ()++instance ( CocommutativeCoalgebra r a+         , CocommutativeCoalgebra r b+         ) => CocommutativeCoalgebra r (a,b)++instance ( CocommutativeCoalgebra r a+         , CocommutativeCoalgebra r b+         , CocommutativeCoalgebra r c+         ) => CocommutativeCoalgebra r (a,b,c)++instance ( CocommutativeCoalgebra r a+         , CocommutativeCoalgebra r b+         , CocommutativeCoalgebra r c+         , CocommutativeCoalgebra r d+         ) => CocommutativeCoalgebra r (a,b,c,d)++instance ( CocommutativeCoalgebra r a+         , CocommutativeCoalgebra r b+         , CocommutativeCoalgebra r c+         , CocommutativeCoalgebra r d+         , CocommutativeCoalgebra r e+         ) => CocommutativeCoalgebra r (a,b,c,d,e)++instance ( Commutative r+         , Semiring r+         , Ord a) => CocommutativeCoalgebra r (Set a)++instance ( Commutative r+         , Semiring r+         ) => CocommutativeCoalgebra r IntSet++instance ( Commutative r+         , Semiring r+         , Ord a+         , Abelian b+         ) => CocommutativeCoalgebra r (Map a b)++instance ( Commutative r+         , Semiring r+         , Abelian b+         ) => CocommutativeCoalgebra r (IntMap b)++++class ( Bialgebra r h+      , CommutativeAlgebra r h+      , CocommutativeCoalgebra r h+      ) => CommutativeBialgebra r h++instance ( Bialgebra r h+         , CommutativeAlgebra r h+         , CocommutativeCoalgebra r h+         ) => CommutativeBialgebra r h

@@ -0,0 +1,215 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}+module Numeric.Algebra.Complex+  ( Complicated(..)+  , ComplexBasis(..)+  , Complex(..)+  ) where++import Control.Applicative+import Control.Monad.Reader.Class+import Data.Data+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Ix+import Data.Key+import Data.Monoid+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Traversable+import Numeric.Algebra+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)++-- complex basis+data ComplexBasis = E | I deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)+data Complex a = Complex a a deriving (Eq,Show,Read,Data,Typeable)++class Complicated r where+  e :: r+  i :: r++instance Complicated ComplexBasis where+  e = E+  i = I++instance Rig r => Complicated (Complex r) where+  e = Complex one zero+  i = Complex zero one+  +instance Rig r => Complicated (ComplexBasis -> r) where+  e E = one+  e _ = zero+  i I = one+  i _ = zero ++instance Complicated a => Complicated (Covector r a) where+  e = return e+  i = return i++type instance Key Complex = ComplexBasis++instance Representable Complex where+  tabulate f = Complex (f E) (f I)++instance Indexable Complex where+  index (Complex a _ ) E = a+  index (Complex _ b ) I = b++instance Lookup Complex where+  lookup = lookupDefault++instance Adjustable Complex where+  adjust f E (Complex a b) = Complex (f a) b+  adjust f I (Complex a b) = Complex a (f b)++instance Distributive Complex where+  distribute = distributeRep ++instance Functor Complex where+  fmap f (Complex a b) = Complex (f a) (f b)++instance Zip Complex where+  zipWith f (Complex a1 b1) (Complex a2 b2) = Complex (f a1 a2) (f b1 b2)++instance ZipWithKey Complex where+  zipWithKey f (Complex a1 b1) (Complex a2 b2) = Complex (f E a1 a2) (f I b1 b2)++instance Keyed Complex where+  mapWithKey = mapWithKeyRep++instance Apply Complex where+  (<.>) = apRep++instance Applicative Complex where+  pure = pureRep+  (<*>) = apRep ++instance Bind Complex where+  (>>-) = bindRep++instance Monad Complex where+  return = pureRep+  (>>=) = bindRep++instance MonadReader ComplexBasis Complex where+  ask = askRep+  local = localRep++instance Foldable Complex where+  foldMap f (Complex a b) = f a `mappend` f b++instance FoldableWithKey Complex where+  foldMapWithKey f (Complex a b) = f E a `mappend` f I b++instance Traversable Complex where+  traverse f (Complex a b) = Complex <$> f a <*> f b++instance TraversableWithKey Complex where+  traverseWithKey f (Complex a b) = Complex <$> f E a <*> f I b++instance Foldable1 Complex where+  foldMap1 f (Complex a b) = f a <> f b++instance FoldableWithKey1 Complex where+  foldMapWithKey1 f (Complex a b) = f E a <> f I b++instance Traversable1 Complex where+  traverse1 f (Complex a b) = Complex <$> f a <.> f b++instance TraversableWithKey1 Complex where+  traverseWithKey1 f (Complex a b) = Complex <$> f E a <.> f I b++instance HasTrie ComplexBasis where+  type BaseTrie ComplexBasis = Complex+  embedKey = id+  projectKey = id++instance Additive r => Additive (Complex r) where+  (+) = addRep +  replicate1p = replicate1pRep++instance LeftModule r s => LeftModule r (Complex s) where+  r .* Complex a b = Complex (r .* a) (r .* b)++instance RightModule r s => RightModule r (Complex s) where+  Complex a b *. r = Complex (a *. r) (b *. r)++instance Monoidal r => Monoidal (Complex r) where+  zero = zeroRep+  replicate = replicateRep++instance Group r => Group (Complex r) where+  (-) = minusRep+  negate = negateRep+  subtract = subtractRep+  times = timesRep++instance Abelian r => Abelian (Complex r)++instance Idempotent r => Idempotent (Complex r)++instance Partitionable r => Partitionable (Complex r) where+  partitionWith f (Complex a b) = id =<<+    partitionWith (\a1 a2 -> +    partitionWith (\b1 b2 -> f (Complex a1 b1) (Complex a2 b2)) b) a++instance Rng k => Algebra k ComplexBasis where+  mult f = f' where+    fe = f E E - f I I+    fi = f E I + f I E+    f' E = fe+    f' I = fi++instance Rng k => UnitalAlgebra k ComplexBasis where+  unit x E = x+  unit _ _ = zero++instance Rng k => Coalgebra k ComplexBasis where+  comult f = f' where +    fe = f E+    fi = f I+    f' E E = fe+    f' E I = fi+    f' I E = fi+    f' I I = negate fe++instance Rng k => CounitalCoalgebra k ComplexBasis where+  counit f = f E++instance Rng k => Bialgebra k ComplexBasis ++instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k ComplexBasis where+  inv f E = f E+  inv f b = negate (f b)++instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k ComplexBasis where+  coinv = inv++instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k ComplexBasis where+  antipode = inv++instance (Commutative r, Rng r) => Multiplicative (Complex r) where+  (*) = mulRep++instance (TriviallyInvolutive r, Rng r) => Commutative (Complex r)++instance (Commutative r, Rng r) => Semiring (Complex r)++instance (Commutative r, Ring r) => Unital (Complex r) where+  one = oneRep++instance (Commutative r, Ring r) => Rig (Complex r) where+  fromNatural n = Complex (fromNatural n) zero++instance (Commutative r, Ring r) => Ring (Complex r) where+  fromInteger n = Complex (fromInteger n) zero++instance (Commutative r, Rng r) => LeftModule (Complex r) (Complex r) where (.*) = (*)+instance (Commutative r, Rng r) => RightModule (Complex r) (Complex r) where (*.) = (*)++instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Complex r) where+  adjoint (Complex a b) = Complex (adjoint a) (negate b)++instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Complex r)

@@ -2,8 +2,6 @@ module Numeric.Algebra.Division   ( Division(..)   , DivisionAlgebra(..)---  , CodivisionCoalgebra(..)---  , DivisionBialgebra   ) where  import Prelude hiding ((*), recip, (/),(^))@@ -73,14 +71,3 @@ instance (Unital r, DivisionAlgebra r a) => Division (a -> r) where   recip = recipriocal -{--class CounitalCoalgebra r c => DivisionCoalgebra r c where-  corecipriocal :: (c -> r) -> c -> r--instance CodivisionCoalgebra () c where-  corecipriocal _ _ = ()---- | corecipriocal = recipriocal-class (Bialgebra r h, DivisionAlgebra r h, CodivisionCoalgebra r h) => DivisionBialgebra r h-instance (Bialgebra r h, DivisionAlgebra r h, CodivisionCoalgebra r h) => DivisionBialgebra r h--}

@@ -48,11 +48,11 @@  -- a basis vector for a simple geometric algebra with the euclidean inner product newtype Blade m = Blade { runBlade :: Word64 } deriving -  (Eq,Ord,Num,Bits,Enum,Ix,Bounded,Show,Read,Real,Integral-  ,Additive,Abelian,LeftModule Natural,RightModule Natural,Monoidal-  ,Multiplicative,Unital,Commutative-  ,Semiring,Rig-  ,DecidableZero,DecidableAssociates,DecidableUnits+  ( Eq,Ord,Num,Bits,Enum,Ix,Bounded,Show,Read,Real,Integral+  , Additive,Abelian,LeftModule Natural,RightModule Natural,Monoidal+  , Multiplicative,Unital,Commutative+  , Semiring,Rig+  , DecidableZero,DecidableAssociates,DecidableUnits   )  instance HasTrie (Blade m) where@@ -67,7 +67,6 @@   v             :: m -> Blade m   e             :: Int -> m - -- assuming n /= 0, find the index of the least significant set bit in a basis blade lsb :: Blade m -> Int lsb n = fromIntegral $ ix ! shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58@@ -95,11 +94,11 @@ -- Euclidean basis, we can work with basis vectors for euclidean spaces of up to 64 dimensions without  -- expanding the representation of our basis vectors newtype Euclidean = Euclidean Int deriving -  (Eq,Ord,Show,Read,Num,Ix,Enum,Real,Integral-  ,Data,Typeable-  ,Additive,LeftModule Natural,RightModule Natural,Monoidal,Abelian,LeftModule Integer,RightModule Integer,Group-  ,Multiplicative,TriviallyInvolutive,InvolutiveMultiplication,InvolutiveSemiring,Unital,Commutative-  ,Semiring,Rig,Ring+  ( Eq,Ord,Show,Read,Num,Ix,Enum,Real,Integral+  , Data,Typeable+  , Additive,LeftModule Natural,RightModule Natural,Monoidal,Abelian,LeftModule Integer,RightModule Integer,Group+  , Multiplicative,TriviallyInvolutive,InvolutiveMultiplication,InvolutiveSemiring,Unital,Commutative+  , Semiring,Rig,Ring   )  instance HasTrie Euclidean where

@@ -0,0 +1,205 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}+module Numeric.Algebra.Hyperbolic +  ( Hyperbolic(..)+  , HyperBasis(..)+  , Hyper(..)+  ) where++import Control.Applicative+import Control.Monad.Reader.Class+import Data.Data+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Ix+import Data.Key+import Data.Monoid+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Traversable+import Numeric.Algebra+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)++-- complex basis+data HyperBasis = S | C deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)+data Hyper a = Hyper a a deriving (Eq,Show,Read,Data,Typeable)++class Hyperbolic r where+  s :: r+  c :: r++instance Hyperbolic HyperBasis where+  s = S+  c = C++instance Rig r => Hyperbolic (Hyper r) where+  s = Hyper one zero+  c = Hyper zero one+  +instance Rig r => Hyperbolic (HyperBasis -> r) where+  s S = one+  s C = zero+  c S = zero+  c C = one++instance Hyperbolic a => Hyperbolic (Covector r a) where+  s = return s+  c = return c++type instance Key Hyper = HyperBasis++instance Representable Hyper where+  tabulate f = Hyper (f S) (f C)++instance Indexable Hyper where+  index (Hyper a _ ) S = a+  index (Hyper _ b ) C = b++instance Lookup Hyper where+  lookup = lookupDefault++instance Adjustable Hyper where+  adjust f S (Hyper a b) = Hyper (f a) b+  adjust f C (Hyper a b) = Hyper a (f b)++instance Distributive Hyper where+  distribute = distributeRep ++instance Functor Hyper where+  fmap f (Hyper a b) = Hyper (f a) (f b)++instance Zip Hyper where+  zipWith f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f a1 a2) (f b1 b2)++instance ZipWithKey Hyper where+  zipWithKey f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f S a1 a2) (f C b1 b2)++instance Keyed Hyper where+  mapWithKey = mapWithKeyRep++instance Apply Hyper where+  (<.>) = apRep++instance Applicative Hyper where+  pure = pureRep+  (<*>) = apRep ++instance Bind Hyper where+  (>>-) = bindRep++instance Monad Hyper where+  return = pureRep+  (>>=) = bindRep++instance MonadReader HyperBasis Hyper where+  ask = askRep+  local = localRep++instance Foldable Hyper where+  foldMap f (Hyper a b) = f a `mappend` f b++instance FoldableWithKey Hyper where+  foldMapWithKey f (Hyper a b) = f S a `mappend` f C b++instance Traversable Hyper where+  traverse f (Hyper a b) = Hyper <$> f a <*> f b++instance TraversableWithKey Hyper where+  traverseWithKey f (Hyper a b) = Hyper <$> f S a <*> f C b++instance Foldable1 Hyper where+  foldMap1 f (Hyper a b) = f a <> f b++instance FoldableWithKey1 Hyper where+  foldMapWithKey1 f (Hyper a b) = f S a <> f C b++instance Traversable1 Hyper where+  traverse1 f (Hyper a b) = Hyper <$> f a <.> f b++instance TraversableWithKey1 Hyper where+  traverseWithKey1 f (Hyper a b) = Hyper <$> f S a <.> f C b++instance HasTrie HyperBasis where+  type BaseTrie HyperBasis = Hyper+  embedKey = id+  projectKey = id++instance Additive r => Additive (Hyper r) where+  (+) = addRep +  replicate1p = replicate1pRep++instance LeftModule r s => LeftModule r (Hyper s) where+  r .* Hyper a b = Hyper (r .* a) (r .* b)++instance RightModule r s => RightModule r (Hyper s) where+  Hyper a b *. r = Hyper (a *. r) (b *. r)++instance Monoidal r => Monoidal (Hyper r) where+  zero = zeroRep+  replicate = replicateRep++instance Group r => Group (Hyper r) where+  (-) = minusRep+  negate = negateRep+  subtract = subtractRep+  times = timesRep++instance Abelian r => Abelian (Hyper r)++instance Idempotent r => Idempotent (Hyper r)++instance Partitionable r => Partitionable (Hyper r) where+  partitionWith f (Hyper a b) = id =<<+    partitionWith (\a1 a2 -> +    partitionWith (\b1 b2 -> f (Hyper a1 b1) (Hyper a2 b2)) b) a++-- the dual, hyperbolic trigonometric algebra+instance (Commutative k, Semiring k) => Algebra k HyperBasis where+  mult f = f' where+    fs = f S C + f C S+    fc = f C C + f S S+    f' S = fs+    f' C = fc++instance (Commutative k, Monoidal k, Semiring k) => UnitalAlgebra k HyperBasis where+  unit _ S = zero+  unit x C = x++-- the actual hyperbolic trigonometric coalgebra+instance (Commutative k, Semiring k) => Coalgebra k HyperBasis where+  comult f = f' where+     fs = f S+     fc = f C+     f' S S = fc+     f' S C = fs +     f' C S = fs+     f' C C = fc++instance (Commutative k, Semiring k) => CounitalCoalgebra k HyperBasis where+  counit f = f C++instance (Commutative k, Semiring k) => Multiplicative (Hyper k) where+  (*) = mulRep++instance (Commutative k, Semiring k) => Commutative (Hyper k)++instance (Commutative k, Semiring k) => Semiring (Hyper k)++instance (Commutative k, Rig k) => Unital (Hyper k) where+  one = Hyper zero one++instance (Commutative r, Rig r) => Rig (Hyper r) where+  fromNatural n = Hyper zero (fromNatural n)++instance (Commutative r, Ring r) => Ring (Hyper r) where+  fromInteger n = Hyper zero (fromInteger n)++instance (Commutative r, Semiring r) => LeftModule (Hyper r) (Hyper r) where (.*) = (*)+instance (Commutative r, Semiring r) => RightModule (Hyper r) (Hyper r) where (*.) = (*)++instance (Commutative r, Semiring r, InvolutiveMultiplication r) => InvolutiveMultiplication (Hyper r) where+  adjoint (Hyper a b) = Hyper (adjoint a) (adjoint b)++instance (Commutative r, InvolutiveSemiring r) => InvolutiveSemiring (Hyper r)

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeOperators #-} module Numeric.Algebra.Involutive   (    -- * Involution@@ -19,9 +19,14 @@ import Numeric.Algebra.Commutative import Numeric.Algebra.Unital import Data.Int+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Key import Data.Word import Numeric.Natural.Internal ++ -- | An semigroup with involution --  -- > adjoint a * adjoint b = adjoint (b * a)@@ -42,26 +47,56 @@ 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++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++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++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++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 +instance (HasTrie h, InvolutiveAlgebra r h) => InvolutiveMultiplication (h :->: r) where+  adjoint = tabulate . inv . index+++ -- | 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@@ -69,21 +104,42 @@ instance InvolutiveSemiring Word32 instance InvolutiveSemiring Word64 -instance InvolutiveSemiring ()-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)+instance ( InvolutiveSemiring a+         , InvolutiveSemiring b+         ) => InvolutiveSemiring (a, b) --- adjoint = id-class (Commutative r, InvolutiveMultiplication r) => TriviallyInvolutive r+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 Bool instance TriviallyInvolutive Word instance TriviallyInvolutive Natural instance TriviallyInvolutive Word8@@ -91,76 +147,231 @@ 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 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)++instance ( HasTrie a+         , TriviallyInvolutive r+         , TriviallyInvolutiveAlgebra r a+         ) => TriviallyInvolutive (a :->: r)+++ -- inv is an associative algebra homomorphism-class Algebra r a => InvolutiveAlgebra r a where+class (InvolutiveSemiring r, Algebra r a) => InvolutiveAlgebra r a where   inv :: (a -> r) -> a -> r --- instance InvolutiveAlgebra () a where inv _ _ = ()--- instance (Algebra r b, InvolutiveAlgebra r a) => InvolutiveAlgebra (b -> r) a where inv f c a = inv (`f` a) c- 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 (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 (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 (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+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 -instance InvolutiveAlgebra r h => InvolutiveMultiplication (h -> r) where-  adjoint = inv -class (CommutativeAlgebra r a, 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)-instance TriviallyInvolutiveAlgebra r h => TriviallyInvolutive (h -> r)--- instance TriviallyInvolutiveAlgebra () a --- instance (Algebra r b, TriviallyInvolutiveAlgebra r a) => TriviallyInvolutiveAlgebra (b -> r) a+class ( CommutativeAlgebra r a+      , TriviallyInvolutive r+      , InvolutiveAlgebra r a+      ) => TriviallyInvolutiveAlgebra r a -class Coalgebra r c => InvolutiveCoalgebra r c where+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 InvolutiveCoalgebra () c where coinv _ _ = ()--- instance (Algebra r b, InvolutiveCoalgebra r c) => InvolutiveCoalgebra (b -> r) c where coinv f c a = coinv (`f` a) c+ 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--- instance InvolutiveCoalgebra r h => Involutive (Covector r h) -class (CommutativeCoalgebra r a, InvolutiveCoalgebra r a) => TriviallyInvolutiveCoalgebra r a+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 TriviallyInvolutiveCoalgebra () a --- instance (Algebra r b, TriviallyInvolutiveCoalgebra r a) => TriviallyInvolutiveCoalgebra (b -> r) 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 (TriviallyInvolutiveCoalgebra r a, TriviallyInvolutiveCoalgebra r b) => TriviallyInvolutiveCoalgebra r (a, b) where-instance (TriviallyInvolutiveCoalgebra r a, TriviallyInvolutiveCoalgebra r b, TriviallyInvolutiveCoalgebra r c) => TriviallyInvolutiveCoalgebra r (a, b, c) where-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)+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 --- inv = coinv-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+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 (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+++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

@@ -0,0 +1,293 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}+module Numeric.Algebra.Quaternion +  ( Complicated(..)+  , Hamiltonian(..)+  , QuaternionBasis(..)+  , Quaternion(..)+  , complicate+  , uncomplicate+  ) where++import Control.Applicative+import Control.Monad.Reader.Class+import Data.Ix+import Data.Key+import Data.Data+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Traversable+import Data.Monoid+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Numeric.Algebra+import Numeric.Algebra.Complex (ComplexBasis, Complicated(..))+import qualified Numeric.Algebra.Complex as Complex+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)++class Complicated t => Hamiltonian t where+  j :: t+  k :: t++instance Complicated QuaternionBasis where+  e = E+  i = I++instance Hamiltonian QuaternionBasis where+  j = J+  k = K++instance Rig r => Complicated (Quaternion r) where+  e = Quaternion one zero zero zero+  i = Quaternion zero one zero zero++instance Rig r => Hamiltonian (Quaternion r) where+  j = Quaternion zero zero one zero+  k = Quaternion one zero zero one ++instance Rig r => Complicated (QuaternionBasis -> r) where+  e E = one +  e _ = zero++  i I = one+  i _ = zero+  +instance Rig r => Hamiltonian (QuaternionBasis -> r) where+  j J = one+  j _ = zero++  k K = one+  k _ = zero++instance Hamiltonian a => Hamiltonian (Covector r a) where+  j = return j+  k = return k++-- quaternion basis+data QuaternionBasis = E | I | J | K deriving (Eq,Ord,Enum,Read,Show,Bounded,Ix,Data,Typeable)++data Quaternion a = Quaternion a a a a deriving (Eq,Show,Read,Data,Typeable)++type instance Key Quaternion = QuaternionBasis++instance Representable Quaternion where+  tabulate f = Quaternion (f E) (f I) (f J) (f K)++instance Indexable Quaternion where+  index (Quaternion a _ _ _) E = a+  index (Quaternion _ b _ _) I = b+  index (Quaternion _ _ c _) J = c+  index (Quaternion _ _ _ d) K = d++instance Lookup Quaternion where+  lookup = lookupDefault++instance Adjustable Quaternion where+  adjust f E (Quaternion a b c d) = Quaternion (f a) b c d+  adjust f I (Quaternion a b c d) = Quaternion a (f b) c d+  adjust f J (Quaternion a b c d) = Quaternion a b (f c) d+  adjust f K (Quaternion a b c d) = Quaternion a b c (f d)++instance Distributive Quaternion where+  distribute = distributeRep ++instance Functor Quaternion where+  fmap = fmapRep++instance Zip Quaternion where+  zipWith f (Quaternion a1 b1 c1 d1) (Quaternion a2 b2 c2 d2) = +    Quaternion (f a1 a2) (f b1 b2) (f c1 c2) (f d1 d2)++instance ZipWithKey Quaternion where+  zipWithKey f (Quaternion a1 b1 c1 d1) (Quaternion a2 b2 c2 d2) = +    Quaternion (f E a1 a2) (f I b1 b2) (f J c1 c2) (f K d1 d2)++instance Keyed Quaternion where+  mapWithKey = mapWithKeyRep++instance Apply Quaternion where+  (<.>) = apRep++instance Applicative Quaternion where+  pure = pureRep+  (<*>) = apRep ++instance Bind Quaternion where+  (>>-) = bindRep++instance Monad Quaternion where+  return = pureRep+  (>>=) = bindRep++instance MonadReader QuaternionBasis Quaternion where+  ask = askRep+  local = localRep++instance Foldable Quaternion where+  foldMap f (Quaternion a b c d) = +    f a `mappend` f b `mappend` f c `mappend` f d++instance FoldableWithKey Quaternion where+  foldMapWithKey f (Quaternion a b c d) = +    f E a `mappend` f I b `mappend` f J c `mappend` f K d++instance Traversable Quaternion where+  traverse f (Quaternion a b c d) = +    Quaternion <$> f a <*> f b <*> f c <*> f d++instance TraversableWithKey Quaternion where+  traverseWithKey f (Quaternion a b c d) = +    Quaternion <$> f E a <*> f I b <*> f J c <*> f K d++instance Foldable1 Quaternion where+  foldMap1 f (Quaternion a b c d) = +    f a <> f b <> f c <> f d++instance FoldableWithKey1 Quaternion where+  foldMapWithKey1 f (Quaternion a b c d) = +    f E a <> f I b <> f J c <> f K d++instance Traversable1 Quaternion where+  traverse1 f (Quaternion a b c d) = +    Quaternion <$> f a <.> f b <.> f c <.> f d++instance TraversableWithKey1 Quaternion where+  traverseWithKey1 f (Quaternion a b c d) = +    Quaternion <$> f E a <.> f I b <.> f J c <.> f K d++instance HasTrie QuaternionBasis where+  type BaseTrie QuaternionBasis = Quaternion+  embedKey = id+  projectKey = id++instance Additive r => Additive (Quaternion r) where+  (+) = addRep +  replicate1p = replicate1pRep++instance LeftModule r s => LeftModule r (Quaternion s) where+  r .* Quaternion a b c d =+    Quaternion (r .* a) (r .* b) (r .* c) (r .* d)++instance RightModule r s => RightModule r (Quaternion s) where+  Quaternion a b c d *. r =+    Quaternion (a *. r) (b *. r) (c *. r) (d *. r)++instance Monoidal r => Monoidal (Quaternion r) where+  zero = zeroRep+  replicate = replicateRep++instance Group r => Group (Quaternion r) where+  (-) = minusRep+  negate = negateRep+  subtract = subtractRep+  times = timesRep++instance Abelian r => Abelian (Quaternion r)++instance Idempotent r => Idempotent (Quaternion r)++instance Partitionable r => Partitionable (Quaternion r) where+  partitionWith f (Quaternion a b c d) = id =<<+    partitionWith (\a1 a2 -> id =<< +    partitionWith (\b1 b2 -> id =<< +    partitionWith (\c1 c2 -> +    partitionWith (\d1 d2 -> f (Quaternion a1 b1 c1 d1) +                               (Quaternion a2 b2 c2 d2)+                  ) d) c) b) a++instance (TriviallyInvolutive r, Rng r) => Algebra r QuaternionBasis where+  mult f = f' where+    fe = f E E - (f I I + f J J + f K K)+    fi = f E I + f I E + f J K - f K J+    fj = f E J + f J E + f K I - f I K+    fk = f E K + f K E + f I J - f J I+    f' E = fe+    f' I = fi+    f' J = fj+    f' K = fk+             +instance (TriviallyInvolutive r, Rng r) => UnitalAlgebra r QuaternionBasis where+  unit x E = x +  unit _ _ = zero++instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where+  comult f = f' where+    fe = f E+    fi = f I+    fj = f J+    fk = f K+    fe' = negate fe+    fi' = negate fi+    fj' = negate fj+    fk' = negate fk+    f' E E = fe+    f' E I = fi+    f' E J = fj+    f' E K = fk+    f' I E = fi+    f' I I = fe'+    f' I J = fk+    f' I K = fj'+    f' J E = fj+    f' J I = fk'+    f' J J = fe'+    f' J K = fi+    f' K E = fk+    f' K I = fj+    f' K J = fi'+    f' K K = fe'++instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where+  counit f = f E++instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis ++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis where+  inv f E = f E+  inv f b = negate (f b)++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis where+  coinv = inv++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis where+  antipode = inv++instance (TriviallyInvolutive r, Rng r) => Multiplicative (Quaternion r) where+  (*) = mulRep++instance (TriviallyInvolutive r, Rng r) => Semiring (Quaternion r)++instance (TriviallyInvolutive r, Ring r) => Unital (Quaternion r) where+  one = oneRep++instance (TriviallyInvolutive r, Ring r) => Rig (Quaternion r) where+  fromNatural n = Quaternion (fromNatural n) zero zero zero++instance (TriviallyInvolutive r, Ring r) => Ring (Quaternion r) where+  fromInteger n = Quaternion (fromInteger n) zero zero zero++instance ( TriviallyInvolutive r, Rng r) => LeftModule (Quaternion r) (Quaternion r) where +  (.*) = (*)+instance (TriviallyInvolutive r, Rng r) => RightModule (Quaternion r) (Quaternion r) where +  (*.) = (*)++instance (TriviallyInvolutive r, Rng r) => InvolutiveMultiplication (Quaternion r) where+  -- without trivial involution, multiplication fails associativity, and we'd need to +  -- support weaker multiplicative properties like Alternative and PowerAssociative+  adjoint (Quaternion a b c d) = Quaternion a (negate b) (negate c) (negate d)++-- | Cayley-Dickson quaternion isomorphism (one way)+complicate :: QuaternionBasis -> (ComplexBasis, ComplexBasis)+complicate E = (Complex.E, Complex.E)+complicate I = (Complex.I, Complex.E)+complicate J = (Complex.E, Complex.I)+complicate K = (Complex.I, Complex.I)++-- | Cayley-Dickson quaternion isomorphism (the other half)+uncomplicate :: ComplexBasis -> ComplexBasis -> QuaternionBasis+uncomplicate Complex.E Complex.E = E+uncomplicate Complex.I Complex.E = I+uncomplicate Complex.E Complex.I = J+uncomplicate Complex.I Complex.I = K

@@ -0,0 +1,206 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}+module Numeric.Algebra.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.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Ix+import Data.Key+import Data.Monoid+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Traversable+import Numeric.Algebra+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)++-- complex basis+data TrigBasis = S | C deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)+data Trig a = Trig a a deriving (Eq,Show,Read,Data,Typeable)++class Trigonometric r where+  s :: r+  c :: r++instance Trigonometric TrigBasis where+  s = S+  c = C++instance Rig r => Trigonometric (Trig r) where+  s = Trig one zero+  c = Trig zero one+  +instance Rig r => Trigonometric (TrigBasis -> r) where+  s S = one+  s C = zero+  c S = zero+  c C = one++instance Trigonometric a => Trigonometric (Covector r a) where+  s = return s+  c = return c++type instance Key Trig = TrigBasis++instance Representable Trig where+  tabulate f = Trig (f S) (f C)++instance Indexable Trig where+  index (Trig a _ ) S = a+  index (Trig _ b ) C = b++instance Lookup Trig where+  lookup = lookupDefault++instance Adjustable Trig where+  adjust f S (Trig a b) = Trig (f a) b+  adjust f C (Trig a b) = Trig a (f b)++instance Distributive Trig where+  distribute = distributeRep ++instance Functor Trig where+  fmap f (Trig a b) = Trig (f a) (f b)++instance Zip Trig where+  zipWith f (Trig a1 b1) (Trig a2 b2) = Trig (f a1 a2) (f b1 b2)++instance ZipWithKey Trig where+  zipWithKey f (Trig a1 b1) (Trig a2 b2) = Trig (f S a1 a2) (f C b1 b2)++instance Keyed Trig where+  mapWithKey = mapWithKeyRep++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 FoldableWithKey Trig where+  foldMapWithKey f (Trig a b) = f S a `mappend` f C b++instance Traversable Trig where+  traverse f (Trig a b) = Trig <$> f a <*> f b++instance TraversableWithKey Trig where+  traverseWithKey f (Trig a b) = Trig <$> f S a <*> f C b++instance Foldable1 Trig where+  foldMap1 f (Trig a b) = f a <> f b++instance FoldableWithKey1 Trig where+  foldMapWithKey1 f (Trig a b) = f S a <> f C b++instance Traversable1 Trig where+  traverse1 f (Trig a b) = Trig <$> f a <.> f b++instance TraversableWithKey1 Trig where+  traverseWithKey1 f (Trig a b) = Trig <$> f S a <.> f C b++instance HasTrie TrigBasis where+  type BaseTrie TrigBasis = Trig+  embedKey = id+  projectKey = id++instance Additive r => Additive (Trig r) where+  (+) = addRep +  replicate1p = replicate1pRep++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+  replicate = replicateRep++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 dual, trigonometric algebra+instance (Commutative k, Rng k) => Algebra k TrigBasis where+  mult f = f' where+    fs = f S C + f C S+    fc = f C C - f S S+    f' S = fs+    f' C = fc++instance (Commutative k, Rng k) => UnitalAlgebra k TrigBasis where+  unit _ S = zero+  unit x C = x++-- the actual trigonometric coalgebra+instance (Commutative k, Rng k) => Coalgebra k TrigBasis where+  comult f = f' where+     fs = f S+     fc = f C+     fc' = negate fc+     f' S S = fc'+     f' S C = fs +     f' C S = fs+     f' C C = fc++instance (Commutative k, Rng k) => CounitalCoalgebra k TrigBasis where+  counit f = f C++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 zero one++instance (Commutative r, Ring r) => Rig (Trig r) where+  fromNatural n = Trig zero (fromNatural n)++instance (Commutative r, Ring r) => Ring (Trig r) where+  fromInteger n = Trig zero (fromInteger n)++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) (adjoint b)++instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Trig r)

@@ -82,7 +82,7 @@   replicate1p n (Covector m) = Covector $ replicate1p n m  instance Coalgebra r m => Multiplicative (Covector r m) where-  f * Covector g = Covector $ \k -> f $* g . comult k+  Covector f * Covector g = Covector $ \k -> f (\m -> g (comult k m))  instance (Commutative m, Coalgebra r m) => Commutative (Covector r m) 

@@ -1,215 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}-module Numeric.Module.Complex-  ( Complicated(..)-  , ComplexBasis(..)-  , Complex-  ) where--import Control.Applicative-import Control.Monad.Reader.Class-import Data.Data-import Data.Distributive-import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Foldable-import Data.Ix-import Data.Key-import Data.Monoid-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.Traversable-import Numeric.Algebra-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)---- complex basis-data ComplexBasis = E | I deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)-data Complex a = Complex a a deriving (Eq,Show,Read,Data,Typeable)--class Complicated r where-  e :: r-  i :: r--instance Complicated ComplexBasis where-  e = E-  i = I--instance Rig r => Complicated (Complex r) where-  e = Complex one zero-  i = Complex zero one-  -instance Rig r => Complicated (ComplexBasis -> r) where-  e E = one-  e _ = zero-  i I = one-  i _ = zero --instance Complicated a => Complicated (Covector r a) where-  e = return e-  i = return i--type instance Key Complex = ComplexBasis--instance Representable Complex where-  tabulate f = Complex (f E) (f I)--instance Indexable Complex where-  index (Complex a _ ) E = a-  index (Complex _ b ) I = b--instance Lookup Complex where-  lookup = lookupDefault--instance Adjustable Complex where-  adjust f E (Complex a b) = Complex (f a) b-  adjust f I (Complex a b) = Complex a (f b)--instance Distributive Complex where-  distribute = distributeRep --instance Functor Complex where-  fmap f (Complex a b) = Complex (f a) (f b)--instance Zip Complex where-  zipWith f (Complex a1 b1) (Complex a2 b2) = Complex (f a1 a2) (f b1 b2)--instance ZipWithKey Complex where-  zipWithKey f (Complex a1 b1) (Complex a2 b2) = Complex (f E a1 a2) (f I b1 b2)--instance Keyed Complex where-  mapWithKey = mapWithKeyRep--instance Apply Complex where-  (<.>) = apRep--instance Applicative Complex where-  pure = pureRep-  (<*>) = apRep --instance Bind Complex where-  (>>-) = bindRep--instance Monad Complex where-  return = pureRep-  (>>=) = bindRep--instance MonadReader ComplexBasis Complex where-  ask = askRep-  local = localRep--instance Foldable Complex where-  foldMap f (Complex a b) = f a `mappend` f b--instance FoldableWithKey Complex where-  foldMapWithKey f (Complex a b) = f E a `mappend` f I b--instance Traversable Complex where-  traverse f (Complex a b) = Complex <$> f a <*> f b--instance TraversableWithKey Complex where-  traverseWithKey f (Complex a b) = Complex <$> f E a <*> f I b--instance Foldable1 Complex where-  foldMap1 f (Complex a b) = f a <> f b--instance FoldableWithKey1 Complex where-  foldMapWithKey1 f (Complex a b) = f E a <> f I b--instance Traversable1 Complex where-  traverse1 f (Complex a b) = Complex <$> f a <.> f b--instance TraversableWithKey1 Complex where-  traverseWithKey1 f (Complex a b) = Complex <$> f E a <.> f I b--instance HasTrie ComplexBasis where-  type BaseTrie ComplexBasis = Complex-  embedKey = id-  projectKey = id--instance Additive r => Additive (Complex r) where-  (+) = addRep -  replicate1p = replicate1pRep--instance LeftModule r s => LeftModule r (Complex s) where-  r .* Complex a b = Complex (r .* a) (r .* b)--instance RightModule r s => RightModule r (Complex s) where-  Complex a b *. r = Complex (a *. r) (b *. r)--instance Monoidal r => Monoidal (Complex r) where-  zero = zeroRep-  replicate = replicateRep--instance Group r => Group (Complex r) where-  (-) = minusRep-  negate = negateRep-  subtract = subtractRep-  times = timesRep--instance Abelian r => Abelian (Complex r)--instance Idempotent r => Idempotent (Complex r)--instance Partitionable r => Partitionable (Complex r) where-  partitionWith f (Complex a b) = id =<<-    partitionWith (\a1 a2 -> -    partitionWith (\b1 b2 -> f (Complex a1 b1) (Complex a2 b2)) b) a--instance Rng k => Algebra k ComplexBasis where-  mult f = f' where-    fe = f E E - f I I-    fi = f E I + f I E-    f' E = fe-    f' I = fi--instance Rng k => UnitalAlgebra k ComplexBasis where-  unit x E = x-  unit _ _ = zero--instance Rng k => Coalgebra k ComplexBasis where-  comult f = f' where -    fe = f E-    fi = f I-    f' E E = fe-    f' E I = fi-    f' I E = fi-    f' I I = negate fe--instance Rng k => CounitalCoalgebra k ComplexBasis where-  counit f = f E--instance Rng k => Bialgebra k ComplexBasis --instance Rng k => InvolutiveAlgebra k ComplexBasis where-  inv f E = f E-  inv f b = negate (f b)--instance Rng k => InvolutiveCoalgebra k ComplexBasis where-  coinv = inv--instance Rng k => HopfAlgebra k ComplexBasis where-  antipode = inv--instance (Commutative r, Rng r) => Multiplicative (Complex r) where-  (*) = mulRep--instance (TriviallyInvolutive r, Rng r) => Commutative (Complex r)--instance (Commutative r, Rng r) => Semiring (Complex r)--instance (Commutative r, Ring r) => Unital (Complex r) where-  one = oneRep--instance (Commutative r, Ring r) => Rig (Complex r) where-  fromNatural n = Complex (fromNatural n) zero--instance (Commutative r, Ring r) => Ring (Complex r) where-  fromInteger n = Complex (fromInteger n) zero--instance (Commutative r, Rng r) => LeftModule (Complex r) (Complex r) where (.*) = (*)-instance (Commutative r, Rng r) => RightModule (Complex r) (Complex r) where (*.) = (*)--instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Complex r) where-  adjoint (Complex a b) = Complex (adjoint a) (negate b)--instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Complex r)

@@ -1,275 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}-module Numeric.Module.Quaternion -  ( Complicated(..)-  , Hamiltonian(..)-  , QuaternionBasis(..)-  , Quaternion(..)-  , complicate-  , uncomplicate-  ) where--import Control.Applicative-import Control.Monad.Reader.Class-import Data.Ix-import Data.Key-import Data.Data-import Data.Distributive-import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Foldable-import Data.Traversable-import Data.Monoid-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Numeric.Algebra-import Numeric.Module.Complex (ComplexBasis, Complicated(..))-import qualified Numeric.Module.Complex as Complex-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)--class Complicated t => Hamiltonian t where-  j :: t-  k :: t--instance Complicated QuaternionBasis where-  e = E-  i = I--instance Hamiltonian QuaternionBasis where-  j = J-  k = K--instance Rig r => Complicated (Quaternion r) where-  e = Quaternion one zero zero zero-  i = Quaternion zero one zero zero--instance Rig r => Hamiltonian (Quaternion r) where-  j = Quaternion zero zero one zero-  k = Quaternion one zero zero one --instance Rig r => Complicated (QuaternionBasis -> r) where-  e E = one -  e _ = zero--  i I = one-  i _ = zero-  -instance Rig r => Hamiltonian (QuaternionBasis -> r) where-  j J = one-  j _ = zero--  k K = one-  k _ = zero--instance Hamiltonian a => Hamiltonian (Covector r a) where-  j = return j-  k = return k---- quaternion basis-data QuaternionBasis = E | I | J | K deriving (Eq,Ord,Enum,Read,Show,Bounded,Ix,Data,Typeable)--data Quaternion a = Quaternion a a a a deriving (Eq,Show,Read,Data,Typeable)--type instance Key Quaternion = QuaternionBasis--instance Representable Quaternion where-  tabulate f = Quaternion (f E) (f I) (f J) (f K)--instance Indexable Quaternion where-  index (Quaternion a _ _ _) E = a-  index (Quaternion _ b _ _) I = b-  index (Quaternion _ _ c _) J = c-  index (Quaternion _ _ _ d) K = d--instance Lookup Quaternion where-  lookup = lookupDefault--instance Adjustable Quaternion where-  adjust f E (Quaternion a b c d) = Quaternion (f a) b c d-  adjust f I (Quaternion a b c d) = Quaternion a (f b) c d-  adjust f J (Quaternion a b c d) = Quaternion a b (f c) d-  adjust f K (Quaternion a b c d) = Quaternion a b c (f d)--instance Distributive Quaternion where-  distribute = distributeRep --instance Functor Quaternion where-  fmap = fmapRep--instance Zip Quaternion where-  zipWith f (Quaternion a1 b1 c1 d1) (Quaternion a2 b2 c2 d2) = Quaternion (f a1 a2) (f b1 b2) (f c1 c2) (f d1 d2)--instance ZipWithKey Quaternion where-  zipWithKey f (Quaternion a1 b1 c1 d1) (Quaternion a2 b2 c2 d2) = Quaternion (f E a1 a2) (f I b1 b2) (f J c1 c2) (f K d1 d2)--instance Keyed Quaternion where-  mapWithKey = mapWithKeyRep--instance Apply Quaternion where-  (<.>) = apRep--instance Applicative Quaternion where-  pure = pureRep-  (<*>) = apRep --instance Bind Quaternion where-  (>>-) = bindRep--instance Monad Quaternion where-  return = pureRep-  (>>=) = bindRep--instance MonadReader QuaternionBasis Quaternion where-  ask = askRep-  local = localRep--instance Foldable Quaternion where-  foldMap f (Quaternion a b c d) = f a `mappend` f b `mappend` f c `mappend` f d--instance FoldableWithKey Quaternion where-  foldMapWithKey f (Quaternion a b c d) = f E a `mappend` f I b `mappend` f J c `mappend` f K d--instance Traversable Quaternion where-  traverse f (Quaternion a b c d) = Quaternion <$> f a <*> f b <*> f c <*> f d--instance TraversableWithKey Quaternion where-  traverseWithKey f (Quaternion a b c d) = Quaternion <$> f E a <*> f I b <*> f J c <*> f K d--instance Foldable1 Quaternion where-  foldMap1 f (Quaternion a b c d) = f a <> f b <> f c <> f d--instance FoldableWithKey1 Quaternion where-  foldMapWithKey1 f (Quaternion a b c d) = f E a <> f I b <> f J c <> f K d--instance Traversable1 Quaternion where-  traverse1 f (Quaternion a b c d) = Quaternion <$> f a <.> f b <.> f c <.> f d--instance TraversableWithKey1 Quaternion where-  traverseWithKey1 f (Quaternion a b c d) = Quaternion <$> f E a <.> f I b <.> f J c <.> f K d--instance HasTrie QuaternionBasis where-  type BaseTrie QuaternionBasis = Quaternion-  embedKey = id-  projectKey = id--instance Additive r => Additive (Quaternion r) where-  (+) = addRep -  replicate1p = replicate1pRep--instance LeftModule r s => LeftModule r (Quaternion s) where-  r .* Quaternion a b c d = Quaternion (r .* a) (r .* b) (r .* c) (r .* d)--instance RightModule r s => RightModule r (Quaternion s) where-  Quaternion a b c d *. r = Quaternion (a *. r) (b *. r) (c *. r) (d *. r)--instance Monoidal r => Monoidal (Quaternion r) where-  zero = zeroRep-  replicate = replicateRep--instance Group r => Group (Quaternion r) where-  (-) = minusRep-  negate = negateRep-  subtract = subtractRep-  times = timesRep--instance Abelian r => Abelian (Quaternion r)--instance Idempotent r => Idempotent (Quaternion r)--instance Partitionable r => Partitionable (Quaternion r) where-  partitionWith f (Quaternion a b c d) = id =<<-                partitionWith (\a1 a2 -> id =<< -                partitionWith (\b1 b2 -> id =<< -                partitionWith (\c1 c2 -> -                partitionWith (\d1 d2 -> f (Quaternion a1 b1 c1 d1) -                                           (Quaternion a2 b2 c2 d2)-                              ) d) c) b) a--instance (TriviallyInvolutive r, Rng r) => Algebra r QuaternionBasis where-  mult f = f' where-    fe = f E E - (f I I + f J J + f K K)-    fi = f E I + f I E + f J K - f K J-    fj = f E J + f J E + f K I - f I K-    fk = f E K + f K E + f I J - f J I-    f' E = fe-    f' I = fi-    f' J = fj-    f' K = fk-             -instance (TriviallyInvolutive r, Rng r) => UnitalAlgebra r QuaternionBasis where-  unit x E = x -  unit _ _ = zero--instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where-  comult f = f' where-     fe = f E-     fi = f I-     fj = f J-     fk = f K-     f' E E = fe-     f' E I = fi-     f' E J = fj-     f' E K = fk-     f' I E = fi-     f' I I = negate fe-     f' I J = fk-     f' I K = negate fj-     f' J E = fj-     f' J I = negate fk-     f' J J = negate fe-     f' J K = fi-     f' K E = fk-     f' K I = fj-     f' K J = negate fi-     f' K K = negate fe--instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where-  counit f = f E--instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis --instance (TriviallyInvolutive r, Rng r)  => InvolutiveAlgebra r QuaternionBasis where-  inv f E = f E-  inv f b = negate (f b)--instance (TriviallyInvolutive r, Rng r) => InvolutiveCoalgebra r QuaternionBasis where-  coinv = inv--instance (TriviallyInvolutive r, Rng r) => HopfAlgebra r QuaternionBasis where-  antipode = inv--instance (TriviallyInvolutive r, Rng r) => Multiplicative (Quaternion r) where-  (*) = mulRep--instance (TriviallyInvolutive r, Rng r) => Semiring (Quaternion r)--instance (TriviallyInvolutive r, Ring r) => Unital (Quaternion r) where-  one = oneRep--instance (TriviallyInvolutive r, Ring r) => Rig (Quaternion r) where-  fromNatural n = Quaternion (fromNatural n) zero zero zero--instance (TriviallyInvolutive r, Ring r) => Ring (Quaternion r) where-  fromInteger n = Quaternion (fromInteger n) zero zero zero--instance (TriviallyInvolutive r, Rng r) => LeftModule (Quaternion r) (Quaternion r) where (.*) = (*)-instance (TriviallyInvolutive r, Rng r) => RightModule (Quaternion r) (Quaternion r) where (*.) = (*)--instance (TriviallyInvolutive r, Rng r) => InvolutiveMultiplication (Quaternion r) where-  -- without trivial involution, multiplication fails associativity, and we'd need to -  -- support weaker multiplicative properties like Alternative and PowerAssociative-  adjoint (Quaternion a b c d) = Quaternion a (negate b) (negate c) (negate d)---- | Cayley-Dickson quaternion isomorphism (one way)-complicate :: QuaternionBasis -> (ComplexBasis, ComplexBasis)-complicate E = (Complex.E, Complex.E)-complicate I = (Complex.I, Complex.E)-complicate J = (Complex.E, Complex.I)-complicate K = (Complex.I, Complex.I)---- | Cayley-Dickson quaternion isomorphism (the other half)-uncomplicate :: ComplexBasis -> ComplexBasis -> QuaternionBasis-uncomplicate Complex.E Complex.E = E-uncomplicate Complex.I Complex.E = I-uncomplicate Complex.E Complex.I = J-uncomplicate Complex.I Complex.I = K

@@ -1,6 +1,6 @@ name:          algebra category:      Math, Algebra-version:       0.5.0+version:       0.6.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -30,26 +30,28 @@     mtl >= 2.0 && < 2.1,     semigroups >= 0.5 && < 0.6,     semigroupoids >= 1.2.2 && < 1.3,-    representable-functors >= 1.8 && < 1.9,-    representable-tries >= 1.8.1 && < 1.9,+    representable-functors >= 2.0 && < 2.1,+    representable-tries >= 2.0 && < 2.1,     void >= 0.5.4 && < 0.6  -- reflection >= 0.4 && < 0.5,   exposed-modules:     Numeric.Algebra+    Numeric.Algebra.Complex+    Numeric.Algebra.Quaternion+    Numeric.Algebra.Trigonometric+    Numeric.Algebra.Hyperbolic+    Numeric.Algebra.Geometric     Numeric.Band.Rectangular     Numeric.Covector     Numeric.Exp     Numeric.Log     Numeric.Map-    Numeric.Module.Complex-    Numeric.Module.Quaternion     Numeric.Natural.Internal     Numeric.Rng.Zero     Numeric.Ring.Rng     Numeric.Ring.Opposite     Numeric.Ring.Endomorphism-    Numeric.Algebra.Geometric    other-modules:     Numeric.Additive.Class