algebra 0.4.0 → 0.5.0

raw patch · 77 files changed

+3148/−2242 lines, 77 filesdep +arraydep +distributivedep +keysdep −reflectiondep ~representable-triessetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: array, distributive, keys, representable-functors

Dependencies removed: reflection

Dependency ranges changed: representable-tries

API changes (from Hackage documentation)

Files

• Numeric/Addition.hs +0/−15
• Numeric/Addition/Abelian.hs +0/−35
• Numeric/Addition/Idempotent.hs +0/−33
• Numeric/Addition/Partitionable.hs +0/−48
• Numeric/Additive/Class.hs +214/−0
• Numeric/Additive/Group.hs +141/−0
• Numeric/Algebra.hs +162/−0
• Numeric/Algebra/Class.hs +490/−0
• Numeric/Algebra/Commutative.hs +85/−0
• Numeric/Algebra/Division.hs +86/−0
• Numeric/Algebra/Factorable.hs +49/−0
• Numeric/Algebra/Free.hs +0/−9
• Numeric/Algebra/Free/Class.hs +0/−46
• Numeric/Algebra/Free/Hopf.hs +0/−32
• Numeric/Algebra/Free/Unital.hs +0/−43
• Numeric/Algebra/Geometric.hs +216/−0
• Numeric/Algebra/Hopf.hs +33/−0
• Numeric/Algebra/Idempotent.hs +59/−0
• Numeric/Algebra/Involutive.hs +166/−0
• Numeric/Algebra/Unital.hs +157/−0
• Numeric/Band.hs +0/−7
• Numeric/Band/Class.hs +2/−25
• Numeric/Band/Rectangular.hs +2/−2
• Numeric/Covector.hs +158/−0
• Numeric/Decidable/Associates.hs +2/−2
• Numeric/Decidable/Units.hs +2/−2
• Numeric/Decidable/Zero.hs +3/−3
• Numeric/Dioid/Class.hs +10/−0
• Numeric/Exp.hs +3/−5
• Numeric/Functional/Antilinear.hs +0/−79
• Numeric/Functional/Linear.hs +0/−129
• Numeric/Group.hs +0/−9
• Numeric/Group/Additive.hs +0/−142
• Numeric/Group/Multiplicative.hs +0/−59
• Numeric/Log.hs +5/−10
• Numeric/Map.hs +312/−0
• Numeric/Map/Linear.hs +0/−307
• Numeric/Module.hs +0/−5
• Numeric/Module/Class.hs +2/−91
• Numeric/Module/Complex.hs +215/−0
• Numeric/Module/Quaternion.hs +275/−0
• Numeric/Module/Representable.hs +80/−0
• Numeric/Monoid.hs +0/−9
• Numeric/Monoid/Additive.hs +0/−119
• Numeric/Monoid/Multiplicative.hs +0/−7
• Numeric/Monoid/Multiplicative/Internal.hs +0/−96
• Numeric/Multiplication.hs +0/−15
• Numeric/Multiplication/Commutative.hs +0/−28
• Numeric/Multiplication/Factorable.hs +0/−49
• Numeric/Multiplication/Involutive.hs +0/−42
• Numeric/Order.hs +0/−9
• Numeric/Order/Additive.hs +2/−2
• Numeric/Order/Class.hs +1/−1
• Numeric/Polynomial/Basis/Power.hs +0/−126
• Numeric/Quadrance/Class.hs +86/−0
• Numeric/Rig.hs +0/−9
• Numeric/Rig/Characteristic.hs +22/−28
• Numeric/Rig/Class.hs +3/−5
• Numeric/Ring.hs +0/−11
• Numeric/Ring/Class.hs +2/−2
• Numeric/Ring/Endomorphism.hs +19/−15
• Numeric/Ring/Opposite.hs +4/−12
• Numeric/Ring/Rng.hs +8/−17
• Numeric/Rng.hs +0/−11
• Numeric/Rng/Class.hs +5/−21
• Numeric/Rng/Zero.hs +11/−16
• Numeric/Semigroup.hs +0/−19
• Numeric/Semigroup/Additive.hs +0/−123
• Numeric/Semigroup/Multiplicative.hs +0/−7
• Numeric/Semiring.hs +0/−9
• Numeric/Semiring/Class.hs +0/−5
• Numeric/Semiring/Integral.hs +5/−4
• Numeric/Semiring/Internal.hs +0/−202
• Numeric/Semiring/Involutive.hs +3/−30
• Setup.hs +0/−2
• Setup.lhs +7/−0
• algebra.cabal +41/−53

@@ -1,15 +0,0 @@-module Numeric.Addition -  ( module Numeric.Addition.Abelian-  , module Numeric.Addition.Idempotent-  , module Numeric.Addition.Partitionable-  , module Numeric.Semigroup.Additive-  , module Numeric.Monoid.Additive-  , module Numeric.Group.Additive-  ) where--import Numeric.Addition.Abelian-import Numeric.Addition.Idempotent-import Numeric.Addition.Partitionable-import Numeric.Semigroup.Additive-import Numeric.Monoid.Additive-import Numeric.Group.Additive

@@ -1,35 +0,0 @@-module Numeric.Addition.Abelian-  ( -  -- * An Addition Abelian Semigroup-    Abelian-  ) where--import Data.Int-import Data.Word-import Numeric.Semigroup.Additive-import Numeric.Natural.Internal---- | an additive abelian semigroup------ a + b = b + a-class Additive r => Abelian r--instance Abelian r => Abelian (e -> r)-instance Abelian ()-instance Abelian Bool-instance Abelian Integer-instance Abelian Natural-instance Abelian Int-instance Abelian Int8-instance Abelian Int16-instance Abelian Int32-instance Abelian Int64-instance Abelian Word-instance Abelian Word8-instance Abelian Word16-instance Abelian Word32-instance Abelian Word64-instance (Abelian a, Abelian b) => Abelian (a,b) -instance (Abelian a, Abelian b, Abelian c) => Abelian (a,b,c) -instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a,b,c,d) -instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a,b,c,d,e) 

@@ -1,33 +0,0 @@-module Numeric.Addition.Idempotent-  ( -  -- * Additive Monoids-    Idempotent-  , replicate1pIdempotent-  , replicateIdempotent-  ) where--import Numeric.Semigroup.Additive-import Numeric.Monoid.Additive-import Numeric.Natural.Internal---- | An additive semigroup with idempotent addition.------ > a + a = a------ An (Idempotent r, Rig r) => r is also known as a dioid-class Additive r => Idempotent r--replicate1pIdempotent :: Natural -> r -> r-replicate1pIdempotent _ r = r--replicateIdempotent :: (Integral n, Idempotent r, AdditiveMonoid r) => n -> r -> r-replicateIdempotent 0 _ = zero-replicateIdempotent _ x = x--instance Idempotent ()-instance Idempotent Bool-instance 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)-instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d, Idempotent e) => Idempotent (a,b,c,d,e)

