algebra 3.1 → 4.0

raw patch · 20 files changed

+61/−579 lines, 20 filesdep +adjunctionsdep −categoriesdep −keysdep −representable-functorsdep ~arraydep ~distributivedep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: adjunctions

Dependencies removed: categories, keys, representable-functors, representable-tries

Dependency ranges changed: array, distributive, mtl, semigroupoids, semigroups, tagged, transformers, void

API changes (from Hackage documentation)

Files

• .gitignore +12/−1
• algebra.cabal +11/−14
• src/Numeric/Additive/Class.hs +1/−12
• src/Numeric/Additive/Group.hs +0/−8
• src/Numeric/Algebra.hs +0/−1
• src/Numeric/Algebra/Class.hs +0/−21
• src/Numeric/Algebra/Commutative.hs +0/−11
• src/Numeric/Algebra/Complex.hs +4/−48
• src/Numeric/Algebra/Dual.hs +2/−39
• src/Numeric/Algebra/Hyperbolic.hs +2/−40
• src/Numeric/Algebra/Involutive.hs +0/−15
• src/Numeric/Algebra/Quaternion.hs +4/−60
• src/Numeric/Coalgebra/Dual.hs +2/−40
• src/Numeric/Coalgebra/Geometric.hs +0/−11
• src/Numeric/Coalgebra/Hyperbolic.hs +2/−39
• src/Numeric/Coalgebra/Quaternion.hs +4/−60
• src/Numeric/Coalgebra/Trigonometric.hs +2/−50
• src/Numeric/Covector.hs +1/−13
• src/Numeric/Map.hs +3/−84
• src/Numeric/Module/Representable.hs +11/−12

@@ -1,2 +1,13 @@-_darcs dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#

@@ -1,6 +1,6 @@ name:          algebra category:      Math, Algebra-version:       3.1+version:       4.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -43,21 +43,18 @@     GeneralizedNewtypeDeriving    build-depends:-    array                   >= 0.3.0.2 && < 0.5,+    adjunctions             >= 4       && < 5,+    array                   >= 0.3.0.2 && < 0.6,     base                    == 4.*,-    distributive            >= 0.2.2,-    transformers            >= 0.2     && < 0.4,-    tagged                  >= 0.4.2,-    categories              >= 1.0,     containers              >= 0.3     && < 0.6,-    keys                    >= 3,-    mtl                     >= 2.0.1   && < 2.2,-    nats                    >= 0.1,-    semigroups              >= 0.9,-    semigroupoids           >= 3,-    representable-functors  >= 3,-    representable-tries     >= 3,-    void                    >= 0.5.5.1+    distributive            >= 0.2.2   && < 1,+    mtl                     >= 2.0.1   && < 2.3,+    nats                    >= 0.1     && < 1,+    semigroups              >= 0.9     && < 1,+    semigroupoids           >= 4       && < 5,+    transformers            >= 0.2     && < 0.5,+    tagged                  >= 0.4.2   && < 1,+    void                    >= 0.5.5.1 && < 1    exposed-modules:     Numeric.Additive.Class

@@ -17,12 +17,8 @@ import Data.Word import Data.Foldable hiding (concat) import Data.Semigroup.Foldable-import Data.Key-import Data.Functor.Representable-import Data.Functor.Representable.Trie--- import Data.Foldable hiding (concat) import Numeric.Natural.Internal-import Prelude (fmap,(-),Bool(..),($),id,(>>=),fromIntegral,(*),otherwise,quot,maybe,error,even,Maybe(..),(==),(.),($!),Integer,(||),toInteger,Integral)+import Prelude ((-),Bool(..),($),id,(>>=),fromIntegral,(*),otherwise,quot,maybe,error,even,Maybe(..),(==),(.),($!),Integer,(||),toInteger) import qualified Prelude import Data.List.NonEmpty (NonEmpty(..), fromList) @@ -62,11 +58,6 @@   sinnum1p n f e = sinnum1p n (f e)   sumWith1 f xs e = sumWith1 (`f` e) xs -instance (HasTrie b, Additive r) => Additive (b :->: r) where-  (+) = zipWith (+)-  sinnum1p = fmap . sinnum1p-  sumWith1 f xs = tabulate $ \e -> sumWith1 (\a -> index (f a) e) xs- instance Additive Bool where   (+) = (||)   sinnum1p _ a = a@@ -187,7 +178,6 @@ 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@@ -219,7 +209,6 @@ 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)