@@ -1,48 +0,0 @@-module Numeric.Addition.Partitionable-  ( -- * Partitionable Additive Semigroups-    Partitionable(..)-  ) where--import Prelude ((-),Bool(..),($),id,(>>=))-import Numeric.Semigroup.Additive-import Numeric.Natural-import Data.List.NonEmpty (NonEmpty(..), fromList)--concat :: NonEmpty (NonEmpty a) -> NonEmpty a-concat m = m >>= id--class Additive m => Partitionable m where-  -- | partitionWith f c returns a list containing f a b for each a b such that a + b = c, -  partitionWith :: (m -> m -> r) -> m -> NonEmpty r--instance Partitionable Bool where-  partitionWith f False = f False False :| []-  partitionWith f True  = f False True :| [f True False, f True True]--instance Partitionable Natural where-  partitionWith f n = fromList [ f k (n - k) | k <- [0..n] ]--instance Partitionable () where-  partitionWith f () = f () () :| []--instance (Partitionable a, Partitionable b) => Partitionable (a,b) where-  partitionWith f (a,b) = concat $ partitionWith (\ax ay -> -                                   partitionWith (\bx by -> f (ax,bx) (ay,by)) b) a--instance (Partitionable a, Partitionable b, Partitionable c) => Partitionable (a,b,c) where-  partitionWith f (a,b,c) = concat $ partitionWith (\ax ay -> -                            concat $ partitionWith (\bx by -> -                                     partitionWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a--instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d ) => Partitionable (a,b,c,d) where-  partitionWith f (a,b,c,d) = concat $ partitionWith (\ax ay -> -                              concat $ partitionWith (\bx by -> -                              concat $ partitionWith (\cx cy -> -                                       partitionWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a--instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d, Partitionable e) => Partitionable (a,b,c,d,e) where-  partitionWith f (a,b,c,d,e) = concat $ partitionWith (\ax ay -> -                                concat $ partitionWith (\bx by -> -                                concat $ partitionWith (\cx cy -> -                                concat $ partitionWith (\dx dy -> -                                         partitionWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a

@@ -0,0 +1,214 @@+module Numeric.Additive.Class+  ( +  -- * Additive Semigroups+    Additive(..)+  , sum1+  -- * Additive Abelian semigroups+  , Abelian+  -- * Additive Monoids+  , Idempotent+  , replicate1pIdempotent+  -- * Partitionable semigroups+  , Partitionable(..)+  ) where++import Data.Int+import Data.Word+import Data.Semigroup.Foldable+import Data.Foldable hiding (concat)+import Numeric.Natural.Internal+import Prelude ((-),Bool(..),($),id,(>>=),fromIntegral,(*),otherwise,quot,maybe,error,even,Maybe(..),(==),(.),($!),Integer,(||),toInteger,Integral)+import qualified Prelude+import Data.List.NonEmpty (NonEmpty(..), fromList)++infixl 6 +++-- | +-- > (a + b) + c = a + (b + c)+-- > replicate 1 a = a+-- > replicate (2 * n) a = replicate n a + replicate n a+-- > replicate (2 * n + 1) a = replicate n a + replicate n a + a+class Additive r where+  (+) :: r -> r -> r++  -- | replicate1p n r = replicate (1 + n) r+  replicate1p :: Whole n => n -> r -> r+  replicate1p y0 x0 = f x0 (1 Prelude.+ y0)+    where+      f x y+        | even y = f (x + x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x + x) (unsafePred y  `quot` 2) x+      g x y z+        | even y = g (x + x) (y `quot` 2) z+        | y == 1 = x + z+        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)++  sumWith1 :: Foldable1 f => (a -> r) -> f a -> r+  sumWith1 f = maybe (error "Numeric.Additive.Semigroup.sumWith1: empty structure") id . foldl' mf Nothing+     where mf Nothing y = Just $! f y +           mf (Just x) y = Just $! x + f y++sum1 :: (Foldable1 f, Additive r) => f r -> r+sum1 = sumWith1 id++instance Additive r => Additive (b -> r) where+  f + g = \e -> f e + g e +  replicate1p n f e = replicate1p n (f e)+  sumWith1 f xs e = sumWith1 (`f` e) xs++instance Additive Bool where+  (+) = (||)+  replicate1p _ a = a++instance Additive Natural where+  (+) = (Prelude.+)+  replicate1p n r = (1 Prelude.+ toNatural n) * r++instance Additive Integer where +  (+) = (Prelude.+)+  replicate1p n r = (1 Prelude.+ toInteger n) * r++instance Additive Int where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int8 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int16 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int32 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int64 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word8 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word16 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word32 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word64 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive () where+  _ + _ = ()+  replicate1p _ _ = () +  sumWith1 _ _ = ()++instance (Additive a, Additive b) => Additive (a,b) where+  (a,b) + (i,j) = (a + i, b + j)+  replicate1p n (a,b) = (replicate1p n a, replicate1p n b)++instance (Additive a, Additive b, Additive c) => Additive (a,b,c) where+  (a,b,c) + (i,j,k) = (a + i, b + j, c + k)+  replicate1p n (a,b,c) = (replicate1p n a, replicate1p n b, replicate1p n c)++instance (Additive a, Additive b, Additive c, Additive d) => Additive (a,b,c,d) where+  (a,b,c,d) + (i,j,k,l) = (a + i, b + j, c + k, d + l)+  replicate1p n (a,b,c,d) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d)++instance (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (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)+  replicate1p n (a,b,c,d,e) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d, replicate1p n e)+++concat :: NonEmpty (NonEmpty a) -> NonEmpty a+concat m = m >>= id++class Additive m => Partitionable m where+  -- | partitionWith f c returns a list containing f a b for each a b such that a + b = c, +  partitionWith :: (m -> m -> r) -> m -> NonEmpty r++instance Partitionable Bool where+  partitionWith f False = f False False :| []+  partitionWith f True  = f False True :| [f True False, f True True]++instance Partitionable Natural where+  partitionWith f n = fromList [ f k (n - k) | k <- [0..n] ]++instance Partitionable () where+  partitionWith f () = f () () :| []++instance (Partitionable a, Partitionable b) => Partitionable (a,b) where+  partitionWith f (a,b) = concat $ partitionWith (\ax ay -> +                                   partitionWith (\bx by -> f (ax,bx) (ay,by)) b) a++instance (Partitionable a, Partitionable b, Partitionable c) => Partitionable (a,b,c) where+  partitionWith f (a,b,c) = concat $ partitionWith (\ax ay -> +                            concat $ partitionWith (\bx by -> +                                     partitionWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a++instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d ) => Partitionable (a,b,c,d) where+  partitionWith f (a,b,c,d) = concat $ partitionWith (\ax ay -> +                              concat $ partitionWith (\bx by -> +                              concat $ partitionWith (\cx cy -> +                                       partitionWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a++instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d, Partitionable e) => Partitionable (a,b,c,d,e) where+  partitionWith f (a,b,c,d,e) = concat $ partitionWith (\ax ay -> +                                concat $ partitionWith (\bx by -> +                                concat $ partitionWith (\cx cy -> +                                concat $ partitionWith (\dx dy -> +                                         partitionWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a+++-- | an additive abelian semigroup+--+-- a + b = b + a+class Additive r => Abelian r++instance Abelian r => Abelian (e -> r)+instance Abelian ()+instance Abelian Bool+instance Abelian Integer+instance Abelian Natural+instance Abelian Int+instance Abelian Int8+instance Abelian Int16+instance Abelian Int32+instance Abelian Int64+instance Abelian Word+instance Abelian Word8+instance Abelian Word16+instance Abelian Word32+instance Abelian Word64+instance (Abelian a, Abelian b) => Abelian (a,b) +instance (Abelian a, Abelian b, Abelian c) => Abelian (a,b,c) +instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a,b,c,d) +instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a,b,c,d,e) ++-- | An additive semigroup with idempotent addition.+--+-- > a + a = a+--+class Additive r => Idempotent r++replicate1pIdempotent :: Natural -> r -> r+replicate1pIdempotent _ r = r++instance Idempotent ()+instance Idempotent Bool+instance 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)+instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d, Idempotent e) => Idempotent (a,b,c,d,e)

@@ -0,0 +1,141 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+module Numeric.Additive.Group+  ( -- * Additive Groups+    Group(..)+  ) where++import Data.Int+import Data.Word+import Prelude hiding ((*), (+), (-), negate, subtract)+import qualified Prelude+import Numeric.Additive.Class+import Numeric.Algebra.Class++infixl 6 - +infixl 7 `times`++class (LeftModule Integer r, RightModule Integer r, Monoidal r) => Group r where+  (-)      :: r -> r -> r+  negate   :: r -> r+  subtract :: r -> r -> r+  times    :: Integral n => n -> r -> r+  times y0 x0 = case compare y0 0 of+    LT -> f (negate x0) (Prelude.negate y0)+    EQ -> zero+    GT -> f x0 y0+    where+      f x y +        | even y = f (x + x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) x+      g x y z +        | even y = g (x + x) (y `quot` 2) z+        | y == 1 = x + z+        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) (x + z)++  negate a = zero - a+  a - b  = a + negate b +  subtract a b = negate a + b++instance Group r => Group (e -> r) where+  f - g = \x -> f x - g x+  negate f x = negate (f x)+  subtract f g x = subtract (f x) (g x)+  times n f e = times n (f e)++instance Group Integer where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Int where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Int8 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Int16 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Int32 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Int64 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Word where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Word8 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Word16 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Word32 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group Word64 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance Group () where +  _ - _   = ()+  negate _ = ()+  subtract _ _  = ()+  times _ _   = ()++instance (Group a, Group b) => Group (a,b) where+  negate (a,b) = (negate a, negate b)+  (a,b) - (i,j) = (a-i, b-j)+  subtract (a,b) (i,j) = (subtract a i, subtract b j)+  times n (a,b) = (times n a,times n b)++instance (Group a, Group b, Group c) => Group (a,b,c) where+  negate (a,b,c) = (negate a, negate b, negate c)+  (a,b,c) - (i,j,k) = (a-i, b-j, c-k)+  subtract (a,b,c) (i,j,k) = (subtract a i, subtract b j, subtract c k)+  times n (a,b,c) = (times n a,times n b, times n c)++instance (Group a, Group b, Group c, Group d) => Group (a,b,c,d) where+  negate (a,b,c,d) = (negate a, negate b, negate c, negate d)+  (a,b,c,d) - (i,j,k,l) = (a-i, b-j, c-k, d-l)+  subtract (a,b,c,d) (i,j,k,l) = (subtract a i, subtract b j, subtract c k, subtract d l)+  times n (a,b,c,d) = (times n a,times n b, times n c, times n d)++instance (Group a, Group b, Group c, Group d, Group e) => Group (a,b,c,d,e) where+  negate (a,b,c,d,e) = (negate a, negate b, negate c, negate d, negate e)+  (a,b,c,d,e) - (i,j,k,l,m) = (a-i, b-j, c-k, d-l, e-m)+  subtract (a,b,c,d,e) (i,j,k,l,m) = (subtract a i, subtract b j, subtract c k, subtract d l, subtract e m)+  times n (a,b,c,d,e) = (times n a,times n b, times n c, times n d, times n e)+

@@ -0,0 +1,162 @@+module Numeric.Algebra+  ( +  -- * Additive++  -- ** additive semigroups+    Additive(..)+  , sum1+  -- ** additive Abelian semigroups+  , Abelian+  -- ** additive idempotent semigroups+  , Idempotent+  , replicate1pIdempotent+  , replicateIdempotent+  -- ** partitionable additive semigroups+  , Partitionable(..)+  -- ** additive monoids+  , Monoidal(..)+  , sum+  -- ** additive groups+  , Group(..)++  -- * Multiplicative+  +  -- ** multiplicative semigroups+  , Multiplicative(..)+  , product1+  -- ** commutative multiplicative semigroups+  , Commutative+  -- ** multiplicative monoids+  , Unital(..)+  , product+  -- ** idempotent multiplicative semigroups+  , Band+  , pow1pBand+  , powBand+  -- ** multiplicative groups+  , Division(..)+  -- ** factorable multiplicative semigroups+  , Factorable(..)+  -- ** involutive multiplicative semigroups+  , InvolutiveMultiplication(..)+  , TriviallyInvolutive++  -- * Ring-Structures+  -- ** Semirings +  , Semiring+  , InvolutiveSemiring+  , Dioid+  -- ** Rngs+  , Rng+  -- ** Rigs+  , Rig(..)+  -- * Rings+  , Ring(..)++  -- * Modules+  , LeftModule(..)+  , RightModule(..)+  , Module++  -- * Algebras+  -- ** associative algebras over (non-commutative) semirings +  , Algebra(..)+  , Coalgebra(..)+  -- ** unital algebras+  , UnitalAlgebra(..)+  , CounitalCoalgebra(..)+  , Bialgebra+  -- ** involutive algebras+  , InvolutiveAlgebra(..)+  , InvolutiveCoalgebra(..)+  , InvolutiveBialgebra+  , TriviallyInvolutiveAlgebra+  , TriviallyInvolutiveCoalgebra+  , TriviallyInvolutiveBialgebra+  -- ** idempotent algebras+  , IdempotentAlgebra+  , IdempotentBialgebra+  -- ** commutative algebras+  , CommutativeAlgebra+  , CommutativeBialgebra+  , CommutativeCoalgebra+  -- ** division algebras+  , DivisionAlgebra(..)+  -- ** Hopf alegebras+  , HopfAlgebra(..)++  -- * Ring Properties+  -- ** Characteristic+  , Characteristic(..)+  , charInt, charWord+  -- ** Order+  , Order(..)+  , OrderedRig+  , AdditiveOrder++  , DecidableZero+  , DecidableUnits+  , DecidableAssociates++  -- * Natural numbers+  , Natural+  , Whole(toNatural)++  -- * Representable Additive+  , addRep, replicate1pRep+  -- * Representable Monoidal+  , zeroRep, replicateRep+  -- * Representable Group+  , negateRep, minusRep, subtractRep, timesRep+  -- * Representable Multiplicative (via Algebra)+  , mulRep+  -- * Representable Unital (via UnitalAlgebra)+  , oneRep+  -- * Representable Rig (via Algebra)+  , fromNaturalRep+  -- * Representable Ring (via Algebra)+  , fromIntegerRep+  +  -- * Norm+  , Quadrance(..)++  -- * Covectors+  , Covector(..)+  -- ** Covectors as linear functionals+  , counitM+  , unitM+  , comultM+  , multM+  , invM+  , coinvM+  , antipodeM+  , convolveM+  , memoM+  ) where++import Prelude ()+import Numeric.Additive.Class+import Numeric.Additive.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Involutive+import Numeric.Algebra.Idempotent+import Numeric.Algebra.Commutative+import Numeric.Algebra.Division+import Numeric.Algebra.Factorable+import Numeric.Algebra.Unital+import Numeric.Algebra.Hopf+import Numeric.Covector+import Numeric.Decidable.Units+import Numeric.Decidable.Associates+import Numeric.Decidable.Zero+import Numeric.Dioid.Class+import Numeric.Module.Representable+import Numeric.Natural.Internal+import Numeric.Order.Class+import Numeric.Order.Additive+import Numeric.Quadrance.Class+import Numeric.Rig.Class+import Numeric.Rig.Characteristic+import Numeric.Rig.Ordered+import Numeric.Rng.Class+import Numeric.Ring.Class

@@ -0,0 +1,490 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+module Numeric.Algebra.Class +  (+  -- * Multiplicative Semigroups+    Multiplicative(..)+  , pow1pIntegral+  , product1+  -- * Semirings+  , Semiring+  -- * Left and Right Modules+  , LeftModule(..)+  , RightModule(..)+  , Module+  -- * Additive Monoids+  , Monoidal(..)+  , sum+  , replicateIdempotent+  -- * Associative algebras+  , Algebra(..)+  -- * Coassociative coalgebras+  , Coalgebra(..)+  ) where++import  Numeric.Additive.Class+import Data.Monoid (mappend)+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 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 Prelude+import Numeric.Natural.Internal++infixr 8 `pow1p`+infixl 7 *, .*, *.++-- | A multiplicative semigroup+class Multiplicative r where+  (*) :: r -> r -> r ++-- class Multiplicative r => PowerAssociative r where+  -- pow1p x n = pow x (1 + n)+  pow1p :: Whole n => r -> n -> r+  pow1p x0 y0 = f x0 (y0 Prelude.+ 1) where+    f x y +      | even y = f (x * x) (y `quot` 2)+      | y == 1 = x+      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) x+    g x y z +      | even y = g (x * x) (y `quot` 2) z+      | y == 1 = x * z+      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) (x * z)++-- class PowerAssociative r => Assocative r where+  productWith1 :: Foldable1 f => (a -> r) -> f a -> r+  productWith1 f = maybe (error "Numeric.Multiplicative.Semigroup.productWith1: empty structure") id . foldl' mf Nothing+    where +      mf Nothing y = Just $! f y+      mf (Just x) y = Just $! x * f y++product1 :: (Foldable1 f, Multiplicative r) => f r -> r+product1 = productWith1 id++pow1pIntegral :: (Integral r, Integral n) => r -> n -> r+pow1pIntegral r n = r ^ (1 Prelude.+ n)++instance Multiplicative Bool where+  (*) = (&&)+  pow1p m _ = m++instance Multiplicative Natural where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Integer where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int8 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int16 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int32 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int64 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word8 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word16 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word32 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word64 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative () where+  _ * _ = ()+  pow1p _ _ = ()++instance (Multiplicative a, Multiplicative b) => Multiplicative (a,b) where+  (a,b) * (c,d) = (a * c, b * d)++instance (Multiplicative a, Multiplicative b, Multiplicative c) => Multiplicative (a,b,c) where+  (a,b,c) * (i,j,k) = (a * i, b * j, c * k)++instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d) => Multiplicative (a,b,c,d) where+  (a,b,c,d) * (i,j,k,l) = (a * i, b * j, c * k, d * l)++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)++-- | 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)+-- > (a + b)c = ac + bc -- right distribution (we are a [Right]NearSemiring)+--+-- Common notation includes the laws for additive and multiplicative identity in semiring.+--+-- If you want that, look at 'Rig' instead.+--+-- Ideally we'd use the cyclic definition:+--+-- > class (LeftModule r r, RightModule r r, Additive r, Abelian r, Multiplicative r) => Semiring r+--+-- to enforce that every semiring r is an r-module over itself, but Haskell doesn't like that.+class (Additive r, Abelian r, Multiplicative r) => Semiring r+instance Semiring Integer+instance Semiring Natural+instance Semiring Bool+instance Semiring Int+instance Semiring Int8+instance Semiring Int16+instance Semiring Int32+instance Semiring Int64+instance Semiring Word+instance Semiring Word8+instance Semiring Word16+instance Semiring Word32+instance Semiring Word64+instance Semiring ()+instance (Semiring a, Semiring b) => Semiring (a, b)+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)++-- | An associative algebra built with a free module over a semiring+class Semiring r => Algebra r a where+  mult :: (a -> a -> r) -> a -> r++instance Algebra () a where+  mult _ _ = ()++-- | The tensor algebra+instance Semiring r => Algebra r [a] where+  mult f = go [] where+    go ls rrs@(r:rs) = f (reverse ls) rrs + go (r:ls) rs+    go ls [] = f (reverse ls) []++-- | The tensor algebra+instance Semiring r => Algebra r (Seq a) where+  mult f = go Seq.empty where+    go ls s = case viewl s of+       EmptyL -> f ls s +       r :< rs -> f ls s + go (ls |> r) rs++instance Semiring r => Algebra r () where+  mult f = f ()++instance (Semiring r, Ord a) => Algebra r (Set a) where+  mult f = go Set.empty where+    go ls s = case Set.minView s of+       Nothing -> f ls s+       Just (r, rs) -> f ls s + go (Set.insert r ls) rs+instance Semiring r => Algebra r IntSet where+  mult f = go IntSet.empty where+    go ls s = case IntSet.minView s of+       Nothing -> f ls s+       Just (r, rs) -> f ls s + go (IntSet.insert r ls) rs++instance (Semiring r, Monoidal r, Ord a, Partitionable b) => Algebra r (Map a b) -- where+--  mult f xs = case minViewWithKey xs of+--    Nothing -> zero +--    Just ((k, r), rs) -> ...+instance (Semiring r, Monoidal r, Partitionable a) => Algebra r (IntMap a)++instance (Algebra r a, Algebra r b) => Algebra r (a,b) where+  mult f (a,b) = mult (\a1 a2 -> mult (\b1 b2 -> f (a1,b1) (a2,b2)) b) a++instance (Algebra r a, Algebra r b, Algebra r c) => Algebra r (a,b,c) where+  mult f (a,b,c) = mult (\a1 a2 -> mult (\b1 b2 -> mult (\c1 c2 -> f (a1,b1,c1) (a2,b2,c2)) c) b) a++instance (Algebra r a, Algebra r b, Algebra r c, Algebra r d) => Algebra r (a,b,c,d) where+  mult f (a,b,c,d) = mult (\a1 a2 -> mult (\b1 b2 -> mult (\c1 c2 -> mult (\d1 d2 -> f (a1,b1,c1,d1) (a2,b2,c2,d2)) d) c) b) a++instance (Algebra r a, Algebra r b, Algebra r c, Algebra r d, Algebra r e) => Algebra r (a,b,c,d,e) where+  mult f (a,b,c,d,e) = mult (\a1 a2 -> mult (\b1 b2 -> mult (\c1 c2 -> mult (\d1 d2 -> mult (\e1 e2 -> f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2)) e) d) c) b) a++-- 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++-- | Every coalgebra gives rise to an algebra by vector space duality classically.+-- Sadly, it requires vector space duality, which we cannot use constructively.+-- The dual argument only relies in the fact that any constructive coalgebra can only inspect a finite number of coefficients, +-- which we CAN exploit.+instance Algebra r m => Coalgebra r (m -> r) where+  comult k f g = k (f * g)++-- incoherent+-- instance Coalgebra () c where comult _ _ _ = ()++-- incoherent+-- 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+  comult = const++instance (Coalgebra r a, Coalgebra r b) => Coalgebra r (a, b) where+  comult f (a1,b1) (a2,b2) = comult (\a -> comult (\b -> f (a,b)) b1 b2) a1 a2++instance (Coalgebra r a, Coalgebra r b, Coalgebra r c) => Coalgebra r (a, b, c) where+  comult f (a1,b1,c1) (a2,b2,c2) = comult (\a -> comult (\b -> comult (\c -> f (a,b,c)) c1 c2) b1 b2) a1 a2++instance (Coalgebra r a, Coalgebra r b, Coalgebra r c, Coalgebra r d) => Coalgebra r (a, b, c, d) where+  comult f (a1,b1,c1,d1) (a2,b2,c2,d2) = comult (\a -> comult (\b -> comult (\c -> comult (\d -> f (a,b,c,d)) d1 d2) c1 c2) b1 b2) a1 a2++instance (Coalgebra r a, Coalgebra r b, Coalgebra r c, Coalgebra r d, Coalgebra r e) => Coalgebra r (a, b, c, d, e) where+  comult f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = comult (\a -> comult (\b -> comult (\c -> comult (\d -> comult (\e -> f (a,b,c,d,e)) e1 e2) d1 d2) c1 c2) b1 b2) a1 a2++-- | The tensor Hopf algebra+instance Semiring r => Coalgebra r [a] where+  comult f as bs = f (mappend as bs)++-- | The tensor Hopf algebra+instance Semiring r => Coalgebra r (Seq a) where+  comult f as bs = f (mappend as bs)++-- | the free commutative band coalgebra+instance (Semiring r, Ord a) => Coalgebra r (Set a) where+  comult f as bs = f (Set.union as bs)++-- | the free commutative band coalgebra over Int+instance Semiring r => Coalgebra r IntSet where+  comult f as bs = f (IntSet.union as bs)++-- | the free commutative coalgebra over a set and a given semigroup+instance (Semiring r, Ord a, Additive b) => Coalgebra r (Map a b) where+  comult f as bs = f (Map.unionWith (+) as bs)++-- | the free commutative coalgebra over a set and Int+instance (Semiring r, Additive b) => Coalgebra r (IntMap b) where+  comult f as bs = f (IntMap.unionWith (+) as bs)++class (Semiring r, Additive m) => LeftModule r m where+  (.*) :: r -> m -> m++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 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 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+class (LeftModule Natural m, RightModule Natural m) => Monoidal m where+  zero :: m++  replicate :: Whole n => n -> m -> m+  replicate 0 _  = zero+  replicate n x0 = f x0 n+    where+      f x y+        | even y = f (x + x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x + x) (unsafePred y `quot` 2) x+      g x y z+        | even y = g (x + x) (y `quot` 2) z+        | y == 1 = x + z+        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)++  sumWith :: Foldable f => (a -> m) -> f a -> m+  sumWith f = foldl' (\b a -> b + f a) zero++sum :: (Foldable f, Monoidal m) => f m -> m+sum = sumWith id++replicateIdempotent :: (Integral n, Idempotent r, Monoidal r) => n -> r -> r+replicateIdempotent 0 _ = zero+replicateIdempotent _ x = x++instance Monoidal Bool where +  zero = False+  replicate 0 _ = False+  replicate _ r = r++instance Monoidal Natural where+  zero = 0+  replicate n r = toNatural n * r++instance Monoidal Integer where +  zero = 0+  replicate n r = toInteger n * r++instance Monoidal Int where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Int8 where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Int16 where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Int32 where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Int64 where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Word where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Word8 where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Word16 where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Word32 where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal Word64 where +  zero = 0+  replicate n r = fromIntegral n * r++instance Monoidal r => Monoidal (e -> r) where+  zero = const zero+  sumWith f xs e = sumWith (`f` e) xs+  replicate n r e = replicate n (r e)++instance Monoidal () where +  zero = ()+  replicate _ () = ()+  sumWith _ _ = ()++instance (Monoidal a, Monoidal b) => Monoidal (a,b) where+  zero = (zero,zero)+  replicate n (a,b) = (replicate n a, replicate n b)++instance (Monoidal a, Monoidal b, Monoidal c) => Monoidal (a,b,c) where+  zero = (zero,zero,zero)+  replicate n (a,b,c) = (replicate n a, replicate n b, replicate n c)++instance (Monoidal a, Monoidal b, Monoidal c, Monoidal d) => Monoidal (a,b,c,d) where+  zero = (zero,zero,zero,zero)+  replicate n (a,b,c,d) = (replicate n a, replicate n b, replicate n c, replicate n d)++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)

@@ -0,0 +1,85 @@+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances #-}+module Numeric.Algebra.Commutative +  ( Commutative+  , CommutativeAlgebra+  , CommutativeCoalgebra+  , CommutativeBialgebra+  ) where++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++-- | A commutative multiplicative semigroup+class Multiplicative r => Commutative r++instance Commutative () +instance Commutative Bool+instance Commutative Integer+instance Commutative Int+instance Commutative Int8+instance Commutative Int16+instance Commutative Int32+instance Commutative Int64+instance Commutative Natural+instance Commutative Word+instance Commutative Word8+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 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)++-- incoherent+-- instance (Algebra r a, CommutativeAlgebra r b) => CommutativeAlgebra (a -> r) b+-- instance CommutativeAlgebra () a++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 CommutativeAlgebra r a => Commutative (a -> r)++class Coalgebra r c => CommutativeCoalgebra r c+++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)++-- incoherent+-- instance (Algebra r a, CommutativeCoalgebra r c) => CommutativeCoalgebra (a -> r) c -- TODO: check this instance!+-- instance CommutativeCoalgebra () a++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

@@ -0,0 +1,86 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Algebra.Division+  ( Division(..)+  , DivisionAlgebra(..)+--  , CodivisionCoalgebra(..)+--  , DivisionBialgebra+  ) where++import Prelude hiding ((*), recip, (/),(^))+import Numeric.Algebra.Class+import Numeric.Algebra.Unital++infixr 8 ^+infixl 7 /, \\++-- A multiplicative group+class Unital r => Division r where+  recip  :: r -> r+  (/)    :: r -> r -> r+  (\\)   :: r -> r -> r+  (^)    :: Integral n => r -> n -> r+  recip a = one / a+  a / b = a * recip b+  a \\ b = recip a * b+  x0 ^ y0 = case compare y0 0 of+    LT -> f (recip x0) (negate y0)+    EQ -> one+    GT -> f x0 y0+    where+       f x y +         | even y = f (x * x) (y `quot` 2)+         | y == 1 = x+         | otherwise = g (x * x) ((y - 1) `quot` 2) x+       g x y z +         | even y = g (x * x) (y `quot` 2) z+         | y == 1 = x * z+         | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)++instance Division () where +  _ / _   = ()+  recip _ = ()+  _ \\ _  = ()+  _ ^ _   = ()++instance (Division a, Division b) => Division (a,b) where+  recip (a,b) = (recip a, recip b)+  (a,b) / (i,j) = (a/i,b/j)+  (a,b) \\ (i,j) = (a\\i,b\\j)+  (a,b) ^ n = (a^n,b^n)++instance (Division a, Division b, Division c) => Division (a,b,c) where+  recip (a,b,c) = (recip a, recip b, recip c)+  (a,b,c) / (i,j,k) = (a/i,b/j,c/k)+  (a,b,c) \\ (i,j,k) = (a\\i,b\\j,c\\k)+  (a,b,c) ^ n = (a^n,b^n,c^n)++instance (Division a, Division b, Division c, Division d) => Division (a,b,c,d) where+  recip (a,b,c,d) = (recip a, recip b, recip c, recip d)+  (a,b,c,d) / (i,j,k,l) = (a/i,b/j,c/k,d/l)+  (a,b,c,d) \\ (i,j,k,l) = (a\\i,b\\j,c\\k,d\\l)+  (a,b,c,d) ^ n = (a^n,b^n,c^n,d^n)++instance (Division a, Division b, Division c, Division d, Division e) => Division (a,b,c,d,e) where+  recip (a,b,c,d,e) = (recip a, recip b, recip c, recip d, recip e)+  (a,b,c,d,e) / (i,j,k,l,m) = (a/i,b/j,c/k,d/l,e/m)+  (a,b,c,d,e) \\ (i,j,k,l,m) = (a\\i,b\\j,c\\k,d\\l,e\\m)+  (a,b,c,d,e) ^ n = (a^n,b^n,c^n,d^n,e^n)++class UnitalAlgebra r a => DivisionAlgebra r a where+  recipriocal :: (a -> r) -> a -> r+  -- recipriocal f = one `over` f++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+-}

@@ -0,0 +1,49 @@+module Numeric.Algebra.Factorable+  ( -- * Factorable Multiplicative Semigroups+    Factorable(..)+  ) where++import Data.List.NonEmpty+import Numeric.Algebra.Class (Multiplicative(..))+import Prelude hiding (concat)++-- | `factorWith f c` returns a non-empty list containing `f a b` for all `a, b` such that `a * b = c`.+--+-- Results of factorWith f 0 are undefined and may result in either an error or an infinite list.++class Multiplicative m => Factorable m where+  factorWith :: (m -> m -> r) -> m -> NonEmpty r++instance Factorable Bool where+  factorWith f False = f False False :| [f False True, f True False]+  factorWith f True  = f True True :| []++instance Factorable () where+  factorWith f () = f () () :| []++concat :: NonEmpty (NonEmpty a) -> NonEmpty a+concat m = m >>= id++instance (Factorable a, Factorable b) => Factorable (a,b) where+  factorWith f (a,b) = concat $ factorWith (\ax ay ->+                                factorWith (\bx by -> f (ax,bx) (ay,by)) b) a++instance (Factorable a, Factorable b, Factorable c) => Factorable (a,b,c) where+  factorWith f (a,b,c) = concat $ factorWith (\ax ay ->+                            concat $ factorWith (\bx by ->+                                     factorWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a++instance (Factorable a, Factorable b, Factorable c,Factorable d ) => Factorable (a,b,c,d) where+  factorWith f (a,b,c,d) = concat $ factorWith (\ax ay ->+                           concat $ factorWith (\bx by ->+                           concat $ factorWith (\cx cy ->+                                    factorWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a++instance (Factorable a, Factorable b, Factorable c,Factorable d, Factorable e) => Factorable (a,b,c,d,e) where+  factorWith f (a,b,c,d,e) = concat $ factorWith (\ax ay ->+                             concat $ factorWith (\bx by ->+                             concat $ factorWith (\cx cy ->+                             concat $ factorWith (\dx dy ->+                                      factorWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a++

@@ -1,9 +0,0 @@-module Numeric.Algebra.Free -  ( module Numeric.Algebra.Free.Class-  , module Numeric.Algebra.Free.Unital-  , module Numeric.Algebra.Free.Hopf-  ) where--import Numeric.Algebra.Free.Class-import Numeric.Algebra.Free.Unital-import Numeric.Algebra.Free.Hopf

@@ -1,46 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Numeric.Algebra.Free.Class -  ( FreeAlgebra(..)-  , FreeCoalgebra(..)-  ) where--import Numeric.Semiring.Internal-import Data.Sequence-import Data.Monoid (mappend)-import Prelude ()---- A coassociative coalgebra over a semiring using-class Semiring r => FreeCoalgebra r c where-  cojoin :: (c -> r) -> c -> c -> r---- convolve :: (FreeAlgebra r a, FreeCoalgebra r c) => ((c -> r) -> a -> r) -> ((c -> r) -> a -> r) -> ((c -> r) -> a -> r---- | Every coalgebra gives rise to an algebra by vector space duality classically.--- Sadly, it requires vector space duality, which we cannot use constructively.--- This is the dual, which relies in the fact that any constructive coalgebra can only inspect a finite number of coefficients.-instance FreeAlgebra r m => FreeCoalgebra r (m -> r) where-  cojoin k f g = k (f * g)--instance FreeCoalgebra () c where-  cojoin _ _ _ = ()--instance (FreeAlgebra r b, FreeCoalgebra r c) => FreeCoalgebra (b -> r) c where-  cojoin f c1 c2 b = cojoin (`f` b) c1 c2 --instance (FreeCoalgebra r a, FreeCoalgebra r b) => FreeCoalgebra r (a, b) where-  cojoin f (a1,b1) (a2,b2) = cojoin (\a -> cojoin (\b -> f (a,b)) b1 b2) a1 a2--instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c) => FreeCoalgebra r (a, b, c) where-  cojoin f (a1,b1,c1) (a2,b2,c2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> f (a,b,c)) c1 c2) b1 b2) a1 a2--instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c, FreeCoalgebra r d) => FreeCoalgebra r (a, b, c, d) where-  cojoin f (a1,b1,c1,d1) (a2,b2,c2,d2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> cojoin (\d -> f (a,b,c,d)) d1 d2) c1 c2) b1 b2) a1 a2--instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c, FreeCoalgebra r d, FreeCoalgebra r e) => FreeCoalgebra r (a, b, c, d, e) where-  cojoin f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> cojoin (\d -> cojoin (\e -> f (a,b,c,d,e)) e1 e2) d1 d2) c1 c2) b1 b2) a1 a2--instance Semiring r => FreeCoalgebra r [a] where-  cojoin f as bs = f (mappend as bs)--instance Semiring r => FreeCoalgebra r (Seq a) where-  cojoin f as bs = f (mappend as bs)