@@ -6,8 +6,6 @@  import Data.Int import Data.Word-import Data.Key-import Data.Functor.Representable.Trie import Prelude hiding ((*), (+), (-), negate, subtract,zipWith) import qualified Prelude import Numeric.Additive.Class@@ -44,12 +42,6 @@   negate f x = negate (f x)   subtract f g x = subtract (f x) (g x)   times n f e = times n (f e)--instance (HasTrie e, Group r) => Group (e :->: r) where-  (-) = zipWith (-)-  negate = fmap negate-  subtract = zipWith subtract-  times = fmap . times  instance Group Integer where   (-) = (Prelude.-)

@@ -136,7 +136,6 @@   , coinvM   , antipodeM   , convolveM-  , memoM   ) where  import Prelude ()

@@ -21,14 +21,10 @@   , Coalgebra(..)   ) where -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 import Data.Map (Map) import Data.Monoid (mappend) -- import Data.Semigroup.Foldable@@ -149,8 +145,6 @@  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: -- @@ -186,7 +180,6 @@ 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@@ -254,9 +247,6 @@ instance Algebra r m => Coalgebra r (m -> r) where   comult k f g = k (f * g) -instance (HasTrie m, Algebra r m) => Coalgebra r (m :->: r) where-  comult k f g = k (f * g)- -- 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  @@ -381,9 +371,6 @@ 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 @@ -460,9 +447,6 @@ 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 @@ -571,11 +555,6 @@   zero = const zero   sumWith f xs e = sumWith (`f` e) xs   sinnum n r e = sinnum 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-  sinnum n r = tabulate $ sinnum n . index r  instance Monoidal () where    zero = ()

@@ -6,7 +6,6 @@   , CommutativeBialgebra   ) where -import Data.Functor.Representable.Trie import Data.Int import Data.IntSet (IntSet) import Data.IntMap (IntMap)@@ -63,12 +62,6 @@  instance CommutativeAlgebra r a => Commutative (a -> r) -instance ( HasTrie a-         , CommutativeAlgebra r a-         ) => Commutative (a :->: r) --- class Algebra r a => CommutativeAlgebra r a  instance ( Commutative r@@ -126,10 +119,6 @@ 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 () 

@@ -19,11 +19,9 @@ import Data.Data import Data.Distributive import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Foldable import Data.Ix hiding (index)-import Data.Key import Data.Semigroup import Data.Semigroup.Traversable import Data.Semigroup.Foldable@@ -38,10 +36,10 @@ 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) -realPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a+realPart :: (Representable f, Rep f ~ ComplexBasis) => f a -> a realPart f = index f E  -imagPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a+imagPart :: (Representable f, Rep f ~ ComplexBasis) => f a -> a imagPart f = index f I  instance Distinguished ComplexBasis where@@ -64,43 +62,18 @@   i I = one   i _ = zero  -instance Rig r => Distinguished (ComplexBasis :->: r) where-  e = Trie e-  -instance Rig r => Complicated (ComplexBasis :->: r) where-  i = Trie i--type instance Key Complex = ComplexBasis- instance Representable Complex where+  type Rep Complex = ComplexBasis   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 @@ -122,31 +95,14 @@ 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 

@@ -11,11 +11,9 @@ import Data.Data import Data.Distributive import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Foldable import Data.Ix-import Data.Key import Data.Semigroup hiding (Dual) import Data.Semigroup.Traversable import Data.Semigroup.Foldable@@ -49,37 +47,19 @@   d D = one   d _       = zero  -type instance Key Dual = DualBasis  instance Representable Dual where+  type Rep Dual = DualBasis   tabulate f = Dual (f E) (f D)--instance Indexable Dual where   index (Dual a _ ) E = a   index (Dual _ b ) D = b -instance Lookup Dual where-  lookup = lookupDefault--instance Adjustable Dual where-  adjust f E (Dual a b) = Dual (f a) b-  adjust f D (Dual a b) = Dual a (f b)- instance Distributive Dual where   distribute = distributeRep   instance Functor Dual where   fmap f (Dual a b) = Dual (f a) (f b) -instance Zip Dual where-  zipWith f (Dual a1 b1) (Dual a2 b2) = Dual (f a1 a2) (f b1 b2)--instance ZipWithKey Dual where-  zipWithKey f (Dual a1 b1) (Dual a2 b2) = Dual (f E a1 a2) (f D b1 b2)--instance Keyed Dual where-  mapWithKey = mapWithKeyRep- instance Apply Dual where   (<.>) = apRep @@ -101,31 +81,14 @@ instance Foldable Dual where   foldMap f (Dual a b) = f a `mappend` f b -instance FoldableWithKey Dual where-  foldMapWithKey f (Dual a b) = f E a `mappend` f D b- instance Traversable Dual where   traverse f (Dual a b) = Dual <$> f a <*> f b -instance TraversableWithKey Dual where-  traverseWithKey f (Dual a b) = Dual <$> f E a <*> f D b- instance Foldable1 Dual where   foldMap1 f (Dual a b) = f a <> f b -instance FoldableWithKey1 Dual where-  foldMapWithKey1 f (Dual a b) = f E a <> f D b- instance Traversable1 Dual where   traverse1 f (Dual a b) = Dual <$> f a <.> f b--instance TraversableWithKey1 Dual where-  traverseWithKey1 f (Dual a b) = Dual <$> f E a <.> f D b--instance HasTrie DualBasis where-  type BaseTrie DualBasis = Dual-  embedKey = id-  projectKey = id  instance Additive r => Additive (Dual r) where   (+) = addRep 