@@ -1,32 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Numeric.Algebra.Free.Hopf-  ( Hopf(..)-  ) where--import Numeric.Algebra.Free.Unital---- | A Hopf algebra on a semiring, where the module is free.------ If @antipode . antipode = id@ then we are 'Involutive'--class (FreeUnitalAlgebra r h, FreeCounitalCoalgebra r h) => Hopf r h where-  -- > convolve id antipode = convolve antipode id = unit . counit-  antipode :: (h -> r) -> h -> r--instance (FreeUnitalAlgebra r a, Hopf r h) => Hopf (a -> r) h where-  antipode f h a = antipode (`f` a) h--instance Hopf () h where-  antipode = id--instance (Hopf r a, Hopf r b) => Hopf r (a, b) where-  antipode f (a,b) = antipode (\a' -> antipode (\b' -> f (a',b')) b) a--instance (Hopf r a, Hopf r b, Hopf r c) => Hopf r (a, b, c) where-  antipode f (a,b,c) = antipode (\a' -> antipode (\b' -> antipode (\c' -> f (a',b',c')) c) b) a--instance (Hopf r a, Hopf r b, Hopf r c, Hopf r d) => Hopf r (a, b, c, d) where-  antipode f (a,b,c,d) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> f (a',b',c',d')) d) c) b) a--instance (Hopf r a, Hopf r b, Hopf r c, Hopf r d, Hopf r e) => Hopf r (a, b, c, d, e) where-  antipode f (a,b,c,d,e) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> antipode (\e' -> f (a',b',c',d',e')) e) d) c) b) a

@@ -1,43 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Numeric.Algebra.Free.Unital-  ( FreeUnitalAlgebra(..)-  , FreeCounitalCoalgebra(..)-  ) where--import Numeric.Algebra.Free.Class-import Numeric.Monoid.Multiplicative.Internal-import Data.Sequence (Seq)-import Numeric.Semiring.Internal-import qualified Data.Sequence as Seq-import Prelude (($))---- A coassociative counital coalgebra over a semiring, where the module is free-class FreeCoalgebra r c => FreeCounitalCoalgebra r c where-  counit :: (c -> r) -> r--instance (Unital r, FreeUnitalAlgebra r m) => FreeCounitalCoalgebra r (m -> r) where-  counit k = k one--instance (FreeUnitalAlgebra r a, FreeCounitalCoalgebra r c) => FreeCounitalCoalgebra (a -> r) c where -  counit k a = counit (`k` a)--instance FreeCounitalCoalgebra () a where-  counit _ = ()--instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b) => FreeCounitalCoalgebra r (a, b) where-  counit k = counit $ \a -> counit $ \b -> k (a,b)--instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c) => FreeCounitalCoalgebra r (a, b, c) where-  counit k = counit $ \a -> counit $ \b -> counit $ \c -> k (a,b,c)--instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c, FreeCounitalCoalgebra r d) => FreeCounitalCoalgebra r (a, b, c, d) where-  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> k (a,b,c,d)--instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c, FreeCounitalCoalgebra r d, FreeCounitalCoalgebra r e) => FreeCounitalCoalgebra r (a, b, c, d, e) where-  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> counit $ \e -> k (a,b,c,d,e)--instance Semiring r => FreeCounitalCoalgebra r [a] where-  counit k = k []--instance Semiring r => FreeCounitalCoalgebra r (Seq a) where-  counit k = k (Seq.empty)

@@ -0,0 +1,216 @@+{-# LANGUAGE +    MultiParamTypeClasses, +    GeneralizedNewtypeDeriving, +    BangPatterns,+    TypeOperators,+    DeriveDataTypeable,+    FlexibleInstances,+    TypeFamilies,+    UndecidableInstances,+    ScopedTypeVariables #-}++module Numeric.Algebra.Geometric+  ( +  -- * Geometric algebra primitives+    Blade(..)+  , Multivector+  , Comultivector+  -- * Operations over an eigenbasis+  , Eigenbasis(..)+  , Eigenmetric(..)+  -- * Grade+  , grade+  , filterGrade+  -- * Inversions+  , reverse+  , gradeInversion+  , cliffordConjugate+  -- * Products+  , geometric+  , outer+  -- * Inner products+  , contractL+  , contractR+  , hestenes+  , dot+  , liftProduct+  ) where++import Control.Monad (mfilter)+import Data.Bits+import Data.Functor.Representable.Trie+import Data.Word+import Data.Data+import Data.Ix+import Data.Array.Unboxed+import Numeric.Algebra+import Prelude hiding ((-),(*),(+),negate,reverse)++-- 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+  )++instance HasTrie (Blade m) where+  type BaseTrie (Blade m) = BaseTrie Word64+  embedKey = embedKey . runBlade+  projectKey = Blade . projectKey++-- A metric space over an eigenbasis+class Eigenbasis m where+  euclidean     :: proxy m -> Bool+  antiEuclidean :: proxy m -> Bool+  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+  where +    -- a 64 bit deBruijn multiplication table+    ix :: UArray (Blade m) Word8+    ix = listArray (0, 63) +      [ 63,  0, 58,  1, 59, 47, 53,  2+      , 60, 39, 48, 27, 54, 33, 42,  3+      , 61, 51, 37, 40, 49, 18, 28, 20+      , 55, 30, 34, 11, 43, 14, 22,  4+      , 62, 57, 46, 52, 38, 26, 32, 41+      , 50, 36, 17, 19, 29, 10, 13, 21+      , 56, 45, 25, 31, 35, 16,  9, 12+      , 44, 24, 15,  8, 23,  7,  6,  5+      ]++class (Ring r, Eigenbasis m) => Eigenmetric r m where+  metric :: m -> r++type Comultivector r m = Covector r (Blade m)++type Multivector r m = Blade m :->: r++-- 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+  )++instance HasTrie Euclidean where+  type BaseTrie Euclidean = BaseTrie Int+  embedKey (Euclidean i) = embedKey i+  projectKey = Euclidean . projectKey++instance Eigenbasis Euclidean where+  euclidean _ = True+  antiEuclidean _ = False+  v n = shiftL 1 (fromIntegral n)+  e = fromIntegral++instance Ring r => Eigenmetric r Euclidean where+  metric _ = one++grade :: Blade m -> Int+grade = fromIntegral . count 5 . count 4 . count 3 . count 2 . count 1 . count 0 where +  count c x = (x .&. mask) + (shiftR x p .&. mask) where +    p = shiftL 1 c+    mask = (-1) `div` (shiftL 1 p + 1)++m1powTimes :: (Bits n, Group r) => n -> r -> r+m1powTimes n r +  | (n .&. 1) == 0 = r+  | otherwise      = negate r++reorder :: Group r => Blade m -> Blade m -> r -> r+reorder a0 b = m1powTimes $ go 0 (shiftR a0 1)+  where+    go !acc 0 = acc+    go acc a = go (acc + grade (a .&. b)) (shiftR a 1)++-- <A>_k+filterGrade :: Monoidal r => Blade m -> Int -> Covector r (Blade m)+filterGrade b k | grade b == k = zero+                | otherwise    = return b++instance Eigenmetric r m => Coalgebra r (Blade m) where+  comult f n m = scale (n .&. m) $ reorder n m $ f $ xor n m where+    scale b+      | euclidean n = id+      | otherwise   = (go one b *)+    go :: Eigenmetric r m => r -> Blade m -> r+    go acc 0 = acc+    go acc n' | b <- lsb n'+              , m' <- metric (e b :: m)+              = go (acc*m') (clearBit n' b)++instance Eigenmetric r m => CounitalCoalgebra r (Blade m) where+  counit f = f (Blade zero)++-- instance Group r => InvertibleModule r Blade where+  +-- reversion (A~) is an involution for the outer product+reverse :: Group r => Blade m -> Comultivector r m+reverse b = shiftR (g * (g - 1)) 1 `m1powTimes` return b where+  g = grade b++cliffordConjugate :: Group r => Blade m -> Comultivector r m+cliffordConjugate b = shiftR (g * (g + 1)) 1 `m1powTimes` return b where+  g = grade b++-- A^+gradeInversion :: Group r => Blade m -> Comultivector r m+gradeInversion b = grade b `m1powTimes` return b++geometric :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m  +geometric = multM++outer :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m+outer m n | m .&. n == 0 = geometric m n +          | otherwise    = zero++-- A _| B+-- grade (A _| B) = grade B - grade A+contractL :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m +contractL a b +  | ga Prelude.> gb   = zero+  | otherwise = mfilter (\r -> grade r == gb - ga) (geometric a b)+  where+    ga = grade a+    gb = grade b++-- A |_ B+-- grade (A |_ B) = grade A - grade B+contractR :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m+contractR a b +  | ga Prelude.< gb   = zero+  | otherwise = mfilter (\r -> grade r == ga - gb) (geometric a b)+  where+    ga = grade a+    gb = grade b++-- the modified Hestenes' product+dot :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m+dot a b = mfilter (\r -> grade r == abs(grade a - grade b)) (geometric a b)++-- Hestenes' inner product+-- if 0 /= grade a <= grade b then +-- dot a b = hestenes a b = leftContract a b+hestenes :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m+hestenes a b+  | ga == 0 || gb == 0 = zero+  | otherwise = mfilter (\r -> grade r == abs(ga - gb)) (geometric a b)+  where+    ga = grade a+    gb = grade b++liftProduct :: (Blade m -> Blade m -> Comultivector r m) -> Comultivector r m -> Comultivector r m -> Comultivector r m+liftProduct f ma mb = do+  a <- ma+  b <- mb+  f a b

@@ -0,0 +1,33 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Algebra.Hopf+  ( HopfAlgebra(..)+  ) where++import Numeric.Algebra.Unital++-- | A HopfAlgebra algebra on a semiring, where the module is free.+--+-- When @antipode . antipode = id@ and antipode is an antihomomorphism then we are an InvolutiveBialgebra with @inv = antipode@ as well++class Bialgebra r h => HopfAlgebra r h where+  -- > convolve id antipode = convolve antipode id = unit . counit+  antipode :: (h -> r) -> h -> r++-- incoherent+-- instance (UnitalAlgebra r a, HopfAlgebra r h) => HopfAlgebra (a -> r) h where antipode f h a = antipode (`f` a) h+-- instance HopfAlgebra () h where antipode = id++-- TODO: check this+-- instance InvolutiveSemiring r => HopfAlgebra r () where antipode = adjoint++instance (HopfAlgebra r a, HopfAlgebra r b) => HopfAlgebra r (a, b) where+  antipode f (a,b) = antipode (\a' -> antipode (\b' -> f (a',b')) b) a++instance (HopfAlgebra r a, HopfAlgebra r b, HopfAlgebra r c) => HopfAlgebra r (a, b, c) where+  antipode f (a,b,c) = antipode (\a' -> antipode (\b' -> antipode (\c' -> f (a',b',c')) c) b) a++instance (HopfAlgebra r a, HopfAlgebra r b, HopfAlgebra r c, HopfAlgebra r d) => HopfAlgebra r (a, b, c, d) where+  antipode f (a,b,c,d) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> f (a',b',c',d')) d) c) b) a++instance (HopfAlgebra r a, HopfAlgebra r b, HopfAlgebra r c, HopfAlgebra r d, HopfAlgebra r e) => HopfAlgebra r (a, b, c, d, e) where+  antipode f (a,b,c,d,e) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> antipode (\e' -> f (a',b',c',d',e')) e) d) c) b) a

@@ -0,0 +1,59 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}+module Numeric.Algebra.Idempotent +  ( Band+  , pow1pBand+  , powBand+  -- * Idempotent algebras+  , IdempotentAlgebra+  , IdempotentCoalgebra+  , IdempotentBialgebra+  ) where++import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Natural+import Data.Set (Set)+import Data.IntSet (IntSet)++-- | An multiplicative semigroup with idempotent multiplication.+--+-- > a * a = a+class Multiplicative r => Band r++pow1pBand :: Whole n => r -> n -> r+pow1pBand r _ = r ++powBand :: (Unital r, Whole n) => r -> n -> r+powBand _ 0 = one+powBand r _ = r++instance Band ()+instance Band Bool+instance (Band a, Band b) => Band (a,b)+instance (Band a, Band b, Band c) => Band (a,b,c)+instance (Band a, Band b, Band c, Band d) => Band (a,b,c,d)+instance (Band a, Band b, Band c, Band d, Band e) => Band (a,b,c,d,e)++-- idempotent algebra+class Algebra r a => IdempotentAlgebra r a+instance (Semiring r, Band r, Ord a) => IdempotentAlgebra r (Set a)+instance (Semiring r, Band r) => IdempotentAlgebra r IntSet+instance (Semiring r, Band r) => IdempotentAlgebra r ()+instance (IdempotentAlgebra r a, IdempotentAlgebra r b) => IdempotentAlgebra r (a,b)+instance (IdempotentAlgebra r a, IdempotentAlgebra r b, IdempotentAlgebra r c) => IdempotentAlgebra r (a,b,c)+instance (IdempotentAlgebra r a, IdempotentAlgebra r b, IdempotentAlgebra r c, IdempotentAlgebra r d) => IdempotentAlgebra r (a,b,c,d)+instance (IdempotentAlgebra r a, IdempotentAlgebra r b, IdempotentAlgebra r c, IdempotentAlgebra r d, IdempotentAlgebra r e) => IdempotentAlgebra r (a,b,c,d,e)++-- idempotent coalgebra+class Coalgebra r c => IdempotentCoalgebra r c+instance (Semiring r, Band r, Ord c) => IdempotentCoalgebra r (Set c)+instance (Semiring r, Band r) => IdempotentCoalgebra r IntSet+instance (Semiring r, Band r) => IdempotentCoalgebra r ()+instance (IdempotentCoalgebra r a, IdempotentCoalgebra r b) => IdempotentCoalgebra r (a,b)+instance (IdempotentCoalgebra r a, IdempotentCoalgebra r b, IdempotentCoalgebra r c) => IdempotentCoalgebra r (a,b,c)+instance (IdempotentCoalgebra r a, IdempotentCoalgebra r b, IdempotentCoalgebra r c, IdempotentCoalgebra r d) => IdempotentCoalgebra r (a,b,c,d)+instance (IdempotentCoalgebra r a, IdempotentCoalgebra r b, IdempotentCoalgebra r c, IdempotentCoalgebra r d, IdempotentCoalgebra r e) => IdempotentCoalgebra r (a,b,c,d,e)++-- idempotent bialgebra+class (Bialgebra r h, IdempotentAlgebra r h, IdempotentCoalgebra r h) => IdempotentBialgebra r h +instance (Bialgebra r h, IdempotentAlgebra r h, IdempotentCoalgebra r h) => IdempotentBialgebra r h 

@@ -0,0 +1,166 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}+module Numeric.Algebra.Involutive+  ( +  -- * Involution+    InvolutiveMultiplication(..)+  , InvolutiveSemiring+  -- * Involutive Algebras+  , InvolutiveAlgebra(..)+  , InvolutiveCoalgebra(..)+  , InvolutiveBialgebra+  -- * Trivial Involution+  , TriviallyInvolutive+  , TriviallyInvolutiveAlgebra+  , TriviallyInvolutiveCoalgebra+  , TriviallyInvolutiveBialgebra+  ) where++import Numeric.Algebra.Class+import Numeric.Algebra.Commutative+import Numeric.Algebra.Unital+import Data.Int+import Data.Word+import Numeric.Natural.Internal++-- | An semigroup with involution+-- +-- > adjoint a * adjoint b = adjoint (b * a)+class Multiplicative r => InvolutiveMultiplication r where+  adjoint :: r -> r++instance InvolutiveMultiplication Int where adjoint = id+instance InvolutiveMultiplication Integer where adjoint = id+instance InvolutiveMultiplication Int8 where adjoint = id+instance InvolutiveMultiplication Int16 where adjoint = id+instance InvolutiveMultiplication Int32 where adjoint = id+instance InvolutiveMultiplication Int64 where adjoint = id+instance InvolutiveMultiplication Bool where adjoint = id+instance InvolutiveMultiplication Word where adjoint = id+instance InvolutiveMultiplication Natural where adjoint = id+instance InvolutiveMultiplication Word8 where adjoint = id+instance InvolutiveMultiplication Word16 where adjoint = id+instance InvolutiveMultiplication Word32 where adjoint = id+instance InvolutiveMultiplication Word64 where adjoint = id+instance InvolutiveMultiplication () where adjoint = id+instance (InvolutiveMultiplication a, InvolutiveMultiplication b) => InvolutiveMultiplication (a,b) where+  adjoint (a,b) = (adjoint a, adjoint b)+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c) => InvolutiveMultiplication (a,b,c) where+  adjoint (a,b,c) = (adjoint a, adjoint b, adjoint c)+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d) => InvolutiveMultiplication (a,b,c,d) where+  adjoint (a,b,c,d) = (adjoint a, adjoint b, adjoint c, adjoint d)+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d, InvolutiveMultiplication e) => InvolutiveMultiplication (a,b,c,d,e) where+  adjoint (a,b,c,d,e) = (adjoint a, adjoint b, adjoint c, adjoint d, adjoint e)+++-- | adjoint (x + y) = adjoint x + adjoint y+class (Semiring r, InvolutiveMultiplication r) => InvolutiveSemiring r++instance InvolutiveSemiring Integer+instance InvolutiveSemiring Int+instance InvolutiveSemiring Int8+instance InvolutiveSemiring Int16+instance InvolutiveSemiring Int32+instance InvolutiveSemiring Int64++instance InvolutiveSemiring Natural+instance InvolutiveSemiring Word+instance InvolutiveSemiring Word8+instance InvolutiveSemiring Word16+instance InvolutiveSemiring Word32+instance InvolutiveSemiring Word64++instance InvolutiveSemiring ()+instance (InvolutiveSemiring a, InvolutiveSemiring b) => InvolutiveSemiring (a, b)+instance (InvolutiveSemiring a, InvolutiveSemiring b, InvolutiveSemiring c) => InvolutiveSemiring (a, b, c)+instance (InvolutiveSemiring a, InvolutiveSemiring b, InvolutiveSemiring c, InvolutiveSemiring d) => InvolutiveSemiring (a, b, c, d)+instance (InvolutiveSemiring a, InvolutiveSemiring b, InvolutiveSemiring c, InvolutiveSemiring d, InvolutiveSemiring e) => InvolutiveSemiring (a, b, c, d, e)++-- adjoint = id+class (Commutative r, InvolutiveMultiplication r) => TriviallyInvolutive r+instance TriviallyInvolutive 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+instance TriviallyInvolutive Word16+instance TriviallyInvolutive Word32+instance TriviallyInvolutive Word64+instance TriviallyInvolutive ()+instance (TriviallyInvolutive a, TriviallyInvolutive b) => TriviallyInvolutive (a,b)+instance (TriviallyInvolutive a, TriviallyInvolutive b, TriviallyInvolutive c) => TriviallyInvolutive (a,b,c)+instance (TriviallyInvolutive a, TriviallyInvolutive b, TriviallyInvolutive c, TriviallyInvolutive d) => TriviallyInvolutive (a,b,c,d)+instance (TriviallyInvolutive a, TriviallyInvolutive b, TriviallyInvolutive c, TriviallyInvolutive d, TriviallyInvolutive e) => TriviallyInvolutive (a,b,c,d,e)++-- inv is an associative algebra homomorphism+class 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 c) => InvolutiveAlgebra r (a, b, c) where+  inv f (a,b,c) = inv (\a' -> inv (\b' -> inv (\c' -> f (a',b',c')) c) b) a++instance (InvolutiveAlgebra r a, InvolutiveAlgebra r b, InvolutiveAlgebra r c, InvolutiveAlgebra r d) => InvolutiveAlgebra r (a, b, c, d) where+  inv f (a,b,c,d) = inv (\a' -> inv (\b' -> inv (\c' -> inv (\d' -> f (a',b',c',d')) d) c) b) a++instance (InvolutiveAlgebra r a, InvolutiveAlgebra r b, InvolutiveAlgebra r c, InvolutiveAlgebra r d, InvolutiveAlgebra r e) => InvolutiveAlgebra r (a, b, c, d, e) where+  inv f (a,b,c,d,e) = inv (\a' -> inv (\b' -> inv (\c' -> inv (\d' -> inv (\e' -> f (a',b',c',d',e')) e) d) c) b) a++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 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 TriviallyInvolutiveCoalgebra () a +-- instance (Algebra r b, TriviallyInvolutiveCoalgebra r a) => TriviallyInvolutiveCoalgebra (b -> r) 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)++-- 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++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,157 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Algebra.Unital+  ( +  -- * Unital Multiplication (Multiplicative monoid)+    Unital(..)+  , product+  -- * Unital Associative Algebra +  , UnitalAlgebra(..)+  -- * Unital Coassociative Coalgebra+  , CounitalCoalgebra(..)+  -- * Bialgebra+  , Bialgebra+  ) where++import Numeric.Algebra.Class+import Numeric.Natural.Internal+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Foldable hiding (product)+import Data.Int+import Data.Word+import Prelude hiding ((*), foldr, product)++infixr 8 `pow`++class Multiplicative r => Unital r where+  one :: r+  pow :: Whole n => r -> n -> r+  pow _ 0 = one+  pow x0 y0 = f x0 y0 where+    f x y +      | even y = f (x * x) (y `quot` 2)+      | y == 1 = x+      | otherwise = g (x * x) ((y - 1) `quot` 2) x+    g x y z +      | even y = g (x * x) (y `quot` 2) z+      | y == 1 = x * z+      | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)+  productWith :: Foldable f => (a -> r) -> f a -> r+  productWith f = foldl' (\b a -> b * f a) one++product :: (Foldable f, Unital r) => f r -> r+product = productWith id++instance Unital Bool where one = True+instance Unital Integer where one = 1+instance Unital Int where one = 1+instance Unital Int8 where one = 1+instance Unital Int16 where one = 1+instance Unital Int32 where one = 1+instance Unital Int64 where one = 1+instance Unital Natural where one = 1+instance Unital Word where one = 1+instance Unital Word8 where one = 1+instance Unital Word16 where one = 1+instance Unital Word32 where one = 1+instance Unital Word64 where one = 1+instance Unital () where one = ()+instance (Unital a, Unital b) => Unital (a,b) where+  one = (one,one)++instance (Unital a, Unital b, Unital c) => Unital (a,b,c) where+  one = (one,one,one)++instance (Unital a, Unital b, Unital c, Unital d) => Unital (a,b,c,d) where+  one = (one,one,one,one)++instance (Unital a, Unital b, Unital c, Unital d, Unital e) => Unital (a,b,c,d,e) where+  one = (one,one,one,one,one)++-- | An associative unital algebra over a semiring, built using a free module+class Algebra r a => UnitalAlgebra r a where+  unit :: r -> a -> r++instance (Unital r, UnitalAlgebra r a) => Unital (a -> r) where+  one = unit one++instance Semiring r => UnitalAlgebra r () where+  unit r () = r++-- incoherent+-- instance UnitalAlgebra () a where unit _ _ = ()+-- instance (UnitalAlgebra r a, UnitalAlgebra r b) => UnitalAlgebra (a -> r) b where unit f b a = unit (f a) b++instance (UnitalAlgebra r a, UnitalAlgebra r b) => UnitalAlgebra r (a,b) where+  unit r (a,b) = unit r a * unit r b++instance (UnitalAlgebra r a, UnitalAlgebra r b, UnitalAlgebra r c) => UnitalAlgebra r (a,b,c) where+  unit r (a,b,c) = unit r a * unit r b * unit r c++instance (UnitalAlgebra r a, UnitalAlgebra r b, UnitalAlgebra r c, UnitalAlgebra r d) => UnitalAlgebra r (a,b,c,d) where+  unit r (a,b,c,d) = unit r a * unit r b * unit r c * unit r d++instance (UnitalAlgebra r a, UnitalAlgebra r b, UnitalAlgebra r c, UnitalAlgebra r d, UnitalAlgebra r e) => UnitalAlgebra r (a,b,c,d,e) where+  unit r (a,b,c,d,e) = unit r a * unit r b * unit r c * unit r d * unit r e++instance (Monoidal r, Semiring r) => UnitalAlgebra r [a] where+  unit r [] = r+  unit _ _ = zero++instance (Monoidal r, Semiring r) => UnitalAlgebra r (Seq a) where+  unit r a | Seq.null a = r+           | otherwise = zero++-- A coassociative counital coalgebra over a semiring, where the module is free+class Coalgebra r c => CounitalCoalgebra r c where+  counit :: (c -> r) -> r++instance (Unital r, UnitalAlgebra r m) => CounitalCoalgebra r (m -> r) where+  counit k = k one++-- incoherent+-- instance (UnitalAlgebra r a, CounitalCoalgebra r c) => CounitalCoalgebra (a -> r) c where counit k a = counit (`k` a)+-- instance CounitalCoalgebra () a where counit _ = ()++instance Semiring r => CounitalCoalgebra r () where+  counit f = f ()++instance (CounitalCoalgebra r a, CounitalCoalgebra r b) => CounitalCoalgebra r (a, b) where+  counit k = counit $ \a -> counit $ \b -> k (a,b)++instance (CounitalCoalgebra r a, CounitalCoalgebra r b, CounitalCoalgebra r c) => CounitalCoalgebra r (a, b, c) where+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> k (a,b,c)++instance (CounitalCoalgebra r a, CounitalCoalgebra r b, CounitalCoalgebra r c, CounitalCoalgebra r d) => CounitalCoalgebra r (a, b, c, d) where+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> k (a,b,c,d)++instance (CounitalCoalgebra r a, CounitalCoalgebra r b, CounitalCoalgebra r c, CounitalCoalgebra r d, CounitalCoalgebra r e) => CounitalCoalgebra r (a, b, c, d, e) where+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> counit $ \e -> k (a,b,c,d,e)++instance Semiring r => CounitalCoalgebra r [a] where+  counit k = k []++instance Semiring r => CounitalCoalgebra r (Seq a) where+  counit k = k (Seq.empty)++-- | A bialgebra is both a unital algebra and counital coalgebra +-- where the `mult` and `unit` are compatible in some sense with +-- the `comult` and `counit`. That is to say that +-- 'mult' and 'unit' are a coalgebra homomorphisms or (equivalently) that +-- 'comult' and 'counit' are an algebra homomorphisms.++class (UnitalAlgebra r a, CounitalCoalgebra r a) => Bialgebra r a++-- TODO+-- instance (Unital r, Bialgebra r m) => Bialgebra r (m -> r)+-- instance Bialgebra () c+-- instance (UnitalAlgebra r b, Bialgebra r c) => Bialgebra (b -> r) c++instance Semiring r => Bialgebra r ()+instance (Bialgebra r a, Bialgebra r b) => Bialgebra r (a, b)+instance (Bialgebra r a, Bialgebra r b, Bialgebra r c) => Bialgebra r (a, b, c)+instance (Bialgebra r a, Bialgebra r b, Bialgebra r c, Bialgebra r d) => Bialgebra r (a, b, c, d)+instance (Bialgebra r a, Bialgebra r b, Bialgebra r c, Bialgebra r d, Bialgebra r e) => Bialgebra r (a, b, c, d, e)++instance (Monoidal r, Semiring r) => Bialgebra r [a]+instance (Monoidal r, Semiring r) => Bialgebra r (Seq a)

@@ -1,7 +0,0 @@-module Numeric.Band-  ( module Numeric.Band.Class-  , module Numeric.Band.Rectangular-  ) where--import Numeric.Band.Class-import Numeric.Band.Rectangular

@@ -1,30 +1,7 @@ module Numeric.Band.Class-  ( -  -- * Multiplicative Bands-    Band+  ( Band   , pow1pBand   , powBand   ) where -import Numeric.Semigroup.Multiplicative-import Numeric.Monoid.Multiplicative-import Numeric.Natural---- | An multiplicative semigroup with idempotent multiplication.------ > a * a = a-class Multiplicative r => Band r--pow1pBand :: Whole n => r -> n -> r-pow1pBand r _ = r --powBand :: (Unital r, Whole n) => r -> n -> r-powBand _ 0 = one-powBand r _ = r--instance Band ()-instance Band Bool-instance (Band a, Band b) => Band (a,b)-instance (Band a, Band b, Band c) => Band (a,b,c)-instance (Band a, Band b, Band c, Band d) => Band (a,b,c,d)-instance (Band a, Band b, Band c, Band d, Band e) => Band (a,b,c,d,e)+import Numeric.Algebra.Idempotent

@@ -2,8 +2,8 @@   ( Rect(..)   ) where -import Numeric.Semigroup.Multiplicative-import Numeric.Band.Class+import Numeric.Algebra.Class+import Numeric.Algebra.Idempotent import Data.Semigroupoid  -- | a rectangular band is a nowhere commutative semigroup.

@@ -0,0 +1,158 @@+{-# LANGUAGE ImplicitParams, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+module Numeric.Covector +  ( Covector(..)+  -- * Covectors as linear functionals+  , counitM+  , unitM+  , comultM+  , multM+  , invM+  , coinvM+  , antipodeM+  , convolveM+  , memoM+  ) where++import Numeric.Additive.Class+import Numeric.Additive.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Algebra.Idempotent+import Numeric.Algebra.Involutive+import Numeric.Algebra.Commutative+import Numeric.Algebra.Hopf+import Numeric.Module.Class+import Numeric.Rig.Class+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++-- 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)++instance Functor (Covector r) where+  fmap f m = Covector $ \k -> m $* k . f++instance Apply (Covector r) where+  mf <.> ma = Covector $ \k -> mf $* \f -> ma $* k . f++instance Applicative (Covector r) where+  pure a = Covector $ \k -> k a+  mf <*> ma = Covector $ \k -> mf $* \f -> ma $* k . f++instance Bind (Covector r) where+  m >>- f = Covector $ \k -> m $* \a -> f a $* k+  +instance Monad (Covector r) where+  return a = Covector $ \k -> k a+  m >>= f = Covector $ \k -> m $* \a -> f a $* k++instance Additive r => Alt (Covector r) where+  Covector m <!> Covector n = Covector $ m + n++instance Monoidal r => Plus (Covector r) where+  zero = Covector zero ++instance Monoidal r => Alternative (Covector r) where+  Covector m <|> Covector n = Covector $ m + n+  empty = Covector zero++instance Monoidal r => MonadPlus (Covector r) where+  Covector m `mplus` Covector n = Covector $ m + n+  mzero = Covector zero++instance Additive r => Additive (Covector r a) where+  Covector m + Covector n = Covector $ m + n+  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++instance (Commutative m, Coalgebra r m) => Commutative (Covector r m)++instance Coalgebra r m => Semiring (Covector r m)++instance CounitalCoalgebra r m => Unital (Covector r m) where+  one = Covector counit++instance (Rig r, CounitalCoalgebra r m) => Rig (Covector r m)++instance (Ring r, CounitalCoalgebra r m) => Ring (Covector r m)++instance Idempotent r => Idempotent (Covector r a)++instance (Idempotent r, IdempotentCoalgebra r a) => Band (Covector r a)++multM :: Coalgebra r c => c -> c -> Covector r c+multM a b = Covector $ \k -> comult k a b++unitM :: CounitalCoalgebra r c => Covector r c+unitM = Covector counit++comultM :: Algebra r a => a -> Covector r (a,a)+comultM c = Covector $ \k -> mult (curry k) c ++counitM :: UnitalAlgebra r a => a -> Covector r ()+counitM a = Covector $ \k -> unit (k ()) a++convolveM :: (Algebra r c, Coalgebra r a) => (c -> Covector r a) -> (c -> Covector r a) -> c -> Covector r a+convolveM f g c = do+   (c1,c2) <- comultM c+   a1 <- f c1+   a2 <- g c2+   multM a1 a2++invM :: InvolutiveAlgebra r h => h -> Covector r h+invM = Covector . flip inv++coinvM :: InvolutiveCoalgebra r h => h -> Covector r h+coinvM = Covector . flip coinv++-- | 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++instance Monoidal s => Monoidal (Covector s a) where+  zero = Covector zero+  replicate n (Covector m) = Covector (replicate n m)++instance Abelian s => Abelian (Covector s a)++instance Group s => Group (Covector s a) where+  Covector m - Covector n = Covector $ m - n+  negate (Covector m) = Covector $ negate m+  subtract (Covector m) (Covector n) = Covector $ subtract m n+  times n (Covector m) = Covector $ times n m++instance Coalgebra r m => LeftModule (Covector r m) (Covector r m) where+  (.*) = (*)++instance LeftModule r s => LeftModule r (Covector s m) where+  s .* m = Covector $ \k -> s .* (m $* k)++instance Coalgebra r m => RightModule (Covector r m) (Covector r m) where+  (*.) = (*)++instance RightModule r s => RightModule r (Covector s m) where+  m *. s = Covector $ \k -> (m $* k) *. s

@@ -7,8 +7,8 @@ import Data.Function (on) import Data.Int import Data.Word-import Numeric.Monoid.Multiplicative-import Numeric.Natural+import Numeric.Algebra.Unital+import Numeric.Natural.Internal  isAssociateIntegral :: Num n => n -> n -> Bool isAssociateIntegral = (==) `on` abs

@@ -7,8 +7,8 @@ import Data.Maybe (isJust) import Data.Int import Data.Word-import Numeric.Semigroup.Multiplicative-import Numeric.Monoid.Multiplicative+import Numeric.Algebra.Class+import Numeric.Algebra.Unital import Numeric.Natural.Internal import Control.Applicative import Prelude hiding ((*))

@@ -2,12 +2,12 @@   ( DecidableZero(..)   ) where -import Numeric.Monoid.Additive+import Numeric.Algebra.Class import Data.Int import Data.Word-import Numeric.Natural+import Numeric.Natural.Internal -class AdditiveMonoid r => DecidableZero r where+class Monoidal r => DecidableZero r where   isZero :: r -> Bool  instance DecidableZero Bool where isZero = not

@@ -0,0 +1,10 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module Numeric.Dioid.Class +  ( Dioid+  ) where++import Numeric.Additive.Class+import Numeric.Algebra.Class++class (Semiring r, Idempotent r) => Dioid r+instance (Semiring r, Idempotent r) => Dioid r

@@ -3,9 +3,7 @@   ) where  import Data.Function (on)-import Numeric.Addition-import Numeric.Multiplication-import Numeric.Band.Class+import Numeric.Algebra  import Prelude hiding ((+),(-),negate,replicate,subtract) @@ -16,12 +14,12 @@   productWith1 f = Exp . sumWith1 (runExp . f)   pow1p (Exp m) n = Exp (replicate1p n m) -instance AdditiveMonoid r => Unital (Exp r) where+instance Monoidal r => Unital (Exp r) where   one = Exp zero   pow (Exp m) n = Exp (replicate n m)   productWith f = Exp . sumWith (runExp . f) -instance AdditiveGroup r => MultiplicativeGroup (Exp r) where+instance Group r => Division (Exp r) where   Exp a / Exp b = Exp (a - b)   recip (Exp a) = Exp (negate a)   Exp a \\ Exp b = Exp (subtract a b)

@@ -1,79 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}-module Numeric.Functional.Antilinear -  ( Antilinear(..)-  ) where--import Numeric.Module-import Numeric.Addition-import Control.Applicative-import Control.Monad-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)---- | Antilinear functionals from elements of a free module to a scalar---- appAntilinear f (x + y) = appAntilinear f x + appAntilinear f y--- appAntilinear f (a .* x) = adjoint a * appAntilinear f x--newtype Antilinear s a = Antilinear { appAntilinear :: (a -> s) -> s }--instance Functor (Antilinear s) where-  fmap f (Antilinear m) = Antilinear (\k -> m (k . f))--instance Apply (Antilinear s) where-  Antilinear mf <.> Antilinear ma = Antilinear (\k -> mf (\f -> ma (k . f)))--instance Applicative (Antilinear s) where-  pure a = Antilinear (\k -> k a)-  Antilinear mf <*> Antilinear ma = Antilinear (\k -> mf (\f -> ma (k . f)))--instance Bind (Antilinear s) where-  Antilinear m >>- f = Antilinear (\k -> m (\a -> appAntilinear (f a) k))-  -instance Monad (Antilinear s) where-  return a = Antilinear (\k -> k a)-  Antilinear m >>= f = Antilinear (\k -> m (\a -> appAntilinear (f a) k))--instance Additive s => Alt (Antilinear s) where-  Antilinear m <!> Antilinear n = Antilinear (m + n)--instance AdditiveMonoid s => Plus (Antilinear s) where-  zero = Antilinear zero --instance AdditiveMonoid s => Alternative (Antilinear s) where-  Antilinear m <|> Antilinear n = Antilinear (m + n)-  empty = Antilinear zero--instance AdditiveMonoid s => MonadPlus (Antilinear s) where-  Antilinear m `mplus` Antilinear n = Antilinear (m + n)-  mzero = Antilinear zero--instance Additive s => Additive (Antilinear s a) where-  Antilinear m + Antilinear n = Antilinear (m + n)-  replicate1p n (Antilinear m) = Antilinear (replicate1p n m)--instance AdditiveMonoid s => AdditiveMonoid (Antilinear s a) where-  zero = Antilinear zero-  replicate n (Antilinear m) = Antilinear (replicate n m)--instance AdditiveGroup s => AdditiveGroup (Antilinear s a) where-  Antilinear m - Antilinear n = Antilinear (m - n)-  negate (Antilinear m) = Antilinear (negate m)-  subtract (Antilinear m) (Antilinear n) = Antilinear (subtract m n)-  times n (Antilinear m) = Antilinear (times n m)--instance Abelian s => Abelian (Antilinear s a)---- instance (Multiplicative m, Semiring s) => LeftModule (Antilinear s m) (Antilinear s m) where (.*) = (*)--instance LeftModule r s => LeftModule r (Antilinear s m) where-  s .* Antilinear m = Antilinear (\k -> s .* m k)---- instance (Multiplicative m, Semiring s) => RightModule (Antilinear s m) (Antilinear s m) where (*.) = (*)--instance RightModule r s => RightModule r (Antilinear s m) where-  Antilinear m *. s = Antilinear (\k -> m k *. s)-