@@ -10,11 +10,9 @@ import Data.Data import Data.Distributive import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Foldable import Data.Ix-import Data.Key import Data.Semigroup.Traversable import Data.Semigroup.Foldable import Data.Semigroup@@ -41,37 +39,18 @@   sinh Sinh' = one   sinh Cosh' = zero -type instance Key Hyper' = HyperBasis'- instance Representable Hyper' where+  type Rep Hyper' = HyperBasis'   tabulate f = Hyper' (f Cosh') (f Sinh')--instance Indexable Hyper' where   index (Hyper' a _ ) Cosh' = a   index (Hyper' _ b ) Sinh' = b -instance Lookup Hyper' where-  lookup = lookupDefault--instance Adjustable Hyper' where-  adjust f Cosh' (Hyper' a b) = Hyper' (f a) b-  adjust f Sinh' (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 Cosh' a1 a2) (f Sinh' b1 b2)--instance Keyed Hyper' where-  mapWithKey = mapWithKeyRep- instance Apply Hyper' where   (<.>) = apRep @@ -93,31 +72,14 @@ instance Foldable Hyper' where   foldMap f (Hyper' a b) = f a `mappend` f b -instance FoldableWithKey Hyper' where-  foldMapWithKey f (Hyper' a b) = f Cosh' a `mappend` f Sinh' 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 Cosh' a <*> f Sinh' b- instance Foldable1 Hyper' where   foldMap1 f (Hyper' a b) = f a <> f b -instance FoldableWithKey1 Hyper' where-  foldMapWithKey1 f (Hyper' a b) = f Cosh' a <> f Sinh' 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 Cosh' a <.> f Sinh' b--instance HasTrie HyperBasis' where-  type BaseTrie HyperBasis' = Hyper'-  embedKey = id-  projectKey = id  instance Additive r => Additive (Hyper' r) where   (+) = addRep 

@@ -19,9 +19,6 @@ 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 @@ -81,11 +78,6 @@ 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 @@ -173,13 +165,6 @@ 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 (InvolutiveSemiring r, Algebra r a) => InvolutiveAlgebra r a where

@@ -18,12 +18,10 @@ import Control.Applicative import Control.Monad.Reader.Class import Data.Ix hiding (index)-import Data.Key import Data.Data import Data.Distributive import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Foldable import Data.Traversable import Data.Semigroup@@ -55,16 +53,6 @@   j = Quaternion zero zero one zero   k = Quaternion one zero zero one  -instance Rig r => Distinguished (QuaternionBasis :->: r) where-  e = Trie e--instance Rig r => Complicated (QuaternionBasis :->: r) where-  i = Trie i--instance Rig r => Hamiltonian (QuaternionBasis :->: r) where-  j = Trie j-  k = Trie k- instance Rig r => Distinguished (QuaternionBasis -> r) where   e E = one    e _ = zero@@ -85,43 +73,20 @@  data Quaternion a = Quaternion a a a a deriving (Eq,Show,Read,Data,Typeable) -type instance Key Quaternion = QuaternionBasis- instance Representable Quaternion where+  type Rep Quaternion = QuaternionBasis   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 @@ -144,39 +109,18 @@   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    sinnum1p = sinnum1pRep@@ -320,10 +264,10 @@ complicate J = (e, i) complicate K = (i, i) -scalarPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> r+scalarPart :: (Representable f, Rep f ~ QuaternionBasis) => f r -> r scalarPart f = index f E -vectorPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> (r,r,r)+vectorPart :: (Representable f, Rep f ~ QuaternionBasis) => f r -> (r,r,r) vectorPart f = (index f I, index f J, index f K)  instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion r) where

@@ -11,11 +11,9 @@ import Data.Data import Data.Distributive import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Foldable import Data.Ix-import Data.Key import Data.Semigroup.Traversable import Data.Semigroup.Foldable import Data.Semigroup@@ -49,37 +47,18 @@   d D = one   d _       = zero  -type instance Key Dual' = DualBasis'- instance Representable Dual' where+  type Rep Dual' = DualBasis'   tabulate f = Dual' (f E) (f D)--instance Indexable Dual' where   index (Dual' a _ ) E = a   index (Dual' _ b ) D = b -instance Lookup Dual' where-  lookup = lookupDefault--instance Adjustable Dual' where-  adjust f E (Dual' a b) = Dual' (f a) b-  adjust f D (Dual' a b) = Dual' a (f b)- instance Distributive Dual' where   distribute = distributeRep   instance Functor Dual' where   fmap f (Dual' a b) = Dual' (f a) (f b) -instance Zip Dual' where-  zipWith f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f a1 a2) (f b1 b2)--instance ZipWithKey Dual' where-  zipWithKey f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f E a1 a2) (f D b1 b2)--instance Keyed Dual' where-  mapWithKey = mapWithKeyRep- instance Apply Dual' where   (<.>) = apRep @@ -101,31 +80,14 @@ instance Foldable Dual' where   foldMap f (Dual' a b) = f a `mappend` f b -instance FoldableWithKey Dual' where-  foldMapWithKey f (Dual' a b) = f E a `mappend` f D b- instance Traversable Dual' where   traverse f (Dual' a b) = Dual' <$> f a <*> f b -instance TraversableWithKey Dual' where-  traverseWithKey f (Dual' a b) = Dual' <$> f E a <*> f D b- instance Foldable1 Dual' where   foldMap1 f (Dual' a b) = f a <> f b -instance FoldableWithKey1 Dual' where-  foldMapWithKey1 f (Dual' a b) = f E a <> f D b- instance Traversable1 Dual' where   traverse1 f (Dual' a b) = Dual' <$> f a <.> f b--instance TraversableWithKey1 Dual' where-  traverseWithKey1 f (Dual' a b) = Dual' <$> f E a <.> f D b--instance HasTrie DualBasis' where-  type BaseTrie DualBasis' = Dual'-  embedKey = id-  projectKey = id  instance Additive r => Additive (Dual' r) where   (+) = addRep 

@@ -39,7 +39,6 @@  import Control.Monad (mfilter) import Data.Bits-import Data.Functor.Representable.Trie import Data.Word import Data.Data import Data.Ix@@ -56,11 +55,6 @@   , DecidableZero,DecidableAssociates,DecidableUnits   ) -instance HasTrie (BasisCoblade m) where-  type BaseTrie (BasisCoblade m) = BaseTrie Word64-  embedKey = embedKey . runBasisCoblade-  projectKey = BasisCoblade . projectKey- -- A metric space over an eigenbasis class Eigenbasis m where   euclidean     :: proxy m -> Bool@@ -99,11 +93,6 @@   , Multiplicative,TriviallyInvolutive,InvolutiveMultiplication,InvolutiveSemiring,Unital,Commutative   , Semiring,Rig,Ring   )--instance HasTrie Euclidean where-  type BaseTrie Euclidean = BaseTrie Int-  embedKey (Euclidean i) = embedKey i-  projectKey = Euclidean . projectKey  instance Eigenbasis Euclidean where   euclidean _ = True

@@ -10,11 +10,9 @@ import Data.Data import Data.Distributive import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Foldable import Data.Ix-import Data.Key import Data.Semigroup.Traversable import Data.Semigroup.Foldable import Data.Semigroup@@ -41,37 +39,19 @@   sinh Sinh = one   sinh Cosh = zero -type instance Key Hyper = HyperBasis  instance Representable Hyper where+  type Rep Hyper = HyperBasis   tabulate f = Hyper (f Cosh) (f Sinh)--instance Indexable Hyper where   index (Hyper a _ ) Cosh = a   index (Hyper _ b ) Sinh = b -instance Lookup Hyper where-  lookup = lookupDefault--instance Adjustable Hyper where-  adjust f Cosh (Hyper a b) = Hyper (f a) b-  adjust f Sinh (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 Cosh a1 a2) (f Sinh b1 b2)--instance Keyed Hyper where-  mapWithKey = mapWithKeyRep- instance Apply Hyper where   (<.>) = apRep @@ -93,31 +73,14 @@ instance Foldable Hyper where   foldMap f (Hyper a b) = f a `mappend` f b -instance FoldableWithKey Hyper where-  foldMapWithKey f (Hyper a b) = f Cosh a `mappend` f Sinh 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 Cosh a <*> f Sinh b- instance Foldable1 Hyper where   foldMap1 f (Hyper a b) = f a <> f b -instance FoldableWithKey1 Hyper where-  foldMapWithKey1 f (Hyper a b) = f Cosh a <> f Sinh 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 Cosh a <.> f Sinh b--instance HasTrie HyperBasis where-  type BaseTrie HyperBasis = Hyper-  embedKey = id-  projectKey = id  instance Additive r => Additive (Hyper r) where   (+) = addRep 

@@ -18,12 +18,10 @@ import Control.Applicative import Control.Monad.Reader.Class import Data.Ix hiding (index)-import Data.Key import Data.Data import Data.Distributive import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Foldable import Data.Traversable import Data.Semigroup.Traversable@@ -55,16 +53,6 @@   j = Quaternion' zero zero one zero   k = Quaternion' one zero zero one -instance Rig r => Distinguished (QuaternionBasis' :->: r) where-  e = Trie e--instance Rig r => Complicated (QuaternionBasis' :->: r) where-  i = Trie i--instance Rig r => Hamiltonian (QuaternionBasis' :->: r) where-  j = Trie j-  k = Trie k- instance Rig r => Distinguished (QuaternionBasis' -> r) where   e E' = one   e _ = zero@@ -85,43 +73,20 @@  data Quaternion' a = Quaternion' a a a a deriving (Eq,Show,Read,Data,Typeable) -type instance Key Quaternion' = QuaternionBasis'- instance Representable Quaternion' where+  type Rep Quaternion' = QuaternionBasis'   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 @@ -144,39 +109,18 @@   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   sinnum1p = sinnum1pRep@@ -302,10 +246,10 @@ complicate' J' = (e, i) complicate' K' = (i, i) -scalarPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> r+scalarPart' :: (Representable f, Rep f ~ QuaternionBasis') => f r -> r scalarPart' f = index f E' -vectorPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> (r,r,r)+vectorPart' :: (Representable f, Rep f ~ QuaternionBasis') => f r -> (r,r,r) vectorPart' f = (index f I', index f J', index f K')  instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion' r) where

@@ -15,11 +15,9 @@ import Data.Data import Data.Distributive import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Foldable import Data.Ix-import Data.Key import Data.Semigroup.Traversable import Data.Semigroup.Foldable import Data.Semigroup@@ -67,47 +65,18 @@   sin Sin = one   sin Cos = zero -instance Rig r => Trigonometric (TrigBasis :->: r) where-  cos = Trie cos-  sin = Trie sin--instance Rig r => Distinguished (TrigBasis :->: r) where-  e = Trie e--instance Rig r => Complicated (TrigBasis :->: r) where-  i = Trie i-  -type instance Key Trig = TrigBasis- instance Representable Trig where+  type Rep Trig = TrigBasis   tabulate f = Trig (f Cos) (f Sin)--instance Indexable Trig where   index (Trig a _ ) Cos = a   index (Trig _ b ) Sin = b -instance Lookup Trig where-  lookup = lookupDefault--instance Adjustable Trig where-  adjust f Cos (Trig a b) = Trig (f a) b-  adjust f Sin (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 Cos a1 a2) (f Sin b1 b2)--instance Keyed Trig where-  mapWithKey = mapWithKeyRep- instance Apply Trig where   (<.>) = apRep @@ -129,31 +98,14 @@ instance Foldable Trig where   foldMap f (Trig a b) = f a `mappend` f b -instance FoldableWithKey Trig where-  foldMapWithKey f (Trig a b) = f Cos a `mappend` f Sin 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 Cos a <*> f Sin b- instance Foldable1 Trig where   foldMap1 f (Trig a b) = f a <> f b -instance FoldableWithKey1 Trig where-  foldMapWithKey1 f (Trig a b) = f Cos a <> f Sin 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 Cos a <.> f Sin b--instance HasTrie TrigBasis where-  type BaseTrie TrigBasis = Trig-  embedKey = id-  projectKey = id  instance Additive r => Additive (Trig r) where   (+) = addRep 

@@ -1,7 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} module Numeric.Covector   ( Covector(..)-  , ($*)   -- * Covectors as linear functionals   , counitM   , unitM@@ -11,7 +10,6 @@   , coinvM   , antipodeM   , convolveM-  , memoM   ) where  import Numeric.Additive.Class@@ -26,12 +24,9 @@ import Numeric.Ring.Class import Control.Applicative import Control.Monad-import Data.Key-import Data.Functor.Representable.Trie import Data.Functor.Plus hiding (zero) import qualified Data.Functor.Plus as Plus import Data.Functor.Bind-import qualified Prelude import Prelude hiding ((+),(-),negate,subtract,replicate,(*))  -- | Linear functionals from elements of an (infinite) free module to a scalar@@ -39,12 +34,8 @@ -- f $* (x + y) = (f $* x) + (f $* y) -- f $* (a .* x) = a * (f $* x) -newtype Covector r a = Covector ((a -> r) -> r)- infixr 0 $*--($*) :: Indexable m => Covector r (Key m) -> m r -> r-Covector f $* m = f (index m)+newtype Covector r a = Covector { ($*) :: (a -> r) -> r }  instance Functor (Covector r) where   fmap f m = Covector $ \k -> m $* k . f@@ -127,9 +118,6 @@ -- | convolveM antipodeM return = convolveM return antipodeM = comultM >=> uncurry joinM antipodeM :: HopfAlgebra r h => h -> Covector r h antipodeM = Covector . flip antipode--memoM :: HasTrie a => a -> Covector s a-memoM = Covector . flip memo  -- TODO: we can also build up the augmentation ideal 