@@ -1,129 +0,0 @@-{-# LANGUAGE ImplicitParams, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}-module Numeric.Functional.Linear -  ( Linear(..)-  -- * Vectors-  , Vector-  , unitVector-  -- * Covectors as linear functionals-  , Covector-  , counitCovector-  , embedCovector-  , augmentCovector-  ) where--import Numeric.Addition-import Numeric.Algebra.Free-import Numeric.Multiplication-import Numeric.Module-import Numeric.Semiring.Class-import Numeric.Rig.Class-import Numeric.Rng.Class-import Numeric.Ring.Class-import Control.Applicative-import Control.Monad-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,(*))--infixr 0 $*---- | Linear functionals from elements of a free module to a scalar---- f $* (x + y) = (f $* x) + (f $* y)--- f $* (a .* x) = a * (f $* x)--newtype Linear r a = Linear { ($*) :: (a -> r) -> r }--type Covector a r = Linear r a-type Vector = (->)--instance Functor (Linear r) where-  fmap f m = Linear $ \k -> m $* k . f--instance Apply (Linear r) where-  mf <.> ma = Linear $ \k -> mf $* \f -> ma $* k . f--instance Applicative (Linear r) where-  pure a = Linear $ \k -> k a-  mf <*> ma = Linear $ \k -> mf $* \f -> ma $* k . f--instance Bind (Linear r) where-  m >>- f = Linear $ \k -> m $* \a -> f a $* k-  -instance Monad (Linear r) where-  return a = Linear $ \k -> k a-  m >>= f = Linear $ \k -> m $* \a -> f a $* k--instance Additive r => Alt (Linear r) where-  Linear m <!> Linear n = Linear $ m + n--instance AdditiveMonoid r => Plus (Linear r) where-  zero = Linear zero --instance AdditiveMonoid r => Alternative (Linear r) where-  Linear m <|> Linear n = Linear $ m + n-  empty = Linear zero--instance AdditiveMonoid r => MonadPlus (Linear r) where-  Linear m `mplus` Linear n = Linear $ m + n-  mzero = Linear zero--instance Additive r => Additive (Linear r a) where-  Linear m + Linear n = Linear $ m + n-  replicate1p n (Linear m) = Linear $ replicate1p n m--instance FreeCoalgebra r m => Multiplicative (Linear r m) where-  f * Linear g = Linear $ \k -> f $* g . cojoin k-instance (Commutative m, FreeCoalgebra r m) => Commutative (Linear r m)-instance FreeCoalgebra r m => Semiring (Linear r m)-instance FreeCounitalCoalgebra r m => Unital (Linear r m) where-  one = Linear counit-instance (Rig r, FreeCounitalCoalgebra r m) => Rig (Linear r m)-instance (Rng r, FreeCounitalCoalgebra r m) => Rng (Linear r m)-instance (Ring r, FreeCounitalCoalgebra r m) => Ring (Linear r m)--unitVector :: (FreeUnitalAlgebra r a, Unital r) => a -> r-unitVector = unit one--counitCovector :: FreeCounitalCoalgebra r c => Linear r c-counitCovector = Linear counit---- ring homomorphism from r -> r^a, generalizes the embedding of a semiring into its monoid semiring-embedCovector :: (Unital m, FreeCounitalCoalgebra r m) => r -> Linear r m-embedCovector r = Linear $ \k -> r * k one---- if the characteristic of s does not divide the order of a, then s[a] is semisimple--- and if a has a length function, we can build a filtered algebra---- | The augmentation ring homomorphism from r^a -> r, generalizes the augmentation homomorphism from a monoid semiring to the underlying semiring-augmentCovector :: Unital s => Linear s a -> s-augmentCovector m = m $* const one---- TODO: we can also build up the augmentation ideal--instance AdditiveMonoid s => AdditiveMonoid (Linear s a) where-  zero = Linear zero-  replicate n (Linear m) = Linear (replicate n m)--instance Abelian s => Abelian (Linear s a)--instance AdditiveGroup s => AdditiveGroup (Linear s a) where-  Linear m - Linear n = Linear $ m - n-  negate (Linear m) = Linear $ negate m-  subtract (Linear m) (Linear n) = Linear $ subtract m n-  times n (Linear m) = Linear $ times n m--instance FreeCoalgebra r m => LeftModule (Linear r m) (Linear r m) where-  (.*) = (*)--instance LeftModule r s => LeftModule r (Linear s m) where-  s .* m = Linear $ \k -> s .* (m $* k)--instance FreeCoalgebra r m => RightModule (Linear r m) (Linear r m) where-  (*.) = (*)--instance RightModule r s => RightModule r (Linear s m) where-  m *. s = Linear $ \k -> (m $* k) *. s-

@@ -1,9 +0,0 @@-module Numeric.Group-  ( module Numeric.Monoid-  , module Numeric.Group.Additive-  , module Numeric.Group.Multiplicative-  ) where--import Numeric.Monoid-import Numeric.Group.Additive-import Numeric.Group.Multiplicative

@@ -1,142 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}-module Numeric.Group.Additive-  ( -  -- * Additive Groups-    AdditiveGroup(..)-  ) where--import Data.Int-import Data.Word-import Prelude hiding ((+), (-), negate, subtract)-import qualified Prelude-import Numeric.Semigroup.Additive-import Numeric.Monoid.Additive-import Numeric.Module.Class--infixl 6 - -infixl 7 `times`--class (LeftModule Integer r, RightModule Integer r, AdditiveMonoid r) => AdditiveGroup r where-  (-)      :: r -> r -> r-  negate   :: r -> r-  subtract :: r -> r -> r-  times    :: Integral n => n -> r -> r-  times y0 x0 = case compare y0 0 of-    LT -> f (negate x0) (Prelude.negate y0)-    EQ -> zero-    GT -> f x0 y0-    where-      f x y -        | even y = f (x + x) (y `quot` 2)-        | y == 1 = x-        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) x-      g x y z -        | even y = g (x + x) (y `quot` 2) z-        | y == 1 = x + z-        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) (x + z)--  negate a = zero - a-  a - b  = a + negate b -  subtract a b = negate a + b--instance AdditiveGroup r => AdditiveGroup (e -> r) where-  f - g = \x -> f x - g x-  negate f x = negate (f x)-  subtract f g x = subtract (f x) (g x)-  times n f e = times n (f e)--instance AdditiveGroup Integer where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Int where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Int8 where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Int16 where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Int32 where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Int64 where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Word where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Word8 where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Word16 where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Word32 where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup Word64 where-  (-) = (Prelude.-)-  negate = Prelude.negate-  subtract = Prelude.subtract-  times n r = fromIntegral n * r--instance AdditiveGroup () where -  _ - _   = ()-  negate _ = ()-  subtract _ _  = ()-  times _ _   = ()--instance (AdditiveGroup a, AdditiveGroup b) => AdditiveGroup (a,b) where-  negate (a,b) = (negate a, negate b)-  (a,b) - (i,j) = (a-i, b-j)-  subtract (a,b) (i,j) = (subtract a i, subtract b j)-  times n (a,b) = (times n a,times n b)--instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c) => AdditiveGroup (a,b,c) where-  negate (a,b,c) = (negate a, negate b, negate c)-  (a,b,c) - (i,j,k) = (a-i, b-j, c-k)-  subtract (a,b,c) (i,j,k) = (subtract a i, subtract b j, subtract c k)-  times n (a,b,c) = (times n a,times n b, times n c)--instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c, AdditiveGroup d) => AdditiveGroup (a,b,c,d) where-  negate (a,b,c,d) = (negate a, negate b, negate c, negate d)-  (a,b,c,d) - (i,j,k,l) = (a-i, b-j, c-k, d-l)-  subtract (a,b,c,d) (i,j,k,l) = (subtract a i, subtract b j, subtract c k, subtract d l)-  times n (a,b,c,d) = (times n a,times n b, times n c, times n d)--instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c, AdditiveGroup d, AdditiveGroup e) => AdditiveGroup (a,b,c,d,e) where-  negate (a,b,c,d,e) = (negate a, negate b, negate c, negate d, negate e)-  (a,b,c,d,e) - (i,j,k,l,m) = (a-i, b-j, c-k, d-l, e-m)-  subtract (a,b,c,d,e) (i,j,k,l,m) = (subtract a i, subtract b j, subtract c k, subtract d l, subtract e m)-  times n (a,b,c,d,e) = (times n a,times n b, times n c, times n d, times n e)

@@ -1,59 +0,0 @@-module Numeric.Group.Multiplicative-  ( MultiplicativeGroup(..)-  ) where--import Prelude hiding ((*), recip, (/),(^))-import Numeric.Semigroup.Multiplicative-import Numeric.Monoid.Multiplicative--infixr 8 ^-infixl 7 /, \\--class Unital r => MultiplicativeGroup r where-  recip  :: r -> r-  (/)    :: r -> r -> r-  (\\)   :: r -> r -> r-  (^)    :: Integral n => r -> n -> r-  recip a = one / a-  a / b = a * recip b-  a \\ b = recip a * b-  x0 ^ y0 = case compare y0 0 of-    LT -> f (recip x0) (negate y0)-    EQ -> one-    GT -> f x0 y0-    where-       f x y -         | even y = f (x * x) (y `quot` 2)-         | y == 1 = x-         | otherwise = g (x * x) ((y - 1) `quot` 2) x-       g x y z -         | even y = g (x * x) (y `quot` 2) z-         | y == 1 = x * z-         | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)--instance MultiplicativeGroup () where -  _ / _   = ()-  recip _ = ()-  _ \\ _  = ()-  _ ^ _   = ()-instance (MultiplicativeGroup a, MultiplicativeGroup b) => MultiplicativeGroup (a,b) where-  recip (a,b) = (recip a, recip b)-  (a,b) / (i,j) = (a/i,b/j)-  (a,b) \\ (i,j) = (a\\i,b\\j)-  (a,b) ^ n = (a^n,b^n)-instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c) => MultiplicativeGroup (a,b,c) where-  recip (a,b,c) = (recip a, recip b, recip c)-  (a,b,c) / (i,j,k) = (a/i,b/j,c/k)-  (a,b,c) \\ (i,j,k) = (a\\i,b\\j,c\\k)-  (a,b,c) ^ n = (a^n,b^n,c^n)-instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c, MultiplicativeGroup d) => MultiplicativeGroup (a,b,c,d) where-  recip (a,b,c,d) = (recip a, recip b, recip c, recip d)-  (a,b,c,d) / (i,j,k,l) = (a/i,b/j,c/k,d/l)-  (a,b,c,d) \\ (i,j,k,l) = (a\\i,b\\j,c\\k,d\\l)-  (a,b,c,d) ^ n = (a^n,b^n,c^n,d^n)--instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c, MultiplicativeGroup d, MultiplicativeGroup e) => MultiplicativeGroup (a,b,c,d,e) where-  recip (a,b,c,d,e) = (recip a, recip b, recip c, recip d, recip e)-  (a,b,c,d,e) / (i,j,k,l,m) = (a/i,b/j,c/k,d/l,e/m)-  (a,b,c,d,e) \\ (i,j,k,l,m) = (a\\i,b\\j,c\\k,d\\l,e\\m)-  (a,b,c,d,e) ^ n = (a^n,b^n,c^n,d^n,e^n)

@@ -4,17 +4,12 @@   ) where  import Data.Function (on)-import Numeric.Addition-import Numeric.Module-import Numeric.Multiplication-import Numeric.Band.Class-import Numeric.Natural.Internal+import Numeric.Algebra  import Prelude hiding ((*),(^),(/),recip,negate,subtract)  newtype Log r = Log { runLog :: r }  - instance Multiplicative r => Additive (Log r) where   Log a + Log b = Log (a * b)   sumWith1 f = Log . productWith1 (runLog . f)@@ -26,18 +21,18 @@ instance Unital r => RightModule Natural (Log r) where   Log m *. n = Log (pow m n) -instance Unital r => AdditiveMonoid (Log r) where+instance Unital r => Monoidal (Log r) where   zero = Log one   replicate n (Log m) = Log (pow m n)   sumWith f = Log . productWith (runLog . f) -instance MultiplicativeGroup r => LeftModule Integer (Log r) where+instance Division r => LeftModule Integer (Log r) where   n .* Log m = Log (m ^ n) -instance MultiplicativeGroup r => RightModule Integer (Log r) where+instance Division r => RightModule Integer (Log r) where   Log m *. n = Log (m ^ n) -instance MultiplicativeGroup r => AdditiveGroup (Log r) where+instance Division r => Group (Log r) where   Log a - Log b = Log (a / b)   negate (Log a) = Log (recip a)   subtract (Log a) (Log b) = Log (a \\ b)

@@ -0,0 +1,312 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}+module Numeric.Map+  ( Map(..)+  , ($@)+  , multMap+  , unitMap+  , memoMap+  , comultMap+  , counitMap+  , invMap+  , coinvMap+  , antipodeMap+  , convolveMap+  ) where++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 hiding (Sum)+import Data.Functor.Representable+import Data.Functor.Representable.Trie +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)++-- | linear maps from elements of a free module to another free module over r+--+-- > f $# x + y = (f $# x) + (f $# y)+-- > f $# (r .* x) = r .* (f $# x)+--+--+-- @Map r b a@ represents a linear mapping from a free module with basis @a@ over @r@ to a free module with basis @b@ over @r@.+-- +-- Note well the reversed direction of the arrow, due to the contravariance of change of basis!+--+-- This way enables we can employ arbitrary pure functions as linear maps by lifting them using `arr`, or build them+-- by using the monad instance for Map r b.  As a consequence Map is an instance of, well, almost everything.++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+($#) (Map m) = tabulate . m . index++infixr 0 $@+-- | extract a linear functional from a linear map+($@) :: Map r b a -> b -> Covector r a+m $@ b = Covector $ \k -> (m $# k) b++-- NB: due to contravariance (>>>) to get the usual notion of composition!+instance Category (Map r) where+  id = Map id+  Map f . Map g = Map (g . f)++instance Semigroupoid (Map r) where+  Map f `o` Map g = Map (g . f)++instance Functor (Map r b) where+  fmap f m = Map $ \k -> m $# k . f++instance Apply (Map r b) where+  mf <.> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b++instance Applicative (Map r b) where+  pure a = Map $ \k _ -> k a+  mf <*> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b++instance Bind (Map r b) where+  Map m >>- f = Map $ \k b -> m (\a -> (f a $# k) b) b+  +instance Monad (Map r b) where+  return a = Map $ \k _ -> k a+  m >>= f = Map $ \k b -> (m $# \a -> (f a $# k) b) b++instance PFunctor (,) (Map r) (Map r) where+  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a++instance QFunctor (,) (Map r) (Map r) where+  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a++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++instance Disassociative (Map r) (,) where+  disassociate = arr disassociate++instance Braided (Map r) (,) where+  braid = arr braid++instance Symmetric (Map r) (,)++type instance Id (Map r) (,) = ()++instance C.Monoidal (Map r) (,) where+  idl = arr C.idl+  idr = arr C.idr++instance C.Comonoidal (Map r) (,) where+  coidl = arr C.coidl+  coidr = arr C.coidr++instance PreCartesian (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) where+  first m = Map $ \k -> either (m $# k . Left) (k . Right)++instance QFunctor Either (Map r) (Map r) where+  second m = Map $ \k -> either (k . Left) (m $# k . Right)++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++instance Disassociative (Map r) Either where+  disassociate = arr disassociate++instance Braided (Map r) Either where+  braid = arr braid++instance Symmetric (Map r) Either++type instance Id (Map r) Either = Void++instance PreCoCartesian (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.Comonoidal (Map r) Either where+  coidl = arr C.coidl+  coidr = arr C.coidr++instance C.Monoidal (Map r) Either where+  idl = arr C.idl+  idr = arr C.idr++instance Arrow (Map r) where+  arr f = Map (. f)+  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a+  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a+  m *** n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a+  m &&& n = Map $ \k a -> (m $# \b -> (n $# \c -> k (b,c)) a) a++instance ArrowApply (Map r) where+  app = Map $ \k (f,a) -> (f $# k) a++instance MonadReader b (Map r b) where+  ask = id+  local f m = Map $ \k -> (m $# k) . f++-- While the following typechecks, it isn't correct,+-- callCC is non-linear, the internal Map ignores the functional it is given!+--+--instance MonadCont (Map r b) where+--  callCC f = Map $ \k -> (f $# \a -> Map $ \_ _ -> k a) k++-- label :: ((a -> r) -> Map r b a) -> Map r b a+-- label f = Map $ \k -> f k $# k ++-- break :: (a -> r) -> a -> Map r b a++instance Monoidal r => ArrowZero (Map r) where+  zeroArrow = Map zero++instance Monoidal r => ArrowPlus (Map r) where+  Map m <+> Map n = Map $ m + n++instance ArrowChoice (Map r) where+  left m = Map $ \k -> either (m $# k . Left) (k . Right)+  right m = Map $ \k -> either (k . Left) (m $# k . Right)+  m +++ n =  Map $ \k -> either (m $# k . Left) (n $# k . Right)+  m ||| n = Map $ \k -> either (m $# k) (n $# k) ++-- TODO: ArrowLoop?++-- TODO: more categories instances for (Map r) & Either to get to precocartesian!++instance Additive r => Additive (Map r b a) where+  Map m + Map n = Map $ m + n+  replicate1p n (Map m) = Map $ replicate1p n m++instance Coalgebra r m => Multiplicative (Map r b m) where+  f * g = Map $ \k b -> (f $# \a -> (g $# comult k a) b) b+instance CounitalCoalgebra r m => Unital (Map r b m) where+  one = Map $ \k _ -> counit k++instance Coalgebra r m => Semiring (Map r b m)++instance Coalgebra r m => LeftModule (Map r b m) (Map r b m) where +  (.*) = (*)++instance LeftModule r s => LeftModule r (Map s b m) where+  s .* Map m = Map $ \k b -> s .* m k b++instance Coalgebra r m => RightModule (Map r b m) (Map r b m) where (*.) = (*)+instance RightModule r s => RightModule r (Map s b m) where+  Map m *. s = Map $ \k b -> m k b *. s++instance Additive r => Alt (Map r b) where+  Map m <!> Map n = Map $ m + n++instance Monoidal r => Plus (Map r b) where+  zero = Map zero ++instance Monoidal r => Alternative (Map r b) where+  Map m <|> Map n = Map $ m + n+  empty = Map zero++instance Monoidal r => MonadPlus (Map r b) where+  Map m `mplus` Map n = Map $ m + n+  mzero = Map zero++instance Monoidal s => Monoidal (Map s b a) where+  zero = Map zero+  replicate n (Map m) = Map $ replicate n m++instance Abelian s => Abelian (Map s b a)++instance Group s => Group (Map s b a) where+  Map m - Map n = Map $ m - n+  negate (Map m) = Map $ negate m+  subtract (Map m) (Map n) = Map $ subtract m n+  times n (Map m) = Map $ times n m++instance (Commutative m, Coalgebra r m) => Commutative (Map r b m)++instance (Rig r, CounitalCoalgebra r m) => Rig (Map r b m)++instance (Ring r, CounitalCoalgebra r m) => Ring (Map r a m)++-- | (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++multMap :: Coalgebra r c => Map r (c,c) c+multMap = Map $ uncurry . comult++counitMap :: UnitalAlgebra r a => Map r a ()+counitMap = Map $ \k -> unit $ k ()++unitMap :: CounitalCoalgebra r c => Map r () c+unitMap = Map $ \k () -> counit k++-- | convolution given an associative algebra and coassociative coalgebra+convolveMap :: (Algebra r a, Coalgebra r c) => Map r a c -> Map r a c -> Map r a c+convolveMap f g = multMap . (f *** g) . comultMap++-- convolveMap antipodeMap id = convolveMap id antipodeMap = unit . counit+antipodeMap :: HopfAlgebra r h => Map r h h+antipodeMap = Map antipode++coinvMap :: InvolutiveAlgebra r a => Map r a a+coinvMap = Map inv++invMap :: InvolutiveCoalgebra r c => Map r c c+invMap = Map coinv++{-+-- ring homomorphism from r -> r^a+embedMap :: (Unital m, CounitalCoalgebra r m) => (b -> r) -> Map r b m +embedMap f = Map $ \k b -> f b * k one++-- if the characteristic of s does not divide the order of a, then s[a] is semisimple+-- and if a has a length function, we can build a filtered algebra++-- | The augmentation ring homomorphism from r^a -> r+augmentMap :: Unital s => Map s b m -> b -> s+augmentMap m = m $# const one+-}+