@@ -4,7 +4,6 @@   , ($@)   , multMap   , unitMap-  , memoMap   , comultMap   , counitMap   , invMap@@ -15,27 +14,16 @@  import Control.Applicative import Control.Arrow-import Control.Categorical.Bifunctor import Control.Category-import Control.Category.Associative-import Control.Category.Braided-import Control.Category.Cartesian-import Control.Category.Cartesian.Closed-import Control.Category.Distributive-import qualified Control.Category.Monoidal as C-import Control.Category.Monoidal (Id) import Control.Monad import Control.Monad.Reader.Class-import Data.Key-import Data.Functor.Representable-import Data.Functor.Representable.Trie+import Data.Functor.Rep import Data.Functor.Bind import Data.Functor.Plus hiding (zero) import qualified Data.Functor.Plus as Plus import Data.Semigroupoid-import Data.Void import Numeric.Algebra-import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat, (.), id, curry, uncurry, fst, snd)+import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat, (.), id, fst, snd)  -- | linear maps from elements of a free module to another free module over r --@@ -53,7 +41,7 @@ infixr 0 $# newtype Map r b a = Map ((a -> r) -> b -> r) -($#) :: (Indexable v, Representable w) => Map r (Key w) (Key v) -> v r -> w r+($#) :: (Representable v, Representable w) => Map r (Rep w) (Rep v) -> v r -> w r ($#) (Map m) = tabulate . m . index  infixr 0 $@@@ -86,71 +74,6 @@   return a = Map $ \k _ -> k a   m >>= f = Map $ \k b -> (m $# \a -> (f a $# k) b) b -instance PFunctor (,) (Map r) (Map r)-instance QFunctor (,) (Map r) (Map r)-instance Bifunctor (,) (Map r) (Map r) (Map r) where-  bimap m n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a--instance Associative (Map r) (,) where-  associate = arr associate-  disassociate = arr disassociate--instance Braided (Map r) (,) where-  braid = arr braid--instance Symmetric (Map r) (,)--instance C.Monoidal (Map r) (,) where-  type Id (Map r) (,) = ()-  idl = arr C.idl-  idr = arr C.idr-  coidl = arr C.coidl-  coidr = arr C.coidr--instance Cartesian (Map r) where-  type Product (Map r) = (,)-  fst = arr fst-  snd = arr snd-  diag = arr diag-  f &&& g = Map $ \k a -> (f $# \b -> (g $# \c -> k (b,c)) a) a--instance CCC (Map r) where-  type Exp (Map r) = Map r-  apply = Map $ \k (f,a) -> (f $# k) a-  curry m = Map $ \k a -> k (Map $ \k' b -> (m $# k') (a, b))-  uncurry m = Map $ \k (a, b) -> (m $# (\m' -> (m' $# k) b)) a--instance Distributive (Map r) where-  distribute = Map $ \k (a,p) -> k $ bimap ((,) a) ((,)a) p--instance PFunctor Either (Map r) (Map r)-instance QFunctor Either (Map r) (Map r)-instance Bifunctor Either (Map r) (Map r) (Map r) where-  bimap m n = Map $ \k -> either (m $# k . Left) (n $# k . Right)--instance Associative (Map r) Either where-  associate = arr associate-  disassociate = arr disassociate--instance Braided (Map r) Either where-  braid = arr braid--instance Symmetric (Map r) Either--instance CoCartesian (Map r) where-  type Sum (Map r) = Either-  inl = arr inl-  inr = arr inr-  codiag = arr codiag-  m ||| n = Map $ \k -> either (m $# k) (n $# k)--instance C.Monoidal (Map r) Either where-  type Id (Map r) Either = Void-  idl = arr C.idl-  idr = arr C.idr-  coidl = arr C.coidl-  coidr = arr C.coidr- instance Arrow (Map r) where   arr f = Map (. f)   first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a@@ -248,10 +171,6 @@ -- | (inefficiently) combine a linear combination of basis vectors to make a map. -- arrMap :: (Monoidal r, Semiring r) => (b -> [(r, a)]) -> Map r b a -- arrMap f = Map $ \k b -> sum [ r * k a | (r, a) <- f b ]---- | Memoize the results of this linear map-memoMap :: HasTrie a => Map r a a-memoMap = Map memo  comultMap :: Algebra r a => Map r a (a,a) comultMap = Map $ mult . curry