@@ -1,307 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}-module Numeric.Map.Linear-  ( Map(..)-  , ($@)-  , joinMap-  , unitMap-  , memoMap-  , cojoinMap-  , counitMap-  , antipodeMap-  , convolveMap-  , embedMap-  , augmentMap-  , arrMap-  ) where--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 Control.Category.Monoidal-import Control.Monad hiding (join)-import Control.Monad.Reader.Class-import Data.Functor.Representable.Trie-import Data.Functor.Bind hiding (join)-import Data.Functor.Plus hiding (zero)-import qualified Data.Functor.Plus as Plus-import Data.Semigroupoid-import Data.Void-import Numeric.Addition-import Numeric.Algebra.Free-import Numeric.Multiplication-import Numeric.Module-import Numeric.Semiring.Class-import Numeric.Rig.Class-import Numeric.Ring.Class-import Numeric.Rng.Class-import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat, (.), id, curry, uncurry, fst, snd)-import Numeric.Functional.Linear---- | linear maps from elements of a free module to another free module over r------ > f $# x + y = (f $# x) + (f $# y)--- > f $# (r .* x) = r .* (f $# x)--------- @Map r b a@ represents a linear mapping from a free module with basis @a@ over @r@ to a free module with basis @b@ over @r@.--- --- Note well the change of direction, due to the contravariance of change of basis!------ This way enables we can employ arbitrary pure functions as linear maps by lifting them using `arr`, or build them--- by using the monad instance for Map r b.  As a consequence Map is an instance of, well, almost everything.--infixr 0 $#-newtype Map r b a = Map { ($#) :: (a -> r) -> b -> r }--infixr 0 $@--- | extract a linear functional from a linear map-($@) :: Map r b a -> b -> Linear r a-m $@ b = Linear $ \k -> (m $# k) b---- NB: due to contravariance (>>>) to get the usual notion of composition!-instance Category (Map r) where-  id = Map id-  Map f . Map g = Map (g . f)--instance Semigroupoid (Map r) where-  Map f `o` Map g = Map (g . f)--instance Functor (Map r b) where-  fmap f m = Map $ \k -> m $# k . f--instance Apply (Map r b) where-  mf <.> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b--instance Applicative (Map r b) where-  pure a = Map $ \k _ -> k a-  mf <*> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b--instance Bind (Map r b) where-  Map m >>- f = Map $ \k b -> m (\a -> (f a $# k) b) b-  -instance Monad (Map r b) where-  return a = Map $ \k _ -> k a-  m >>= f = Map $ \k b -> (m $# \a -> (f a $# k) b) b--instance PFunctor (,) (Map r) (Map r) where-  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a--instance QFunctor (,) (Map r) (Map r) where-  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a--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--instance Disassociative (Map r) (,) where-  disassociate = arr disassociate--instance Braided (Map r) (,) where-  braid = arr braid--instance Symmetric (Map r) (,)--type instance Id (Map r) (,) = ()--instance Monoidal (Map r) (,) where-  idl = arr idl-  idr = arr idr--instance Comonoidal (Map r) (,) where-  coidl = arr coidl-  coidr = arr coidr--instance PreCartesian (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) where-  first m = Map $ \k -> either (m $# k . Left) (k . Right)--instance QFunctor Either (Map r) (Map r) where-  second m = Map $ \k -> either (k . Left) (m $# k . Right)--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--instance Disassociative (Map r) Either where-  disassociate = arr disassociate--instance Braided (Map r) Either where-  braid = arr braid--instance Symmetric (Map r) Either--type instance Id (Map r) Either = Void--instance PreCoCartesian (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 Comonoidal (Map r) Either where-  coidl = arr coidl-  coidr = arr coidr--instance Monoidal (Map r) Either where-  idl = arr idl-  idr = arr idr--instance Arrow (Map r) where-  arr f = Map (. f)-  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a-  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a-  m *** n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a-  m &&& n = Map $ \k a -> (m $# \b -> (n $# \c -> k (b,c)) a) a--instance ArrowApply (Map r) where-  app = Map $ \k (f,a) -> (f $# k) a--instance MonadReader b (Map r b) where-  ask = id-  local f m = Map $ \k -> (m $# k) . f---- While the following typechecks, it isn't correct,--- callCC is non-linear, the internal Map ignores the functional it is given!------instance MonadCont (Map r b) where---  callCC f = Map $ \k -> (f $# \a -> Map $ \_ _ -> k a) k---- label :: ((a -> r) -> Map r b a) -> Map r b a--- label f = Map $ \k -> f k $# k ---- break :: (a -> r) -> a -> Map r b a--instance AdditiveMonoid r => ArrowZero (Map r) where-  zeroArrow = Map zero--instance AdditiveMonoid r => ArrowPlus (Map r) where-  Map m <+> Map n = Map $ m + n--instance ArrowChoice (Map r) where-  left m = Map $ \k -> either (m $# k . Left) (k . Right)-  right m = Map $ \k -> either (k . Left) (m $# k . Right)-  m +++ n =  Map $ \k -> either (m $# k . Left) (n $# k . Right)-  m ||| n = Map $ \k -> either (m $# k) (n $# k) ---- TODO: ArrowLoop?---- TODO: more categories instances for (Map r) & Either to get to precocartesian!--instance Additive r => Additive (Map r b a) where-  Map m + Map n = Map $ m + n-  replicate1p n (Map m) = Map $ replicate1p n m--instance FreeCoalgebra r m => Multiplicative (Map r b m) where-  f * g = Map $ \k b -> (f $# \a -> (g $# cojoin k a) b) b-instance FreeCounitalCoalgebra r m => Unital (Map r b m) where-  one = Map $ \k _ -> counit k--instance FreeCoalgebra r m => Semiring (Map r b m)--instance FreeCoalgebra r m => LeftModule (Map r b m) (Map r b m) where -  (.*) = (*)--instance LeftModule r s => LeftModule r (Map s b m) where-  s .* Map m = Map $ \k b -> s .* m k b--instance FreeCoalgebra r m => RightModule (Map r b m) (Map r b m) where (*.) = (*)-instance RightModule r s => RightModule r (Map s b m) where-  Map m *. s = Map $ \k b -> m k b *. s--instance Additive r => Alt (Map r b) where-  Map m <!> Map n = Map $ m + n--instance AdditiveMonoid r => Plus (Map r b) where-  zero = Map zero --instance AdditiveMonoid r => Alternative (Map r b) where-  Map m <|> Map n = Map $ m + n-  empty = Map zero--instance AdditiveMonoid r => MonadPlus (Map r b) where-  Map m `mplus` Map n = Map $ m + n-  mzero = Map zero--instance AdditiveMonoid s => AdditiveMonoid (Map s b a) where-  zero = Map zero-  replicate n (Map m) = Map $ replicate n m--instance Abelian s => Abelian (Map s b a)--instance AdditiveGroup s => AdditiveGroup (Map s b a) where-  Map m - Map n = Map $ m - n-  negate (Map m) = Map $ negate m-  subtract (Map m) (Map n) = Map $ subtract m n-  times n (Map m) = Map $ times n m--instance (Commutative m, FreeCoalgebra r m) => Commutative (Map r b m)--instance (Rig r, FreeCounitalCoalgebra r m) => Rig (Map r b m)-instance (Rng r, FreeCounitalCoalgebra r m) => Rng (Map r b m)-instance (Ring r, FreeCounitalCoalgebra r m) => Ring (Map r a m)---- | (inefficiently) combine a linear combination of basis vectors to make a map.-arrMap :: (AdditiveMonoid 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--joinMap :: FreeAlgebra r a => Map r a (a,a)-joinMap = Map $ join . curry--cojoinMap :: FreeCoalgebra r c => Map r (c,c) c-cojoinMap = Map $ uncurry . cojoin--unitMap :: FreeUnitalAlgebra r a => Map r a ()-unitMap = Map $ \k -> unit $ k ()--counitMap :: FreeCounitalCoalgebra r c => Map r () c-counitMap = Map $ \k () -> counit k---- | convolution given an associative algebra and coassociative coalgebra-convolveMap :: (FreeAlgebra r a, FreeCoalgebra r c) => Map r a c -> Map r a c -> Map r a c-convolveMap f g = joinMap >>> (f *** g) >>> cojoinMap---- convolveMap antipodeMap id = convolveMap id antipodeMap = unit . counit-antipodeMap :: Hopf r h => Map r h h-antipodeMap = Map antipode---- ring homomorphism from r -> r^a-embedMap :: (Unital m, FreeCounitalCoalgebra r m) => (b -> r) -> Map r b m -embedMap f = Map $ \k b -> f b * k one---- if the characteristic of s does not divide the order of a, then s[a] is semisimple--- and if a has a length function, we can build a filtered algebra---- | The augmentation ring homomorphism from r^a -> r-augmentMap :: Unital s => Map s b m -> b -> s-augmentMap m = m $# const one-

@@ -1,5 +0,0 @@-module Numeric.Module -  ( module Numeric.Module.Class-  ) where--import Numeric.Module.Class

@@ -1,98 +1,9 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--- This package is an unfortunate ball of mud forced on me by mutual dependencies module Numeric.Module.Class   (     -- * Module over semirings     LeftModule(..)   , RightModule(..)+  , Module   ) where -import Data.Int-import Data.Word-import Numeric.Natural.Internal-import Numeric.Semigroup.Additive-import Numeric.Semiring.Internal-import Prelude hiding ((*))--infixl 7 .*, *.--class (Semiring r, Additive m) => LeftModule r m where-  (.*) :: r -> m -> m--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 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 (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)-+import Numeric.Algebra.Class

@@ -0,0 +1,215 @@+{-# 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)

@@ -0,0 +1,275 @@+{-# 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

@@ -0,0 +1,80 @@+{-# LANGUAGE RebindableSyntax, FlexibleContexts #-}+module Numeric.Module.Representable +  ( +  -- * Representable Additive+    addRep, replicate1pRep+  -- * Representable Monoidal+  , zeroRep, replicateRep+  -- * Representable Group+  , negateRep, minusRep, subtractRep, timesRep+  -- * Representable Multiplicative (via Algebra)+  , mulRep+  -- * Representable Unital (via UnitalAlgebra)+  , oneRep+  -- * Representable Rig (via Algebra)+  , fromNaturalRep+  -- * Representable Ring (via Algebra)+  , fromIntegerRep+  ) where++import Control.Applicative+import Data.Functor+import Data.Functor.Representable+import Data.Key+import Numeric.Additive.Class+import Numeric.Additive.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Natural.Internal+import Numeric.Rig.Class+import Numeric.Ring.Class+import Control.Category+import Prelude (($), Integral(..),Integer)++-- | `Additive.(+)` default definition+addRep :: (Zip m, Additive r) => m r -> m r -> m r+addRep = zipWith (+)++-- | `Additive.replicate1p` default definition+replicate1pRep :: (Whole n, Functor m, Additive r) => n -> m r -> m r+replicate1pRep = fmap . replicate1p++-- | `Monoidal.zero` default definition+zeroRep :: (Applicative m, Monoidal r) => m r +zeroRep = pure zero++-- | `Monoidal.replicate` default definition+replicateRep :: (Whole n, Functor m, Monoidal r) => n -> m r -> m r+replicateRep = fmap . replicate++-- | `Group.negate` default definition+negateRep :: (Functor m, Group r) => m r -> m r+negateRep = fmap negate++-- | `Group.(-)` default definition+minusRep :: (Zip m, Group r) => m r -> m r -> m r+minusRep = zipWith (-)++-- | `Group.subtract` default definition+subtractRep :: (Zip m, Group r) => m r -> m r -> m r+subtractRep = zipWith 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 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 = tabulate $ unit one++-- | `Rig.fromNatural` default definition+fromNaturalRep :: (UnitalAlgebra r (Key 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 n = tabulate $ unit (fromInteger n)

@@ -1,9 +0,0 @@-module Numeric.Monoid-  ( module Numeric.Semigroup-  , module Numeric.Monoid.Additive-  , module Numeric.Monoid.Multiplicative-  ) where--import Numeric.Semigroup-import Numeric.Monoid.Additive-import Numeric.Monoid.Multiplicative

@@ -1,119 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}-module Numeric.Monoid.Additive-  ( -  -- * Additive Monoids-    AdditiveMonoid(..)-  , sum-  ) where--import Data.Foldable hiding (sum)-import Data.Int-import Data.Word-import Numeric.Module.Class-import Numeric.Natural.Internal-import Numeric.Semigroup.Additive-import Prelude hiding ((+), sum, replicate)---- | An additive monoid------ > zero + a = a = a + zero-class (LeftModule Natural m, RightModule Natural m) => AdditiveMonoid m where-  zero :: m--  replicate :: Whole n => n -> m -> m-  replicate 0 _  = zero-  replicate n x0 = f x0 n-    where-      f x y-        | even y = f (x + x) (y `quot` 2)-        | y == 1 = x-        | otherwise = g (x + x) (unsafePred y `quot` 2) x-      g x y z-        | even y = g (x + x) (y `quot` 2) z-        | y == 1 = x + z-        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)--  sumWith :: Foldable f => (a -> m) -> f a -> m-  sumWith f = foldl' (\b a -> b + f a) zero--sum :: (Foldable f, AdditiveMonoid m) => f m -> m-sum = sumWith id--instance AdditiveMonoid Bool where -  zero = False-  replicate 0 _ = False-  replicate _ r = r--instance AdditiveMonoid Natural where-  zero = 0-  replicate n r = toNatural n * r--instance AdditiveMonoid Integer where -  zero = 0-  replicate n r = toInteger n * r--instance AdditiveMonoid Int where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Int8 where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Int16 where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Int32 where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Int64 where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Word where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Word8 where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Word16 where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Word32 where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid Word64 where -  zero = 0-  replicate n r = fromIntegral n * r--instance AdditiveMonoid r => AdditiveMonoid (e -> r) where-  zero = const zero-  sumWith f xs e = sumWith (`f` e) xs-  replicate n r e = replicate n (r e)--instance AdditiveMonoid () where -  zero = ()-  replicate _ () = ()-  sumWith _ _ = ()--instance (AdditiveMonoid a, AdditiveMonoid b) => AdditiveMonoid (a,b) where-  zero = (zero,zero)-  replicate n (a,b) = (replicate n a, replicate n b)--instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c) => AdditiveMonoid (a,b,c) where-  zero = (zero,zero,zero)-  replicate n (a,b,c) = (replicate n a, replicate n b, replicate n c)--instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c, AdditiveMonoid d) => AdditiveMonoid (a,b,c,d) where-  zero = (zero,zero,zero,zero)-  replicate n (a,b,c,d) = (replicate n a, replicate n b, replicate n c, replicate n d)--instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c, AdditiveMonoid d, AdditiveMonoid e) => AdditiveMonoid (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,7 +0,0 @@-module Numeric.Monoid.Multiplicative-  ( Unital(..)-  , product-  ) where--import Numeric.Monoid.Multiplicative.Internal-import Prelude ()

@@ -1,96 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Numeric.Monoid.Multiplicative.Internal-  ( Unital(..)-  , product-  , FreeUnitalAlgebra(..)-  ) where--import Data.Foldable hiding (product)-import Data.Int-import Data.Word-import Data.Sequence (Seq)-import qualified Data.Sequence as Seq-import Prelude hiding ((*), foldr, product)-import Numeric.Semiring.Internal-import Numeric.Monoid.Additive-import Numeric.Natural.Internal--infixr 8 `pow`--class Multiplicative r => Unital r where-  one :: r-  pow :: Whole n => r -> n -> r-  pow _ 0 = one-  pow x0 y0 = f x0 y0 where-    f x y -      | even y = f (x * x) (y `quot` 2)-      | y == 1 = x-      | otherwise = g (x * x) ((y - 1) `quot` 2) x-    g x y z -      | even y = g (x * x) (y `quot` 2) z-      | y == 1 = x * z-      | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)-  productWith :: Foldable f => (a -> r) -> f a -> r-  productWith f = foldl' (\b a -> b * f a) one--product :: (Foldable f, Unital r) => f r -> r-product = productWith id--instance Unital Bool where one = True-instance Unital Integer where one = 1-instance Unital Int where one = 1-instance Unital Int8 where one = 1-instance Unital Int16 where one = 1-instance Unital Int32 where one = 1-instance Unital Int64 where one = 1-instance Unital Natural where one = 1-instance Unital Word where one = 1-instance Unital Word8 where one = 1-instance Unital Word16 where one = 1-instance Unital Word32 where one = 1-instance Unital Word64 where one = 1-instance Unital () where one = ()-instance (Unital a, Unital b) => Unital (a,b) where-  one = (one,one)--instance (Unital a, Unital b, Unital c) => Unital (a,b,c) where-  one = (one,one,one)--instance (Unital a, Unital b, Unital c, Unital d) => Unital (a,b,c,d) where-  one = (one,one,one,one)--instance (Unital a, Unital b, Unital c, Unital d, Unital e) => Unital (a,b,c,d,e) where-  one = (one,one,one,one,one)---- | An associative unital algebra over a semiring, built using a free module-class (FreeAlgebra r a) => FreeUnitalAlgebra r a where-  unit :: r -> a -> r--instance (Unital r, FreeUnitalAlgebra r a) => Unital (a -> r) where-  one = unit one--instance FreeUnitalAlgebra () a where-  unit _ _ = ()--instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b) => FreeUnitalAlgebra (a -> r) b where-  unit f b a = unit (f a) b--instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b) => FreeUnitalAlgebra r (a,b) where-  unit r (a,b) = unit r a * unit r b--instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c) => FreeUnitalAlgebra r (a,b,c) where-  unit r (a,b,c) = unit r a * unit r b * unit r c--instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c, FreeUnitalAlgebra r d) => FreeUnitalAlgebra r (a,b,c,d) where-  unit r (a,b,c,d) = unit r a * unit r b * unit r c * unit r d--instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c, FreeUnitalAlgebra r d, FreeUnitalAlgebra r e) => FreeUnitalAlgebra r (a,b,c,d,e) where-  unit r (a,b,c,d,e) = unit r a * unit r b * unit r c * unit r d * unit r e--instance (AdditiveMonoid r, Semiring r) => FreeUnitalAlgebra r [a] where-  unit r [] = r-  unit _ _ = zero--instance (AdditiveMonoid r, Semiring r) => FreeUnitalAlgebra r (Seq a) where-  unit r a | Seq.null a = r-           | otherwise = zero

@@ -1,15 +0,0 @@-module Numeric.Multiplication -  ( module Numeric.Semigroup.Multiplicative-  , module Numeric.Monoid.Multiplicative-  , module Numeric.Group.Multiplicative-  , module Numeric.Multiplication.Commutative-  , module Numeric.Multiplication.Involutive-  , module Numeric.Multiplication.Factorable-  ) where--import Numeric.Semigroup.Multiplicative-import Numeric.Monoid.Multiplicative-import Numeric.Group.Multiplicative-import Numeric.Multiplication.Commutative-import Numeric.Multiplication.Involutive-import Numeric.Multiplication.Factorable

@@ -1,28 +0,0 @@-module Numeric.Multiplication.Commutative where--import Data.Int-import Data.Word-import Numeric.Semigroup.Multiplicative-import Numeric.Natural---- | A commutative multiplicative semigroup-class Multiplicative r => Commutative r--instance Commutative () -instance Commutative Bool-instance Commutative Integer-instance Commutative Int-instance Commutative Int8-instance Commutative Int16-instance Commutative Int32-instance Commutative Int64-instance Commutative Natural-instance Commutative Word-instance Commutative Word8-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) 