@@ -19,8 +19,7 @@  import Control.Applicative import Data.Functor-import Data.Functor.Representable-import Data.Key+import Data.Functor.Rep import Numeric.Additive.Class import Numeric.Additive.Group import Numeric.Algebra.Class@@ -32,8 +31,8 @@ import Prelude (($), Integral(..),Integer)  -- | `Additive.(+)` default definition-addRep :: (Zip m, Additive r) => m r -> m r -> m r-addRep = zipWith (+)+addRep :: (Applicative m, Additive r) => m r -> m r -> m r+addRep = liftA2 (+)  -- | `Additive.sinnum1p` default definition sinnum1pRep :: (Whole n, Functor m, Additive r) => n -> m r -> m r@@ -52,29 +51,29 @@ negateRep = fmap negate  -- | `Group.(-)` default definition-minusRep :: (Zip m, Group r) => m r -> m r -> m r-minusRep = zipWith (-)+minusRep :: (Applicative m, Group r) => m r -> m r -> m r+minusRep = liftA2 (-)  -- | `Group.subtract` default definition-subtractRep :: (Zip m, Group r) => m r -> m r -> m r-subtractRep = zipWith subtract+subtractRep :: (Applicative m, Group r) => m r -> m r -> m r+subtractRep = liftA2 subtract  -- | `Group.times` default definition timesRep :: (Integral n, Functor m, Group r) => n -> m r -> m r timesRep = fmap . times  -- | `Multiplicative.(*)` default definition-mulRep :: (Representable m, Algebra r (Key m)) => m r -> m r -> m r+mulRep :: (Representable m, Algebra r (Rep m)) => m r -> m r -> m r mulRep m n = tabulate $ mult (\b1 b2 -> index m b1 * index n b2)  -- | `Unital.one` default definition-oneRep :: (Representable m, Unital r, UnitalAlgebra r (Key m)) => m r+oneRep :: (Representable m, Unital r, UnitalAlgebra r (Rep m)) => m r oneRep = tabulate $ unit one  -- | `Rig.fromNatural` default definition-fromNaturalRep :: (UnitalAlgebra r (Key m), Representable m, Rig r) => Natural -> m r+fromNaturalRep :: (UnitalAlgebra r (Rep m), Representable m, Rig r) => Natural -> m r fromNaturalRep n = tabulate $ unit (fromNatural n)  -- | `Ring.fromInteger` default definition-fromIntegerRep :: (UnitalAlgebra r (Key m), Representable m, Ring r) => Integer -> m r+fromIntegerRep :: (UnitalAlgebra r (Rep m), Representable m, Ring r) => Integer -> m r fromIntegerRep n = tabulate $ unit (fromInteger n)