@@ -1,49 +0,0 @@-module Numeric.Multiplication.Factorable-  ( -- * Partitionable Additive Semigroups-    Factorable(..)-  ) where--import Data.List.NonEmpty-import Numeric.Semigroup.Multiplicative-import Prelude hiding (concat)---- | `factorWith f c` returns a non-empty list containing `f a b` for all `a, b` such that `a * b = c`.------ Results of factorWith f 0 are undefined and may result in either an error or an infinite list.--class Multiplicative m => Factorable m where-  factorWith :: (m -> m -> r) -> m -> NonEmpty r--instance Factorable Bool where-  factorWith f False = f False False :| [f False True, f True False]-  factorWith f True  = f True True :| []--instance Factorable () where-  factorWith f () = f () () :| []--concat :: NonEmpty (NonEmpty a) -> NonEmpty a-concat m = m >>= id--instance (Factorable a, Factorable b) => Factorable (a,b) where-  factorWith f (a,b) = concat $ factorWith (\ax ay ->-                                factorWith (\bx by -> f (ax,bx) (ay,by)) b) a--instance (Factorable a, Factorable b, Factorable c) => Factorable (a,b,c) where-  factorWith f (a,b,c) = concat $ factorWith (\ax ay ->-                            concat $ factorWith (\bx by ->-                                     factorWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a--instance (Factorable a, Factorable b, Factorable c,Factorable d ) => Factorable (a,b,c,d) where-  factorWith f (a,b,c,d) = concat $ factorWith (\ax ay ->-                           concat $ factorWith (\bx by ->-                           concat $ factorWith (\cx cy ->-                                    factorWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a--instance (Factorable a, Factorable b, Factorable c,Factorable d, Factorable e) => Factorable (a,b,c,d,e) where-  factorWith f (a,b,c,d,e) = concat $ factorWith (\ax ay ->-                             concat $ factorWith (\bx by ->-                             concat $ factorWith (\cx cy ->-                             concat $ factorWith (\dx dy ->-                                      factorWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a--

@@ -1,42 +0,0 @@-module Numeric.Multiplication.Involutive-  ( InvolutiveMultiplication(..)-  , adjointCommutative-  ) where--import Data.Int-import Data.Word-import Numeric.Natural.Internal-import Numeric.Semigroup.Multiplicative-import Numeric.Multiplication.Commutative---- | An semigroup with involution--- --- > adjoint a * adjoint b = adjoint (b * a)-class Multiplicative r => InvolutiveMultiplication r where-  adjoint :: r -> r--adjointCommutative :: Commutative r => r -> r-adjointCommutative = id--instance InvolutiveMultiplication Int where adjoint = id-instance InvolutiveMultiplication Integer where adjoint = id-instance InvolutiveMultiplication Int8 where adjoint = id-instance InvolutiveMultiplication Int16 where adjoint = id-instance InvolutiveMultiplication Int32 where adjoint = id-instance InvolutiveMultiplication Int64 where adjoint = id-instance InvolutiveMultiplication Bool where adjoint = id-instance InvolutiveMultiplication Word where adjoint = id-instance InvolutiveMultiplication Natural where adjoint = id-instance InvolutiveMultiplication Word8 where adjoint = id-instance InvolutiveMultiplication Word16 where adjoint = id-instance InvolutiveMultiplication Word32 where adjoint = id-instance InvolutiveMultiplication Word64 where adjoint = id-instance InvolutiveMultiplication () where adjoint = id-instance (InvolutiveMultiplication a, InvolutiveMultiplication b) => InvolutiveMultiplication (a,b) where-  adjoint (a,b) = (adjoint a, adjoint b)-instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c) => InvolutiveMultiplication (a,b,c) where-  adjoint (a,b,c) = (adjoint a, adjoint b, adjoint c)-instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d) => InvolutiveMultiplication (a,b,c,d) where-  adjoint (a,b,c,d) = (adjoint a, adjoint b, adjoint c, adjoint d)-instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d, InvolutiveMultiplication e) => InvolutiveMultiplication (a,b,c,d,e) where-  adjoint (a,b,c,d,e) = (adjoint a, adjoint b, adjoint c, adjoint d, adjoint e)

@@ -1,9 +0,0 @@-module Numeric.Order-  ( module Numeric.Order.Class-  , module Numeric.Order.Additive-  , module Numeric.Rig.Ordered-  ) where--import Numeric.Order.Class-import Numeric.Order.Additive-import Numeric.Rig.Ordered

@@ -2,8 +2,8 @@   ( AdditiveOrder   ) where -import Numeric.Natural-import Numeric.Semigroup.Additive+import Numeric.Natural.Internal+import Numeric.Additive.Class import Numeric.Order.Class  -- An additive semigroup with a partial order (<=)

@@ -5,7 +5,7 @@  import Data.Int import Data.Word-import Numeric.Natural+import Numeric.Natural.Internal  -- a partial order (a, <=) class Order a where

@@ -1,126 +0,0 @@-{-# LANGUAGE TypeOperators, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-}-module Numeric.Polynomial.Basis.Power -  ( -  -- * Power basis-    (:^)(Power, logPower)-  , (^:)-  -- * Variables-  , W(..), X(..), Y(..), Z(..)-  , x-  , at-  , delta-  , coef-  ) where--import Control.Applicative-import Data.Foldable-import Data.Function (on)-import Data.Proxy-import Data.Reflection-import Data.Functor.Representable.Trie-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Traversable-import Numeric.Addition-import Numeric.Algebra.Free-import Numeric.Multiplication-import Numeric.Decidable.Zero-import Numeric.Decidable.Units-import Numeric.Semiring.Class-import Numeric.Rig.Class-import Numeric.Functional.Linear-import Numeric.Natural.Internal-import Prelude hiding ((^),(+),(-),(*),negate, replicate,subtract)--infixr 8 :^,^:--newtype x:^n = Power { logPower :: n } deriving (Eq,Ord)---- convenient constructor --- X ^: 12-(^:) :: x -> n -> x :^ n-_ ^: n = Power n--data W = W deriving Show; instance Reifies W W where reflect _ = W-  -data X = X deriving Show; instance Reifies X X where reflect _ = X--data Y = Y deriving Show; instance Reifies Y Y where reflect _ = Y--data Z = Z deriving Show; instance Reifies Z Z where reflect _ = Z--instance (Show t, Reifies x t, Show n) => Show (x:^n) where-  showsPrec d p = showParen (d > 8) $-   showsPrec 9 (reflect (proxyX p)) . showString "^:" . showsPrec 8 (logPower p) where-      proxyX :: x:^n -> Proxy x-      proxyX _ = Proxy--instance Functor ((:^) x) where-  fmap f (Power n) = Power (f n)--instance Foldable ((:^) x) where-  foldMap f (Power n) = f n--instance Traversable ((:^) x) where-  traverse f (Power n) = Power <$> f n--instance Foldable1 ((:^) x) where-  foldMap1 f (Power n) = f n--instance Traversable1 ((:^) x) where-  traverse1 f (Power n) = Power <$> f n--instance HasTrie n => HasTrie (x :^ n) where-  type BaseTrie (x :^ n) = BaseTrie n-  embedKey = embedKey . logPower-  projectKey = Power . projectKey--instance Additive n => Multiplicative (x :^ n) where-  Power n * Power m = Power (n + m)-  pow1p (Power n) m = Power (replicate1p m n)--instance AdditiveMonoid n => Unital (x :^ n) where-  one = Power zero-  pow (Power n) m = Power (replicate m n)--instance AdditiveGroup n => MultiplicativeGroup (x :^ n) where-  Power n / Power m = Power (n - m)-  recip (Power n) = Power (negate n)-  Power n \\ Power m = Power (subtract n m)-  Power n ^ m = Power (times m n)--instance DecidableZero n => DecidableUnits (x :^ n) where-  recipUnit (Power n) | isZero n  = Just (Power n)-                      | otherwise = Nothing--instance Partitionable n => Factorable (x :^ n) where-  factorWith f = partitionWith (f `on` Power) . logPower --instance (Semiring r, Additive n) => FreeCoalgebra r (x :^ n) where-  cojoin f i j = f $ i * j--instance (Semiring r, AdditiveMonoid n) => FreeCounitalCoalgebra r (x :^ n) where-  counit f = f one--instance (Semiring r, Partitionable n) => FreeAlgebra r (x :^ n) where-  join f = sum1 . partitionWith (f `on` Power) . logPower--instance (Semiring r, AdditiveMonoid r, Unital r, DecidableZero n, Partitionable n) => FreeUnitalAlgebra r (x :^ n) where-  unit r (Power n) | isZero n  = r-                   | otherwise = zero--x :: Unital n => Linear r (x:^n)-x = Linear $ \k -> k $ Power one---- the price of this approach is the loss of Horner's scheme-at :: (Unital r, Whole n) => Linear r (x:^n) -> r -> r-m `at` r = m $* pow r . logPower--delta :: (Rig r, Eq a) => a -> a -> r-delta i j | i == j = one-          | otherwise = zero---- extract the nth coefficient of a polynomial-coef :: (Rig r, Eq n) => n -> Linear r (x:^n) -> r-coef n m = m $* delta (Power n)-

@@ -0,0 +1,86 @@+{-# LANGUAGE MultiParamTypeClasses, IncoherentInstances, OverlappingInstances, FlexibleInstances #-}+module Numeric.Quadrance.Class+  ( Quadrance(..)+  ) where++import Data.Int+import Data.Word+import Numeric.Additive.Class+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Rig.Class+import Numeric.Natural.Internal+import Prelude hiding ((+),(*))++-- a module with a computable squared norm+class Additive r => Quadrance r m where+  quadrance :: m -> r++instance Quadrance () a where +  quadrance _ = ()++instance Monoidal r => Quadrance r () where+  quadrance _ = zero++instance (Quadrance r a, Quadrance r b) => Quadrance r (a,b) where+  quadrance (a,b) = quadrance a + quadrance b++instance (Quadrance r a, Quadrance r b, Quadrance r c) => Quadrance r (a,b,c) where+  quadrance (a,b,c) = quadrance a + quadrance b + quadrance c++instance (Quadrance r a, Quadrance r b, Quadrance r c, Quadrance r d) => Quadrance r (a,b,c,d) where+  quadrance (a,b,c,d) = quadrance a + quadrance b + quadrance c + quadrance d++instance (Quadrance r a, Quadrance r b, Quadrance r c, Quadrance r d, Quadrance r e) => Quadrance r (a,b,c,d,e) where+  quadrance (a,b,c,d,e) = quadrance a + quadrance b + quadrance c + quadrance d + quadrance e++instance Rig r => Quadrance r Bool where+  quadrance False = zero+  quadrance True  = one++sq :: Multiplicative r => r -> r+sq r = r * r++instance Rig r => Quadrance r Int where+  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Word where+  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Natural where+  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Integer where +  quadrance = fromNatural . Natural . fromInteger . sq++instance Rig r => Quadrance r Int8 where +  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Int16 where +  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Int32 where+  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Int64 where+  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Word8 where +  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Word16 where +  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Word32 where+  quadrance = fromNatural . Natural . sq . toInteger++instance Rig r => Quadrance r Word64 where+  quadrance = fromNatural . Natural . sq . toInteger++{-+instance InvolutiveSemiring r => Quadrance r (Complex r) where+  quadrance n = e (adjoint n * n)++instance InvolutiveSemiring r => Quadrance r (Quaternion r) where+  quadrance n = e (adjoint n * n)+-}

@@ -1,9 +0,0 @@-module Numeric.Rig-  ( module Numeric.Rig.Class-  , module Numeric.Rig.Ordered-  , module Numeric.Rig.Characteristic-  ) where--import Numeric.Rig.Class-import Numeric.Rig.Ordered-import Numeric.Rig.Characteristic

@@ -2,32 +2,26 @@   ( Characteristic(..)   , charInt   , charWord-  , frobenius   ) where  import Data.Int import Data.Word-import Data.Proxy import Numeric.Rig.Class-import Numeric.Ring.Endomorphism import Numeric.Natural.Internal-import Numeric.Monoid.Multiplicative import Prelude hiding ((^)) -class Rig r => Characteristic r where-  char :: Proxy r -> Natural---- the frobenius ring endomorphism (assuming the characteristic is prime)-frobenius :: Characteristic r => End r-frobenius = End $ \r -> r `pow` char (ofRing r)+data Proxy p = Proxy -ofRing :: r -> Proxy r-ofRing _ = Proxy+class Rig r => Characteristic r where+  char :: proxy r -> Natural -charInt :: (Integral s, Bounded s) => Proxy s -> Natural+charInt :: (Integral s, Bounded s) => proxy s -> Natural charInt p = 2 * fromIntegral (maxBound `asProxyTypeOf` p) + 2 -charWord :: (Whole s, Bounded s) => Proxy s -> Natural+asProxyTypeOf :: a -> p a -> a+asProxyTypeOf = const++charWord :: (Whole s, Bounded s) => proxy s -> Natural charWord p = toNatural (maxBound `asProxyTypeOf` p) + 1  -- | NB: we're using the boolean semiring, not the boolean ring@@ -48,40 +42,40 @@  instance (Characteristic a, Characteristic b) => Characteristic (a,b) where   char p = char (a p) `lcm` char (b p) where-    a :: Proxy (a,b) -> Proxy a+    a :: proxy (a,b) -> Proxy a     a _ = Proxy-    b :: Proxy (a,b) -> Proxy b+    b :: proxy (a,b) -> Proxy b     b _ = Proxy  instance (Characteristic a, Characteristic b, Characteristic c) => Characteristic (a,b,c) where   char p = char (a p) `lcm` char (b p) `lcm` char (c p) where-    a :: Proxy (a,b,c) -> Proxy a+    a :: proxy (a,b,c) -> Proxy a     a _ = Proxy-    b :: Proxy (a,b,c) -> Proxy b+    b :: proxy (a,b,c) -> Proxy b     b _ = Proxy-    c :: Proxy (a,b,c) -> Proxy c+    c :: proxy (a,b,c) -> Proxy c     c _ = Proxy  instance (Characteristic a, Characteristic b, Characteristic c, Characteristic d) => Characteristic (a,b,c,d) where   char p = char (a p) `lcm` char (b p) `lcm` char (c p) `lcm` char (d p) where-    a :: Proxy (a,b,c,d) -> Proxy a+    a :: proxy (a,b,c,d) -> Proxy a     a _ = Proxy-    b :: Proxy (a,b,c,d) -> Proxy b+    b :: proxy (a,b,c,d) -> Proxy b     b _ = Proxy-    c :: Proxy (a,b,c,d) -> Proxy c+    c :: proxy (a,b,c,d) -> Proxy c     c _ = Proxy-    d :: Proxy (a,b,c,d) -> Proxy d+    d :: proxy (a,b,c,d) -> Proxy d     d _ = Proxy  instance (Characteristic a, Characteristic b, Characteristic c, Characteristic d, Characteristic e) => Characteristic (a,b,c,d,e) where   char p = char (a p) `lcm` char (b p) `lcm` char (c p) `lcm` char (d p) `lcm` char (e p) where-    a :: Proxy (a,b,c,d,e) -> Proxy a+    a :: proxy (a,b,c,d,e) -> Proxy a     a _ = Proxy-    b :: Proxy (a,b,c,d,e) -> Proxy b+    b :: proxy (a,b,c,d,e) -> Proxy b     b _ = Proxy-    c :: Proxy (a,b,c,d,e) -> Proxy c+    c :: proxy (a,b,c,d,e) -> Proxy c     c _ = Proxy-    d :: Proxy (a,b,c,d,e) -> Proxy d+    d :: proxy (a,b,c,d,e) -> Proxy d     d _ = Proxy-    e :: Proxy (a,b,c,d,e) -> Proxy e+    e :: proxy (a,b,c,d,e) -> Proxy e     e _ = Proxy

@@ -4,9 +4,8 @@   , fromWhole   ) where -import Numeric.Monoid.Additive-import Numeric.Monoid.Multiplicative-import Numeric.Semiring.Class+import Numeric.Algebra.Class+import Numeric.Algebra.Unital import Data.Int import Data.Word import Prelude (Integer, Bool, Num(fromInteger),(/=),id,(.))@@ -16,8 +15,7 @@ fromNaturalNum (Natural n) = fromInteger n  -- | A Ring without (n)egation--class (Semiring r, AdditiveMonoid r, Unital r) => Rig r where+class (Semiring r, Unital r, Monoidal r) => Rig r where   fromNatural :: Natural -> r   fromNatural n = replicate n one 

@@ -1,11 +0,0 @@-module Numeric.Ring-  ( module Numeric.Ring.Class-  , module Numeric.Ring.Endomorphism-  , module Numeric.Ring.Opposite-  , module Numeric.Ring.Rng-  ) where--import Numeric.Ring.Class-import Numeric.Ring.Endomorphism-import Numeric.Ring.Opposite-import Numeric.Ring.Rng

@@ -7,8 +7,8 @@ import Data.Word import Numeric.Rig.Class import Numeric.Rng.Class-import Numeric.Group.Additive-import Numeric.Monoid.Multiplicative+import Numeric.Additive.Group+import Numeric.Algebra.Unital import qualified Prelude import Prelude (Integral(toInteger), Integer, (.)) 

@@ -3,17 +3,13 @@   ( End(..)   , toEnd   , fromEnd+  , frobenius   ) where  import Data.Monoid-import Numeric.Addition-import Numeric.Module-import Numeric.Multiplication-import Numeric.Semiring.Class-import Numeric.Rng.Class-import Numeric.Rig.Class-import Numeric.Ring.Class+import Numeric.Algebra import Prelude hiding ((*),(+),(-),negate,subtract)+import Data.Proxy  -- | The endomorphism ring of an abelian group or the endomorphism semiring of an abelian monoid -- @@ -25,9 +21,9 @@ instance Additive r => Additive (End r) where   End f + End g = End (f + g) instance Abelian r => Abelian (End r)-instance AdditiveMonoid r => AdditiveMonoid (End r) where+instance Monoidal r => Monoidal (End r) where   zero = End (const zero)-instance AdditiveGroup r => AdditiveGroup (End r) where+instance Group r => Group (End r) where   End f - End g = End (f - g)   negate (End f) = End (negate f)   subtract (End f) (End g) = End (subtract f g)@@ -36,19 +32,19 @@ instance Unital (End r) where   one = End id instance (Abelian r, Commutative r) => Commutative (End r) -instance (Abelian r, AdditiveMonoid r) => Semiring (End r)-instance (Abelian r, AdditiveMonoid r) => Rig (End r)-instance (Abelian r, AdditiveGroup r) => Rng (End r)-instance (Abelian r, AdditiveGroup r) => Ring (End r)-instance (AdditiveMonoid m, Abelian m) => LeftModule (End m) (End m) where+instance (Abelian r, Monoidal r) => Semiring (End r)+instance (Abelian r, Monoidal r) => Rig (End r)+instance (Abelian r, Group r) => Ring (End r)+instance (Monoidal m, Abelian m) => LeftModule (End m) (End m) where   End f .* End g = End (f . g)-instance (AdditiveMonoid m, Abelian m) => RightModule (End m) (End m) where+instance (Monoidal m, Abelian m) => RightModule (End m) (End m) where   End f *. End g = End (f . g) instance LeftModule r m => LeftModule r (End m) where   r .* End f = End (\e -> r .* f e) instance RightModule r m => RightModule r (End m) where   End f *. r = End (\e -> f e *. r) +-- TODO: Involutive? Invertible? -- instance SimpleAdditiveAbelianGroup r => DivisionRing (End r) where  -- ring isomorphism from r to the endomorphism ring of r.@@ -58,3 +54,11 @@ -- ring isomorphism from the endormorphism ring of r to r. fromEnd :: Unital r => End r -> r fromEnd (End f) = f one++-- the frobenius ring endomorphism (assuming the characteristic is prime)+frobenius :: Characteristic r => End r+frobenius = End $ \r -> r `pow` char (ofRing r)++ofRing :: r -> Proxy r+ofRing _ = Proxy+

@@ -8,14 +8,7 @@ import Data.Semigroup.Foldable import Data.Semigroup.Traversable import Data.Traversable-import Numeric.Addition-import Numeric.Multiplication-import Numeric.Module-import Numeric.Band.Class-import Numeric.Semiring.Class-import Numeric.Rig.Class-import Numeric.Rng.Class-import Numeric.Ring.Class+import Numeric.Algebra import Numeric.Decidable.Associates import Numeric.Decidable.Units import Numeric.Decidable.Zero@@ -41,7 +34,7 @@   Opposite a + Opposite b = Opposite (a + b)   replicate1p n (Opposite a) = Opposite (replicate1p n a)   sumWith1 f = Opposite . sumWith1 (runOpposite . f)-instance AdditiveMonoid r => AdditiveMonoid (Opposite r) where+instance Monoidal r => Monoidal (Opposite r) where   zero = Opposite zero   replicate n (Opposite a) = Opposite (replicate n a)   sumWith f = Opposite . sumWith (runOpposite . f)@@ -53,7 +46,7 @@   Opposite s *. r = Opposite (r .* s) instance Semiring r => RightModule (Opposite r) (Opposite r) where   (*.) = (*)-instance AdditiveGroup r => AdditiveGroup (Opposite r) where+instance Group r => Group (Opposite r) where   negate = Opposite . negate . runOpposite   Opposite a - Opposite b = Opposite (a - b)   subtract (Opposite a) (Opposite b) = Opposite (subtract a b)@@ -74,12 +67,11 @@ instance Unital r => Unital (Opposite r) where   one = Opposite one   pow (Opposite a) n = Opposite (pow a n)-instance MultiplicativeGroup r => MultiplicativeGroup (Opposite r) where+instance Division r => Division (Opposite r) where   recip = Opposite . recip . runOpposite   Opposite a / Opposite b = Opposite (b \\ a)   Opposite a \\ Opposite b = Opposite (b / a)   Opposite a ^ n = Opposite (a ^ n) instance Semiring r => Semiring (Opposite r)-instance Rng r => Rng (Opposite r) instance Rig r => Rig (Opposite r) instance Ring r => Ring (Opposite r)

@@ -5,14 +5,7 @@   , liftRngHom   ) where -import Numeric.Addition-import Numeric.Module-import Numeric.Natural.Internal-import Numeric.Multiplication-import Numeric.Rig.Class-import Numeric.Rng.Class-import Numeric.Ring.Class-import Numeric.Semiring.Class+import Numeric.Algebra import Prelude hiding ((+),(-),(*),(/),replicate,negate,subtract,fromIntegral)  -- | The free Ring given a Rng obtained by adjoining Z, such that@@ -28,23 +21,23 @@  instance Abelian r => Abelian (RngRing r) -instance (Abelian r, AdditiveMonoid r) => LeftModule Natural (RngRing r) where+instance (Abelian r, Monoidal r) => LeftModule Natural (RngRing r) where   n .* RngRing m a = RngRing (toInteger n * m) (replicate n a) -instance (Abelian r, AdditiveMonoid r) => RightModule Natural (RngRing r) where+instance (Abelian r, Monoidal r) => RightModule Natural (RngRing r) where   RngRing m a *. n = RngRing (toInteger n * m) (replicate n a) -instance (Abelian r, AdditiveMonoid r) => AdditiveMonoid (RngRing r) where+instance (Abelian r, Monoidal r) => Monoidal (RngRing r) where   zero = RngRing 0 zero   replicate n (RngRing m a) = RngRing (toInteger n * m) (replicate n a) -instance (Abelian r, AdditiveGroup r) => LeftModule Integer (RngRing r) where+instance (Abelian r, Group r) => LeftModule Integer (RngRing r) where   n .* RngRing m a = RngRing (toInteger n * m) (times n a) -instance (Abelian r, AdditiveGroup r) => RightModule Integer (RngRing r) where+instance (Abelian r, Group r) => RightModule Integer (RngRing r) where   RngRing m a *. n = RngRing (toInteger n * m) (times n a) -instance (Abelian r, AdditiveGroup r) => AdditiveGroup (RngRing r) where+instance (Abelian r, Group r) => Group (RngRing r) where   RngRing n a - RngRing m b = RngRing (n - m) (a - b)   negate (RngRing n a) = RngRing (negate n) (negate a)   subtract (RngRing n a) (RngRing m b) = RngRing (subtract n m) (subtract a b)@@ -64,12 +57,10 @@ instance Rng r => Unital (RngRing r) where   one = RngRing 1 zero -instance (Rng r, MultiplicativeGroup r) => MultiplicativeGroup (RngRing r) where+instance (Rng r, Division r) => Division (RngRing r) where   RngRing n a / RngRing m b = RngRing 0 $ (times n one + a) / (times m one + b)  instance Rng r => Semiring (RngRing r) --instance Rng r => Rng (RngRing r)  instance Rng r => Rig (RngRing r) 

@@ -1,11 +0,0 @@-module Numeric.Rng-  ( module Numeric.Group.Additive-  , module Numeric.Semiring-  , module Numeric.Rng.Class-  , module Numeric.Rng.Zero-  ) where--import Numeric.Group.Additive-import Numeric.Semiring-import Numeric.Rng.Class-import Numeric.Rng.Zero

@@ -1,28 +1,12 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-} module Numeric.Rng.Class   ( Rng   ) where -import Numeric.Group.Additive-import Numeric.Semiring-import Data.Int-import Data.Word+import Numeric.Additive.Group+import Numeric.Algebra.Class  -- | A Ring without an /i/dentity. -class (AdditiveGroup r, Semiring r) => Rng r where-instance Rng Integer-instance Rng Int-instance Rng Int8-instance Rng Int16-instance Rng Int32-instance Rng Int64-instance Rng Word-instance Rng Word8-instance Rng Word16-instance Rng Word32-instance Rng Word64-instance Rng ()-instance (Rng a, Rng b) => Rng (a, b)-instance (Rng a, Rng b, Rng c) => Rng (a, b, c)-instance (Rng a, Rng b, Rng c, Rng d) => Rng (a, b, c, d)-instance (Rng a, Rng b, Rng c, Rng d, Rng e) => Rng (a, b, c, d, e)+class (Group r, Semiring r) => Rng r+instance (Group r, Semiring r) => Rng r

@@ -3,12 +3,7 @@   ( ZeroRng(..)   ) where -import Numeric.Addition-import Numeric.Multiplication-import Numeric.Module-import Numeric.Semiring.Class-import Numeric.Rng.Class-import Numeric.Natural.Internal+import Numeric.Algebra import Data.Foldable (toList) import Prelude hiding ((+),(-),negate,subtract,replicate) @@ -29,32 +24,32 @@  instance Abelian r => Abelian (ZeroRng r) -instance AdditiveMonoid r => AdditiveMonoid (ZeroRng r) where+instance Monoidal r => Monoidal (ZeroRng r) where   zero = ZeroRng zero   sumWith f = ZeroRng . sumWith (runZeroRng . f)   replicate n (ZeroRng a) = ZeroRng (replicate n a)   -instance AdditiveGroup r => AdditiveGroup (ZeroRng r) where+instance Group r => Group (ZeroRng r) where   ZeroRng a - ZeroRng b = ZeroRng (a - b)   negate (ZeroRng a) = ZeroRng (negate a)   subtract (ZeroRng a) (ZeroRng b) = ZeroRng (subtract a b)   times n (ZeroRng a) = ZeroRng (times n a) -instance AdditiveMonoid r => Multiplicative (ZeroRng r) where+instance Monoidal r => Multiplicative (ZeroRng r) where   _ * _ = zero   productWith1 f as = case toList as of     [] -> error "productWith1: empty Foldable1"     [a] -> f a     _   -> zero -instance (AdditiveMonoid r, Abelian r) => Semiring (ZeroRng r)-instance AdditiveMonoid r => Commutative (ZeroRng r)-instance (AdditiveGroup r, Abelian r) => Rng (ZeroRng r)-instance AdditiveMonoid r => LeftModule Natural (ZeroRng r) where+instance (Monoidal r, Abelian r) => Semiring (ZeroRng r)+instance Monoidal r => Commutative (ZeroRng r)+instance (Group r, Abelian r) => Rng (ZeroRng r)+instance Monoidal r => LeftModule Natural (ZeroRng r) where   (.*) = replicate-instance AdditiveMonoid r => RightModule Natural (ZeroRng r) where+instance Monoidal r => RightModule Natural (ZeroRng r) where   m *. n = replicate n m-instance AdditiveGroup r => LeftModule Integer (ZeroRng r) where+instance Group r => LeftModule Integer (ZeroRng r) where   (.*) = times-instance AdditiveGroup r => RightModule Integer (ZeroRng r) where+instance Group r => RightModule Integer (ZeroRng r) where   m *. n = times n m

@@ -1,19 +0,0 @@-module Numeric.Semigroup-  ( module Numeric.Semigroup.Additive-  , module Numeric.Semigroup.Multiplicative-  , module Numeric.Addition.Abelian-  , module Numeric.Addition.Idempotent-  , module Numeric.Order.Additive-  , module Numeric.Band-  , module Numeric.Multiplication.Commutative-  , module Numeric.Multiplication.Involutive-  ) where--import Numeric.Semigroup.Additive-import Numeric.Semigroup.Multiplicative-import Numeric.Addition.Abelian-import Numeric.Addition.Idempotent-import Numeric.Order.Additive-import Numeric.Band-import Numeric.Multiplication.Commutative-import Numeric.Multiplication.Involutive

@@ -1,123 +0,0 @@-module Numeric.Semigroup.Additive-  ( -  -- * Additive Semigroups-    Additive(..)-  , sum1-  ) where--import qualified Prelude-import Prelude hiding ((+), replicate)-import Data.Int-import Data.Word-import Data.Semigroup.Foldable-import Data.Foldable-import Numeric.Natural.Internal--infixl 6 +---- | --- > (a + b) + c = a + (b + c)--- > replicate 1 a = a--- > replicate (2 * n) a = replicate n a + replicate n a--- > replicate (2 * n + 1) a = replicate n a + replicate n a + a-class Additive r where-  (+) :: r -> r -> r--  -- | replicate1p n r = replicate (1 + n) r-  replicate1p :: Whole n => n -> r -> r-  replicate1p y0 x0 = f x0 (1 Prelude.+ y0)-    where-      f x y-        | even y = f (x + x) (y `quot` 2)-        | y == 1 = x-        | otherwise = g (x + x) (unsafePred y  `quot` 2) x-      g x y z-        | even y = g (x + x) (y `quot` 2) z-        | y == 1 = x + z-        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)--  sumWith1 :: Foldable1 f => (a -> r) -> f a -> r-  sumWith1 f = maybe (error "Numeric.Additive.Semigroup.sumWith1: empty structure") id . foldl' mf Nothing-     where mf Nothing y = Just $! f y -           mf (Just x) y = Just $! x + f y--sum1 :: (Foldable1 f, Additive r) => f r -> r-sum1 = sumWith1 id--instance Additive r => Additive (b -> r) where-  f + g = \e -> f e + g e -  replicate1p n f e = replicate1p n (f e)-  sumWith1 f xs e = sumWith1 (`f` e) xs--instance Additive Bool where-  (+) = (||)-  replicate1p _ a = a--instance Additive Natural where-  (+) = (Prelude.+)-  replicate1p n r = (1 Prelude.+ toNatural n) * r--instance Additive Integer where -  (+) = (Prelude.+)-  replicate1p n r = (1 Prelude.+ toInteger n) * r--instance Additive Int where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Int8 where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Int16 where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Int32 where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Int64 where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word8 where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word16 where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word32 where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word64 where-  (+) = (Prelude.+)-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive () where-  _ + _ = ()-  replicate1p _ _ = () -  sumWith1 _ _ = ()--instance (Additive a, Additive b) => Additive (a,b) where-  (a,b) + (i,j) = (a + i, b + j)-  replicate1p n (a,b) = (replicate1p n a, replicate1p n b)--instance (Additive a, Additive b, Additive c) => Additive (a,b,c) where-  (a,b,c) + (i,j,k) = (a + i, b + j, c + k)-  replicate1p n (a,b,c) = (replicate1p n a, replicate1p n b, replicate1p n c)--instance (Additive a, Additive b, Additive c, Additive d) => Additive (a,b,c,d) where-  (a,b,c,d) + (i,j,k,l) = (a + i, b + j, c + k, d + l)-  replicate1p n (a,b,c,d) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d)--instance (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (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)-  replicate1p n (a,b,c,d,e) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d, replicate1p n e)

@@ -1,7 +0,0 @@-module Numeric.Semigroup.Multiplicative-  ( Multiplicative(..)-  , pow1pIntegral-  , product1-  ) where--import Numeric.Semiring.Internal

@@ -1,9 +0,0 @@-module Numeric.Semiring-  ( module Numeric.Semiring.Class-  , module Numeric.Semiring.Integral-  , module Numeric.Semiring.Involutive-  ) where--import Numeric.Semiring.Class-import Numeric.Semiring.Integral-import Numeric.Semiring.Involutive

@@ -1,5 +0,0 @@-module Numeric.Semiring.Class-  ( Semiring-  ) where--import Numeric.Semiring.Internal

@@ -2,12 +2,13 @@   ( IntegralSemiring   ) where -import Numeric.Semiring.Class-import Numeric.Monoid.Additive+import Numeric.Algebra.Class import Numeric.Natural.Internal --- a * b = 0 implies a == 0 || b == 0-class (AdditiveMonoid r, Semiring r) => IntegralSemiring r+-- | An integral semiring has no zero divisors+--+-- > a * b = 0 implies a == 0 || b == 0+class (Monoidal r, Semiring r) => IntegralSemiring r  instance IntegralSemiring Integer instance IntegralSemiring Natural

@@ -1,202 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--- This package is an unfortunate ball of mud forced on me by mutual dependencies-module Numeric.Semiring.Internal-  ( -  -- * Multiplicative Semigroups-    Multiplicative(..)-  , pow1pIntegral-  , product1-  -- * Semirings-  , Semiring-  -- * Associative algebras of free semigroups over semirings-  , FreeAlgebra(..)-  ) where--import Data.Foldable hiding (sum, concat)-import Data.Semigroup.Foldable-import Data.Int-import Data.Sequence hiding (reverse)-import qualified Data.Sequence as Seq-import Data.Word-import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)-import qualified Prelude-import Numeric.Natural.Internal-import Numeric.Semigroup.Additive-import Numeric.Addition.Abelian--infixr 8 `pow1p`-infixl 7 *---- | A multiplicative semigroup-class Multiplicative r where-  (*) :: r -> r -> r --  -- pow1p x n = pow x (1 + n)-  pow1p :: Whole n => r -> n -> r-  pow1p x0 y0 = f x0 (y0 Prelude.+ 1) where-    f x y -      | even y = f (x * x) (y `quot` 2)-      | y == 1 = x-      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) x-    g x y z -      | even y = g (x * x) (y `quot` 2) z-      | y == 1 = x * z-      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) (x * z)--  productWith1 :: Foldable1 f => (a -> r) -> f a -> r-  productWith1 f = maybe (error "Numeric.Multiplicative.Semigroup.productWith1: empty structure") id . foldl' mf Nothing-    where -      mf Nothing y = Just $! f y-      mf (Just x) y = Just $! x * f y--product1 :: (Foldable1 f, Multiplicative r) => f r -> r-product1 = productWith1 id--pow1pIntegral :: (Integral r, Integral n) => r -> n -> r-pow1pIntegral r n = r ^ (1 Prelude.+ n)--instance Multiplicative Bool where-  (*) = (&&)-  pow1p m _ = m--instance Multiplicative Natural where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Integer where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Int where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Int8 where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Int16 where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Int32 where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Int64 where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Word where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Word8 where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Word16 where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Word32 where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative Word64 where-  (*) = (Prelude.*)-  pow1p = pow1pIntegral--instance Multiplicative () where-  _ * _ = ()-  pow1p _ _ = ()--instance (Multiplicative a, Multiplicative b) => Multiplicative (a,b) where-  (a,b) * (c,d) = (a * c, b * d)--instance (Multiplicative a, Multiplicative b, Multiplicative c) => Multiplicative (a,b,c) where-  (a,b,c) * (i,j,k) = (a * i, b * j, c * k)--instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d) => Multiplicative (a,b,c,d) where-  (a,b,c,d) * (i,j,k,l) = (a * i, b * j, c * k, d * l)--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)---- | A pair of an additive abelian semigroup, and a multiplicative semigroup, with the distributive laws:--- --- > a(b + c) = ab + ac--- > (a + b)c = ac + bc------ Common notation includes the laws for additive and multiplicative identity in semiring.------ If you want that, look at 'Rig' instead.------ Ideally we'd use the cyclic definition:------ > class (LeftModule r r, RightModule r r, Additive r, Abelian r, Multiplicative r) => Semiring r------ to enforce that every semiring r is an r-module over itself, but Haskell doesn't like that.-class (Additive r, Abelian r, Multiplicative r) => Semiring r--instance Semiring Integer-instance Semiring Natural-instance Semiring Bool-instance Semiring Int-instance Semiring Int8-instance Semiring Int16-instance Semiring Int32-instance Semiring Int64-instance Semiring Word-instance Semiring Word8-instance Semiring Word16-instance Semiring Word32-instance Semiring Word64-instance Semiring ()-instance (Semiring a, Semiring b) => Semiring (a, b)-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)---- | An associative algebra built with a free module over a semiring-class Semiring r => FreeAlgebra r a where-  join :: (a -> a -> r) -> a -> r--instance FreeAlgebra r a => Multiplicative (a -> r) where-  f * g = join $ \a b -> f a * g b--instance FreeAlgebra r a => Semiring (a -> r) --  -instance FreeAlgebra () a where-  join _ _ = ()---- | The tensor algebra-instance Semiring r => FreeAlgebra r [a] where-  join f = go [] where-    go ls rrs@(r:rs) = f (reverse ls) rrs + go (r:ls) rs-    go ls [] = f (reverse ls) []---- | The tensor algebra-instance Semiring r => FreeAlgebra r (Seq a) where-  join f = go Seq.empty where-    go ls s = case viewl s of-       EmptyL -> f ls s -       r :< rs -> f ls s + go (ls |> r) rs--instance (FreeAlgebra r a, FreeAlgebra r b) => FreeAlgebra r (a,b) where-  join f (a,b) = join (\a1 a2 -> join (\b1 b2 -> f (a1,b1) (a2,b2)) b) a--instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c) => FreeAlgebra r (a,b,c) where-  join f (a,b,c) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> f (a1,b1,c1) (a2,b2,c2)) c) b) a--instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c, FreeAlgebra r d) => FreeAlgebra r (a,b,c,d) where-  join f (a,b,c,d) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> join (\d1 d2 -> f (a1,b1,c1,d1) (a2,b2,c2,d2)) d) c) b) a--instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c, FreeAlgebra r d, FreeAlgebra r e) => FreeAlgebra r (a,b,c,d,e) where-  join f (a,b,c,d,e) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> join (\d1 d2 -> join (\e1 e2 -> f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2)) e) d) c) b) a---- TODO: check this-instance (FreeAlgebra r b, FreeAlgebra r a) => FreeAlgebra (b -> r) a where-  join f a b = join (\a1 a2 -> f a1 a2 b) a-

@@ -1,32 +1,5 @@-module Numeric.Semiring.Involutive-  ( Involutive +module Numeric.Semiring.Involutive +  ( InvolutiveSemiring   ) where -import Data.Int-import Data.Word-import Numeric.Natural-import Numeric.Multiplication.Involutive-import Numeric.Rig.Class---- | adjoint (x + y) = adjoint x + adjoint y-class (Rig r, InvolutiveMultiplication r) => Involutive r--instance Involutive Integer-instance Involutive Int-instance Involutive Int8-instance Involutive Int16-instance Involutive Int32-instance Involutive Int64--instance Involutive Natural-instance Involutive Word-instance Involutive Word8-instance Involutive Word16-instance Involutive Word32-instance Involutive Word64--instance Involutive ()-instance (Involutive a, Involutive b) => Involutive (a, b)-instance (Involutive a, Involutive b, Involutive c) => Involutive (a, b, c)-instance (Involutive a, Involutive b, Involutive c, Involutive d) => Involutive (a, b, c, d)-instance (Involutive a, Involutive b, Involutive c, Involutive d, Involutive e) => Involutive (a, b, c, d, e)+import Numeric.Algebra.Involutive

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -1,6 +1,6 @@ name:          algebra category:      Math, Algebra-version:       0.4.0+version:       0.5.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -19,78 +19,66 @@  library   build-depends: +    array >= 0.3.0.2 && < 0.4,     base >= 4 && < 4.4,+    distributive >= 0.2 && < 0.3,     transformers >= 0.2.0 && < 0.3,     tagged >= 0.2.2 && < 0.3,     categories >= 0.58.0 && < 0.59,     containers >= 0.3.0.0 && < 0.5,+    keys >= 1.8 && < 1.9,     mtl >= 2.0 && < 2.1,     semigroups >= 0.5 && < 0.6,     semigroupoids >= 1.2.2 && < 1.3,-    reflection >= 0.4 && < 0.5,-    representable-tries >= 1.8 && < 1.9,+    representable-functors >= 1.8 && < 1.9,+    representable-tries >= 1.8.1 && < 1.9,     void >= 0.5.4 && < 0.6 +-- reflection >= 0.4 && < 0.5,   exposed-modules:-    Numeric.Addition-    Numeric.Addition.Abelian-    Numeric.Addition.Partitionable-    Numeric.Addition.Idempotent-    Numeric.Algebra.Free-    Numeric.Algebra.Free.Class-    Numeric.Algebra.Free.Unital-    Numeric.Algebra.Free.Hopf-    Numeric.Band+    Numeric.Algebra     Numeric.Band.Rectangular-    Numeric.Band.Class-    Numeric.Decidable.Zero-    Numeric.Decidable.Units-    Numeric.Decidable.Associates+    Numeric.Covector     Numeric.Exp-    Numeric.Functional.Linear-    Numeric.Functional.Antilinear-    Numeric.Group-    Numeric.Group.Additive-    Numeric.Group.Multiplicative-    Numeric.Module-    Numeric.Monoid-    Numeric.Monoid.Additive-    Numeric.Monoid.Multiplicative     Numeric.Log-    Numeric.Module.Class-    Numeric.Multiplication-    Numeric.Multiplication.Commutative-    Numeric.Multiplication.Involutive-    Numeric.Multiplication.Factorable-    Numeric.Map.Linear-    Numeric.Natural+    Numeric.Map+    Numeric.Module.Complex+    Numeric.Module.Quaternion     Numeric.Natural.Internal-    Numeric.Order-    Numeric.Order.Additive-    Numeric.Order.Class-    Numeric.Polynomial.Basis.Power-    Numeric.Rig-    Numeric.Rig.Class-    Numeric.Rig.Ordered-    Numeric.Rig.Characteristic-    Numeric.Rng-    Numeric.Rng.Class     Numeric.Rng.Zero-    Numeric.Ring-    Numeric.Ring.Class     Numeric.Ring.Rng     Numeric.Ring.Opposite     Numeric.Ring.Endomorphism-    Numeric.Semigroup-    Numeric.Semigroup.Additive-    Numeric.Semigroup.Multiplicative-    Numeric.Semiring-    Numeric.Semiring.Class-    Numeric.Semiring.Integral-    Numeric.Semiring.Involutive+    Numeric.Algebra.Geometric    other-modules:-    Numeric.Semiring.Internal-    Numeric.Monoid.Multiplicative.Internal+    Numeric.Additive.Class+    Numeric.Additive.Group+    Numeric.Algebra.Class+    Numeric.Algebra.Involutive+    Numeric.Algebra.Idempotent+    Numeric.Algebra.Division+    Numeric.Algebra.Unital+    Numeric.Algebra.Commutative+    Numeric.Algebra.Factorable+    Numeric.Algebra.Hopf+    Numeric.Natural+    Numeric.Decidable.Zero+    Numeric.Decidable.Units+    Numeric.Decidable.Associates+    Numeric.Module.Class+    Numeric.Module.Representable+    Numeric.Semiring.Integral+    Numeric.Semiring.Involutive+    Numeric.Band.Class+    Numeric.Dioid.Class+    Numeric.Quadrance.Class+    Numeric.Rig.Class+    Numeric.Rng.Class+    Numeric.Ring.Class+    Numeric.Rig.Ordered+    Numeric.Rig.Characteristic+    Numeric.Order.Class+    Numeric.Order.Additive    ghc-options: -Wall