packages feed

algebra 2.1.1.2 → 3.0

raw patch · 125 files changed

+6508/−6506 lines, 125 filesdep ~basedep ~keysdep ~representable-functors

Dependency ranges changed: base, keys, representable-functors, representable-tries, semigroupoids

Files

− Numeric/Additive/Class.hs 
@@ -1,226 +0,0 @@-{-# LANGUAGE TypeOperators #-}-module Numeric.Additive.Class-  ( -  -- * Additive Semigroups-    Additive(..)-  , sum1-  -- * Additive Abelian semigroups-  , Abelian-  -- * Additive Monoids-  , Idempotent-  , sinnum1pIdempotent-  -- * Partitionable semigroups-  , Partitionable(..)-  ) where--import Data.Int-import Data.Word-import Data.Foldable hiding (concat)-import Data.Semigroup.Foldable-import Data.Key-import Data.Functor.Representable-import Data.Functor.Representable.Trie--- import Data.Foldable hiding (concat)-import Numeric.Natural.Internal-import Prelude (fmap,(-),Bool(..),($),id,(>>=),fromIntegral,(*),otherwise,quot,maybe,error,even,Maybe(..),(==),(.),($!),Integer,(||),toInteger,Integral)-import qualified Prelude-import Data.List.NonEmpty (NonEmpty(..), fromList)--infixl 6 +---- | --- > (a + b) + c = a + (b + c)--- > sinnum 1 a = a--- > sinnum (2 * n) a = sinnum n a + sinnum n a--- > sinnum (2 * n + 1) a = sinnum n a + sinnum n a + a-class Additive r where-  (+) :: r -> r -> r--  -- | sinnum1p n r = sinnum (1 + n) r-  sinnum1p :: Whole n => n -> r -> r-  sinnum1p 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 -  sinnum1p n f e = sinnum1p n (f e)-  sumWith1 f xs e = sumWith1 (`f` e) xs--instance (HasTrie b, Additive r) => Additive (b :->: r) where-  (+) = zipWith (+)-  sinnum1p = fmap . sinnum1p-  sumWith1 f xs = tabulate $ \e -> sumWith1 (\a -> index (f a) e) xs--instance Additive Bool where-  (+) = (||)-  sinnum1p _ a = a--instance Additive Natural where-  (+) = (Prelude.+)-  sinnum1p n r = (1 Prelude.+ toNatural n) * r--instance Additive Integer where -  (+) = (Prelude.+)-  sinnum1p n r = (1 Prelude.+ toInteger n) * r--instance Additive Int where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Int8 where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Int16 where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Int32 where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Int64 where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word8 where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word16 where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word32 where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive Word64 where-  (+) = (Prelude.+)-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r--instance Additive () where-  _ + _ = ()-  sinnum1p _ _ = () -  sumWith1 _ _ = ()--instance (Additive a, Additive b) => Additive (a,b) where-  (a,b) + (i,j) = (a + i, b + j)-  sinnum1p n (a,b) = (sinnum1p n a, sinnum1p 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)-  sinnum1p n (a,b,c) = (sinnum1p n a, sinnum1p n b, sinnum1p 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)-  sinnum1p n (a,b,c,d) = (sinnum1p n a, sinnum1p n b, sinnum1p n c, sinnum1p 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)-  sinnum1p n (a,b,c,d,e) = (sinnum1p n a, sinnum1p n b, sinnum1p n c, sinnum1p n d, sinnum1p 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 (HasTrie e, 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--sinnum1pIdempotent :: Natural -> r -> r-sinnum1pIdempotent _ r = r--instance Idempotent ()-instance Idempotent Bool-instance Idempotent r => Idempotent (e -> r)-instance (HasTrie e, Idempotent r) => Idempotent (e :->: r)-instance (Idempotent a, Idempotent b) => Idempotent (a,b)-instance (Idempotent a, Idempotent b, Idempotent c) => Idempotent (a,b,c)-instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d) => Idempotent (a,b,c,d)-instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d, Idempotent e) => Idempotent (a,b,c,d,e)
− Numeric/Additive/Group.hs 
@@ -1,149 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeOperators #-}-module Numeric.Additive.Group-  ( -- * Additive Groups-    Group(..)-  ) where--import Data.Int-import Data.Word-import Data.Key-import Data.Functor.Representable.Trie-import Prelude hiding ((*), (+), (-), negate, subtract,zipWith)-import qualified Prelude-import Numeric.Additive.Class-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 (HasTrie e, Group r) => Group (e :->: r) where-  (-) = zipWith (-)-  negate = fmap negate-  subtract = zipWith subtract-  times = fmap . times--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)-
− Numeric/Algebra.hs 
@@ -1,171 +0,0 @@-module Numeric.Algebra-  ( -  -- * Additive--  -- ** additive semigroups-    Additive(..)-  , sum1-  -- ** additive Abelian semigroups-  , Abelian-  -- ** additive idempotent semigroups-  , Idempotent-  , sinnum1pIdempotent-  , sinnumIdempotent-  -- ** 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(..)-  -- ** Division Rings-  , LocalRing-  , DivisionRing-  , Field--  -- * 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-  , CocommutativeCoalgebra-  -- ** division algebras-  , DivisionAlgebra(..)-  -- ** Hopf alegebras-  , HopfAlgebra(..)--  -- * Ring Properties-  -- ** Characteristic-  , Characteristic(..)-  , charInt, charWord-  -- ** Order-  , Order(..)-  , OrderedRig-  , AdditiveOrder-  , LocallyFiniteOrder--  , DecidableZero-  , DecidableUnits-  , DecidableAssociates--  -- * Natural numbers-  , Natural-  , Whole(toNatural)--  -- * Representable Additive-  , addRep, sinnum1pRep-  -- * Representable Monoidal-  , zeroRep, sinnumRep-  -- * 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.Order.LocallyFinite-import Numeric.Quadrance.Class-import Numeric.Rig.Class-import Numeric.Rig.Characteristic-import Numeric.Rig.Ordered-import Numeric.Rng.Class-import Numeric.Ring.Class-import Numeric.Ring.Local-import Numeric.Ring.Division-import Numeric.Field.Class
− Numeric/Algebra/Class.hs 
@@ -1,600 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeOperators #-}-module Numeric.Algebra.Class -  (-  -- * Multiplicative Semigroups-    Multiplicative(..)-  , pow1pIntegral-  , product1-  -- * Semirings-  , Semiring-  -- * Left and Right Modules-  , LeftModule(..)-  , RightModule(..)-  , Module-  -- * Additive Monoids-  , Monoidal(..)-  , sum-  , sinnumIdempotent-  -- * Associative algebras-  , Algebra(..)-  -- * Coassociative coalgebras-  , Coalgebra(..)-  ) where--import Control.Applicative-import Data.Foldable hiding (sum, concat)-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Int-import Data.IntMap (IntMap)-import Data.IntSet (IntSet)-import Data.Key-import Data.Map (Map)-import Data.Monoid (mappend)--- import Data.Semigroup.Foldable-import Data.Sequence hiding (reverse,index)-import Data.Semigroup.Foldable-import Data.Set (Set)-import Data.Word-import Numeric.Additive.Class-import Numeric.Natural.Internal-import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)-import qualified Data.IntMap as IntMap-import qualified Data.IntSet as IntSet-import qualified Data.Map as Map-import qualified Data.Sequence as Seq-import qualified Data.Set as Set-import qualified Prelude--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)--instance Algebra r a => Multiplicative (a -> r) where-  f * g = mult $ \a b -> f a * g b-instance (HasTrie a, Algebra r a) => Multiplicative (a :->: r) where-  f * g = tabulate $ mult $ \a b -> index f a * index g b---- | A pair of an additive abelian semigroup, and a multiplicative semigroup, with the distributive laws:--- --- > a(b + c) = ab + ac -- left distribution (we are a LeftNearSemiring)--- > (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)-instance Algebra r a => Semiring (a -> r) -instance (HasTrie a, Algebra r a) => Semiring (a :->: r) ---- | An associative algebra built with a free module over a semiring-class Semiring r => Algebra r a where-  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---- 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)--instance (HasTrie m, Algebra r m) => Coalgebra r (m :->: r) where-  comult k f g = k (f * g)---- instance Coalgebra () c where comult _ _ _ = ()--- instance (Algebra r b, Coalgebra r c) => Coalgebra (b -> r) c where comult f c1 c2 b = comult (`f` b) c1 c2 --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 (HasTrie e, LeftModule r m) => LeftModule r (e :->: m) where -  (.*) m f = tabulate $ \e -> m .* index f e--instance Additive m => LeftModule () m where -  _ .* a = a--instance (LeftModule r a, LeftModule r b) => LeftModule r (a, b) where-  n .* (a, b) = (n .* a, n .* b)--instance (LeftModule r a, LeftModule r b, LeftModule r c) => LeftModule r (a, b, c) where-  n .* (a, b, c) = (n .* a, n .* b, n .* c)--instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d) => LeftModule r (a, b, c, d) where-  n .* (a, b, c, d) = (n .* a, n .* b, n .* c, n .* d)--instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d, LeftModule r e) => LeftModule r (a, b, c, d, e) where-  n .* (a, b, c, d, e) = (n .* a, n .* b, n .* c, n .* d, n .* e)----class (Semiring r, Additive m) => RightModule r m where-  (*.) :: m -> r -> m--instance RightModule Natural Bool where -  _ *. 0 = False-  a *. _ = a--instance RightModule Natural Natural where (*.) = (*)--instance RightModule Natural Integer where n *. Natural m = n * m--instance RightModule Integer Integer where (*.) = (*) --instance RightModule Natural Int where m *. n = m * fromIntegral n--instance RightModule Integer Int where m *. n = m * fromInteger n--instance RightModule Natural Int8 where m *. n = m * fromIntegral n--instance RightModule Integer Int8 where m *. n = m * fromInteger n--instance RightModule Natural Int16 where m *. n = m * fromIntegral n--instance RightModule Integer Int16 where m *. n = m * fromInteger n--instance RightModule Natural Int32 where m *. n = m * fromIntegral n--instance RightModule Integer Int32 where m *. n = m * fromInteger n--instance RightModule Natural Int64 where m *. n = m * fromIntegral n--instance RightModule Integer Int64 where m *. n = m * fromInteger n--instance RightModule Natural Word where m *. n = m * fromIntegral n--instance RightModule Integer Word where m *. n = m * fromInteger n--instance RightModule Natural Word8 where m *. n = m * fromIntegral n--instance RightModule Integer Word8 where m *. n = m * fromInteger n--instance RightModule Natural Word16 where m *. n = m * fromIntegral n--instance RightModule Integer Word16 where m *. n = m * fromInteger n--instance RightModule Natural Word32 where m *. n = m * fromIntegral n--instance RightModule Integer Word32 where m *. n = m * fromInteger n--instance RightModule Natural Word64 where m *. n = m * fromIntegral n--instance RightModule Integer Word64 where m *. n = m * fromInteger n--instance Semiring r => RightModule r () where -  _ *. _ = ()--instance RightModule r m => RightModule r (e -> m) where -  (*.) f m e = f e *. m--instance (HasTrie e, RightModule r m) => RightModule r (e :->: m) where -  (*.) f m = tabulate $ \e -> index f e *. m--instance Additive m => RightModule () m where -  (*.) = const--instance (RightModule r a, RightModule r b) => RightModule r (a, b) where-  (a, b) *. n = (a *. n, b *. n)--instance (RightModule r a, RightModule r b, RightModule r c) => RightModule r (a, b, c) where-  (a, b, c) *. n = (a *. n, b *. n, c *. n)--instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d) => RightModule r (a, b, c, d) where-  (a, b, c, d) *. n = (a *. n, b *. n, c *. n, d *. n)--instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d, RightModule r e) => RightModule r (a, b, c, d, e) where-  (a, b, c, d, e) *. n = (a *. n, b *. n, c *. n, d *. n, e *. n)----class (LeftModule r m, RightModule r m) => Module r m-instance (LeftModule r m, RightModule r m) => Module r m------ | An additive monoid------ > zero + a = a = a + zero-class (LeftModule Natural m, RightModule Natural m) => Monoidal m where-  zero :: m--  sinnum :: Whole n => n -> m -> m-  sinnum 0 _  = zero-  sinnum 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--sinnumIdempotent :: (Integral n, Idempotent r, Monoidal r) => n -> r -> r-sinnumIdempotent 0 _ = zero-sinnumIdempotent _ x = x--instance Monoidal Bool where -  zero = False-  sinnum 0 _ = False-  sinnum _ r = r--instance Monoidal Natural where-  zero = 0-  sinnum n r = toNatural n * r--instance Monoidal Integer where -  zero = 0-  sinnum n r = toInteger n * r--instance Monoidal Int where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Int8 where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Int16 where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Int32 where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Int64 where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Word where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Word8 where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Word16 where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Word32 where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal Word64 where -  zero = 0-  sinnum n r = fromIntegral n * r--instance Monoidal r => Monoidal (e -> r) where-  zero = const zero-  sumWith f xs e = sumWith (`f` e) xs-  sinnum n r e = sinnum n (r e)--instance (HasTrie e, Monoidal r) => Monoidal (e :->: r) where-  zero = pure zero-  sumWith f xs = tabulate $ \e -> sumWith (\a -> index (f a) e) xs-  sinnum n r = tabulate $ sinnum n . index r--instance Monoidal () where -  zero = ()-  sinnum _ () = ()-  sumWith _ _ = ()--instance (Monoidal a, Monoidal b) => Monoidal (a,b) where-  zero = (zero,zero)-  sinnum n (a,b) = (sinnum n a, sinnum n b)--instance (Monoidal a, Monoidal b, Monoidal c) => Monoidal (a,b,c) where-  zero = (zero,zero,zero)-  sinnum n (a,b,c) = (sinnum n a, sinnum n b, sinnum n c)--instance (Monoidal a, Monoidal b, Monoidal c, Monoidal d) => Monoidal (a,b,c,d) where-  zero = (zero,zero,zero,zero)-  sinnum n (a,b,c,d) = (sinnum n a, sinnum n b, sinnum n c, sinnum 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)-  sinnum n (a,b,c,d,e) = (sinnum n a, sinnum n b, sinnum n c, sinnum n d, sinnum n e)-
− Numeric/Algebra/Commutative.hs 
@@ -1,187 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances, TypeOperators #-}-module Numeric.Algebra.Commutative -  ( Commutative-  , CommutativeAlgebra-  , CocommutativeCoalgebra-  , CommutativeBialgebra-  ) where--import Data.Functor.Representable.Trie-import Data.Int-import Data.IntSet (IntSet)-import Data.IntMap (IntMap)-import Data.Set (Set)-import Data.Map (Map)-import Data.Word-import Numeric.Additive.Class-import Numeric.Algebra.Class-import Numeric.Algebra.Unital-import Numeric.Natural-import Prelude (Bool, Ord, Integer)------ | 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)--instance CommutativeAlgebra r a => Commutative (a -> r)--instance ( HasTrie a-         , CommutativeAlgebra r a-         ) => Commutative (a :->: r) ----class Algebra r a => CommutativeAlgebra r a--instance ( Commutative r-         , Semiring r-         ) => CommutativeAlgebra r ()--instance ( CommutativeAlgebra r a-         , CommutativeAlgebra r b-         ) => CommutativeAlgebra r (a,b)--instance ( CommutativeAlgebra r a-         , CommutativeAlgebra r b-         , CommutativeAlgebra r c-         ) => CommutativeAlgebra r (a,b,c)--instance ( CommutativeAlgebra r a-         , CommutativeAlgebra r b-         , CommutativeAlgebra r c-         , CommutativeAlgebra r d-         ) => CommutativeAlgebra r (a,b,c,d)--instance ( CommutativeAlgebra r a-         , CommutativeAlgebra r b-         , CommutativeAlgebra r c-         , CommutativeAlgebra r d-         , CommutativeAlgebra r e-         ) => CommutativeAlgebra r (a,b,c,d,e)--instance ( Commutative r-         , Semiring r-         , Ord a-         ) => CommutativeAlgebra r (Set a)--instance (Commutative r-         , Semiring r-         ) => CommutativeAlgebra r IntSet--instance (Commutative r-         , Monoidal r-         , Semiring r-         , Ord a-         , Abelian b-         , Partitionable b-         ) => CommutativeAlgebra r (Map a b)--instance ( Commutative r-         , Monoidal r-         , Semiring r-         , Abelian b-         , Partitionable b-         ) => CommutativeAlgebra r (IntMap b)----class Coalgebra r c => CocommutativeCoalgebra r c--instance CommutativeAlgebra r m => CocommutativeCoalgebra r (m -> r)--instance ( HasTrie m-         , CommutativeAlgebra r m-         ) => CocommutativeCoalgebra r (m :->: r)--instance (Commutative r, Semiring r) => CocommutativeCoalgebra r ()--instance ( CocommutativeCoalgebra r a-         , CocommutativeCoalgebra r b-         ) => CocommutativeCoalgebra r (a,b)--instance ( CocommutativeCoalgebra r a-         , CocommutativeCoalgebra r b-         , CocommutativeCoalgebra r c-         ) => CocommutativeCoalgebra r (a,b,c)--instance ( CocommutativeCoalgebra r a-         , CocommutativeCoalgebra r b-         , CocommutativeCoalgebra r c-         , CocommutativeCoalgebra r d-         ) => CocommutativeCoalgebra r (a,b,c,d)--instance ( CocommutativeCoalgebra r a-         , CocommutativeCoalgebra r b-         , CocommutativeCoalgebra r c-         , CocommutativeCoalgebra r d-         , CocommutativeCoalgebra r e-         ) => CocommutativeCoalgebra r (a,b,c,d,e)--instance ( Commutative r-         , Semiring r-         , Ord a) => CocommutativeCoalgebra r (Set a)--instance ( Commutative r-         , Semiring r-         ) => CocommutativeCoalgebra r IntSet--instance ( Commutative r-         , Semiring r-         , Ord a-         , Abelian b-         ) => CocommutativeCoalgebra r (Map a b)--instance ( Commutative r-         , Semiring r-         , Abelian b-         ) => CocommutativeCoalgebra r (IntMap b)----class ( Bialgebra r h-      , CommutativeAlgebra r h-      , CocommutativeCoalgebra r h-      ) => CommutativeBialgebra r h--instance ( Bialgebra r h-         , CommutativeAlgebra r h-         , CocommutativeCoalgebra r h-         ) => CommutativeBialgebra r h
− Numeric/Algebra/Complex.hs 
@@ -1,252 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses-           , FlexibleInstances-           , TypeFamilies-           , UndecidableInstances-           , DeriveDataTypeable-           , TypeOperators #-}-module Numeric.Algebra.Complex-  ( Distinguished(..)-  , Complicated(..)-  , ComplexBasis(..)-  , Complex(..)-  , realPart-  , imagPart-  , uncomplicate-  ) 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 hiding (index)-import Data.Key-import Data.Semigroup-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.Traversable-import Numeric.Algebra-import Numeric.Algebra.Distinguished.Class-import Numeric.Algebra.Complex.Class-import Numeric.Algebra.Quaternion.Class-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)---- 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)--realPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a-realPart f = index f E --imagPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a-imagPart f = index f I--instance Distinguished ComplexBasis where-  e = E-  -instance Complicated ComplexBasis where-  i = I--instance Rig r => Distinguished (Complex r) where-  e = Complex one zero--instance Rig r => Complicated (Complex r) where-  i = Complex zero one--instance Rig r => Distinguished (ComplexBasis -> r) where-  e E = one-  e _ = zero-  -instance Rig r => Complicated (ComplexBasis -> r) where-  i I = one-  i _ = zero --instance Rig r => Distinguished (ComplexBasis :->: r) where-  e = Trie e-  -instance Rig r => Complicated (ComplexBasis :->: r) where-  i = Trie i--type instance Key Complex = ComplexBasis--instance Representable Complex where-  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 -  sinnum1p = sinnum1pRep--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-  sinnum = sinnumRep--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---- the trivial coalgebra-instance Rng k => Coalgebra k ComplexBasis where-  comult f E E = f E-  comult f I I = f I-  comult _ _ _ = zero--instance Rng k => CounitalCoalgebra k ComplexBasis where-  counit f = f E + f I--instance Rng k => Bialgebra k ComplexBasis --instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k ComplexBasis where-  inv f = f' where-    afe = adjoint (f E)-    nfi = negate (f I)-    f' E = afe-    f' I = nfi--instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k ComplexBasis where-  coinv = inv--instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k ComplexBasis where-  antipode = inv--instance (Commutative r, Rng r) => Multiplicative (Complex r) where-  (*) = mulRep--instance (TriviallyInvolutive r, Rng r) => Commutative (Complex r)--instance (Commutative r, Rng r) => Semiring (Complex r)--instance (Commutative r, Ring r) => Unital (Complex r) where-  one = oneRep--instance (Commutative r, Ring r) => Rig (Complex r) where-  fromNatural n = Complex (fromNatural n) zero--instance (Commutative r, Ring r) => Ring (Complex r) where-  fromInteger n = Complex (fromInteger n) zero--instance (Commutative r, Rng r) => LeftModule (Complex r) (Complex r) where (.*) = (*)-instance (Commutative r, Rng r) => RightModule (Complex r) (Complex r) where (*.) = (*)--instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Complex r) where-  adjoint (Complex a b) = Complex (adjoint a) (negate b)--instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Complex r)--instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Complex r) where-  quadrance n = realPart $ adjoint n * n--instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Complex r) where-  recip q@(Complex a b) = Complex (qq \\ a) (qq \\ b)-    where qq = quadrance q---- | half of the Cayley-Dickson quaternion isomorphism -uncomplicate :: Hamiltonian q => ComplexBasis -> ComplexBasis -> q-uncomplicate E E = e-uncomplicate I E = i-uncomplicate E I = j-uncomplicate I I = k-
− Numeric/Algebra/Complex/Class.hs 
@@ -1,13 +0,0 @@-module Numeric.Algebra.Complex.Class-  ( Complicated(..)-  ) where--import Numeric.Algebra.Distinguished.Class-import Numeric.Covector-import Prelude (return)--class Distinguished r => Complicated r where-  i :: r--instance Complicated a => Complicated (Covector r a) where-  i = return i
− Numeric/Algebra/Distinguished/Class.hs 
@@ -1,12 +0,0 @@-module Numeric.Algebra.Distinguished.Class-  ( Distinguished(..)-  ) where--import Numeric.Covector---- a basis with a distinguished point-class Distinguished t where-  e :: t--instance Distinguished a => Distinguished (Covector r a) where-  e = return e
− Numeric/Algebra/Division.hs 
@@ -1,73 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Numeric.Algebra.Division-  ( Division(..)-  , DivisionAlgebra(..)-  ) 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-
− Numeric/Algebra/Dual.hs 
@@ -1,224 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}-module Numeric.Algebra.Dual-  ( Distinguished(..)-  , Infinitesimal(..)-  , DualBasis(..)-  , Dual(..)-  ) 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.Semigroup hiding (Dual)-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.Traversable-import Numeric.Algebra-import Numeric.Algebra.Distinguished.Class-import Numeric.Algebra.Dual.Class-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)---- | dual number basis, D^2 = 0. D /= 0.-data DualBasis = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)-data Dual a = Dual a a deriving (Eq,Show,Read,Data,Typeable)--instance Distinguished DualBasis where-  e = E--instance Infinitesimal DualBasis where-  d = D--instance Rig r => Distinguished (Dual r) where-  e = Dual one zero--instance Rig r => Infinitesimal (Dual r) where-  d = Dual zero one-  -instance Rig r => Distinguished (DualBasis -> r) where-  e E = one-  e _ = zero--instance Rig r => Infinitesimal (DualBasis -> r) where-  d D = one-  d _       = zero --type instance Key Dual = DualBasis--instance Representable Dual where-  tabulate f = Dual (f E) (f D)--instance Indexable Dual where-  index (Dual a _ ) E = a-  index (Dual _ b ) D = b--instance Lookup Dual where-  lookup = lookupDefault--instance Adjustable Dual where-  adjust f E (Dual a b) = Dual (f a) b-  adjust f D (Dual a b) = Dual a (f b)--instance Distributive Dual where-  distribute = distributeRep --instance Functor Dual where-  fmap f (Dual a b) = Dual (f a) (f b)--instance Zip Dual where-  zipWith f (Dual a1 b1) (Dual a2 b2) = Dual (f a1 a2) (f b1 b2)--instance ZipWithKey Dual where-  zipWithKey f (Dual a1 b1) (Dual a2 b2) = Dual (f E a1 a2) (f D b1 b2)--instance Keyed Dual where-  mapWithKey = mapWithKeyRep--instance Apply Dual where-  (<.>) = apRep--instance Applicative Dual where-  pure = pureRep-  (<*>) = apRep --instance Bind Dual where-  (>>-) = bindRep--instance Monad Dual where-  return = pureRep-  (>>=) = bindRep--instance MonadReader DualBasis Dual where-  ask = askRep-  local = localRep--instance Foldable Dual where-  foldMap f (Dual a b) = f a `mappend` f b--instance FoldableWithKey Dual where-  foldMapWithKey f (Dual a b) = f E a `mappend` f D b--instance Traversable Dual where-  traverse f (Dual a b) = Dual <$> f a <*> f b--instance TraversableWithKey Dual where-  traverseWithKey f (Dual a b) = Dual <$> f E a <*> f D b--instance Foldable1 Dual where-  foldMap1 f (Dual a b) = f a <> f b--instance FoldableWithKey1 Dual where-  foldMapWithKey1 f (Dual a b) = f E a <> f D b--instance Traversable1 Dual where-  traverse1 f (Dual a b) = Dual <$> f a <.> f b--instance TraversableWithKey1 Dual where-  traverseWithKey1 f (Dual a b) = Dual <$> f E a <.> f D b--instance HasTrie DualBasis where-  type BaseTrie DualBasis = Dual-  embedKey = id-  projectKey = id--instance Additive r => Additive (Dual r) where-  (+) = addRep -  sinnum1p = sinnum1pRep--instance LeftModule r s => LeftModule r (Dual s) where-  r .* Dual a b = Dual (r .* a) (r .* b)--instance RightModule r s => RightModule r (Dual s) where-  Dual a b *. r = Dual (a *. r) (b *. r)--instance Monoidal r => Monoidal (Dual r) where-  zero = zeroRep-  sinnum = sinnumRep--instance Group r => Group (Dual r) where-  (-) = minusRep-  negate = negateRep-  subtract = subtractRep-  times = timesRep--instance Abelian r => Abelian (Dual r)--instance Idempotent r => Idempotent (Dual r)--instance Partitionable r => Partitionable (Dual r) where-  partitionWith f (Dual a b) = id =<<-    partitionWith (\a1 a2 -> -    partitionWith (\b1 b2 -> f (Dual a1 b1) (Dual a2 b2)) b) a--instance Rng k => Algebra k DualBasis where-  mult f = f' where-    fe = f E E-    fd = f E D + f D E-    f' E = fe-    f' D = fd--instance Rng k => UnitalAlgebra k DualBasis where-  unit x E = x-  unit _ _ = zero---- the trivial coalgebra-instance Rng k => Coalgebra k DualBasis where-  comult f E E = f E-  comult f D D = f D-  comult _ _ _ = zero--instance Rng k => CounitalCoalgebra k DualBasis where-  counit f = f E + f D--instance Rng k => Bialgebra k DualBasis --instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis where-  inv f = f' where-    afe = adjoint (f E)-    nfd = negate (f D)-    f' E = afe-    f' D = nfd--instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis where-  coinv = inv--instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis where-  antipode = inv--instance (Commutative r, Rng r) => Multiplicative (Dual r) where-  (*) = mulRep--instance (TriviallyInvolutive r, Rng r) => Commutative (Dual r)--instance (Commutative r, Rng r) => Semiring (Dual r)--instance (Commutative r, Ring r) => Unital (Dual r) where-  one = oneRep--instance (Commutative r, Ring r) => Rig (Dual r) where-  fromNatural n = Dual (fromNatural n) zero--instance (Commutative r, Ring r) => Ring (Dual r) where-  fromInteger n = Dual (fromInteger n) zero--instance (Commutative r, Rng r) => LeftModule (Dual r) (Dual r) where (.*) = (*)-instance (Commutative r, Rng r) => RightModule (Dual r) (Dual r) where (*.) = (*)--instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual r) where-  adjoint (Dual a b) = Dual (adjoint a) (negate b)--instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual r)--instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual r) where-  quadrance n = case adjoint n * n of-    Dual a _ -> a--instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual r) where-  recip q@(Dual a b) = Dual (qq \\ a) (qq \\ b)-    where qq = quadrance q
− Numeric/Algebra/Dual/Class.hs 
@@ -1,12 +0,0 @@-module Numeric.Algebra.Dual.Class-  ( Infinitesimal(..)-  ) where--import Numeric.Algebra.Distinguished.Class-import Numeric.Covector--class Distinguished t => Infinitesimal t where-  d :: t--instance Infinitesimal a => Infinitesimal (Covector r a) where-  d = return d
− Numeric/Algebra/Factorable.hs 
@@ -1,49 +0,0 @@-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--
− Numeric/Algebra/Hopf.hs 
@@ -1,33 +0,0 @@-{-# 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
− Numeric/Algebra/Hyperbolic.hs 
@@ -1,222 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}-module Numeric.Algebra.Hyperbolic-  ( Hyperbolic(..)-  , HyperBasis'(..)-  , Hyper'(..)-  ) where--import Control.Applicative-import Control.Monad.Reader.Class-import Data.Data-import Data.Distributive-import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Foldable-import Data.Ix-import Data.Key-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.Semigroup-import Data.Traversable-import Numeric.Algebra-import Numeric.Coalgebra.Hyperbolic.Class-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)---- the dual hyperbolic basis-data HyperBasis' = Cosh' | Sinh' deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)-data Hyper' a = Hyper' a a deriving (Eq,Show,Read,Data,Typeable)--instance Hyperbolic HyperBasis' where-  cosh = Cosh'-  sinh = Sinh'--instance Rig r => Hyperbolic (Hyper' r) where-  cosh = Hyper' one zero-  sinh = Hyper' zero one-  -instance Rig r => Hyperbolic (HyperBasis' -> r) where-  cosh Sinh' = zero-  cosh Cosh' = one-  sinh Sinh' = one-  sinh Cosh' = zero--type instance Key Hyper' = HyperBasis'--instance Representable Hyper' where-  tabulate f = Hyper' (f Cosh') (f Sinh')--instance Indexable Hyper' where-  index (Hyper' a _ ) Cosh' = a-  index (Hyper' _ b ) Sinh' = b--instance Lookup Hyper' where-  lookup = lookupDefault--instance Adjustable Hyper' where-  adjust f Cosh' (Hyper' a b) = Hyper' (f a) b-  adjust f Sinh' (Hyper' a b) = Hyper' a (f b)--instance Distributive Hyper' where-  distribute = distributeRep --instance Functor Hyper' where-  fmap f (Hyper' a b) = Hyper' (f a) (f b)--instance Zip Hyper' where-  zipWith f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f a1 a2) (f b1 b2)--instance ZipWithKey Hyper' where-  zipWithKey f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f Cosh' a1 a2) (f Sinh' b1 b2)--instance Keyed Hyper' where-  mapWithKey = mapWithKeyRep--instance Apply Hyper' where-  (<.>) = apRep--instance Applicative Hyper' where-  pure = pureRep-  (<*>) = apRep --instance Bind Hyper' where-  (>>-) = bindRep--instance Monad Hyper' where-  return = pureRep-  (>>=) = bindRep--instance MonadReader HyperBasis' Hyper' where-  ask = askRep-  local = localRep--instance Foldable Hyper' where-  foldMap f (Hyper' a b) = f a `mappend` f b--instance FoldableWithKey Hyper' where-  foldMapWithKey f (Hyper' a b) = f Cosh' a `mappend` f Sinh' b--instance Traversable Hyper' where-  traverse f (Hyper' a b) = Hyper' <$> f a <*> f b--instance TraversableWithKey Hyper' where-  traverseWithKey f (Hyper' a b) = Hyper' <$> f Cosh' a <*> f Sinh' b--instance Foldable1 Hyper' where-  foldMap1 f (Hyper' a b) = f a <> f b--instance FoldableWithKey1 Hyper' where-  foldMapWithKey1 f (Hyper' a b) = f Cosh' a <> f Sinh' b--instance Traversable1 Hyper' where-  traverse1 f (Hyper' a b) = Hyper' <$> f a <.> f b--instance TraversableWithKey1 Hyper' where-  traverseWithKey1 f (Hyper' a b) = Hyper' <$> f Cosh' a <.> f Sinh' b--instance HasTrie HyperBasis' where-  type BaseTrie HyperBasis' = Hyper'-  embedKey = id-  projectKey = id--instance Additive r => Additive (Hyper' r) where-  (+) = addRep -  sinnum1p = sinnum1pRep--instance LeftModule r s => LeftModule r (Hyper' s) where-  r .* Hyper' a b = Hyper' (r .* a) (r .* b)--instance RightModule r s => RightModule r (Hyper' s) where-  Hyper' a b *. r = Hyper' (a *. r) (b *. r)--instance Monoidal r => Monoidal (Hyper' r) where-  zero = zeroRep-  sinnum = sinnumRep--instance Group r => Group (Hyper' r) where-  (-) = minusRep-  negate = negateRep-  subtract = subtractRep-  times = timesRep--instance Abelian r => Abelian (Hyper' r)--instance Idempotent r => Idempotent (Hyper' r)--instance Partitionable r => Partitionable (Hyper' r) where-  partitionWith f (Hyper' a b) = id =<<-    partitionWith (\a1 a2 -> -    partitionWith (\b1 b2 -> f (Hyper' a1 b1) (Hyper' a2 b2)) b) a---- the dual hyperbolic trigonometric algebra-instance (Commutative k, Semiring k) => Algebra k HyperBasis' where-  mult f = f' where-    fs = f Sinh' Cosh' + f Cosh' Sinh'-    fc = f Cosh' Cosh' + f Sinh' Sinh'-    f' Sinh' = fs-    f' Cosh' = fc--instance (Commutative k, Monoidal k, Semiring k) => UnitalAlgebra k HyperBasis' where-  unit _ Sinh' = zero-  unit x Cosh' = x---- the diagonal coalgebra-instance (Commutative k, Monoidal k, Semiring k) => Coalgebra k HyperBasis' where-  comult f = f' where-     fs = f Sinh'-     fc = f Cosh'-     f' Sinh' Sinh' = fs-     f' Sinh' Cosh' = zero-     f' Cosh' Sinh' = zero-     f' Cosh' Cosh' = fc--instance (Commutative k, Monoidal k, Semiring k) => CounitalCoalgebra k HyperBasis' where-  counit f = f Cosh' + f Sinh'--instance (Commutative k, Monoidal k, Semiring k) => Bialgebra k HyperBasis'--instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis' where-  inv f = f' where-    afc = adjoint (f Cosh')-    nfs = negate (f Sinh')-    f' Cosh' = afc-    f' Sinh' = nfs--instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis' where-  coinv = inv--instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis' where-  antipode = inv--instance (Commutative k, Semiring k) => Multiplicative (Hyper' k) where-  (*) = mulRep--instance (Commutative k, Semiring k) => Commutative (Hyper' k)--instance (Commutative k, Semiring k) => Semiring (Hyper' k)--instance (Commutative k, Rig k) => Unital (Hyper' k) where-  one = Hyper' one zero--instance (Commutative r, Rig r) => Rig (Hyper' r) where-  fromNatural n = Hyper' (fromNatural n) zero--instance (Commutative r, Ring r) => Ring (Hyper' r) where-  fromInteger n = Hyper' (fromInteger n) zero--instance (Commutative r, Semiring r) => LeftModule (Hyper' r) (Hyper' r) where (.*) = (*)-instance (Commutative r, Semiring r) => RightModule (Hyper' r) (Hyper' r) where (*.) = (*)--instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveMultiplication (Hyper' r) where-  adjoint (Hyper' a b) = Hyper' (adjoint a) (negate b)--instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveSemiring (Hyper' r)--instance (Commutative r, InvolutiveSemiring r, Rng r) => Quadrance r (Hyper' r) where-  quadrance n = case adjoint n * n of-    Hyper' a _ -> a--instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Hyper' r) where-  recip q@(Hyper' a b) = Hyper' (qq \\ a) (qq \\ b)-    where qq = quadrance q-
− Numeric/Algebra/Idempotent.hs 
@@ -1,59 +0,0 @@-{-# 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
− Numeric/Algebra/Incidence.hs 
@@ -1,36 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses-           , FlexibleInstances-           , UndecidableInstances-           , DeriveDataTypeable-           #-}--module Numeric.Algebra.Incidence-  ( Interval(..)-  , zeta-  , moebius-  ) where--import Data.Data-import Numeric.Algebra.Class-import Numeric.Algebra.Unital-import Numeric.Algebra.Commutative-import Numeric.Ring.Class-import Numeric.Order.Class-import Numeric.Order.LocallyFinite---- the basis for an incidence algebra-data Interval a = Interval a a deriving (Eq,Ord,Show,Read,Data,Typeable)--instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => Algebra r (Interval a) where-  mult f (Interval a c) = sumWith (\b -> f (Interval a b) (Interval b c)) $ range a c-  -instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => UnitalAlgebra r (Interval a) where-  unit r (Interval a b) -    | a ~~ b = r-    | otherwise = zero--zeta :: Unital r => Interval a -> r-zeta = const one--moebius :: (Ring r, LocallyFiniteOrder a) => Interval a -> r-moebius (Interval a b) = moebiusInversion a b
− Numeric/Algebra/Involutive.hs 
@@ -1,377 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeOperators #-}-module Numeric.Algebra.Involutive-  ( -  -- * Involution-    InvolutiveMultiplication(..)-  , InvolutiveSemiring-  -- * Involutive Algebras-  , InvolutiveAlgebra(..)-  , InvolutiveCoalgebra(..)-  , InvolutiveBialgebra-  -- * Trivial Involution-  , TriviallyInvolutive-  , TriviallyInvolutiveAlgebra-  , TriviallyInvolutiveCoalgebra-  , TriviallyInvolutiveBialgebra-  ) where--import Numeric.Algebra.Class-import Numeric.Algebra.Commutative-import Numeric.Algebra.Unital-import Data.Int-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Key-import Data.Word-import Numeric.Natural.Internal------ | An semigroup with involution--- --- > adjoint a * adjoint b = adjoint (b * a)-class Multiplicative r => InvolutiveMultiplication r where-  adjoint :: r -> r--instance InvolutiveMultiplication Int where adjoint = id-instance InvolutiveMultiplication Integer where adjoint = id-instance InvolutiveMultiplication Int8 where adjoint = id-instance InvolutiveMultiplication Int16 where adjoint = id-instance InvolutiveMultiplication Int32 where adjoint = id-instance InvolutiveMultiplication Int64 where adjoint = id-instance InvolutiveMultiplication Bool where adjoint = id-instance InvolutiveMultiplication Word where adjoint = id-instance InvolutiveMultiplication Natural where adjoint = id-instance InvolutiveMultiplication Word8 where adjoint = id-instance InvolutiveMultiplication Word16 where adjoint = id-instance InvolutiveMultiplication Word32 where adjoint = id-instance InvolutiveMultiplication Word64 where adjoint = id-instance InvolutiveMultiplication () where adjoint = id--instance -  ( InvolutiveMultiplication a-  , InvolutiveMultiplication b-  ) => InvolutiveMultiplication (a,b) where-  adjoint (a,b) = (adjoint a, adjoint b)--instance -  ( InvolutiveMultiplication a-  , InvolutiveMultiplication b-  , InvolutiveMultiplication c-  ) => InvolutiveMultiplication (a,b,c) where-  adjoint (a,b,c) = (adjoint a, adjoint b, adjoint c)--instance -  ( InvolutiveMultiplication a-  , InvolutiveMultiplication b-  , InvolutiveMultiplication c-  , InvolutiveMultiplication d-  ) => InvolutiveMultiplication (a,b,c,d) where-  adjoint (a,b,c,d) = (adjoint a, adjoint b, adjoint c, adjoint d)--instance -  ( InvolutiveMultiplication a-  , InvolutiveMultiplication b-  , InvolutiveMultiplication c-  , InvolutiveMultiplication d-  , InvolutiveMultiplication e-  ) => InvolutiveMultiplication (a,b,c,d,e) where-  adjoint (a,b,c,d,e) = (adjoint a, adjoint b, adjoint c, adjoint d, adjoint e)--instance InvolutiveAlgebra r h => InvolutiveMultiplication (h -> r) where-  adjoint = inv--instance (HasTrie h, InvolutiveAlgebra r h) => InvolutiveMultiplication (h :->: r) where-  adjoint = tabulate . inv . index------ | adjoint (x + y) = adjoint x + adjoint y-class (Semiring r, InvolutiveMultiplication r) => InvolutiveSemiring r--instance InvolutiveSemiring ()-instance InvolutiveSemiring Bool-instance InvolutiveSemiring Integer-instance InvolutiveSemiring Int-instance InvolutiveSemiring Int8-instance InvolutiveSemiring Int16-instance InvolutiveSemiring Int32-instance InvolutiveSemiring Int64-instance InvolutiveSemiring Natural-instance InvolutiveSemiring Word-instance InvolutiveSemiring Word8-instance InvolutiveSemiring Word16-instance InvolutiveSemiring Word32-instance InvolutiveSemiring Word64--instance ( InvolutiveSemiring a-         , InvolutiveSemiring b-         ) => InvolutiveSemiring (a, b)--instance ( InvolutiveSemiring a-         , InvolutiveSemiring b-         , InvolutiveSemiring c-         ) => InvolutiveSemiring (a, b, c)--instance ( InvolutiveSemiring a-         , InvolutiveSemiring b-         , InvolutiveSemiring c-         , InvolutiveSemiring d-         ) => InvolutiveSemiring (a, b, c, d)--instance ( InvolutiveSemiring a-         , InvolutiveSemiring b-         , InvolutiveSemiring c-         , InvolutiveSemiring d-         , InvolutiveSemiring e-         ) => InvolutiveSemiring (a, b, c, d, e)----- | --- > adjoint = id-class ( Commutative r-      , InvolutiveMultiplication r-      ) => TriviallyInvolutive r--instance TriviallyInvolutive Bool-instance TriviallyInvolutive Int-instance TriviallyInvolutive Integer-instance TriviallyInvolutive Int8-instance TriviallyInvolutive Int16-instance TriviallyInvolutive Int32-instance TriviallyInvolutive Int64-instance TriviallyInvolutive Word-instance TriviallyInvolutive Natural-instance TriviallyInvolutive Word8-instance TriviallyInvolutive Word16-instance TriviallyInvolutive Word32-instance TriviallyInvolutive Word64-instance TriviallyInvolutive ()--instance ( TriviallyInvolutive a-         , TriviallyInvolutive b-         ) => TriviallyInvolutive (a,b)--instance ( TriviallyInvolutive a-         , TriviallyInvolutive b-         , TriviallyInvolutive c-         ) => TriviallyInvolutive (a,b,c)--instance ( TriviallyInvolutive a-         , TriviallyInvolutive b-         , TriviallyInvolutive c-         , TriviallyInvolutive d-         ) => TriviallyInvolutive (a,b,c,d)--instance ( TriviallyInvolutive a-         , TriviallyInvolutive b-         , TriviallyInvolutive c-         , TriviallyInvolutive d-         , TriviallyInvolutive e-         ) => TriviallyInvolutive (a,b,c,d,e)--instance ( TriviallyInvolutive r-         , TriviallyInvolutiveAlgebra r a-         ) => TriviallyInvolutive (a -> r)--instance ( HasTrie a-         , TriviallyInvolutive r-         , TriviallyInvolutiveAlgebra r a-         ) => TriviallyInvolutive (a :->: r)------ inv is an associative algebra homomorphism-class (InvolutiveSemiring r, Algebra r a) => InvolutiveAlgebra r a where-  inv :: (a -> r) -> a -> r--instance InvolutiveSemiring r => InvolutiveAlgebra r () where-  inv = (adjoint .)--instance -  ( InvolutiveAlgebra r a-  , InvolutiveAlgebra r b-  ) => InvolutiveAlgebra r (a, b) where-  inv f (a,b) = -    inv (\a' -> -    inv (\b' -> f (a',b')) b) a--instance -  ( InvolutiveAlgebra r a-  , InvolutiveAlgebra r b-  , InvolutiveAlgebra r c-  ) => InvolutiveAlgebra r (a, b, c) where-  inv f (a,b,c) =-    inv (\a' -> -    inv (\b' ->-    inv (\c' -> f (a',b',c')) c) b) a--instance -  ( InvolutiveAlgebra r a-  , InvolutiveAlgebra r b-  , InvolutiveAlgebra r c-  , InvolutiveAlgebra r d-  ) => InvolutiveAlgebra r (a, b, c, d) where-  inv f (a,b,c,d) = -    inv (\a' ->-    inv (\b' ->-    inv (\c' -> -    inv (\d' -> f (a',b',c',d')) d) c) b) a--instance -  ( InvolutiveAlgebra r a-  , InvolutiveAlgebra r b-  , InvolutiveAlgebra r c-  , InvolutiveAlgebra r d-  , InvolutiveAlgebra r e-  ) => InvolutiveAlgebra r (a, b, c, d, e) where-  inv f (a,b,c,d,e) = -    inv (\a' -> -    inv (\b' -> -    inv (\c' -> -    inv (\d' -> -    inv (\e' -> f (a',b',c',d',e')) e) d) c) b) a----class ( CommutativeAlgebra r a-      , TriviallyInvolutive r-      , InvolutiveAlgebra r a-      ) => TriviallyInvolutiveAlgebra r a--instance ( TriviallyInvolutive r-         , InvolutiveSemiring r-         ) => TriviallyInvolutiveAlgebra r ()--instance ( TriviallyInvolutiveAlgebra r a-         , TriviallyInvolutiveAlgebra r b-         ) => TriviallyInvolutiveAlgebra r (a, b) where--instance (TriviallyInvolutiveAlgebra r a-         , TriviallyInvolutiveAlgebra r b-         , TriviallyInvolutiveAlgebra r c-         ) => TriviallyInvolutiveAlgebra r (a, b, c) where--instance ( TriviallyInvolutiveAlgebra r a-         , TriviallyInvolutiveAlgebra r b-         , TriviallyInvolutiveAlgebra r c-         , TriviallyInvolutiveAlgebra r d-         ) => TriviallyInvolutiveAlgebra r (a, b, c, d)--instance ( TriviallyInvolutiveAlgebra r a-         , TriviallyInvolutiveAlgebra r b-         , TriviallyInvolutiveAlgebra r c-         , TriviallyInvolutiveAlgebra r d-         , TriviallyInvolutiveAlgebra r e-         ) => TriviallyInvolutiveAlgebra r (a, b, c, d, e)----class ( InvolutiveSemiring r-      , Coalgebra r c-      ) => InvolutiveCoalgebra r c where-  coinv :: (c -> r) -> c -> r--instance InvolutiveSemiring r => InvolutiveCoalgebra r () where-  coinv f c = adjoint (f c)--instance -  ( InvolutiveCoalgebra r a-  , InvolutiveCoalgebra r b-  ) => InvolutiveCoalgebra r (a, b) where-  coinv f (a,b) = -    coinv (\a' -> -    coinv (\b' -> f (a',b')) b) a--instance -  ( InvolutiveCoalgebra r a-  , InvolutiveCoalgebra r b-  , InvolutiveCoalgebra r c-  ) => InvolutiveCoalgebra r (a, b, c) where-  coinv f (a,b,c) = -    coinv (\a' -> -    coinv (\b' -> -    coinv (\c' -> f (a',b',c')) c) b) a--instance -  ( InvolutiveCoalgebra r a-  , InvolutiveCoalgebra r b-  , InvolutiveCoalgebra r c-  , InvolutiveCoalgebra r d-  ) => InvolutiveCoalgebra r (a, b, c, d) where-  coinv f (a,b,c,d) = -    coinv (\a' -> -    coinv (\b' -> -    coinv (\c' -> -    coinv (\d' -> f (a',b',c',d')) d) c) b) a--instance -  ( InvolutiveCoalgebra r a-  , InvolutiveCoalgebra r b-  , InvolutiveCoalgebra r c-  , InvolutiveCoalgebra r d-  , InvolutiveCoalgebra r e-  ) => InvolutiveCoalgebra r (a, b, c, d, e) where-  coinv f (a,b,c,d,e) = -    coinv (\a' -> -    coinv (\b' -> -    coinv (\c' -> -    coinv (\d' -> -    coinv (\e' -> f (a',b',c',d',e')) e) d) c) b) a----class ( CocommutativeCoalgebra r a-      , TriviallyInvolutive r-      , InvolutiveCoalgebra r a-      ) => TriviallyInvolutiveCoalgebra r a--instance ( TriviallyInvolutive r-         , InvolutiveSemiring r-         ) => TriviallyInvolutiveCoalgebra r ()--instance ( TriviallyInvolutiveCoalgebra r a-         , TriviallyInvolutiveCoalgebra r b-         ) => TriviallyInvolutiveCoalgebra r (a, b)--instance ( TriviallyInvolutiveCoalgebra r a-         , TriviallyInvolutiveCoalgebra r b-         , TriviallyInvolutiveCoalgebra r c-         ) => TriviallyInvolutiveCoalgebra r (a, b, c)--instance ( TriviallyInvolutiveCoalgebra r a-         , TriviallyInvolutiveCoalgebra r b-         , TriviallyInvolutiveCoalgebra r c-         , TriviallyInvolutiveCoalgebra r d-         ) => TriviallyInvolutiveCoalgebra r (a, b, c, d)--instance ( TriviallyInvolutiveCoalgebra r a-         , TriviallyInvolutiveCoalgebra r b-         , TriviallyInvolutiveCoalgebra r c-         , TriviallyInvolutiveCoalgebra r d-         , TriviallyInvolutiveCoalgebra r e-         ) => TriviallyInvolutiveCoalgebra r (a, b, c, d, e)----class ( Bialgebra r h-      , InvolutiveAlgebra r h-      , InvolutiveCoalgebra r h-      ) => InvolutiveBialgebra r h--instance ( Bialgebra r h-         , InvolutiveAlgebra r h-         , InvolutiveCoalgebra r h-         ) => InvolutiveBialgebra r h----class ( InvolutiveBialgebra r h-      , TriviallyInvolutiveAlgebra r h-      , TriviallyInvolutiveCoalgebra r h-      ) => TriviallyInvolutiveBialgebra r h--instance ( InvolutiveBialgebra r h-         , TriviallyInvolutiveAlgebra r h-         , TriviallyInvolutiveCoalgebra r h-         ) => TriviallyInvolutiveBialgebra r h
− Numeric/Algebra/Quaternion.hs 
@@ -1,334 +0,0 @@-{-# LANGUAGE FlexibleInstances-           , MultiParamTypeClasses-           , TypeFamilies-           , UndecidableInstances-           , DeriveDataTypeable-           , TypeOperators #-}-module Numeric.Algebra.Quaternion -  ( Distinguished(..)-  , Complicated(..)-  , Hamiltonian(..)-  , QuaternionBasis(..)-  , Quaternion(..)-  , complicate-  , vectorPart-  , scalarPart-  ) where--import Control.Applicative-import Control.Monad.Reader.Class-import Data.Ix hiding (index)-import Data.Key-import Data.Data-import Data.Distributive-import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Foldable-import Data.Traversable-import Data.Semigroup-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Numeric.Algebra-import Numeric.Algebra.Distinguished.Class-import Numeric.Algebra.Complex.Class-import Numeric.Algebra.Quaternion.Class-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)--instance Distinguished QuaternionBasis where-  e = E--instance Complicated QuaternionBasis where-  i = I--instance Hamiltonian QuaternionBasis where-  j = J-  k = K--instance Rig r => Distinguished (Quaternion r) where-  e = Quaternion one zero zero zero--instance Rig r => Complicated (Quaternion r) where-  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 => Distinguished (QuaternionBasis :->: r) where-  e = Trie e--instance Rig r => Complicated (QuaternionBasis :->: r) where-  i = Trie i--instance Rig r => Hamiltonian (QuaternionBasis :->: r) where-  j = Trie j-  k = Trie k--instance Rig r => Distinguished (QuaternionBasis -> r) where-  e E = one -  e _ = zero--instance Rig r => Complicated (QuaternionBasis -> r) where-  i I = one-  i _ = zero-  -instance Rig r => Hamiltonian (QuaternionBasis -> r) where-  j J = one-  j _ = zero--  k K = one-  k _ = zero---- 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 -  sinnum1p = sinnum1pRep--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-  sinnum = sinnumRep--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---- | the quaternion algebra-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---- | the trivial diagonal coalgebra-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' I I = fi-    f' J J = fj-    f' K K = fk-    f' _ _ = zero--instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where-  counit f = f E + f I + f J + f K--{---- dual quaternion comultiplication-instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where-  comult f = f' where-    fe = f E-    fi = f I-    fj = f J-    fk = f K-    fe' = negate fe-    fi' = negate fi-    fj' = negate fj-    fk' = negate fk-    f' E E = fe-    f' E I = fi-    f' E J = fj-    f' E K = fk-    f' I E = fi-    f' I I = fe'-    f' I J = fk-    f' I K = fj'-    f' J E = fj-    f' J I = fk'-    f' J J = fe'-    f' J K = fi-    f' K E = fk-    f' K I = fj-    f' K J = fi'-    f' K K = fe'--instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where-  counit f = f E--}--instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis --instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis where-  inv f E = f E-  inv f b = negate (f b)--instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis where-  coinv = inv--instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis where-  antipode = inv--instance (TriviallyInvolutive r, Rng r) => Multiplicative (Quaternion r) where-  (*) = mulRep--instance (TriviallyInvolutive r, Rng r) => Semiring (Quaternion r)--instance (TriviallyInvolutive r, Ring r) => Unital (Quaternion r) where-  one = oneRep--instance (TriviallyInvolutive r, Ring r) => Rig (Quaternion r) where-  fromNatural n = Quaternion (fromNatural n) zero zero zero--instance (TriviallyInvolutive r, Ring r) => Ring (Quaternion r) where-  fromInteger n = Quaternion (fromInteger n) zero zero zero--instance ( TriviallyInvolutive r, Rng r) => LeftModule (Quaternion r) (Quaternion r) where -  (.*) = (*)-instance (TriviallyInvolutive r, Rng r) => RightModule (Quaternion r) (Quaternion r) where -  (*.) = (*)--instance (TriviallyInvolutive r, Rng r) => InvolutiveMultiplication (Quaternion r) where-  -- without trivial involution, multiplication fails associativity, and we'd need to -  -- support weaker multiplicative properties like Alternative and PowerAssociative-  adjoint (Quaternion a b c d) = Quaternion a (negate b) (negate c) (negate d)---- | Cayley-Dickson quaternion isomorphism (one way)-complicate :: Complicated c => QuaternionBasis -> (c,c)-complicate E = (e, e)-complicate I = (i, e) -complicate J = (e, i)-complicate K = (i, i)--scalarPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> r-scalarPart f = index f E--vectorPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> (r,r,r)-vectorPart f = (index f I, index f J, index f K)--instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion r) where-  quadrance n = scalarPart (adjoint n * n)--instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion r) where-  recip q@(Quaternion a b c d) = Quaternion (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)-    where qq = quadrance q
− Numeric/Algebra/Quaternion/Class.hs 
@@ -1,14 +0,0 @@-module Numeric.Algebra.Quaternion.Class-  ( Hamiltonian(..)-  ) where--import Numeric.Algebra.Complex.Class-import Numeric.Covector--class Complicated t => Hamiltonian t where-  j :: t-  k :: t--instance Hamiltonian a => Hamiltonian (Covector r a) where-  j = return j-  k = return k
− Numeric/Algebra/Unital.hs 
@@ -1,157 +0,0 @@-{-# 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)
− Numeric/Band/Class.hs 
@@ -1,7 +0,0 @@-module Numeric.Band.Class-  ( Band-  , pow1pBand-  , powBand-  ) where--import Numeric.Algebra.Idempotent
− Numeric/Band/Rectangular.hs 
@@ -1,21 +0,0 @@-module Numeric.Band.Rectangular -  ( Rect(..)-  ) where--import Numeric.Algebra.Class-import Numeric.Algebra.Idempotent-import Data.Semigroupoid---- | a rectangular band is a nowhere commutative semigroup.--- That is to say, if ab = ba then a = b. From this it follows--- classically that aa = a and that such a band is isomorphic --- to the following structure-data Rect i j = Rect i j deriving (Eq,Ord,Show,Read)--instance Semigroupoid Rect where-  Rect _ i `o` Rect j _ = Rect j i--instance Multiplicative (Rect i j) where-  Rect i _ * Rect _ j = Rect i j--instance Band (Rect i j)
− Numeric/Coalgebra/Categorical.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, PatternGuards #-}-module Numeric.Coalgebra.Categorical -  ( Morphism(..)-  ) where--import Data.Data-import Numeric.Partial.Semigroup-import Numeric.Partial.Monoid-import Numeric.Partial.Group-import Numeric.Algebra.Class-import Numeric.Algebra.Unital-import Numeric.Algebra.Commutative---- the dual categorical algebra-newtype Morphism a = Morphism a deriving (Eq,Ord,Show,Read,PartialSemigroup,PartialMonoid,PartialGroup,Data,Typeable)--instance (Commutative r, Monoidal r, Semiring r, PartialSemigroup a) => Coalgebra r (Morphism a) where-  comult f a b -    | Just c <- padd a b = f c-    | otherwise = zero--instance (Commutative r, Monoidal r, Semiring r, PartialMonoid a) => CounitalCoalgebra r (Morphism a) where-  counit f = f pzero
− Numeric/Coalgebra/Dual.hs 
@@ -1,227 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}-module Numeric.Coalgebra.Dual-  ( Distinguished(..)-  , Infinitesimal(..)-  , DualBasis'(..)-  , Dual'(..)-  ) 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.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.Semigroup-import Data.Traversable-import Numeric.Algebra-import Numeric.Algebra.Distinguished.Class-import Numeric.Algebra.Dual.Class-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)---- | dual number basis, D^2 = 0. D /= 0.-data DualBasis' = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)-data Dual' a = Dual' a a deriving (Eq,Show,Read,Data,Typeable)--instance Distinguished DualBasis' where-  e = E--instance Infinitesimal DualBasis' where-  d = D--instance Rig r => Distinguished (Dual' r) where-  e = Dual' one zero--instance Rig r => Infinitesimal (Dual' r) where-  d = Dual' zero one-  -instance Rig r => Distinguished (DualBasis' -> r) where-  e E = one-  e _ = zero--instance Rig r => Infinitesimal (DualBasis' -> r) where-  d D = one-  d _       = zero --type instance Key Dual' = DualBasis'--instance Representable Dual' where-  tabulate f = Dual' (f E) (f D)--instance Indexable Dual' where-  index (Dual' a _ ) E = a-  index (Dual' _ b ) D = b--instance Lookup Dual' where-  lookup = lookupDefault--instance Adjustable Dual' where-  adjust f E (Dual' a b) = Dual' (f a) b-  adjust f D (Dual' a b) = Dual' a (f b)--instance Distributive Dual' where-  distribute = distributeRep --instance Functor Dual' where-  fmap f (Dual' a b) = Dual' (f a) (f b)--instance Zip Dual' where-  zipWith f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f a1 a2) (f b1 b2)--instance ZipWithKey Dual' where-  zipWithKey f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f E a1 a2) (f D b1 b2)--instance Keyed Dual' where-  mapWithKey = mapWithKeyRep--instance Apply Dual' where-  (<.>) = apRep--instance Applicative Dual' where-  pure = pureRep-  (<*>) = apRep --instance Bind Dual' where-  (>>-) = bindRep--instance Monad Dual' where-  return = pureRep-  (>>=) = bindRep--instance MonadReader DualBasis' Dual' where-  ask = askRep-  local = localRep--instance Foldable Dual' where-  foldMap f (Dual' a b) = f a `mappend` f b--instance FoldableWithKey Dual' where-  foldMapWithKey f (Dual' a b) = f E a `mappend` f D b--instance Traversable Dual' where-  traverse f (Dual' a b) = Dual' <$> f a <*> f b--instance TraversableWithKey Dual' where-  traverseWithKey f (Dual' a b) = Dual' <$> f E a <*> f D b--instance Foldable1 Dual' where-  foldMap1 f (Dual' a b) = f a <> f b--instance FoldableWithKey1 Dual' where-  foldMapWithKey1 f (Dual' a b) = f E a <> f D b--instance Traversable1 Dual' where-  traverse1 f (Dual' a b) = Dual' <$> f a <.> f b--instance TraversableWithKey1 Dual' where-  traverseWithKey1 f (Dual' a b) = Dual' <$> f E a <.> f D b--instance HasTrie DualBasis' where-  type BaseTrie DualBasis' = Dual'-  embedKey = id-  projectKey = id--instance Additive r => Additive (Dual' r) where-  (+) = addRep -  sinnum1p = sinnum1pRep--instance LeftModule r s => LeftModule r (Dual' s) where-  r .* Dual' a b = Dual' (r .* a) (r .* b)--instance RightModule r s => RightModule r (Dual' s) where-  Dual' a b *. r = Dual' (a *. r) (b *. r)--instance Monoidal r => Monoidal (Dual' r) where-  zero = zeroRep-  sinnum = sinnumRep--instance Group r => Group (Dual' r) where-  (-) = minusRep-  negate = negateRep-  subtract = subtractRep-  times = timesRep--instance Abelian r => Abelian (Dual' r)--instance Idempotent r => Idempotent (Dual' r)--instance Partitionable r => Partitionable (Dual' r) where-  partitionWith f (Dual' a b) = id =<<-    partitionWith (\a1 a2 -> -    partitionWith (\b1 b2 -> f (Dual' a1 b1) (Dual' a2 b2)) b) a--instance Semiring k => Algebra k DualBasis' where-  mult f = f' where-    fe = f E E-    fd = f D D-    f' E = fe-    f' D = fd--instance Semiring k => UnitalAlgebra k DualBasis' where-  unit = const---- the trivial coalgebra-instance Rng k => Coalgebra k DualBasis' where-  comult f = f' where-     fe = f E-     fd = f D-     f' E E = fe-     f' E D = fd-     f' D E = fd-     f' D D = zero--instance Rng k => CounitalCoalgebra k DualBasis' where-  counit f = f E--instance Rng k => Bialgebra k DualBasis' --instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis' where-  inv f = f' where-    afe = adjoint (f E)-    nfd = negate (f D)-    f' E = afe-    f' D = nfd--instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis' where-  coinv = inv--instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis' where-  antipode = inv--instance (Commutative r, Rng r) => Multiplicative (Dual' r) where-  (*) = mulRep--instance (TriviallyInvolutive r, Rng r) => Commutative (Dual' r)--instance (Commutative r, Rng r) => Semiring (Dual' r)--instance (Commutative r, Ring r) => Unital (Dual' r) where-  one = oneRep--instance (Commutative r, Ring r) => Rig (Dual' r) where-  fromNatural n = Dual' (fromNatural n) zero--instance (Commutative r, Ring r) => Ring (Dual' r) where-  fromInteger n = Dual' (fromInteger n) zero--instance (Commutative r, Rng r) => LeftModule (Dual' r) (Dual' r) where (.*) = (*)-instance (Commutative r, Rng r) => RightModule (Dual' r) (Dual' r) where (*.) = (*)--instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual' r) where-  adjoint (Dual' a b) = Dual' (adjoint a) (negate b)--instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual' r)--instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual' r) where-  quadrance n = case adjoint n * n of-    Dual' a _ -> a--instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual' r) where-  recip q@(Dual' a b) = Dual' (qq \\ a) (qq \\ b)-    where qq = quadrance q
− Numeric/Coalgebra/Geometric.hs 
@@ -1,214 +0,0 @@-{-# LANGUAGE -    MultiParamTypeClasses, -    GeneralizedNewtypeDeriving, -    BangPatterns,-    TypeOperators,-    DeriveDataTypeable,-    FlexibleInstances,-    TypeFamilies,-    PatternGuards,-    UndecidableInstances,-    ScopedTypeVariables #-}--module Numeric.Coalgebra.Geometric-  ( -  -- * Geometric coalgebra primitives-    BasisCoblade(..)-  , Comultivector-  -- * Operations over an eigenbasis-  , Eigenbasis(..)-  , Eigenmetric(..)-  , Euclidean(..)-  -- * 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 coalgebra with the Euclidean inner product-newtype BasisCoblade m = BasisCoblade { runBasisCoblade :: 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 (BasisCoblade m) where-  type BaseTrie (BasisCoblade m) = BaseTrie Word64-  embedKey = embedKey . runBasisCoblade-  projectKey = BasisCoblade . projectKey---- A metric space over an eigenbasis-class Eigenbasis m where-  euclidean     :: proxy m -> Bool-  antiEuclidean :: proxy m -> Bool-  v             :: m -> BasisCoblade m-  e             :: Int -> m---- assuming n /= 0, find the index of the least significant set bit in a basis blade-lsb :: BasisCoblade m -> Int-lsb n = fromIntegral $ ix ! shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58-  where -    -- a 64 bit deBruijn multiplication table-    ix :: UArray (BasisCoblade 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 (BasisCoblade m)---- 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 :: BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> Int -> Comultivector r m-filterGrade b k | grade b == k = zero-                | otherwise    = return b--instance Eigenmetric r m => Coalgebra r (BasisCoblade 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 -> BasisCoblade 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 (BasisCoblade m) where-  counit f = f (BasisCoblade zero)---- instance Group r => InvertibleModule r BasisCoblade where-  --- reversion (A~) is an involution for the outer product-reverse :: Group r => BasisCoblade m -> Comultivector r m-reverse b = shiftR (g * (g - 1)) 1 `m1powTimes` return b where-  g = grade b--cliffordConjugate :: Group r => BasisCoblade m -> Comultivector r m-cliffordConjugate b = shiftR (g * (g + 1)) 1 `m1powTimes` return b where-  g = grade b---- A^-gradeInversion :: Group r => BasisCoblade m -> Comultivector r m-gradeInversion b = grade b `m1powTimes` return b--geometric :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m  -geometric = multM--outer :: Eigenmetric r m => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 :: (BasisCoblade m -> BasisCoblade 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
− Numeric/Coalgebra/Hyperbolic.hs 
@@ -1,212 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}-module Numeric.Coalgebra.Hyperbolic -  ( Hyperbolic(..)-  , HyperBasis(..)-  , Hyper(..)-  ) where--import Control.Applicative-import Control.Monad.Reader.Class-import Data.Data-import Data.Distributive-import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Foldable-import Data.Ix-import Data.Key-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.Semigroup-import Data.Traversable-import Numeric.Algebra-import Numeric.Coalgebra.Hyperbolic.Class-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, cosh, sinh)---- complex basis-data HyperBasis = Cosh | Sinh deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)-data Hyper a = Hyper a a deriving (Eq,Show,Read,Data,Typeable)--instance Hyperbolic HyperBasis where-  cosh = Cosh-  sinh = Sinh--instance Rig r => Hyperbolic (Hyper r) where-  cosh = Hyper one zero-  sinh = Hyper zero one-  -instance Rig r => Hyperbolic (HyperBasis -> r) where-  cosh Sinh = zero-  cosh Cosh = one-  sinh Sinh = one-  sinh Cosh = zero--type instance Key Hyper = HyperBasis--instance Representable Hyper where-  tabulate f = Hyper (f Cosh) (f Sinh)--instance Indexable Hyper where-  index (Hyper a _ ) Cosh = a-  index (Hyper _ b ) Sinh = b--instance Lookup Hyper where-  lookup = lookupDefault--instance Adjustable Hyper where-  adjust f Cosh (Hyper a b) = Hyper (f a) b-  adjust f Sinh (Hyper a b) = Hyper a (f b)--instance Distributive Hyper where-  distribute = distributeRep --instance Functor Hyper where-  fmap f (Hyper a b) = Hyper (f a) (f b)--instance Zip Hyper where-  zipWith f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f a1 a2) (f b1 b2)--instance ZipWithKey Hyper where-  zipWithKey f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f Cosh a1 a2) (f Sinh b1 b2)--instance Keyed Hyper where-  mapWithKey = mapWithKeyRep--instance Apply Hyper where-  (<.>) = apRep--instance Applicative Hyper where-  pure = pureRep-  (<*>) = apRep --instance Bind Hyper where-  (>>-) = bindRep--instance Monad Hyper where-  return = pureRep-  (>>=) = bindRep--instance MonadReader HyperBasis Hyper where-  ask = askRep-  local = localRep--instance Foldable Hyper where-  foldMap f (Hyper a b) = f a `mappend` f b--instance FoldableWithKey Hyper where-  foldMapWithKey f (Hyper a b) = f Cosh a `mappend` f Sinh b--instance Traversable Hyper where-  traverse f (Hyper a b) = Hyper <$> f a <*> f b--instance TraversableWithKey Hyper where-  traverseWithKey f (Hyper a b) = Hyper <$> f Cosh a <*> f Sinh b--instance Foldable1 Hyper where-  foldMap1 f (Hyper a b) = f a <> f b--instance FoldableWithKey1 Hyper where-  foldMapWithKey1 f (Hyper a b) = f Cosh a <> f Sinh b--instance Traversable1 Hyper where-  traverse1 f (Hyper a b) = Hyper <$> f a <.> f b--instance TraversableWithKey1 Hyper where-  traverseWithKey1 f (Hyper a b) = Hyper <$> f Cosh a <.> f Sinh b--instance HasTrie HyperBasis where-  type BaseTrie HyperBasis = Hyper-  embedKey = id-  projectKey = id--instance Additive r => Additive (Hyper r) where-  (+) = addRep -  sinnum1p = sinnum1pRep--instance LeftModule r s => LeftModule r (Hyper s) where-  r .* Hyper a b = Hyper (r .* a) (r .* b)--instance RightModule r s => RightModule r (Hyper s) where-  Hyper a b *. r = Hyper (a *. r) (b *. r)--instance Monoidal r => Monoidal (Hyper r) where-  zero = zeroRep-  sinnum = sinnumRep--instance Group r => Group (Hyper r) where-  (-) = minusRep-  negate = negateRep-  subtract = subtractRep-  times = timesRep--instance Abelian r => Abelian (Hyper r)--instance Idempotent r => Idempotent (Hyper r)--instance Partitionable r => Partitionable (Hyper r) where-  partitionWith f (Hyper a b) = id =<<-    partitionWith (\a1 a2 -> -    partitionWith (\b1 b2 -> f (Hyper a1 b1) (Hyper a2 b2)) b) a---- | the trivial diagonal algebra-instance Semiring k => Algebra k HyperBasis where-  mult f = f' where-    fs = f Sinh Sinh-    fc = f Cosh Cosh-    f' Sinh = fs-    f' Cosh = fc--instance Semiring k => UnitalAlgebra k HyperBasis where-  unit = const---- | the hyperbolic trigonometric coalgebra-instance (Commutative k, Semiring k) => Coalgebra k HyperBasis where-  comult f = f' where-     fs = f Sinh-     fc = f Cosh-     f' Sinh Sinh = fc-     f' Sinh Cosh = fs -     f' Cosh Sinh = fs-     f' Cosh Cosh = fc--instance (Commutative k, Semiring k) => CounitalCoalgebra k HyperBasis where-  counit f = f Cosh--instance (Commutative k, Semiring k) => Bialgebra k HyperBasis--instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis where-  inv f = f' where-    afc = adjoint (f Cosh)-    nfs = negate (f Sinh)-    f' Cosh = afc-    f' Sinh = nfs--instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis where-  coinv = inv--instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis where-  antipode = inv--instance (Commutative k, Semiring k) => Multiplicative (Hyper k) where-  (*) = mulRep--instance (Commutative k, Semiring k) => Commutative (Hyper k)--instance (Commutative k, Semiring k) => Semiring (Hyper k)--instance (Commutative k, Rig k) => Unital (Hyper k) where-  one = Hyper one zero--instance (Commutative r, Rig r) => Rig (Hyper r) where-  fromNatural n = Hyper (fromNatural n) zero--instance (Commutative r, Ring r) => Ring (Hyper r) where-  fromInteger n = Hyper (fromInteger n) zero--instance (Commutative r, Semiring r) => LeftModule (Hyper r) (Hyper r) where (.*) = (*)-instance (Commutative r, Semiring r) => RightModule (Hyper r) (Hyper r) where (*.) = (*)--instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveMultiplication (Hyper r) where-  adjoint (Hyper a b) = Hyper (adjoint a) (negate b)--instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveSemiring (Hyper r)
− Numeric/Coalgebra/Hyperbolic/Class.hs 
@@ -1,14 +0,0 @@-module Numeric.Coalgebra.Hyperbolic.Class-  ( Hyperbolic(..)-  ) where--import Prelude (return)-import Numeric.Covector--class Hyperbolic r where-  cosh :: r-  sinh :: r--instance Hyperbolic a => Hyperbolic (Covector r a) where-  cosh = return cosh-  sinh = return sinh
− Numeric/Coalgebra/Incidence.hs 
@@ -1,35 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses-           , FlexibleInstances-           , UndecidableInstances-           , DeriveDataTypeable-           #-}--module Numeric.Coalgebra.Incidence-  ( Interval'(..)-  , zeta'-  , moebius'-  ) where--import Data.Data-import Numeric.Algebra.Class-import Numeric.Algebra.Unital-import Numeric.Algebra.Commutative-import Numeric.Ring.Class-import Numeric.Order.LocallyFinite---- | the dual incidence algebra basis-data Interval' a = Interval' a a deriving (Eq,Ord,Show,Read,Data,Typeable)--instance (Eq a, Commutative r, Monoidal r, Semiring r) => Coalgebra r (Interval' a) where-  comult f (Interval' a b) (Interval' b' c) -    | b == b' = f (Interval' a c)-    | otherwise = zero--instance (Eq a, Bounded a, Commutative r, Monoidal r, Semiring r) => CounitalCoalgebra r (Interval' a) where-  counit f = f (Interval' minBound maxBound)-  -zeta' :: Unital r => Interval' a -> r-zeta' = const one--moebius' :: (Ring r, LocallyFiniteOrder a) => Interval' a -> r-moebius' (Interval' a b) = moebiusInversion a b
− Numeric/Coalgebra/Quaternion.hs 
@@ -1,316 +0,0 @@-{-# LANGUAGE FlexibleInstances-           , MultiParamTypeClasses-           , TypeFamilies-           , UndecidableInstances-           , DeriveDataTypeable-           , TypeOperators #-}-module Numeric.Coalgebra.Quaternion-  ( Distinguished(..)-  , Complicated(..)-  , Hamiltonian(..)-  , QuaternionBasis'(..)-  , Quaternion'(..)-  , complicate'-  , vectorPart'-  , scalarPart'-  ) where--import Control.Applicative-import Control.Monad.Reader.Class-import Data.Ix hiding (index)-import Data.Key-import Data.Data-import Data.Distributive-import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Foldable-import Data.Traversable-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.Semigroup-import Numeric.Algebra-import Numeric.Algebra.Distinguished.Class-import Numeric.Algebra.Complex.Class-import Numeric.Algebra.Quaternion.Class-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)--instance Distinguished QuaternionBasis' where-  e = E'--instance Complicated QuaternionBasis' where-  i = I'--instance Hamiltonian QuaternionBasis' where-  j = J'-  k = K'--instance Rig r => Distinguished (Quaternion' r) where-  e = Quaternion' one zero zero zero--instance Rig r => Complicated (Quaternion' r) where-  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 => Distinguished (QuaternionBasis' :->: r) where-  e = Trie e--instance Rig r => Complicated (QuaternionBasis' :->: r) where-  i = Trie i--instance Rig r => Hamiltonian (QuaternionBasis' :->: r) where-  j = Trie j-  k = Trie k--instance Rig r => Distinguished (QuaternionBasis' -> r) where-  e E' = one-  e _ = zero--instance Rig r => Complicated (QuaternionBasis' -> r) where-  i I' = one-  i _ = zero--instance Rig r => Hamiltonian (QuaternionBasis' -> r) where-  j J' = one-  j _ = zero--  k K' = one-  k _ = zero---- 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-  sinnum1p = sinnum1pRep--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-  sinnum = sinnumRep--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---- | the trivial diagonal algebra-instance (TriviallyInvolutive r, Semiring r) => Algebra r QuaternionBasis' where-  mult f = f' where-    fe = f E' E'-    fi = f I' I'-    fj = f J' J'-    fk = f K' K'-    f' E' = fe-    f' I' = fi-    f' J' = fj-    f' K' = fk--instance (TriviallyInvolutive r, Semiring r) => UnitalAlgebra r QuaternionBasis' where-  unit = const----- | dual quaternion comultiplication-instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis' where-  comult f = f' where-    fe = f E'-    fi = f I'-    fj = f J'-    fk = f K'-    fe' = negate fe-    fi' = negate fi-    fj' = negate fj-    fk' = negate fk-    f' E' E' = fe-    f' E' I' = fi-    f' E' J' = fj-    f' E' K' = fk-    f' I' E' = fi-    f' I' I' = fe'-    f' I' J' = fk-    f' I' K' = fj'-    f' J' E' = fj-    f' J' I' = fk'-    f' J' J' = fe'-    f' J' K' = fi-    f' K' E' = fk-    f' K' I' = fj-    f' K' J' = fi'-    f' K' K' = fe'--instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis' where-  counit f = f E'--instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis'--instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis' where-  inv f E' = f E'-  inv f b = negate (f b)--instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis' where-  coinv = inv--instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis' where-  antipode = inv--instance (TriviallyInvolutive r, Semiring r) => Multiplicative (Quaternion' r) where-  (*) = mulRep--instance (TriviallyInvolutive r, Semiring 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' :: Complicated c => QuaternionBasis' -> (c , c)-complicate' E' = (e, e)-complicate' I' = (i, e)-complicate' J' = (e, i)-complicate' K' = (i, i)--scalarPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> r-scalarPart' f = index f E'--vectorPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> (r,r,r)-vectorPart' f = (index f I', index f J', index f K')--instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion' r) where-  quadrance n = scalarPart' (adjoint n * n)--instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion' r) where-  recip q@(Quaternion' a b c d) = Quaternion' (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)-    where qq = quadrance q
− Numeric/Coalgebra/Trigonometric.hs 
@@ -1,250 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses-           , FlexibleInstances-           , TypeFamilies-           , UndecidableInstances-           , DeriveDataTypeable-           , TypeOperators #-}-module Numeric.Coalgebra.Trigonometric -  ( Trigonometric(..)-  , TrigBasis(..)-  , Trig(..)-  ) where--import Control.Applicative-import Control.Monad.Reader.Class-import Data.Data-import Data.Distributive-import Data.Functor.Bind-import Data.Functor.Representable-import Data.Functor.Representable.Trie-import Data.Foldable-import Data.Ix-import Data.Key-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.Semigroup-import Data.Traversable-import Numeric.Algebra-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, sin, cos)-import Numeric.Algebra.Distinguished.Class-import Numeric.Algebra.Complex.Class-import Numeric.Coalgebra.Trigonometric.Class---- the dual complex basis-data TrigBasis = Cos | Sin deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)-data Trig a = Trig a a deriving (Eq,Show,Read,Data,Typeable)--instance Distinguished TrigBasis where-  e = Cos--instance Complicated TrigBasis where-  i = Sin--instance Trigonometric TrigBasis where-  cos = Cos-  sin = Sin--instance Rig r => Distinguished (Trig r) where-  e = Trig one zero--instance Rig r => Complicated (Trig r) where-  i = Trig zero one--instance Rig r => Trigonometric (Trig r) where-  cos = Trig one zero-  sin = Trig zero one--instance Rig r => Distinguished (TrigBasis -> r) where-  e = cos--instance Rig r => Complicated (TrigBasis -> r) where-  i = sin-  -instance Rig r => Trigonometric (TrigBasis -> r) where-  cos Sin = zero-  cos Cos = one--  sin Sin = one-  sin Cos = zero--instance Rig r => Trigonometric (TrigBasis :->: r) where-  cos = Trie cos-  sin = Trie sin--instance Rig r => Distinguished (TrigBasis :->: r) where-  e = Trie e--instance Rig r => Complicated (TrigBasis :->: r) where-  i = Trie i-  -type instance Key Trig = TrigBasis--instance Representable Trig where-  tabulate f = Trig (f Cos) (f Sin)--instance Indexable Trig where-  index (Trig a _ ) Cos = a-  index (Trig _ b ) Sin = b--instance Lookup Trig where-  lookup = lookupDefault--instance Adjustable Trig where-  adjust f Cos (Trig a b) = Trig (f a) b-  adjust f Sin (Trig a b) = Trig a (f b)--instance Distributive Trig where-  distribute = distributeRep --instance Functor Trig where-  fmap f (Trig a b) = Trig (f a) (f b)--instance Zip Trig where-  zipWith f (Trig a1 b1) (Trig a2 b2) = Trig (f a1 a2) (f b1 b2)--instance ZipWithKey Trig where-  zipWithKey f (Trig a1 b1) (Trig a2 b2) = Trig (f Cos a1 a2) (f Sin b1 b2)--instance Keyed Trig where-  mapWithKey = mapWithKeyRep--instance Apply Trig where-  (<.>) = apRep--instance Applicative Trig where-  pure = pureRep-  (<*>) = apRep --instance Bind Trig where-  (>>-) = bindRep--instance Monad Trig where-  return = pureRep-  (>>=) = bindRep--instance MonadReader TrigBasis Trig where-  ask = askRep-  local = localRep--instance Foldable Trig where-  foldMap f (Trig a b) = f a `mappend` f b--instance FoldableWithKey Trig where-  foldMapWithKey f (Trig a b) = f Cos a `mappend` f Sin b--instance Traversable Trig where-  traverse f (Trig a b) = Trig <$> f a <*> f b--instance TraversableWithKey Trig where-  traverseWithKey f (Trig a b) = Trig <$> f Cos a <*> f Sin b--instance Foldable1 Trig where-  foldMap1 f (Trig a b) = f a <> f b--instance FoldableWithKey1 Trig where-  foldMapWithKey1 f (Trig a b) = f Cos a <> f Sin b--instance Traversable1 Trig where-  traverse1 f (Trig a b) = Trig <$> f a <.> f b--instance TraversableWithKey1 Trig where-  traverseWithKey1 f (Trig a b) = Trig <$> f Cos a <.> f Sin b--instance HasTrie TrigBasis where-  type BaseTrie TrigBasis = Trig-  embedKey = id-  projectKey = id--instance Additive r => Additive (Trig r) where-  (+) = addRep -  sinnum1p = sinnum1pRep--instance LeftModule r s => LeftModule r (Trig s) where-  r .* Trig a b = Trig (r .* a) (r .* b)--instance RightModule r s => RightModule r (Trig s) where-  Trig a b *. r = Trig (a *. r) (b *. r)--instance Monoidal r => Monoidal (Trig r) where-  zero = zeroRep-  sinnum = sinnumRep--instance Group r => Group (Trig r) where-  (-) = minusRep-  negate = negateRep-  subtract = subtractRep-  times = timesRep--instance Abelian r => Abelian (Trig r)--instance Idempotent r => Idempotent (Trig r)--instance Partitionable r => Partitionable (Trig r) where-  partitionWith f (Trig a b) = id =<<-    partitionWith (\a1 a2 -> -    partitionWith (\b1 b2 -> f (Trig a1 b1) (Trig a2 b2)) b) a---- the diagonal algebra-instance (Commutative k, Rng k) => Algebra k TrigBasis where-  mult f = f' where-    fc = f Cos Cos-    fs = f Sin Sin-    f' Cos = fc-    f' Sin = fs---- -instance (Commutative k, Rng k) => UnitalAlgebra k TrigBasis where-  unit = const---- The trigonometric coalgebra-instance (Commutative k, Rng k) => Coalgebra k TrigBasis where-  comult f = f' where-     fs = f Sin-     fc = f Cos-     fc' = negate fc-     f' Sin Sin = fc'-     f' Sin Cos = fs -     f' Cos Sin = fs-     f' Cos Cos = fc--instance (Commutative k, Rng k) => Bialgebra k TrigBasis--instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k TrigBasis where-  inv f = f' where-    afc = adjoint (f Cos)-    nfs = negate (f Sin)-    f' Cos = afc-    f' Sin = nfs--instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k TrigBasis where-  coinv = inv--instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k TrigBasis where-  antipode = inv--instance (Commutative k, Rng k) => CounitalCoalgebra k TrigBasis where-  counit f = f Cos--instance (Commutative k, Rng k) => Multiplicative (Trig k) where-  (*) = mulRep--instance (Commutative k, Rng k) => Commutative (Trig k)--instance (Commutative k, Rng k) => Semiring (Trig k)--instance (Commutative k, Ring k) => Unital (Trig k) where-  one = Trig one zero--instance (Commutative r, Ring r) => Rig (Trig r) where-  fromNatural n = Trig (fromNatural n) zero--instance (Commutative r, Ring r) => Ring (Trig r) where-  fromInteger n = Trig (fromInteger n) zero--instance (Commutative r, Rng r) => LeftModule (Trig r) (Trig r) where (.*) = (*)-instance (Commutative r, Rng r) => RightModule (Trig r) (Trig r) where (*.) = (*)--instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Trig r) where-  adjoint (Trig a b) = Trig (adjoint a) (negate b)--instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Trig r)
− Numeric/Coalgebra/Trigonometric/Class.hs 
@@ -1,14 +0,0 @@-module Numeric.Coalgebra.Trigonometric.Class-  ( Trigonometric(..)-  ) where--import Prelude (return)-import Numeric.Covector--class Trigonometric r where-  cos :: r-  sin :: r--instance Trigonometric a => Trigonometric (Covector r a) where-  cos = return cos-  sin = return sin
− Numeric/Covector.hs 
@@ -1,158 +0,0 @@-{-# LANGUAGE 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.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-  sinnum1p n (Covector m) = Covector $ sinnum1p n m--instance Coalgebra r m => Multiplicative (Covector r m) where-  Covector f * Covector g = Covector $ \k -> f (\m -> g (comult k m))--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-  sinnum n (Covector m) = Covector (sinnum 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
− Numeric/Decidable/Associates.hs 
@@ -1,54 +0,0 @@-module Numeric.Decidable.Associates -  ( DecidableAssociates(..)-  , isAssociateIntegral-  , isAssociateWhole-  ) where--import Data.Function (on)-import Data.Int-import Data.Word-import Numeric.Algebra.Unital-import Numeric.Natural.Internal--isAssociateIntegral :: (Eq n, Num n) => n -> n -> Bool-isAssociateIntegral = (==) `on` abs--isAssociateWhole :: Eq n => n -> n -> Bool-isAssociateWhole = (==)--class Unital r => DecidableAssociates r where-  -- | b is an associate of a if there exists a unit u such that b = a*u-  ---  -- This relationship is symmetric because if u is a unit, u^-1 exists and is a unit, so-  -- -  -- > b*u^-1 = a*u*u^-1 = a-  isAssociate :: r -> r -> Bool--instance DecidableAssociates Bool where isAssociate = (==)-instance DecidableAssociates Integer where isAssociate = isAssociateIntegral-instance DecidableAssociates Int where isAssociate = isAssociateIntegral-instance DecidableAssociates Int8 where isAssociate = isAssociateIntegral-instance DecidableAssociates Int16 where isAssociate = isAssociateIntegral-instance DecidableAssociates Int32 where isAssociate = isAssociateIntegral-instance DecidableAssociates Int64 where isAssociate = isAssociateIntegral--instance DecidableAssociates Natural where isAssociate = isAssociateWhole-instance DecidableAssociates Word where isAssociate = isAssociateWhole-instance DecidableAssociates Word8 where isAssociate = isAssociateWhole-instance DecidableAssociates Word16 where isAssociate = isAssociateWhole-instance DecidableAssociates Word32 where isAssociate = isAssociateWhole-instance DecidableAssociates Word64 where isAssociate = isAssociateWhole--instance DecidableAssociates () where isAssociate _ _ = True--instance (DecidableAssociates a, DecidableAssociates b) => DecidableAssociates (a, b) where-  isAssociate (a,b) (i,j) = isAssociate a i && isAssociate b j--instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c) => DecidableAssociates (a, b, c) where-  isAssociate (a,b,c) (i,j,k) = isAssociate a i && isAssociate b j && isAssociate c k--instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c, DecidableAssociates d) => DecidableAssociates (a, b, c, d) where-  isAssociate (a,b,c,d) (i,j,k,l) = isAssociate a i && isAssociate b j && isAssociate c k && isAssociate d l--instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c, DecidableAssociates d, DecidableAssociates e) => DecidableAssociates (a, b, c, d, e) where-  isAssociate (a,b,c,d,e) (i,j,k,l,m) = isAssociate a i && isAssociate b j && isAssociate c k && isAssociate d l && isAssociate e m
− Numeric/Decidable/Units.hs 
@@ -1,73 +0,0 @@-module Numeric.Decidable.Units -  ( DecidableUnits(..)-  , recipUnitIntegral-  , recipUnitWhole-  ) where--import Data.Maybe (isJust)-import Data.Int-import Data.Word-import Numeric.Algebra.Class-import Numeric.Algebra.Unital-import Numeric.Natural.Internal-import Control.Applicative-import Prelude hiding ((*))--class Unital r => DecidableUnits r where-  recipUnit :: r -> Maybe r--  isUnit :: DecidableUnits r => r -> Bool-  isUnit = isJust . recipUnit--  (^?) :: Integral n => r -> n -> Maybe r-  x0 ^? y0 = case compare y0 0 of-    LT -> fmap (`f` negate y0) (recipUnit x0)-    EQ -> Just one-    GT -> Just (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)--recipUnitIntegral :: Integral r => r -> Maybe r-recipUnitIntegral a@1 = Just a-recipUnitIntegral a@(-1) = Just a-recipUnitIntegral _ = Nothing--recipUnitWhole :: Integral r => r -> Maybe r-recipUnitWhole a@1 = Just a-recipUnitWhole _ = Nothing--instance DecidableUnits Bool where -  recipUnit False = Nothing-  recipUnit True = Just True-instance DecidableUnits Integer where recipUnit = recipUnitIntegral-instance DecidableUnits Int where recipUnit = recipUnitIntegral-instance DecidableUnits Int8 where recipUnit = recipUnitIntegral-instance DecidableUnits Int16 where recipUnit = recipUnitIntegral-instance DecidableUnits Int32 where recipUnit = recipUnitIntegral-instance DecidableUnits Int64 where recipUnit = recipUnitIntegral-instance DecidableUnits Natural where recipUnit = recipUnitWhole-instance DecidableUnits Word where recipUnit = recipUnitWhole-instance DecidableUnits Word8 where recipUnit = recipUnitWhole-instance DecidableUnits Word16 where recipUnit = recipUnitWhole-instance DecidableUnits Word32 where recipUnit = recipUnitWhole-instance DecidableUnits Word64 where recipUnit = recipUnitWhole-instance DecidableUnits () where recipUnit _ = Just ()--instance (DecidableUnits a, DecidableUnits b) => DecidableUnits (a, b) where-  recipUnit (a,b) = (,) <$> recipUnit a <*> recipUnit b--instance (DecidableUnits a, DecidableUnits b, DecidableUnits c) => DecidableUnits (a, b, c) where-  recipUnit (a,b,c) = (,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c--instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d) => DecidableUnits (a, b, c, d) where-  recipUnit (a,b,c,d) = (,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d--instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d, DecidableUnits e) => DecidableUnits (a, b, c, d, e) where-  recipUnit (a,b,c,d,e) = (,,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d <*> recipUnit e
− Numeric/Decidable/Zero.hs 
@@ -1,40 +0,0 @@-module Numeric.Decidable.Zero -  ( DecidableZero(..)-  ) where--import Numeric.Algebra.Class-import Data.Int-import Data.Word-import Numeric.Natural.Internal--class Monoidal r => DecidableZero r where-  isZero :: r -> Bool--instance DecidableZero Bool where isZero = not-instance DecidableZero Integer where isZero = (0==)-instance DecidableZero Int where isZero = (0==)-instance DecidableZero Int8 where isZero = (0==)-instance DecidableZero Int16 where isZero = (0==)-instance DecidableZero Int32 where isZero = (0==)-instance DecidableZero Int64 where isZero = (0==)--instance DecidableZero Natural where isZero = (0==)-instance DecidableZero Word where isZero = (0==)-instance DecidableZero Word8 where isZero = (0==)-instance DecidableZero Word16 where isZero = (0==)-instance DecidableZero Word32 where isZero = (0==)-instance DecidableZero Word64 where isZero = (0==)--instance DecidableZero () where isZero _ = True--instance (DecidableZero a, DecidableZero b) => DecidableZero (a, b) where-  isZero (a,b) = isZero a && isZero b--instance (DecidableZero a, DecidableZero b, DecidableZero c) => DecidableZero (a, b, c) where-  isZero (a,b,c) = isZero a && isZero b && isZero c--instance (DecidableZero a, DecidableZero b, DecidableZero c, DecidableZero d) => DecidableZero (a, b, c, d) where-  isZero (a,b,c,d) = isZero a && isZero b && isZero c && isZero d--instance (DecidableZero a, DecidableZero b, DecidableZero c, DecidableZero d, DecidableZero e) => DecidableZero (a, b, c, d, e) where-  isZero (a,b,c,d,e) = isZero a && isZero b && isZero c && isZero d && isZero e
− Numeric/Dioid/Class.hs 
@@ -1,10 +0,0 @@-{-# 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
− Numeric/Exp.hs 
@@ -1,33 +0,0 @@-module Numeric.Exp-  ( Exp(..)-  ) where--import Data.Function (on)-import Numeric.Algebra--import Prelude hiding ((+),(-),negate,replicate,subtract)--newtype Exp r = Exp { runExp :: r } --instance Additive r => Multiplicative (Exp r) where-  Exp a * Exp b = Exp (a + b)-  productWith1 f = Exp . sumWith1 (runExp . f)-  pow1p (Exp m) n = Exp (sinnum1p n m)--instance Monoidal r => Unital (Exp r) where-  one = Exp zero-  pow (Exp m) n = Exp (sinnum n m)-  productWith f = Exp . sumWith (runExp . f)--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)-  Exp m ^ n = Exp (times n m)--instance Abelian r => Commutative (Exp r)--instance Idempotent r => Band (Exp r)--instance Partitionable r => Factorable (Exp r) where-  factorWith f = partitionWith (f `on` Exp) . runExp
− Numeric/Field/Class.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}-module Numeric.Field.Class -  ( Field-  ) where--import Numeric.Ring.Division-import Numeric.Algebra.Commutative--class (Commutative r, DivisionRing r) => Field r-instance (Commutative r, DivisionRing r) => Field r
− Numeric/Log.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-module Numeric.Log -  ( Log(..)-  ) where--import Data.Function (on)-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)-  sinnum1p n (Log m) = Log (pow1p m n)--instance Unital r => LeftModule Natural (Log r) where-  n .* Log m = Log (pow m n)--instance Unital r => RightModule Natural (Log r) where-  Log m *. n = Log (pow m n)--instance Unital r => Monoidal (Log r) where-  zero = Log one-  sinnum n (Log m) = Log (pow m n)-  sumWith f = Log . productWith (runLog . f)--instance Division r => LeftModule Integer (Log r) where-  n .* Log m = Log (m ^ n)--instance Division r => RightModule Integer (Log r) where-  Log m *. n = Log (m ^ n)--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)-  times n (Log m) = Log (m ^ n)--instance Commutative r => Abelian (Log r)--instance Band r => Idempotent (Log r)--instance Factorable r => Partitionable (Log r) where-  partitionWith f = factorWith (f `on` Log) . runLog
− Numeric/Map.hs 
@@ -1,294 +0,0 @@-{-# 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-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)-instance QFunctor (,) (Map r) (Map r)-instance Bifunctor (,) (Map r) (Map r) (Map r) where-  bimap m n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a--instance Associative (Map r) (,) where-  associate = arr associate-  disassociate = arr disassociate--instance Braided (Map r) (,) where-  braid = arr braid--instance Symmetric (Map r) (,)--instance C.Monoidal (Map r) (,) where-  type Id (Map r) (,) = ()-  idl = arr C.idl-  idr = arr C.idr-  coidl = arr C.coidl-  coidr = arr C.coidr--instance Cartesian (Map r) where-  type Product (Map r) = (,)-  fst = arr fst-  snd = arr snd-  diag = arr diag-  f &&& g = Map $ \k a -> (f $# \b -> (g $# \c -> k (b,c)) a) a--instance CCC (Map r) where-  type Exp (Map r) = Map r-  apply = Map $ \k (f,a) -> (f $# k) a-  curry m = Map $ \k a -> k (Map $ \k' b -> (m $# k') (a, b))-  uncurry m = Map $ \k (a, b) -> (m $# (\m' -> (m' $# k) b)) a--instance Distributive (Map r) where-  distribute = Map $ \k (a,p) -> k $ bimap ((,) a) ((,)a) p--instance PFunctor Either (Map r) (Map r)-instance QFunctor Either (Map r) (Map r)-instance Bifunctor Either (Map r) (Map r) (Map r) where-  bimap m n = Map $ \k -> either (m $# k . Left) (n $# k . Right)--instance Associative (Map r) Either where-  associate = arr associate-  disassociate = arr disassociate--instance Braided (Map r) Either where-  braid = arr braid--instance Symmetric (Map r) Either--instance CoCartesian (Map r) where-  type Sum (Map r) = Either-  inl = arr inl-  inr = arr inr-  codiag = arr codiag-  m ||| n = Map $ \k -> either (m $# k) (n $# k)--instance C.Monoidal (Map r) Either where-  type Id (Map r) Either = Void-  idl = arr C.idl-  idr = arr C.idr-  coidl = arr C.coidl-  coidr = arr C.coidr--instance Arrow (Map r) where-  arr f = Map (. f)-  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a-  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-  sinnum1p n (Map m) = Map $ sinnum1p 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-  sinnum n (Map m) = Map $ sinnum 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--}-
− Numeric/Module/Class.hs 
@@ -1,9 +0,0 @@-module Numeric.Module.Class-  (  -  -- * Module over semirings-    LeftModule(..)-  , RightModule(..)-  , Module-  ) where--import Numeric.Algebra.Class
− Numeric/Module/Representable.hs 
@@ -1,80 +0,0 @@-{-# LANGUAGE RebindableSyntax, FlexibleContexts #-}-module Numeric.Module.Representable -  ( -  -- * Representable Additive-    addRep, sinnum1pRep-  -- * Representable Monoidal-  , zeroRep, sinnumRep-  -- * 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.sinnum1p` default definition-sinnum1pRep :: (Whole n, Functor m, Additive r) => n -> m r -> m r-sinnum1pRep = fmap . sinnum1p---- | `Monoidal.zero` default definition-zeroRep :: (Applicative m, Monoidal r) => m r -zeroRep = pure zero---- | `Monoidal.sinnum` default definition-sinnumRep :: (Whole n, Functor m, Monoidal r) => n -> m r -> m r-sinnumRep = fmap . sinnum---- | `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)
− Numeric/Order/Additive.hs 
@@ -1,21 +0,0 @@-module Numeric.Order.Additive-  ( AdditiveOrder-  ) where--import Numeric.Natural.Internal-import Numeric.Additive.Class-import Numeric.Order.Class---- An additive semigroup with a partial order (<=)---- | z + x <= z + y = x <= y = x + z <= y + z-class (Additive r, Order r) => AdditiveOrder r--instance AdditiveOrder Integer-instance AdditiveOrder Natural-instance AdditiveOrder Bool-instance AdditiveOrder ()-instance (AdditiveOrder a, AdditiveOrder b) => AdditiveOrder (a,b)-instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c) => AdditiveOrder (a,b,c)-instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c, AdditiveOrder d) => AdditiveOrder (a,b,c,d)-instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c, AdditiveOrder d, AdditiveOrder e) => AdditiveOrder (a,b,c,d,e)
− Numeric/Order/Class.hs 
@@ -1,77 +0,0 @@-module Numeric.Order.Class -  ( Order(..)-  , orderOrd-  ) where--import Data.Int-import Data.Word-import Data.Set-import Numeric.Natural.Internal---- a partial order (a, <=)-class Order a where-  (<~) :: a -> a -> Bool-  a <~ b = maybe False (<= EQ) (order a b)--  (<) :: a -> a -> Bool-  a < b = order a b == Just LT--  (>~) :: a -> a -> Bool-  a >~ b = b <~ a--  (>) :: a -> a -> Bool-  a > b = order a b == Just GT--  (~~) :: a -> a -> Bool-  a ~~ b = order a b == Just EQ--  (/~) :: a -> a -> Bool-  a /~ b = order a b /= Just EQ--  order :: a -> a -> Maybe Ordering-  order a b -    | a <~ b = Just $ if b <~ a -               then EQ-               else LT-    | b <~ a = Just GT-    | otherwise = Nothing--  comparable :: a -> a -> Bool-  comparable a b = maybe False (const True) (order a b)---orderOrd :: Ord a => a -> a -> Maybe Ordering-orderOrd a b = Just (compare a b)--instance Order Bool where order = orderOrd -instance Order Integer where order = orderOrd -instance Order Int where order = orderOrd -instance Order Int8 where order = orderOrd -instance Order Int16 where order = orderOrd -instance Order Int32 where order = orderOrd -instance Order Int64 where order = orderOrd -instance Order Natural where order = orderOrd -instance Order Word where order = orderOrd-instance Order Word8 where order = orderOrd-instance Order Word16 where order = orderOrd-instance Order Word32 where order = orderOrd-instance Order Word64 where order = orderOrd-instance Ord a => Order (Set a) where-  (<~) = isSubsetOf--instance Order () where -  order _ _ = Just EQ-  _ <~ _ = True-  comparable _ _ = True--instance (Order a, Order b) => Order (a, b) where -  (a,b) <~ (i,j) = a <~ i && b <~ j--instance (Order a, Order b, Order c) => Order (a, b, c) where -  (a,b,c) <~ (i,j,k) = a <~ i && b <~ j && c <~ k--instance (Order a, Order b, Order c, Order d) => Order (a, b, c, d) where -  (a,b,c,d) <~ (i,j,k,l) = a <~ i && b <~ j && c <~ k && d <~ l--instance (Order a, Order b, Order c, Order d, Order e) => Order (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
− Numeric/Order/LocallyFinite.hs 
@@ -1,227 +0,0 @@-module Numeric.Order.LocallyFinite -  ( LocallyFiniteOrder(..)-  ) where--import Control.Applicative-import Numeric.Additive.Class-import Numeric.Additive.Group-import Numeric.Algebra.Class-import Numeric.Algebra.Unital-import Numeric.Order.Class-import Numeric.Natural.Internal-import Numeric.Rig.Class-import Numeric.Ring.Class-import Data.Int-import Data.Bits-import Data.Word-import Data.Set (Set)-import qualified Data.Set as Set-import qualified Data.Ix as Ix-import Prelude hiding ((*),(+),fromIntegral,(<),negate,(-))--class Order a => LocallyFiniteOrder a where-  range :: a -> a -> [a]-  rangeSize :: a -> a -> Natural--  -- moebiusInversion inversion-  moebiusInversion :: Ring r => a -> a -> r-  moebiusInversion x y = case order x y of-    Just EQ -> one-    Just LT -> sumWith (\z -> if z < y then moebiusInversion x z else zero) $ range x y-    _  -> zero --instance LocallyFiniteOrder Natural where-  range = curry Ix.range-  rangeSize a b -    | a <= b = Natural (runNatural b - runNatural a + 1)-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | unsafePred y == x -> negate one -     _ -> zero--instance LocallyFiniteOrder Integer where-  range = curry Ix.range-  rangeSize a b -    | a <= b = Natural (b - a + 1)-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance Ord a => LocallyFiniteOrder (Set a) where-  range a b -    | Set.isSubsetOf a b = go a $ Set.toList $ Set.difference b a-    | otherwise = []-    where -      go _ [] = []-      go s (x:xs) = do-        s' <- [s, Set.insert x s]-        go s' xs-  rangeSize a b -    | Set.isSubsetOf a b = fromNatural $ shiftL 1 $ Set.size b - Set.size a-    | otherwise = zero-  moebiusInversion a b -    | Set.isSubsetOf a b = -      if (Set.size b - Set.size a) .&. 1 == 0 -      then one -      else negate one-    | otherwise          = zero--instance LocallyFiniteOrder Bool where-  range False False = [False]-  range False True  = [False, True]-  range True  False = []-  range True  True  = [True]-  rangeSize False False = 1-  rangeSize False True  = 2-  rangeSize True  False = 0 -  rangeSize True  True  = 1-  moebiusInversion False False = one-  moebiusInversion False True  = negate one -  moebiusInversion True  False = zero-  moebiusInversion True  True  = one---instance LocallyFiniteOrder Int where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Int8 where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Int16 where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Int32 where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Int64 where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Word where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Word8 where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Word16 where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Word32 where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder Word64 where-  range = curry Ix.range-  rangeSize a b-    | a <= b = Natural $ fromIntegral $ b - a + 1-    | otherwise = 0-  moebiusInversion x y = case compare x y of-     EQ -> one-     LT | y - 1 == x -> negate one -     _  -> zero--instance LocallyFiniteOrder () where-  range _ _ = [()]-  rangeSize _ _ = 1-  moebiusInversion _ _ = one--instance ( LocallyFiniteOrder a-         , LocallyFiniteOrder b-         ) => LocallyFiniteOrder (a,b) where-  range (a,b) (i,j) = (,) <$> range a i <*> range b j-  rangeSize (a,b) (i,j) = rangeSize a i * rangeSize b j-  -- TODO: check this against the default definition above-  moebiusInversion (a,b) (i,j) = moebiusInversion a i * moebiusInversion b j--instance ( LocallyFiniteOrder a-         , LocallyFiniteOrder b-         , LocallyFiniteOrder c-         ) => LocallyFiniteOrder (a,b,c) where-  range (a,b,c) (i,j,k) = (,,) <$> range  a i <*> range b j <*> range c k-  rangeSize (a,b,c) (i,j,k) = rangeSize a i * rangeSize b j * rangeSize c k-  moebiusInversion (a,b,c) (i,j,k) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k---instance ( LocallyFiniteOrder a-         , LocallyFiniteOrder b-         , LocallyFiniteOrder c-         , LocallyFiniteOrder d-         ) => LocallyFiniteOrder (a,b,c,d) where-  range (a,b,c,d) (i,j,k,l) = (,,,) <$> range  a i <*> range b j <*> range c k <*> range d l-  rangeSize (a,b,c,d) (i,j,k,l) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l-  moebiusInversion (a,b,c,d) (i,j,k,l) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l--instance ( LocallyFiniteOrder a-         , LocallyFiniteOrder b-         , LocallyFiniteOrder c-         , LocallyFiniteOrder d-         , LocallyFiniteOrder e-         ) => LocallyFiniteOrder (a, b, c, d, e) where-  range (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> range  a i <*> range b j <*> range c k <*> range d l <*> range e m-  rangeSize (a,b,c,d,e) (i,j,k,l,m) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l * rangeSize e m-  moebiusInversion (a,b,c,d,e) (i,j,k,l,m) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l * moebiusInversion e m-
− Numeric/Partial/Group.hs 
@@ -1,88 +0,0 @@-module Numeric.Partial.Group-  ( PartialGroup(..)-  ) where--import Control.Applicative-import Data.Int-import Data.Word-import Numeric.Partial.Semigroup-import Numeric.Partial.Monoid-import Numeric.Natural--class PartialMonoid a => PartialGroup a where-  pnegate :: a -> Maybe a-  pnegate = pminus pzero--  pminus :: a -> a -> Maybe a-  pminus a b = padd a =<< pnegate b --  psubtract :: a -> a -> Maybe a-  psubtract a b = pnegate a >>= (`padd` b)--instance PartialGroup Int where-  pnegate = Just . negate--instance PartialGroup Integer where-  pnegate = Just . negate--instance PartialGroup Int8 where-  pnegate = Just . negate--instance PartialGroup Int16 where-  pnegate = Just . negate--instance PartialGroup Int32 where-  pnegate = Just . negate--instance PartialGroup Int64 where-  pnegate = Just . negate--instance PartialGroup Word where-  pnegate = Just . negate--instance PartialGroup Word8 where-  pnegate = Just . negate--instance PartialGroup Word16 where-  pnegate = Just . negate--instance PartialGroup Word32 where-  pnegate = Just . negate--instance PartialGroup Word64 where-  pnegate = Just . negate--instance PartialGroup Natural where-  pnegate 0 = Just 0-  pnegate _ = Nothing-  pminus a b -    | a < b = Nothing-    | otherwise = Just (a - b)-  psubtract a b -    | a > b = Nothing-    | otherwise = Just (b - a)--instance PartialGroup () where-  pnegate _ = Just () -  pminus _ _ = Just ()-  psubtract _ _ = Just ()--instance (PartialGroup a, PartialGroup b) => PartialGroup (a, b) where-  pnegate (a, b) = (,) <$> pnegate a <*> pnegate b-  pminus (a, b) (i, j) = (,) <$> pminus a i <*> pminus b j-  psubtract (a, b) (i, j) = (,) <$> psubtract a i <*> psubtract b j--instance (PartialGroup a, PartialGroup b, PartialGroup c) => PartialGroup (a, b, c) where-  pnegate (a, b, c) = (,,) <$> pnegate a <*> pnegate b <*> pnegate c-  pminus (a, b, c) (i, j, k) = (,,) <$> pminus a i <*> pminus b j <*> pminus c k-  psubtract (a, b, c) (i, j, k) = (,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k--instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d) => PartialGroup (a, b, c, d) where-  pnegate (a, b, c, d) = (,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d-  pminus (a, b, c, d) (i, j, k, l) = (,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l-  psubtract (a, b, c, d) (i, j, k, l) = (,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l--instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d, PartialGroup e) => PartialGroup (a, b, c, d, e) where-  pnegate (a, b, c, d, e) = (,,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d <*> pnegate e-  pminus (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l <*> pminus e m-  psubtract (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l <*> psubtract e m
− Numeric/Partial/Monoid.hs 
@@ -1,68 +0,0 @@-module Numeric.Partial.Monoid-  ( PartialMonoid(..)-  ) where--import Numeric.Partial.Semigroup-import Data.Int-import Data.Word-import Numeric.Natural.Internal--class PartialSemigroup a => PartialMonoid a where-  pzero :: a--instance PartialMonoid Bool where-  pzero = False--instance PartialMonoid Int where-  pzero = 0--instance PartialMonoid Integer where-  pzero = 0--instance PartialMonoid Natural where-  pzero = 0--instance PartialMonoid Int8 where-  pzero = 0--instance PartialMonoid Int16 where-  pzero = 0--instance PartialMonoid Int32 where-  pzero = 0--instance PartialMonoid Int64 where-  pzero = 0--instance PartialMonoid Word where-  pzero = 0--instance PartialMonoid Word8 where-  pzero = 0--instance PartialMonoid Word16 where-  pzero = 0--instance PartialMonoid Word32 where-  pzero = 0--instance PartialMonoid Word64 where-  pzero = 0--instance PartialMonoid () where-  pzero = () --instance PartialSemigroup a => PartialMonoid (Maybe a) where-  pzero = Nothing--instance (PartialMonoid a, PartialMonoid b) => PartialMonoid (a, b) where-  pzero = (pzero, pzero)--instance (PartialMonoid a, PartialMonoid b, PartialMonoid c) => PartialMonoid (a, b, c) where-  pzero = (pzero, pzero, pzero)--instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d) => PartialMonoid (a, b, c, d) where-  pzero = (pzero, pzero, pzero, pzero)--instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d, PartialMonoid e) => PartialMonoid (a, b, c, d, e) where-  pzero = (pzero, pzero, pzero, pzero, pzero)
− Numeric/Partial/Semigroup.hs 
@@ -1,80 +0,0 @@-module Numeric.Partial.Semigroup-  ( PartialSemigroup(..)-  ) where--import Control.Applicative-import Data.Word-import Data.Int-import Numeric.Natural.Internal--class PartialSemigroup a where-  padd :: a -> a -> Maybe a--paddNum :: Num a => a -> a -> Maybe a-paddNum a b = Just (a + b)---instance PartialSemigroup Int where-  padd = paddNum--instance PartialSemigroup Integer where-  padd = paddNum--instance PartialSemigroup Natural where-  padd = paddNum--instance PartialSemigroup Int8 where-  padd = paddNum--instance PartialSemigroup Int16 where-  padd = paddNum--instance PartialSemigroup Int32 where-  padd = paddNum--instance PartialSemigroup Int64 where-  padd = paddNum--instance PartialSemigroup Word where-  padd = paddNum--instance PartialSemigroup Word8 where-  padd = paddNum--instance PartialSemigroup Word16 where-  padd = paddNum--instance PartialSemigroup Word32 where-  padd = paddNum--instance PartialSemigroup Word64 where-  padd = paddNum--instance PartialSemigroup a => PartialSemigroup (Maybe a) where-  padd ma mb = Just $ do-   a <- ma-   b <- mb-   padd a b--instance PartialSemigroup Bool where-  padd a b = Just (a || b)--instance PartialSemigroup () where-  padd _ _ = Just ()--instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (a, b) where-  padd (a,b) (i,j) = (,) <$> padd a i <*> padd b j--instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c) => PartialSemigroup (a, b, c) where-  padd (a,b,c) (i,j,k) = (,,) <$> padd a i <*> padd b j <*> padd c k--instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d) => PartialSemigroup (a, b, c, d) where-  padd (a,b,c,d) (i,j,k,l) = (,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l--instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d, PartialSemigroup e) => PartialSemigroup (a, b, c, d, e) where-  padd (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l <*> padd e m--instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (Either a b) where-  padd (Left a) (Left b) = Left <$> padd a b-  padd (Right a) (Right b) = Right <$> padd a b-  padd _ _ = Nothing
− Numeric/Quadrance/Class.hs 
@@ -1,86 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, 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)--}
− Numeric/Rig/Characteristic.hs 
@@ -1,81 +0,0 @@-module Numeric.Rig.Characteristic-  ( Characteristic(..)-  , charInt-  , charWord-  ) where--import Data.Int-import Data.Word-import Numeric.Rig.Class-import Numeric.Natural.Internal-import Prelude hiding ((^))--data Proxy p = Proxy--class Rig r => Characteristic r where-  char :: proxy r -> Natural--charInt :: (Integral s, Bounded s) => proxy s -> Natural-charInt p = 2 * fromIntegral (maxBound `asProxyTypeOf` p) + 2--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-instance Characteristic Bool where char _ = 0-instance Characteristic Integer where char _ = 0-instance Characteristic Natural where char _ = 0-instance Characteristic Int where char = charInt-instance Characteristic Int8 where char = charInt-instance Characteristic Int16 where char = charInt-instance Characteristic Int32 where char = charInt-instance Characteristic Int64 where char = charInt-instance Characteristic Word where char = charWord-instance Characteristic Word8 where char = charWord-instance Characteristic Word16 where char = charWord-instance Characteristic Word32 where char = charWord-instance Characteristic Word64 where char = charWord-instance Characteristic () where char _ = 1--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-    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-    b :: proxy (a,b,c) -> Proxy b-    b _ = Proxy-    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-    b :: proxy (a,b,c,d) -> Proxy b-    b _ = Proxy-    c :: proxy (a,b,c,d) -> Proxy c-    c _ = Proxy-    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-    b :: proxy (a,b,c,d,e) -> Proxy b-    b _ = Proxy-    c :: proxy (a,b,c,d,e) -> Proxy c-    c _ = Proxy-    d :: proxy (a,b,c,d,e) -> Proxy d-    d _ = Proxy-    e :: proxy (a,b,c,d,e) -> Proxy e-    e _ = Proxy
− Numeric/Rig/Class.hs 
@@ -1,47 +0,0 @@-module Numeric.Rig.Class-  ( Rig(..)-  , fromNaturalNum-  , fromWhole-  ) where--import Numeric.Algebra.Class-import Numeric.Algebra.Unital-import Data.Int-import Data.Word-import Prelude (Integer, Bool, Num(fromInteger),(/=),id,(.))-import Numeric.Natural.Internal--fromNaturalNum :: Num r => Natural -> r-fromNaturalNum (Natural n) = fromInteger n---- | A Ring without (n)egation-class (Semiring r, Unital r, Monoidal r) => Rig r where-  fromNatural :: Natural -> r-  fromNatural n = sinnum n one--fromWhole :: (Whole n, Rig r) => n -> r-fromWhole = fromNatural . toNatural--- TODO: optimize--instance Rig Integer where fromNatural = fromNaturalNum-instance Rig Natural where fromNatural = id-instance Rig Bool where fromNatural = (/=) 0-instance Rig Int where fromNatural = fromNaturalNum-instance Rig Int8 where fromNatural = fromNaturalNum-instance Rig Int16 where fromNatural = fromNaturalNum-instance Rig Int32 where fromNatural = fromNaturalNum-instance Rig Int64 where fromNatural = fromNaturalNum-instance Rig Word where fromNatural = fromNaturalNum-instance Rig Word8 where fromNatural = fromNaturalNum-instance Rig Word16 where fromNatural = fromNaturalNum-instance Rig Word32 where fromNatural = fromNaturalNum-instance Rig Word64 where fromNatural = fromNaturalNum-instance Rig () where fromNatural _ = ()-instance (Rig a, Rig b) => Rig (a, b) where-  fromNatural n = (fromNatural n, fromNatural n)-instance (Rig a, Rig b, Rig c) => Rig (a, b, c) where-  fromNatural n = (fromNatural n, fromNatural n, fromNatural n)-instance (Rig a, Rig b, Rig c, Rig d) => Rig (a, b, c, d) where-  fromNatural n = (fromNatural n, fromNatural n, fromNatural n, fromNatural n)-instance (Rig a, Rig b, Rig c, Rig d, Rig e) => Rig (a, b, c, d, e) where-  fromNatural n = (fromNatural n, fromNatural n, fromNatural n, fromNatural n, fromNatural n)
− Numeric/Rig/Ordered.hs 
@@ -1,21 +0,0 @@-module Numeric.Rig.Ordered-  ( OrderedRig-  ) where--import Numeric.Rig.Class-import Numeric.Order.Additive-import Numeric.Natural.Internal---- x <= y ==> x + z <= y + z--- 0 <= x && y <= z implies xy <= xz--- 0 <= x <= 1-class (AdditiveOrder r, Rig r) => OrderedRig r--instance OrderedRig Integer-instance OrderedRig Natural-instance OrderedRig Bool-instance OrderedRig ()-instance (OrderedRig a, OrderedRig b) => OrderedRig (a, b) -instance (OrderedRig a, OrderedRig b, OrderedRig c) => OrderedRig (a, b, c) -instance (OrderedRig a, OrderedRig b, OrderedRig c, OrderedRig d) => OrderedRig (a, b, c, d) -instance (OrderedRig a, OrderedRig b, OrderedRig c, OrderedRig d, OrderedRig e) => OrderedRig (a, b, c, d, e)
− Numeric/Ring/Class.hs 
@@ -1,41 +0,0 @@-module Numeric.Ring.Class-  ( Ring(..)-  , fromIntegral-  ) where--import Data.Int-import Data.Word-import Numeric.Rig.Class-import Numeric.Rng.Class-import Numeric.Additive.Group-import Numeric.Algebra.Unital-import qualified Prelude-import Prelude (Integral(toInteger), Integer, (.))--class (Rig r, Rng r) => Ring r where-  fromInteger :: Integer -> r-  fromInteger n = times n one--fromIntegral :: (Integral n, Ring r) => n -> r-fromIntegral = fromInteger . toInteger--instance Ring Integer where fromInteger = Prelude.fromInteger-instance Ring Int     where fromInteger = Prelude.fromInteger-instance Ring Int8    where fromInteger = Prelude.fromInteger-instance Ring Int16   where fromInteger = Prelude.fromInteger-instance Ring Int32   where fromInteger = Prelude.fromInteger-instance Ring Int64   where fromInteger = Prelude.fromInteger-instance Ring Word    where fromInteger = Prelude.fromInteger-instance Ring Word8   where fromInteger = Prelude.fromInteger-instance Ring Word16  where fromInteger = Prelude.fromInteger-instance Ring Word32  where fromInteger = Prelude.fromInteger-instance Ring Word64  where fromInteger = Prelude.fromInteger-instance Ring () where fromInteger _ = ()-instance (Ring a, Ring b) => Ring (a, b) where-  fromInteger n = (fromInteger n, fromInteger n)-instance (Ring a, Ring b, Ring c) => Ring (a, b, c) where-  fromInteger n = (fromInteger n, fromInteger n, fromInteger n)-instance (Ring a, Ring b, Ring c, Ring d) => Ring (a, b, c, d) where-  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)-instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a, b, c, d, e) where-  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
− Numeric/Ring/Division.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}-module Numeric.Ring.Division-  ( DivisionRing-  ) where--import Numeric.Algebra.Division-import Numeric.Ring.Class--class (Division r, Ring r) => DivisionRing r-instance (Division r, Ring r) => DivisionRing r
− Numeric/Ring/Endomorphism.hs 
@@ -1,64 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Numeric.Ring.Endomorphism -  ( End(..)-  , toEnd-  , fromEnd-  , frobenius-  ) where--import Data.Monoid-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--- --- http://en.wikipedia.org/wiki/Endomorphism_ring-newtype End a = End { appEnd :: a -> a }-instance Monoid (End r) where-  mappend (End a) (End b) = End (a . b)-  mempty = End id-instance Additive r => Additive (End r) where-  End f + End g = End (f + g)-instance Abelian r => Abelian (End r)-instance Monoidal r => Monoidal (End r) where-  zero = End (const zero)-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)-instance Multiplicative (End r) where-  End f * End g = End (f . g)-instance Unital (End r) where-  one = End id-instance (Abelian r, Commutative r) => Commutative (End r) -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 (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.-toEnd :: Multiplicative r => r -> End r-toEnd r = End (*r)---- 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-
− Numeric/Ring/Local.hs 
@@ -1,10 +0,0 @@-module Numeric.Ring.Local -  ( LocalRing -  ) where--import Numeric.Ring.Class---- forall x in r, either x or 1 - x is a unit.--- if a finite sum is a unit then so are some of its terms, so the empty sum is not a unit, and one /= zero.-class Ring r => LocalRing r-
− Numeric/Ring/Opposite.hs 
@@ -1,77 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}-module Numeric.Ring.Opposite -  ( Opposite(..)-  ) where--import Data.Foldable-import Data.Function (on)-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Traversable-import Numeric.Algebra-import Numeric.Decidable.Associates-import Numeric.Decidable.Units-import Numeric.Decidable.Zero-import Prelude hiding ((-),(+),(*),(/),(^),recip,negate,subtract,replicate)---- | http://en.wikipedia.org/wiki/Opposite_ring-newtype Opposite r = Opposite { runOpposite :: r } deriving (Show,Read)-instance Eq r => Eq (Opposite r) where-  (==) = (==) `on` runOpposite-instance Ord r => Ord (Opposite r) where-  compare = compare `on` runOpposite-instance Functor Opposite where-  fmap f (Opposite r) = Opposite (f r)-instance Foldable Opposite where-  foldMap f (Opposite r) = f r-instance Traversable Opposite where-  traverse f (Opposite r) = fmap Opposite (f r)-instance Foldable1 Opposite where-  foldMap1 f (Opposite r) = f r-instance Traversable1 Opposite where-  traverse1 f (Opposite r) = fmap Opposite (f r)-instance Additive r => Additive (Opposite r) where-  Opposite a + Opposite b = Opposite (a + b)-  sinnum1p n (Opposite a) = Opposite (sinnum1p n a)-  sumWith1 f = Opposite . sumWith1 (runOpposite . f)-instance Monoidal r => Monoidal (Opposite r) where-  zero = Opposite zero-  sinnum n (Opposite a) = Opposite (sinnum n a)-  sumWith f = Opposite . sumWith (runOpposite . f)-instance Semiring r => LeftModule (Opposite r) (Opposite r) where-  (.*) = (*)-instance RightModule r s => LeftModule r (Opposite s) where-  r .* Opposite s = Opposite (s *. r)-instance LeftModule r s => RightModule r (Opposite s) where-  Opposite s *. r = Opposite (r .* s)-instance Semiring r => RightModule (Opposite r) (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)-  times n (Opposite a) = Opposite (times n a)-instance Abelian r => Abelian (Opposite r)-instance DecidableZero r => DecidableZero (Opposite r) where-  isZero = isZero . runOpposite-instance DecidableUnits r => DecidableUnits (Opposite r) where-  recipUnit = fmap Opposite . recipUnit . runOpposite-instance DecidableAssociates r => DecidableAssociates (Opposite r) where-  isAssociate (Opposite a) (Opposite b) = isAssociate a b-instance Multiplicative r => Multiplicative (Opposite r) where-  Opposite a * Opposite b = Opposite (b * a)-  pow1p (Opposite a) n = Opposite (pow1p a n)-instance Commutative r => Commutative (Opposite r)-instance Idempotent r => Idempotent (Opposite r)-instance Band r => Band (Opposite r)-instance Unital r => Unital (Opposite r) where-  one = Opposite one-  pow (Opposite a) n = Opposite (pow a n)-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 Rig r => Rig (Opposite r)-instance Ring r => Ring (Opposite r)
− Numeric/Ring/Rng.hs 
@@ -1,75 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Numeric.Ring.Rng-  ( RngRing(..)-  , rngRingHom-  , liftRngHom-  ) where--import Numeric.Algebra-import Prelude hiding ((+),(-),(*),(/),replicate,negate,subtract,fromIntegral)---- | The free Ring given a Rng obtained by adjoining Z, such that--- --- > RngRing r = n*1 + r------ This ring is commonly denoted r^.-data RngRing r = RngRing !Integer r deriving (Show,Read)--instance Abelian r => Additive (RngRing r) where-  RngRing n a + RngRing m b = RngRing (n + m) (a + b)-  sinnum1p n (RngRing m a) = RngRing ((1 + toInteger n) * m) (sinnum1p n a)--instance Abelian r => Abelian (RngRing r)--instance (Abelian r, Monoidal r) => LeftModule Natural (RngRing r) where-  n .* RngRing m a = RngRing (toInteger n * m) (sinnum n a)--instance (Abelian r, Monoidal r) => RightModule Natural (RngRing r) where-  RngRing m a *. n = RngRing (toInteger n * m) (sinnum n a)--instance (Abelian r, Monoidal r) => Monoidal (RngRing r) where-  zero = RngRing 0 zero-  sinnum n (RngRing m a) = RngRing (toInteger n * m) (sinnum n a)--instance (Abelian r, Group r) => LeftModule Integer (RngRing r) where-  n .* RngRing m a = RngRing (toInteger n * m) (times n a)--instance (Abelian r, Group r) => RightModule Integer (RngRing r) where-  RngRing m a *. n = RngRing (toInteger n * m) (times n a)--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)-  times n (RngRing m a) = RngRing (toInteger n * m) (times n a)--instance Rng r => Multiplicative (RngRing r) where-  RngRing n a * RngRing m b = RngRing (n*m) (times n b + times m a + a * b)--instance (Commutative r, Rng r) => Commutative (RngRing r)--instance Rng s => LeftModule (RngRing s) (RngRing s) where-  (.*) = (*) --instance Rng s => RightModule (RngRing s) (RngRing s) where-  (*.) = (*) --instance Rng r => Unital (RngRing r) where-  one = RngRing 1 zero--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 => Rig (RngRing r)--instance Rng r => Ring (RngRing r)---- | The rng homomorphism from r to RngRing r-rngRingHom :: r -> RngRing r-rngRingHom = RngRing 0---- | given a rng homomorphism from a rng r into a ring s, liftRngHom yields a ring homomorphism from the ring `r^` into `s`.-liftRngHom :: Ring s => (r -> s) -> RngRing r -> s-liftRngHom g (RngRing n a) = times n one + g a
− Numeric/Rng/Class.hs 
@@ -1,12 +0,0 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}-module Numeric.Rng.Class-  ( Rng-  ) where--import Numeric.Additive.Group-import Numeric.Algebra.Class---- | A Ring without an /i/dentity.--class (Group r, Semiring r) => Rng r-instance (Group r, Semiring r) => Rng r
− Numeric/Rng/Zero.hs 
@@ -1,55 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}-module Numeric.Rng.Zero-  ( ZeroRng(..)-  ) where--import Numeric.Algebra-import Data.Foldable (toList)-import Prelude hiding ((+),(-),negate,subtract,replicate)---- *** The Zero Rng for an Abelian Group, adding the trivial product------ > _ * _ = zero ------ which distributes over (+)---- ZeroRng/runZeroRng witness an additive Abelian group isomorphism to the zero rng.-newtype ZeroRng r = ZeroRng { runZeroRng :: r } deriving (Eq,Ord,Show,Read)--instance Additive r => Additive (ZeroRng r) where-  ZeroRng a + ZeroRng b = ZeroRng (a + b)-  sumWith1 f = ZeroRng . sumWith1 (runZeroRng . f)--instance Idempotent r => Idempotent (ZeroRng r)--instance Abelian r => Abelian (ZeroRng r)--instance Monoidal r => Monoidal (ZeroRng r) where-  zero = ZeroRng zero-  sumWith f = ZeroRng . sumWith (runZeroRng . f)-  sinnum n (ZeroRng a) = ZeroRng (sinnum n a)-  -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 Monoidal r => Multiplicative (ZeroRng r) where-  _ * _ = zero-  productWith1 f as = case toList as of-    [] -> error "productWith1: empty Foldable1"-    [a] -> f a-    _   -> zero--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-  (.*) = sinnum-instance Monoidal r => RightModule Natural (ZeroRng r) where-  m *. n = sinnum n m-instance Group r => LeftModule Integer (ZeroRng r) where-  (.*) = times-instance Group r => RightModule Integer (ZeroRng r) where-  m *. n = times n m
− Numeric/Semiring/Integral.hs 
@@ -1,15 +0,0 @@-module Numeric.Semiring.Integral -  ( IntegralSemiring-  ) where--import Numeric.Algebra.Class-import Numeric.Natural.Internal---- | 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-instance IntegralSemiring Bool
− Numeric/Semiring/Involutive.hs 
@@ -1,5 +0,0 @@-module Numeric.Semiring.Involutive -  ( InvolutiveSemiring-  ) where--import Numeric.Algebra.Involutive
algebra.cabal view
@@ -1,6 +1,6 @@ name:          algebra category:      Math, Algebra-version:       2.1.1.2+version:       3.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -20,6 +20,8 @@   location: git://github.com/ekmett/algebra.git  library+  hs-source-dirs: src+   other-extensions:     TypeOperators     MultiParamTypeClasses@@ -36,18 +38,18 @@    build-depends:     array                   >= 0.3.0.2 && < 0.5,-    base                    >= 4       && < 5,+    base                    == 4.*,     distributive            >= 0.2.2   && < 0.3,     transformers            >= 0.2     && < 0.4,     tagged                  >= 0.4.2   && < 0.5,     categories              >= 1.0     && < 1.1,     containers              >= 0.3     && < 0.6,-    keys                    >= 2.1.3.1 && < 2.2,+    keys                    == 3.0.*,     mtl                     >= 2.0.1   && < 2.2,     semigroups              >= 0.8.3.1 && < 0.9,-    semigroupoids           >= 1.3.1.2 && < 1.4,-    representable-functors  >= 2.4.0.1 && < 2.5,-    representable-tries     >= 2.4.0.1 && < 2.5,+    semigroupoids           == 3.0.*,+    representable-functors  == 3.0.*,+    representable-tries     == 3.0.*,     void                    >= 0.5.5.1 && < 0.6    exposed-modules:
+ src/Numeric/Additive/Class.hs view
@@ -0,0 +1,226 @@+{-# LANGUAGE TypeOperators #-}+module Numeric.Additive.Class+  ( +  -- * Additive Semigroups+    Additive(..)+  , sum1+  -- * Additive Abelian semigroups+  , Abelian+  -- * Additive Monoids+  , Idempotent+  , sinnum1pIdempotent+  -- * Partitionable semigroups+  , Partitionable(..)+  ) where++import Data.Int+import Data.Word+import Data.Foldable hiding (concat)+import Data.Semigroup.Foldable+import Data.Key+import Data.Functor.Representable+import Data.Functor.Representable.Trie+-- import Data.Foldable hiding (concat)+import Numeric.Natural.Internal+import Prelude (fmap,(-),Bool(..),($),id,(>>=),fromIntegral,(*),otherwise,quot,maybe,error,even,Maybe(..),(==),(.),($!),Integer,(||),toInteger,Integral)+import qualified Prelude+import Data.List.NonEmpty (NonEmpty(..), fromList)++infixl 6 +++-- | +-- > (a + b) + c = a + (b + c)+-- > sinnum 1 a = a+-- > sinnum (2 * n) a = sinnum n a + sinnum n a+-- > sinnum (2 * n + 1) a = sinnum n a + sinnum n a + a+class Additive r where+  (+) :: r -> r -> r++  -- | sinnum1p n r = sinnum (1 + n) r+  sinnum1p :: Whole n => n -> r -> r+  sinnum1p 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 +  sinnum1p n f e = sinnum1p n (f e)+  sumWith1 f xs e = sumWith1 (`f` e) xs++instance (HasTrie b, Additive r) => Additive (b :->: r) where+  (+) = zipWith (+)+  sinnum1p = fmap . sinnum1p+  sumWith1 f xs = tabulate $ \e -> sumWith1 (\a -> index (f a) e) xs++instance Additive Bool where+  (+) = (||)+  sinnum1p _ a = a++instance Additive Natural where+  (+) = (Prelude.+)+  sinnum1p n r = (1 Prelude.+ toNatural n) * r++instance Additive Integer where +  (+) = (Prelude.+)+  sinnum1p n r = (1 Prelude.+ toInteger n) * r++instance Additive Int where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int8 where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int16 where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int32 where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int64 where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word8 where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word16 where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word32 where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word64 where+  (+) = (Prelude.+)+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive () where+  _ + _ = ()+  sinnum1p _ _ = () +  sumWith1 _ _ = ()++instance (Additive a, Additive b) => Additive (a,b) where+  (a,b) + (i,j) = (a + i, b + j)+  sinnum1p n (a,b) = (sinnum1p n a, sinnum1p 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)+  sinnum1p n (a,b,c) = (sinnum1p n a, sinnum1p n b, sinnum1p 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)+  sinnum1p n (a,b,c,d) = (sinnum1p n a, sinnum1p n b, sinnum1p n c, sinnum1p 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)+  sinnum1p n (a,b,c,d,e) = (sinnum1p n a, sinnum1p n b, sinnum1p n c, sinnum1p n d, sinnum1p 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 (HasTrie e, 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++sinnum1pIdempotent :: Natural -> r -> r+sinnum1pIdempotent _ r = r++instance Idempotent ()+instance Idempotent Bool+instance Idempotent r => Idempotent (e -> r)+instance (HasTrie e, Idempotent r) => Idempotent (e :->: r)+instance (Idempotent a, Idempotent b) => Idempotent (a,b)+instance (Idempotent a, Idempotent b, Idempotent c) => Idempotent (a,b,c)+instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d) => Idempotent (a,b,c,d)+instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d, Idempotent e) => Idempotent (a,b,c,d,e)
+ src/Numeric/Additive/Group.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeOperators #-}+module Numeric.Additive.Group+  ( -- * Additive Groups+    Group(..)+  ) where++import Data.Int+import Data.Word+import Data.Key+import Data.Functor.Representable.Trie+import Prelude hiding ((*), (+), (-), negate, subtract,zipWith)+import qualified Prelude+import Numeric.Additive.Class+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 (HasTrie e, Group r) => Group (e :->: r) where+  (-) = zipWith (-)+  negate = fmap negate+  subtract = zipWith subtract+  times = fmap . times++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)+
+ src/Numeric/Algebra.hs view
@@ -0,0 +1,171 @@+module Numeric.Algebra+  ( +  -- * Additive++  -- ** additive semigroups+    Additive(..)+  , sum1+  -- ** additive Abelian semigroups+  , Abelian+  -- ** additive idempotent semigroups+  , Idempotent+  , sinnum1pIdempotent+  , sinnumIdempotent+  -- ** 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(..)+  -- ** Division Rings+  , LocalRing+  , DivisionRing+  , Field++  -- * 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+  , CocommutativeCoalgebra+  -- ** division algebras+  , DivisionAlgebra(..)+  -- ** Hopf alegebras+  , HopfAlgebra(..)++  -- * Ring Properties+  -- ** Characteristic+  , Characteristic(..)+  , charInt, charWord+  -- ** Order+  , Order(..)+  , OrderedRig+  , AdditiveOrder+  , LocallyFiniteOrder++  , DecidableZero+  , DecidableUnits+  , DecidableAssociates++  -- * Natural numbers+  , Natural+  , Whole(toNatural)++  -- * Representable Additive+  , addRep, sinnum1pRep+  -- * Representable Monoidal+  , zeroRep, sinnumRep+  -- * 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.Order.LocallyFinite+import Numeric.Quadrance.Class+import Numeric.Rig.Class+import Numeric.Rig.Characteristic+import Numeric.Rig.Ordered+import Numeric.Rng.Class+import Numeric.Ring.Class+import Numeric.Ring.Local+import Numeric.Ring.Division+import Numeric.Field.Class
+ src/Numeric/Algebra/Class.hs view
@@ -0,0 +1,600 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeOperators #-}+module Numeric.Algebra.Class +  (+  -- * Multiplicative Semigroups+    Multiplicative(..)+  , pow1pIntegral+  , product1+  -- * Semirings+  , Semiring+  -- * Left and Right Modules+  , LeftModule(..)+  , RightModule(..)+  , Module+  -- * Additive Monoids+  , Monoidal(..)+  , sum+  , sinnumIdempotent+  -- * Associative algebras+  , Algebra(..)+  -- * Coassociative coalgebras+  , Coalgebra(..)+  ) where++import Control.Applicative+import Data.Foldable hiding (sum, concat)+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Int+import Data.IntMap (IntMap)+import Data.IntSet (IntSet)+import Data.Key+import Data.Map (Map)+import Data.Monoid (mappend)+-- import Data.Semigroup.Foldable+import Data.Sequence hiding (reverse,index)+import Data.Semigroup.Foldable+import Data.Set (Set)+import Data.Word+import Numeric.Additive.Class+import Numeric.Natural.Internal+import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Prelude++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)++instance Algebra r a => Multiplicative (a -> r) where+  f * g = mult $ \a b -> f a * g b+instance (HasTrie a, Algebra r a) => Multiplicative (a :->: r) where+  f * g = tabulate $ mult $ \a b -> index f a * index g b++-- | A pair of an additive abelian semigroup, and a multiplicative semigroup, with the distributive laws:+-- +-- > a(b + c) = ab + ac -- left distribution (we are a LeftNearSemiring)+-- > (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)+instance Algebra r a => Semiring (a -> r) +instance (HasTrie a, Algebra r a) => Semiring (a :->: r) ++-- | An associative algebra built with a free module over a semiring+class Semiring r => Algebra r a where+  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++-- 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)++instance (HasTrie m, Algebra r m) => Coalgebra r (m :->: r) where+  comult k f g = k (f * g)++-- instance Coalgebra () c where comult _ _ _ = ()+-- instance (Algebra r b, Coalgebra r c) => Coalgebra (b -> r) c where comult f c1 c2 b = comult (`f` b) c1 c2 ++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 (HasTrie e, LeftModule r m) => LeftModule r (e :->: m) where +  (.*) m f = tabulate $ \e -> m .* index f e++instance Additive m => LeftModule () m where +  _ .* a = a++instance (LeftModule r a, LeftModule r b) => LeftModule r (a, b) where+  n .* (a, b) = (n .* a, n .* b)++instance (LeftModule r a, LeftModule r b, LeftModule r c) => LeftModule r (a, b, c) where+  n .* (a, b, c) = (n .* a, n .* b, n .* c)++instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d) => LeftModule r (a, b, c, d) where+  n .* (a, b, c, d) = (n .* a, n .* b, n .* c, n .* d)++instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d, LeftModule r e) => LeftModule r (a, b, c, d, e) where+  n .* (a, b, c, d, e) = (n .* a, n .* b, n .* c, n .* d, n .* e)++++class (Semiring r, Additive m) => RightModule r m where+  (*.) :: m -> r -> m++instance RightModule Natural Bool where +  _ *. 0 = False+  a *. _ = a++instance RightModule Natural Natural where (*.) = (*)++instance RightModule Natural Integer where n *. Natural m = n * m++instance RightModule Integer Integer where (*.) = (*) ++instance RightModule Natural Int where m *. n = m * fromIntegral n++instance RightModule Integer Int where m *. n = m * fromInteger n++instance RightModule Natural Int8 where m *. n = m * fromIntegral n++instance RightModule Integer Int8 where m *. n = m * fromInteger n++instance RightModule Natural Int16 where m *. n = m * fromIntegral n++instance RightModule Integer Int16 where m *. n = m * fromInteger n++instance RightModule Natural Int32 where m *. n = m * fromIntegral n++instance RightModule Integer Int32 where m *. n = m * fromInteger n++instance RightModule Natural Int64 where m *. n = m * fromIntegral n++instance RightModule Integer Int64 where m *. n = m * fromInteger n++instance RightModule Natural Word where m *. n = m * fromIntegral n++instance RightModule Integer Word where m *. n = m * fromInteger n++instance RightModule Natural Word8 where m *. n = m * fromIntegral n++instance RightModule Integer Word8 where m *. n = m * fromInteger n++instance RightModule Natural Word16 where m *. n = m * fromIntegral n++instance RightModule Integer Word16 where m *. n = m * fromInteger n++instance RightModule Natural Word32 where m *. n = m * fromIntegral n++instance RightModule Integer Word32 where m *. n = m * fromInteger n++instance RightModule Natural Word64 where m *. n = m * fromIntegral n++instance RightModule Integer Word64 where m *. n = m * fromInteger n++instance Semiring r => RightModule r () where +  _ *. _ = ()++instance RightModule r m => RightModule r (e -> m) where +  (*.) f m e = f e *. m++instance (HasTrie e, RightModule r m) => RightModule r (e :->: m) where +  (*.) f m = tabulate $ \e -> index f e *. m++instance Additive m => RightModule () m where +  (*.) = const++instance (RightModule r a, RightModule r b) => RightModule r (a, b) where+  (a, b) *. n = (a *. n, b *. n)++instance (RightModule r a, RightModule r b, RightModule r c) => RightModule r (a, b, c) where+  (a, b, c) *. n = (a *. n, b *. n, c *. n)++instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d) => RightModule r (a, b, c, d) where+  (a, b, c, d) *. n = (a *. n, b *. n, c *. n, d *. n)++instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d, RightModule r e) => RightModule r (a, b, c, d, e) where+  (a, b, c, d, e) *. n = (a *. n, b *. n, c *. n, d *. n, e *. n)++++class (LeftModule r m, RightModule r m) => Module r m+instance (LeftModule r m, RightModule r m) => Module r m++++-- | An additive monoid+--+-- > zero + a = a = a + zero+class (LeftModule Natural m, RightModule Natural m) => Monoidal m where+  zero :: m++  sinnum :: Whole n => n -> m -> m+  sinnum 0 _  = zero+  sinnum 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++sinnumIdempotent :: (Integral n, Idempotent r, Monoidal r) => n -> r -> r+sinnumIdempotent 0 _ = zero+sinnumIdempotent _ x = x++instance Monoidal Bool where +  zero = False+  sinnum 0 _ = False+  sinnum _ r = r++instance Monoidal Natural where+  zero = 0+  sinnum n r = toNatural n * r++instance Monoidal Integer where +  zero = 0+  sinnum n r = toInteger n * r++instance Monoidal Int where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Int8 where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Int16 where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Int32 where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Int64 where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Word where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Word8 where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Word16 where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Word32 where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal Word64 where +  zero = 0+  sinnum n r = fromIntegral n * r++instance Monoidal r => Monoidal (e -> r) where+  zero = const zero+  sumWith f xs e = sumWith (`f` e) xs+  sinnum n r e = sinnum n (r e)++instance (HasTrie e, Monoidal r) => Monoidal (e :->: r) where+  zero = pure zero+  sumWith f xs = tabulate $ \e -> sumWith (\a -> index (f a) e) xs+  sinnum n r = tabulate $ sinnum n . index r++instance Monoidal () where +  zero = ()+  sinnum _ () = ()+  sumWith _ _ = ()++instance (Monoidal a, Monoidal b) => Monoidal (a,b) where+  zero = (zero,zero)+  sinnum n (a,b) = (sinnum n a, sinnum n b)++instance (Monoidal a, Monoidal b, Monoidal c) => Monoidal (a,b,c) where+  zero = (zero,zero,zero)+  sinnum n (a,b,c) = (sinnum n a, sinnum n b, sinnum n c)++instance (Monoidal a, Monoidal b, Monoidal c, Monoidal d) => Monoidal (a,b,c,d) where+  zero = (zero,zero,zero,zero)+  sinnum n (a,b,c,d) = (sinnum n a, sinnum n b, sinnum n c, sinnum 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)+  sinnum n (a,b,c,d,e) = (sinnum n a, sinnum n b, sinnum n c, sinnum n d, sinnum n e)+
+ src/Numeric/Algebra/Commutative.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances, TypeOperators #-}+module Numeric.Algebra.Commutative +  ( Commutative+  , CommutativeAlgebra+  , CocommutativeCoalgebra+  , CommutativeBialgebra+  ) where++import Data.Functor.Representable.Trie+import Data.Int+import Data.IntSet (IntSet)+import Data.IntMap (IntMap)+import Data.Set (Set)+import Data.Map (Map)+import Data.Word+import Numeric.Additive.Class+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Natural+import Prelude (Bool, Ord, Integer)++++-- | 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)++instance CommutativeAlgebra r a => Commutative (a -> r)++instance ( HasTrie a+         , CommutativeAlgebra r a+         ) => Commutative (a :->: r) ++++class Algebra r a => CommutativeAlgebra r a++instance ( Commutative r+         , Semiring r+         ) => CommutativeAlgebra r ()++instance ( CommutativeAlgebra r a+         , CommutativeAlgebra r b+         ) => CommutativeAlgebra r (a,b)++instance ( CommutativeAlgebra r a+         , CommutativeAlgebra r b+         , CommutativeAlgebra r c+         ) => CommutativeAlgebra r (a,b,c)++instance ( CommutativeAlgebra r a+         , CommutativeAlgebra r b+         , CommutativeAlgebra r c+         , CommutativeAlgebra r d+         ) => CommutativeAlgebra r (a,b,c,d)++instance ( CommutativeAlgebra r a+         , CommutativeAlgebra r b+         , CommutativeAlgebra r c+         , CommutativeAlgebra r d+         , CommutativeAlgebra r e+         ) => CommutativeAlgebra r (a,b,c,d,e)++instance ( Commutative r+         , Semiring r+         , Ord a+         ) => CommutativeAlgebra r (Set a)++instance (Commutative r+         , Semiring r+         ) => CommutativeAlgebra r IntSet++instance (Commutative r+         , Monoidal r+         , Semiring r+         , Ord a+         , Abelian b+         , Partitionable b+         ) => CommutativeAlgebra r (Map a b)++instance ( Commutative r+         , Monoidal r+         , Semiring r+         , Abelian b+         , Partitionable b+         ) => CommutativeAlgebra r (IntMap b)++++class Coalgebra r c => CocommutativeCoalgebra r c++instance CommutativeAlgebra r m => CocommutativeCoalgebra r (m -> r)++instance ( HasTrie m+         , CommutativeAlgebra r m+         ) => CocommutativeCoalgebra r (m :->: r)++instance (Commutative r, Semiring r) => CocommutativeCoalgebra r ()++instance ( CocommutativeCoalgebra r a+         , CocommutativeCoalgebra r b+         ) => CocommutativeCoalgebra r (a,b)++instance ( CocommutativeCoalgebra r a+         , CocommutativeCoalgebra r b+         , CocommutativeCoalgebra r c+         ) => CocommutativeCoalgebra r (a,b,c)++instance ( CocommutativeCoalgebra r a+         , CocommutativeCoalgebra r b+         , CocommutativeCoalgebra r c+         , CocommutativeCoalgebra r d+         ) => CocommutativeCoalgebra r (a,b,c,d)++instance ( CocommutativeCoalgebra r a+         , CocommutativeCoalgebra r b+         , CocommutativeCoalgebra r c+         , CocommutativeCoalgebra r d+         , CocommutativeCoalgebra r e+         ) => CocommutativeCoalgebra r (a,b,c,d,e)++instance ( Commutative r+         , Semiring r+         , Ord a) => CocommutativeCoalgebra r (Set a)++instance ( Commutative r+         , Semiring r+         ) => CocommutativeCoalgebra r IntSet++instance ( Commutative r+         , Semiring r+         , Ord a+         , Abelian b+         ) => CocommutativeCoalgebra r (Map a b)++instance ( Commutative r+         , Semiring r+         , Abelian b+         ) => CocommutativeCoalgebra r (IntMap b)++++class ( Bialgebra r h+      , CommutativeAlgebra r h+      , CocommutativeCoalgebra r h+      ) => CommutativeBialgebra r h++instance ( Bialgebra r h+         , CommutativeAlgebra r h+         , CocommutativeCoalgebra r h+         ) => CommutativeBialgebra r h
+ src/Numeric/Algebra/Complex.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE MultiParamTypeClasses+           , FlexibleInstances+           , TypeFamilies+           , UndecidableInstances+           , DeriveDataTypeable+           , TypeOperators #-}+module Numeric.Algebra.Complex+  ( Distinguished(..)+  , Complicated(..)+  , ComplexBasis(..)+  , Complex(..)+  , realPart+  , imagPart+  , uncomplicate+  ) 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 hiding (index)+import Data.Key+import Data.Semigroup+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Traversable+import Numeric.Algebra+import Numeric.Algebra.Distinguished.Class+import Numeric.Algebra.Complex.Class+import Numeric.Algebra.Quaternion.Class+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)++-- 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)++realPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a+realPart f = index f E ++imagPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a+imagPart f = index f I++instance Distinguished ComplexBasis where+  e = E+  +instance Complicated ComplexBasis where+  i = I++instance Rig r => Distinguished (Complex r) where+  e = Complex one zero++instance Rig r => Complicated (Complex r) where+  i = Complex zero one++instance Rig r => Distinguished (ComplexBasis -> r) where+  e E = one+  e _ = zero+  +instance Rig r => Complicated (ComplexBasis -> r) where+  i I = one+  i _ = zero ++instance Rig r => Distinguished (ComplexBasis :->: r) where+  e = Trie e+  +instance Rig r => Complicated (ComplexBasis :->: r) where+  i = Trie i++type instance Key Complex = ComplexBasis++instance Representable Complex where+  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 +  sinnum1p = sinnum1pRep++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+  sinnum = sinnumRep++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++-- the trivial coalgebra+instance Rng k => Coalgebra k ComplexBasis where+  comult f E E = f E+  comult f I I = f I+  comult _ _ _ = zero++instance Rng k => CounitalCoalgebra k ComplexBasis where+  counit f = f E + f I++instance Rng k => Bialgebra k ComplexBasis ++instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k ComplexBasis where+  inv f = f' where+    afe = adjoint (f E)+    nfi = negate (f I)+    f' E = afe+    f' I = nfi++instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k ComplexBasis where+  coinv = inv++instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k ComplexBasis where+  antipode = inv++instance (Commutative r, Rng r) => Multiplicative (Complex r) where+  (*) = mulRep++instance (TriviallyInvolutive r, Rng r) => Commutative (Complex r)++instance (Commutative r, Rng r) => Semiring (Complex r)++instance (Commutative r, Ring r) => Unital (Complex r) where+  one = oneRep++instance (Commutative r, Ring r) => Rig (Complex r) where+  fromNatural n = Complex (fromNatural n) zero++instance (Commutative r, Ring r) => Ring (Complex r) where+  fromInteger n = Complex (fromInteger n) zero++instance (Commutative r, Rng r) => LeftModule (Complex r) (Complex r) where (.*) = (*)+instance (Commutative r, Rng r) => RightModule (Complex r) (Complex r) where (*.) = (*)++instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Complex r) where+  adjoint (Complex a b) = Complex (adjoint a) (negate b)++instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Complex r)++instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Complex r) where+  quadrance n = realPart $ adjoint n * n++instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Complex r) where+  recip q@(Complex a b) = Complex (qq \\ a) (qq \\ b)+    where qq = quadrance q++-- | half of the Cayley-Dickson quaternion isomorphism +uncomplicate :: Hamiltonian q => ComplexBasis -> ComplexBasis -> q+uncomplicate E E = e+uncomplicate I E = i+uncomplicate E I = j+uncomplicate I I = k+
+ src/Numeric/Algebra/Complex/Class.hs view
@@ -0,0 +1,13 @@+module Numeric.Algebra.Complex.Class+  ( Complicated(..)+  ) where++import Numeric.Algebra.Distinguished.Class+import Numeric.Covector+import Prelude (return)++class Distinguished r => Complicated r where+  i :: r++instance Complicated a => Complicated (Covector r a) where+  i = return i
+ src/Numeric/Algebra/Distinguished/Class.hs view
@@ -0,0 +1,12 @@+module Numeric.Algebra.Distinguished.Class+  ( Distinguished(..)+  ) where++import Numeric.Covector++-- a basis with a distinguished point+class Distinguished t where+  e :: t++instance Distinguished a => Distinguished (Covector r a) where+  e = return e
+ src/Numeric/Algebra/Division.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Algebra.Division+  ( Division(..)+  , DivisionAlgebra(..)+  ) 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+
+ src/Numeric/Algebra/Dual.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}+module Numeric.Algebra.Dual+  ( Distinguished(..)+  , Infinitesimal(..)+  , DualBasis(..)+  , Dual(..)+  ) 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.Semigroup hiding (Dual)+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Traversable+import Numeric.Algebra+import Numeric.Algebra.Distinguished.Class+import Numeric.Algebra.Dual.Class+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)++-- | dual number basis, D^2 = 0. D /= 0.+data DualBasis = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)+data Dual a = Dual a a deriving (Eq,Show,Read,Data,Typeable)++instance Distinguished DualBasis where+  e = E++instance Infinitesimal DualBasis where+  d = D++instance Rig r => Distinguished (Dual r) where+  e = Dual one zero++instance Rig r => Infinitesimal (Dual r) where+  d = Dual zero one+  +instance Rig r => Distinguished (DualBasis -> r) where+  e E = one+  e _ = zero++instance Rig r => Infinitesimal (DualBasis -> r) where+  d D = one+  d _       = zero ++type instance Key Dual = DualBasis++instance Representable Dual where+  tabulate f = Dual (f E) (f D)++instance Indexable Dual where+  index (Dual a _ ) E = a+  index (Dual _ b ) D = b++instance Lookup Dual where+  lookup = lookupDefault++instance Adjustable Dual where+  adjust f E (Dual a b) = Dual (f a) b+  adjust f D (Dual a b) = Dual a (f b)++instance Distributive Dual where+  distribute = distributeRep ++instance Functor Dual where+  fmap f (Dual a b) = Dual (f a) (f b)++instance Zip Dual where+  zipWith f (Dual a1 b1) (Dual a2 b2) = Dual (f a1 a2) (f b1 b2)++instance ZipWithKey Dual where+  zipWithKey f (Dual a1 b1) (Dual a2 b2) = Dual (f E a1 a2) (f D b1 b2)++instance Keyed Dual where+  mapWithKey = mapWithKeyRep++instance Apply Dual where+  (<.>) = apRep++instance Applicative Dual where+  pure = pureRep+  (<*>) = apRep ++instance Bind Dual where+  (>>-) = bindRep++instance Monad Dual where+  return = pureRep+  (>>=) = bindRep++instance MonadReader DualBasis Dual where+  ask = askRep+  local = localRep++instance Foldable Dual where+  foldMap f (Dual a b) = f a `mappend` f b++instance FoldableWithKey Dual where+  foldMapWithKey f (Dual a b) = f E a `mappend` f D b++instance Traversable Dual where+  traverse f (Dual a b) = Dual <$> f a <*> f b++instance TraversableWithKey Dual where+  traverseWithKey f (Dual a b) = Dual <$> f E a <*> f D b++instance Foldable1 Dual where+  foldMap1 f (Dual a b) = f a <> f b++instance FoldableWithKey1 Dual where+  foldMapWithKey1 f (Dual a b) = f E a <> f D b++instance Traversable1 Dual where+  traverse1 f (Dual a b) = Dual <$> f a <.> f b++instance TraversableWithKey1 Dual where+  traverseWithKey1 f (Dual a b) = Dual <$> f E a <.> f D b++instance HasTrie DualBasis where+  type BaseTrie DualBasis = Dual+  embedKey = id+  projectKey = id++instance Additive r => Additive (Dual r) where+  (+) = addRep +  sinnum1p = sinnum1pRep++instance LeftModule r s => LeftModule r (Dual s) where+  r .* Dual a b = Dual (r .* a) (r .* b)++instance RightModule r s => RightModule r (Dual s) where+  Dual a b *. r = Dual (a *. r) (b *. r)++instance Monoidal r => Monoidal (Dual r) where+  zero = zeroRep+  sinnum = sinnumRep++instance Group r => Group (Dual r) where+  (-) = minusRep+  negate = negateRep+  subtract = subtractRep+  times = timesRep++instance Abelian r => Abelian (Dual r)++instance Idempotent r => Idempotent (Dual r)++instance Partitionable r => Partitionable (Dual r) where+  partitionWith f (Dual a b) = id =<<+    partitionWith (\a1 a2 -> +    partitionWith (\b1 b2 -> f (Dual a1 b1) (Dual a2 b2)) b) a++instance Rng k => Algebra k DualBasis where+  mult f = f' where+    fe = f E E+    fd = f E D + f D E+    f' E = fe+    f' D = fd++instance Rng k => UnitalAlgebra k DualBasis where+  unit x E = x+  unit _ _ = zero++-- the trivial coalgebra+instance Rng k => Coalgebra k DualBasis where+  comult f E E = f E+  comult f D D = f D+  comult _ _ _ = zero++instance Rng k => CounitalCoalgebra k DualBasis where+  counit f = f E + f D++instance Rng k => Bialgebra k DualBasis ++instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis where+  inv f = f' where+    afe = adjoint (f E)+    nfd = negate (f D)+    f' E = afe+    f' D = nfd++instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis where+  coinv = inv++instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis where+  antipode = inv++instance (Commutative r, Rng r) => Multiplicative (Dual r) where+  (*) = mulRep++instance (TriviallyInvolutive r, Rng r) => Commutative (Dual r)++instance (Commutative r, Rng r) => Semiring (Dual r)++instance (Commutative r, Ring r) => Unital (Dual r) where+  one = oneRep++instance (Commutative r, Ring r) => Rig (Dual r) where+  fromNatural n = Dual (fromNatural n) zero++instance (Commutative r, Ring r) => Ring (Dual r) where+  fromInteger n = Dual (fromInteger n) zero++instance (Commutative r, Rng r) => LeftModule (Dual r) (Dual r) where (.*) = (*)+instance (Commutative r, Rng r) => RightModule (Dual r) (Dual r) where (*.) = (*)++instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual r) where+  adjoint (Dual a b) = Dual (adjoint a) (negate b)++instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual r)++instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual r) where+  quadrance n = case adjoint n * n of+    Dual a _ -> a++instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual r) where+  recip q@(Dual a b) = Dual (qq \\ a) (qq \\ b)+    where qq = quadrance q
+ src/Numeric/Algebra/Dual/Class.hs view
@@ -0,0 +1,12 @@+module Numeric.Algebra.Dual.Class+  ( Infinitesimal(..)+  ) where++import Numeric.Algebra.Distinguished.Class+import Numeric.Covector++class Distinguished t => Infinitesimal t where+  d :: t++instance Infinitesimal a => Infinitesimal (Covector r a) where+  d = return d
+ src/Numeric/Algebra/Factorable.hs view
@@ -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++
+ src/Numeric/Algebra/Hopf.hs view
@@ -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
+ src/Numeric/Algebra/Hyperbolic.hs view
@@ -0,0 +1,222 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}+module Numeric.Algebra.Hyperbolic+  ( Hyperbolic(..)+  , HyperBasis'(..)+  , Hyper'(..)+  ) where++import Control.Applicative+import Control.Monad.Reader.Class+import Data.Data+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Ix+import Data.Key+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup+import Data.Traversable+import Numeric.Algebra+import Numeric.Coalgebra.Hyperbolic.Class+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)++-- the dual hyperbolic basis+data HyperBasis' = Cosh' | Sinh' deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)+data Hyper' a = Hyper' a a deriving (Eq,Show,Read,Data,Typeable)++instance Hyperbolic HyperBasis' where+  cosh = Cosh'+  sinh = Sinh'++instance Rig r => Hyperbolic (Hyper' r) where+  cosh = Hyper' one zero+  sinh = Hyper' zero one+  +instance Rig r => Hyperbolic (HyperBasis' -> r) where+  cosh Sinh' = zero+  cosh Cosh' = one+  sinh Sinh' = one+  sinh Cosh' = zero++type instance Key Hyper' = HyperBasis'++instance Representable Hyper' where+  tabulate f = Hyper' (f Cosh') (f Sinh')++instance Indexable Hyper' where+  index (Hyper' a _ ) Cosh' = a+  index (Hyper' _ b ) Sinh' = b++instance Lookup Hyper' where+  lookup = lookupDefault++instance Adjustable Hyper' where+  adjust f Cosh' (Hyper' a b) = Hyper' (f a) b+  adjust f Sinh' (Hyper' a b) = Hyper' a (f b)++instance Distributive Hyper' where+  distribute = distributeRep ++instance Functor Hyper' where+  fmap f (Hyper' a b) = Hyper' (f a) (f b)++instance Zip Hyper' where+  zipWith f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f a1 a2) (f b1 b2)++instance ZipWithKey Hyper' where+  zipWithKey f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f Cosh' a1 a2) (f Sinh' b1 b2)++instance Keyed Hyper' where+  mapWithKey = mapWithKeyRep++instance Apply Hyper' where+  (<.>) = apRep++instance Applicative Hyper' where+  pure = pureRep+  (<*>) = apRep ++instance Bind Hyper' where+  (>>-) = bindRep++instance Monad Hyper' where+  return = pureRep+  (>>=) = bindRep++instance MonadReader HyperBasis' Hyper' where+  ask = askRep+  local = localRep++instance Foldable Hyper' where+  foldMap f (Hyper' a b) = f a `mappend` f b++instance FoldableWithKey Hyper' where+  foldMapWithKey f (Hyper' a b) = f Cosh' a `mappend` f Sinh' b++instance Traversable Hyper' where+  traverse f (Hyper' a b) = Hyper' <$> f a <*> f b++instance TraversableWithKey Hyper' where+  traverseWithKey f (Hyper' a b) = Hyper' <$> f Cosh' a <*> f Sinh' b++instance Foldable1 Hyper' where+  foldMap1 f (Hyper' a b) = f a <> f b++instance FoldableWithKey1 Hyper' where+  foldMapWithKey1 f (Hyper' a b) = f Cosh' a <> f Sinh' b++instance Traversable1 Hyper' where+  traverse1 f (Hyper' a b) = Hyper' <$> f a <.> f b++instance TraversableWithKey1 Hyper' where+  traverseWithKey1 f (Hyper' a b) = Hyper' <$> f Cosh' a <.> f Sinh' b++instance HasTrie HyperBasis' where+  type BaseTrie HyperBasis' = Hyper'+  embedKey = id+  projectKey = id++instance Additive r => Additive (Hyper' r) where+  (+) = addRep +  sinnum1p = sinnum1pRep++instance LeftModule r s => LeftModule r (Hyper' s) where+  r .* Hyper' a b = Hyper' (r .* a) (r .* b)++instance RightModule r s => RightModule r (Hyper' s) where+  Hyper' a b *. r = Hyper' (a *. r) (b *. r)++instance Monoidal r => Monoidal (Hyper' r) where+  zero = zeroRep+  sinnum = sinnumRep++instance Group r => Group (Hyper' r) where+  (-) = minusRep+  negate = negateRep+  subtract = subtractRep+  times = timesRep++instance Abelian r => Abelian (Hyper' r)++instance Idempotent r => Idempotent (Hyper' r)++instance Partitionable r => Partitionable (Hyper' r) where+  partitionWith f (Hyper' a b) = id =<<+    partitionWith (\a1 a2 -> +    partitionWith (\b1 b2 -> f (Hyper' a1 b1) (Hyper' a2 b2)) b) a++-- the dual hyperbolic trigonometric algebra+instance (Commutative k, Semiring k) => Algebra k HyperBasis' where+  mult f = f' where+    fs = f Sinh' Cosh' + f Cosh' Sinh'+    fc = f Cosh' Cosh' + f Sinh' Sinh'+    f' Sinh' = fs+    f' Cosh' = fc++instance (Commutative k, Monoidal k, Semiring k) => UnitalAlgebra k HyperBasis' where+  unit _ Sinh' = zero+  unit x Cosh' = x++-- the diagonal coalgebra+instance (Commutative k, Monoidal k, Semiring k) => Coalgebra k HyperBasis' where+  comult f = f' where+     fs = f Sinh'+     fc = f Cosh'+     f' Sinh' Sinh' = fs+     f' Sinh' Cosh' = zero+     f' Cosh' Sinh' = zero+     f' Cosh' Cosh' = fc++instance (Commutative k, Monoidal k, Semiring k) => CounitalCoalgebra k HyperBasis' where+  counit f = f Cosh' + f Sinh'++instance (Commutative k, Monoidal k, Semiring k) => Bialgebra k HyperBasis'++instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis' where+  inv f = f' where+    afc = adjoint (f Cosh')+    nfs = negate (f Sinh')+    f' Cosh' = afc+    f' Sinh' = nfs++instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis' where+  coinv = inv++instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis' where+  antipode = inv++instance (Commutative k, Semiring k) => Multiplicative (Hyper' k) where+  (*) = mulRep++instance (Commutative k, Semiring k) => Commutative (Hyper' k)++instance (Commutative k, Semiring k) => Semiring (Hyper' k)++instance (Commutative k, Rig k) => Unital (Hyper' k) where+  one = Hyper' one zero++instance (Commutative r, Rig r) => Rig (Hyper' r) where+  fromNatural n = Hyper' (fromNatural n) zero++instance (Commutative r, Ring r) => Ring (Hyper' r) where+  fromInteger n = Hyper' (fromInteger n) zero++instance (Commutative r, Semiring r) => LeftModule (Hyper' r) (Hyper' r) where (.*) = (*)+instance (Commutative r, Semiring r) => RightModule (Hyper' r) (Hyper' r) where (*.) = (*)++instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveMultiplication (Hyper' r) where+  adjoint (Hyper' a b) = Hyper' (adjoint a) (negate b)++instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveSemiring (Hyper' r)++instance (Commutative r, InvolutiveSemiring r, Rng r) => Quadrance r (Hyper' r) where+  quadrance n = case adjoint n * n of+    Hyper' a _ -> a++instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Hyper' r) where+  recip q@(Hyper' a b) = Hyper' (qq \\ a) (qq \\ b)+    where qq = quadrance q+
+ src/Numeric/Algebra/Idempotent.hs view
@@ -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
+ src/Numeric/Algebra/Incidence.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE MultiParamTypeClasses+           , FlexibleInstances+           , UndecidableInstances+           , DeriveDataTypeable+           #-}++module Numeric.Algebra.Incidence+  ( Interval(..)+  , zeta+  , moebius+  ) where++import Data.Data+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Algebra.Commutative+import Numeric.Ring.Class+import Numeric.Order.Class+import Numeric.Order.LocallyFinite++-- the basis for an incidence algebra+data Interval a = Interval a a deriving (Eq,Ord,Show,Read,Data,Typeable)++instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => Algebra r (Interval a) where+  mult f (Interval a c) = sumWith (\b -> f (Interval a b) (Interval b c)) $ range a c+  +instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => UnitalAlgebra r (Interval a) where+  unit r (Interval a b) +    | a ~~ b = r+    | otherwise = zero++zeta :: Unital r => Interval a -> r+zeta = const one++moebius :: (Ring r, LocallyFiniteOrder a) => Interval a -> r+moebius (Interval a b) = moebiusInversion a b
+ src/Numeric/Algebra/Involutive.hs view
@@ -0,0 +1,377 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeOperators #-}+module Numeric.Algebra.Involutive+  ( +  -- * Involution+    InvolutiveMultiplication(..)+  , InvolutiveSemiring+  -- * Involutive Algebras+  , InvolutiveAlgebra(..)+  , InvolutiveCoalgebra(..)+  , InvolutiveBialgebra+  -- * Trivial Involution+  , TriviallyInvolutive+  , TriviallyInvolutiveAlgebra+  , TriviallyInvolutiveCoalgebra+  , TriviallyInvolutiveBialgebra+  ) where++import Numeric.Algebra.Class+import Numeric.Algebra.Commutative+import Numeric.Algebra.Unital+import Data.Int+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Key+import Data.Word+import Numeric.Natural.Internal++++-- | An semigroup with involution+-- +-- > adjoint a * adjoint b = adjoint (b * a)+class Multiplicative r => InvolutiveMultiplication r where+  adjoint :: r -> r++instance InvolutiveMultiplication Int where adjoint = id+instance InvolutiveMultiplication Integer where adjoint = id+instance InvolutiveMultiplication Int8 where adjoint = id+instance InvolutiveMultiplication Int16 where adjoint = id+instance InvolutiveMultiplication Int32 where adjoint = id+instance InvolutiveMultiplication Int64 where adjoint = id+instance InvolutiveMultiplication Bool where adjoint = id+instance InvolutiveMultiplication Word where adjoint = id+instance InvolutiveMultiplication Natural where adjoint = id+instance InvolutiveMultiplication Word8 where adjoint = id+instance InvolutiveMultiplication Word16 where adjoint = id+instance InvolutiveMultiplication Word32 where adjoint = id+instance InvolutiveMultiplication Word64 where adjoint = id+instance InvolutiveMultiplication () where adjoint = id++instance +  ( InvolutiveMultiplication a+  , InvolutiveMultiplication b+  ) => InvolutiveMultiplication (a,b) where+  adjoint (a,b) = (adjoint a, adjoint b)++instance +  ( InvolutiveMultiplication a+  , InvolutiveMultiplication b+  , InvolutiveMultiplication c+  ) => InvolutiveMultiplication (a,b,c) where+  adjoint (a,b,c) = (adjoint a, adjoint b, adjoint c)++instance +  ( InvolutiveMultiplication a+  , InvolutiveMultiplication b+  , InvolutiveMultiplication c+  , InvolutiveMultiplication d+  ) => InvolutiveMultiplication (a,b,c,d) where+  adjoint (a,b,c,d) = (adjoint a, adjoint b, adjoint c, adjoint d)++instance +  ( InvolutiveMultiplication a+  , InvolutiveMultiplication b+  , InvolutiveMultiplication c+  , InvolutiveMultiplication d+  , InvolutiveMultiplication e+  ) => InvolutiveMultiplication (a,b,c,d,e) where+  adjoint (a,b,c,d,e) = (adjoint a, adjoint b, adjoint c, adjoint d, adjoint e)++instance InvolutiveAlgebra r h => InvolutiveMultiplication (h -> r) where+  adjoint = inv++instance (HasTrie h, InvolutiveAlgebra r h) => InvolutiveMultiplication (h :->: r) where+  adjoint = tabulate . inv . index++++-- | adjoint (x + y) = adjoint x + adjoint y+class (Semiring r, InvolutiveMultiplication r) => InvolutiveSemiring r++instance InvolutiveSemiring ()+instance InvolutiveSemiring Bool+instance InvolutiveSemiring Integer+instance InvolutiveSemiring Int+instance InvolutiveSemiring Int8+instance InvolutiveSemiring Int16+instance InvolutiveSemiring Int32+instance InvolutiveSemiring Int64+instance InvolutiveSemiring Natural+instance InvolutiveSemiring Word+instance InvolutiveSemiring Word8+instance InvolutiveSemiring Word16+instance InvolutiveSemiring Word32+instance InvolutiveSemiring Word64++instance ( InvolutiveSemiring a+         , InvolutiveSemiring b+         ) => InvolutiveSemiring (a, b)++instance ( InvolutiveSemiring a+         , InvolutiveSemiring b+         , InvolutiveSemiring c+         ) => InvolutiveSemiring (a, b, c)++instance ( InvolutiveSemiring a+         , InvolutiveSemiring b+         , InvolutiveSemiring c+         , InvolutiveSemiring d+         ) => InvolutiveSemiring (a, b, c, d)++instance ( InvolutiveSemiring a+         , InvolutiveSemiring b+         , InvolutiveSemiring c+         , InvolutiveSemiring d+         , InvolutiveSemiring e+         ) => InvolutiveSemiring (a, b, c, d, e)+++-- | +-- > adjoint = id+class ( Commutative r+      , InvolutiveMultiplication r+      ) => TriviallyInvolutive r++instance TriviallyInvolutive Bool+instance TriviallyInvolutive Int+instance TriviallyInvolutive Integer+instance TriviallyInvolutive Int8+instance TriviallyInvolutive Int16+instance TriviallyInvolutive Int32+instance TriviallyInvolutive Int64+instance TriviallyInvolutive Word+instance TriviallyInvolutive Natural+instance TriviallyInvolutive Word8+instance TriviallyInvolutive Word16+instance TriviallyInvolutive Word32+instance TriviallyInvolutive Word64+instance TriviallyInvolutive ()++instance ( TriviallyInvolutive a+         , TriviallyInvolutive b+         ) => TriviallyInvolutive (a,b)++instance ( TriviallyInvolutive a+         , TriviallyInvolutive b+         , TriviallyInvolutive c+         ) => TriviallyInvolutive (a,b,c)++instance ( TriviallyInvolutive a+         , TriviallyInvolutive b+         , TriviallyInvolutive c+         , TriviallyInvolutive d+         ) => TriviallyInvolutive (a,b,c,d)++instance ( TriviallyInvolutive a+         , TriviallyInvolutive b+         , TriviallyInvolutive c+         , TriviallyInvolutive d+         , TriviallyInvolutive e+         ) => TriviallyInvolutive (a,b,c,d,e)++instance ( TriviallyInvolutive r+         , TriviallyInvolutiveAlgebra r a+         ) => TriviallyInvolutive (a -> r)++instance ( HasTrie a+         , TriviallyInvolutive r+         , TriviallyInvolutiveAlgebra r a+         ) => TriviallyInvolutive (a :->: r)++++-- inv is an associative algebra homomorphism+class (InvolutiveSemiring r, Algebra r a) => InvolutiveAlgebra r a where+  inv :: (a -> r) -> a -> r++instance InvolutiveSemiring r => InvolutiveAlgebra r () where+  inv = (adjoint .)++instance +  ( InvolutiveAlgebra r a+  , InvolutiveAlgebra r b+  ) => InvolutiveAlgebra r (a, b) where+  inv f (a,b) = +    inv (\a' -> +    inv (\b' -> f (a',b')) b) a++instance +  ( InvolutiveAlgebra r a+  , InvolutiveAlgebra r b+  , InvolutiveAlgebra r c+  ) => InvolutiveAlgebra r (a, b, c) where+  inv f (a,b,c) =+    inv (\a' -> +    inv (\b' ->+    inv (\c' -> f (a',b',c')) c) b) a++instance +  ( InvolutiveAlgebra r a+  , InvolutiveAlgebra r b+  , InvolutiveAlgebra r c+  , InvolutiveAlgebra r d+  ) => InvolutiveAlgebra r (a, b, c, d) where+  inv f (a,b,c,d) = +    inv (\a' ->+    inv (\b' ->+    inv (\c' -> +    inv (\d' -> f (a',b',c',d')) d) c) b) a++instance +  ( InvolutiveAlgebra r a+  , InvolutiveAlgebra r b+  , InvolutiveAlgebra r c+  , InvolutiveAlgebra r d+  , InvolutiveAlgebra r e+  ) => InvolutiveAlgebra r (a, b, c, d, e) where+  inv f (a,b,c,d,e) = +    inv (\a' -> +    inv (\b' -> +    inv (\c' -> +    inv (\d' -> +    inv (\e' -> f (a',b',c',d',e')) e) d) c) b) a++++class ( CommutativeAlgebra r a+      , TriviallyInvolutive r+      , InvolutiveAlgebra r a+      ) => TriviallyInvolutiveAlgebra r a++instance ( TriviallyInvolutive r+         , InvolutiveSemiring r+         ) => TriviallyInvolutiveAlgebra r ()++instance ( TriviallyInvolutiveAlgebra r a+         , TriviallyInvolutiveAlgebra r b+         ) => TriviallyInvolutiveAlgebra r (a, b) where++instance (TriviallyInvolutiveAlgebra r a+         , TriviallyInvolutiveAlgebra r b+         , TriviallyInvolutiveAlgebra r c+         ) => TriviallyInvolutiveAlgebra r (a, b, c) where++instance ( TriviallyInvolutiveAlgebra r a+         , TriviallyInvolutiveAlgebra r b+         , TriviallyInvolutiveAlgebra r c+         , TriviallyInvolutiveAlgebra r d+         ) => TriviallyInvolutiveAlgebra r (a, b, c, d)++instance ( TriviallyInvolutiveAlgebra r a+         , TriviallyInvolutiveAlgebra r b+         , TriviallyInvolutiveAlgebra r c+         , TriviallyInvolutiveAlgebra r d+         , TriviallyInvolutiveAlgebra r e+         ) => TriviallyInvolutiveAlgebra r (a, b, c, d, e)++++class ( InvolutiveSemiring r+      , Coalgebra r c+      ) => InvolutiveCoalgebra r c where+  coinv :: (c -> r) -> c -> r++instance InvolutiveSemiring r => InvolutiveCoalgebra r () where+  coinv f c = adjoint (f c)++instance +  ( InvolutiveCoalgebra r a+  , InvolutiveCoalgebra r b+  ) => InvolutiveCoalgebra r (a, b) where+  coinv f (a,b) = +    coinv (\a' -> +    coinv (\b' -> f (a',b')) b) a++instance +  ( InvolutiveCoalgebra r a+  , InvolutiveCoalgebra r b+  , InvolutiveCoalgebra r c+  ) => InvolutiveCoalgebra r (a, b, c) where+  coinv f (a,b,c) = +    coinv (\a' -> +    coinv (\b' -> +    coinv (\c' -> f (a',b',c')) c) b) a++instance +  ( InvolutiveCoalgebra r a+  , InvolutiveCoalgebra r b+  , InvolutiveCoalgebra r c+  , InvolutiveCoalgebra r d+  ) => InvolutiveCoalgebra r (a, b, c, d) where+  coinv f (a,b,c,d) = +    coinv (\a' -> +    coinv (\b' -> +    coinv (\c' -> +    coinv (\d' -> f (a',b',c',d')) d) c) b) a++instance +  ( InvolutiveCoalgebra r a+  , InvolutiveCoalgebra r b+  , InvolutiveCoalgebra r c+  , InvolutiveCoalgebra r d+  , InvolutiveCoalgebra r e+  ) => InvolutiveCoalgebra r (a, b, c, d, e) where+  coinv f (a,b,c,d,e) = +    coinv (\a' -> +    coinv (\b' -> +    coinv (\c' -> +    coinv (\d' -> +    coinv (\e' -> f (a',b',c',d',e')) e) d) c) b) a++++class ( CocommutativeCoalgebra r a+      , TriviallyInvolutive r+      , InvolutiveCoalgebra r a+      ) => TriviallyInvolutiveCoalgebra r a++instance ( TriviallyInvolutive r+         , InvolutiveSemiring r+         ) => TriviallyInvolutiveCoalgebra r ()++instance ( TriviallyInvolutiveCoalgebra r a+         , TriviallyInvolutiveCoalgebra r b+         ) => TriviallyInvolutiveCoalgebra r (a, b)++instance ( TriviallyInvolutiveCoalgebra r a+         , TriviallyInvolutiveCoalgebra r b+         , TriviallyInvolutiveCoalgebra r c+         ) => TriviallyInvolutiveCoalgebra r (a, b, c)++instance ( TriviallyInvolutiveCoalgebra r a+         , TriviallyInvolutiveCoalgebra r b+         , TriviallyInvolutiveCoalgebra r c+         , TriviallyInvolutiveCoalgebra r d+         ) => TriviallyInvolutiveCoalgebra r (a, b, c, d)++instance ( TriviallyInvolutiveCoalgebra r a+         , TriviallyInvolutiveCoalgebra r b+         , TriviallyInvolutiveCoalgebra r c+         , TriviallyInvolutiveCoalgebra r d+         , TriviallyInvolutiveCoalgebra r e+         ) => TriviallyInvolutiveCoalgebra r (a, b, c, d, e)++++class ( Bialgebra r h+      , InvolutiveAlgebra r h+      , InvolutiveCoalgebra r h+      ) => InvolutiveBialgebra r h++instance ( Bialgebra r h+         , InvolutiveAlgebra r h+         , InvolutiveCoalgebra r h+         ) => InvolutiveBialgebra r h++++class ( InvolutiveBialgebra r h+      , TriviallyInvolutiveAlgebra r h+      , TriviallyInvolutiveCoalgebra r h+      ) => TriviallyInvolutiveBialgebra r h++instance ( InvolutiveBialgebra r h+         , TriviallyInvolutiveAlgebra r h+         , TriviallyInvolutiveCoalgebra r h+         ) => TriviallyInvolutiveBialgebra r h
+ src/Numeric/Algebra/Quaternion.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE FlexibleInstances+           , MultiParamTypeClasses+           , TypeFamilies+           , UndecidableInstances+           , DeriveDataTypeable+           , TypeOperators #-}+module Numeric.Algebra.Quaternion +  ( Distinguished(..)+  , Complicated(..)+  , Hamiltonian(..)+  , QuaternionBasis(..)+  , Quaternion(..)+  , complicate+  , vectorPart+  , scalarPart+  ) where++import Control.Applicative+import Control.Monad.Reader.Class+import Data.Ix hiding (index)+import Data.Key+import Data.Data+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Traversable+import Data.Semigroup+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Numeric.Algebra+import Numeric.Algebra.Distinguished.Class+import Numeric.Algebra.Complex.Class+import Numeric.Algebra.Quaternion.Class+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)++instance Distinguished QuaternionBasis where+  e = E++instance Complicated QuaternionBasis where+  i = I++instance Hamiltonian QuaternionBasis where+  j = J+  k = K++instance Rig r => Distinguished (Quaternion r) where+  e = Quaternion one zero zero zero++instance Rig r => Complicated (Quaternion r) where+  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 => Distinguished (QuaternionBasis :->: r) where+  e = Trie e++instance Rig r => Complicated (QuaternionBasis :->: r) where+  i = Trie i++instance Rig r => Hamiltonian (QuaternionBasis :->: r) where+  j = Trie j+  k = Trie k++instance Rig r => Distinguished (QuaternionBasis -> r) where+  e E = one +  e _ = zero++instance Rig r => Complicated (QuaternionBasis -> r) where+  i I = one+  i _ = zero+  +instance Rig r => Hamiltonian (QuaternionBasis -> r) where+  j J = one+  j _ = zero++  k K = one+  k _ = zero++-- 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 +  sinnum1p = sinnum1pRep++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+  sinnum = sinnumRep++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++-- | the quaternion algebra+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++-- | the trivial diagonal coalgebra+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' I I = fi+    f' J J = fj+    f' K K = fk+    f' _ _ = zero++instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where+  counit f = f E + f I + f J + f K++{-+-- dual quaternion comultiplication+instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where+  comult f = f' where+    fe = f E+    fi = f I+    fj = f J+    fk = f K+    fe' = negate fe+    fi' = negate fi+    fj' = negate fj+    fk' = negate fk+    f' E E = fe+    f' E I = fi+    f' E J = fj+    f' E K = fk+    f' I E = fi+    f' I I = fe'+    f' I J = fk+    f' I K = fj'+    f' J E = fj+    f' J I = fk'+    f' J J = fe'+    f' J K = fi+    f' K E = fk+    f' K I = fj+    f' K J = fi'+    f' K K = fe'++instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where+  counit f = f E+-}++instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis ++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis where+  inv f E = f E+  inv f b = negate (f b)++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis where+  coinv = inv++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis where+  antipode = inv++instance (TriviallyInvolutive r, Rng r) => Multiplicative (Quaternion r) where+  (*) = mulRep++instance (TriviallyInvolutive r, Rng r) => Semiring (Quaternion r)++instance (TriviallyInvolutive r, Ring r) => Unital (Quaternion r) where+  one = oneRep++instance (TriviallyInvolutive r, Ring r) => Rig (Quaternion r) where+  fromNatural n = Quaternion (fromNatural n) zero zero zero++instance (TriviallyInvolutive r, Ring r) => Ring (Quaternion r) where+  fromInteger n = Quaternion (fromInteger n) zero zero zero++instance ( TriviallyInvolutive r, Rng r) => LeftModule (Quaternion r) (Quaternion r) where +  (.*) = (*)+instance (TriviallyInvolutive r, Rng r) => RightModule (Quaternion r) (Quaternion r) where +  (*.) = (*)++instance (TriviallyInvolutive r, Rng r) => InvolutiveMultiplication (Quaternion r) where+  -- without trivial involution, multiplication fails associativity, and we'd need to +  -- support weaker multiplicative properties like Alternative and PowerAssociative+  adjoint (Quaternion a b c d) = Quaternion a (negate b) (negate c) (negate d)++-- | Cayley-Dickson quaternion isomorphism (one way)+complicate :: Complicated c => QuaternionBasis -> (c,c)+complicate E = (e, e)+complicate I = (i, e) +complicate J = (e, i)+complicate K = (i, i)++scalarPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> r+scalarPart f = index f E++vectorPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> (r,r,r)+vectorPart f = (index f I, index f J, index f K)++instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion r) where+  quadrance n = scalarPart (adjoint n * n)++instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion r) where+  recip q@(Quaternion a b c d) = Quaternion (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)+    where qq = quadrance q
+ src/Numeric/Algebra/Quaternion/Class.hs view
@@ -0,0 +1,14 @@+module Numeric.Algebra.Quaternion.Class+  ( Hamiltonian(..)+  ) where++import Numeric.Algebra.Complex.Class+import Numeric.Covector++class Complicated t => Hamiltonian t where+  j :: t+  k :: t++instance Hamiltonian a => Hamiltonian (Covector r a) where+  j = return j+  k = return k
+ src/Numeric/Algebra/Unital.hs view
@@ -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)
+ src/Numeric/Band/Class.hs view
@@ -0,0 +1,7 @@+module Numeric.Band.Class+  ( Band+  , pow1pBand+  , powBand+  ) where++import Numeric.Algebra.Idempotent
+ src/Numeric/Band/Rectangular.hs view
@@ -0,0 +1,21 @@+module Numeric.Band.Rectangular +  ( Rect(..)+  ) where++import Numeric.Algebra.Class+import Numeric.Algebra.Idempotent+import Data.Semigroupoid++-- | a rectangular band is a nowhere commutative semigroup.+-- That is to say, if ab = ba then a = b. From this it follows+-- classically that aa = a and that such a band is isomorphic +-- to the following structure+data Rect i j = Rect i j deriving (Eq,Ord,Show,Read)++instance Semigroupoid Rect where+  Rect _ i `o` Rect j _ = Rect j i++instance Multiplicative (Rect i j) where+  Rect i _ * Rect _ j = Rect i j++instance Band (Rect i j)
+ src/Numeric/Coalgebra/Categorical.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, PatternGuards #-}+module Numeric.Coalgebra.Categorical +  ( Morphism(..)+  ) where++import Data.Data+import Numeric.Partial.Semigroup+import Numeric.Partial.Monoid+import Numeric.Partial.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Algebra.Commutative++-- the dual categorical algebra+newtype Morphism a = Morphism a deriving (Eq,Ord,Show,Read,PartialSemigroup,PartialMonoid,PartialGroup,Data,Typeable)++instance (Commutative r, Monoidal r, Semiring r, PartialSemigroup a) => Coalgebra r (Morphism a) where+  comult f a b +    | Just c <- padd a b = f c+    | otherwise = zero++instance (Commutative r, Monoidal r, Semiring r, PartialMonoid a) => CounitalCoalgebra r (Morphism a) where+  counit f = f pzero
+ src/Numeric/Coalgebra/Dual.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}+module Numeric.Coalgebra.Dual+  ( Distinguished(..)+  , Infinitesimal(..)+  , DualBasis'(..)+  , Dual'(..)+  ) 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.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup+import Data.Traversable+import Numeric.Algebra+import Numeric.Algebra.Distinguished.Class+import Numeric.Algebra.Dual.Class+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)++-- | dual number basis, D^2 = 0. D /= 0.+data DualBasis' = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)+data Dual' a = Dual' a a deriving (Eq,Show,Read,Data,Typeable)++instance Distinguished DualBasis' where+  e = E++instance Infinitesimal DualBasis' where+  d = D++instance Rig r => Distinguished (Dual' r) where+  e = Dual' one zero++instance Rig r => Infinitesimal (Dual' r) where+  d = Dual' zero one+  +instance Rig r => Distinguished (DualBasis' -> r) where+  e E = one+  e _ = zero++instance Rig r => Infinitesimal (DualBasis' -> r) where+  d D = one+  d _       = zero ++type instance Key Dual' = DualBasis'++instance Representable Dual' where+  tabulate f = Dual' (f E) (f D)++instance Indexable Dual' where+  index (Dual' a _ ) E = a+  index (Dual' _ b ) D = b++instance Lookup Dual' where+  lookup = lookupDefault++instance Adjustable Dual' where+  adjust f E (Dual' a b) = Dual' (f a) b+  adjust f D (Dual' a b) = Dual' a (f b)++instance Distributive Dual' where+  distribute = distributeRep ++instance Functor Dual' where+  fmap f (Dual' a b) = Dual' (f a) (f b)++instance Zip Dual' where+  zipWith f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f a1 a2) (f b1 b2)++instance ZipWithKey Dual' where+  zipWithKey f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f E a1 a2) (f D b1 b2)++instance Keyed Dual' where+  mapWithKey = mapWithKeyRep++instance Apply Dual' where+  (<.>) = apRep++instance Applicative Dual' where+  pure = pureRep+  (<*>) = apRep ++instance Bind Dual' where+  (>>-) = bindRep++instance Monad Dual' where+  return = pureRep+  (>>=) = bindRep++instance MonadReader DualBasis' Dual' where+  ask = askRep+  local = localRep++instance Foldable Dual' where+  foldMap f (Dual' a b) = f a `mappend` f b++instance FoldableWithKey Dual' where+  foldMapWithKey f (Dual' a b) = f E a `mappend` f D b++instance Traversable Dual' where+  traverse f (Dual' a b) = Dual' <$> f a <*> f b++instance TraversableWithKey Dual' where+  traverseWithKey f (Dual' a b) = Dual' <$> f E a <*> f D b++instance Foldable1 Dual' where+  foldMap1 f (Dual' a b) = f a <> f b++instance FoldableWithKey1 Dual' where+  foldMapWithKey1 f (Dual' a b) = f E a <> f D b++instance Traversable1 Dual' where+  traverse1 f (Dual' a b) = Dual' <$> f a <.> f b++instance TraversableWithKey1 Dual' where+  traverseWithKey1 f (Dual' a b) = Dual' <$> f E a <.> f D b++instance HasTrie DualBasis' where+  type BaseTrie DualBasis' = Dual'+  embedKey = id+  projectKey = id++instance Additive r => Additive (Dual' r) where+  (+) = addRep +  sinnum1p = sinnum1pRep++instance LeftModule r s => LeftModule r (Dual' s) where+  r .* Dual' a b = Dual' (r .* a) (r .* b)++instance RightModule r s => RightModule r (Dual' s) where+  Dual' a b *. r = Dual' (a *. r) (b *. r)++instance Monoidal r => Monoidal (Dual' r) where+  zero = zeroRep+  sinnum = sinnumRep++instance Group r => Group (Dual' r) where+  (-) = minusRep+  negate = negateRep+  subtract = subtractRep+  times = timesRep++instance Abelian r => Abelian (Dual' r)++instance Idempotent r => Idempotent (Dual' r)++instance Partitionable r => Partitionable (Dual' r) where+  partitionWith f (Dual' a b) = id =<<+    partitionWith (\a1 a2 -> +    partitionWith (\b1 b2 -> f (Dual' a1 b1) (Dual' a2 b2)) b) a++instance Semiring k => Algebra k DualBasis' where+  mult f = f' where+    fe = f E E+    fd = f D D+    f' E = fe+    f' D = fd++instance Semiring k => UnitalAlgebra k DualBasis' where+  unit = const++-- the trivial coalgebra+instance Rng k => Coalgebra k DualBasis' where+  comult f = f' where+     fe = f E+     fd = f D+     f' E E = fe+     f' E D = fd+     f' D E = fd+     f' D D = zero++instance Rng k => CounitalCoalgebra k DualBasis' where+  counit f = f E++instance Rng k => Bialgebra k DualBasis' ++instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis' where+  inv f = f' where+    afe = adjoint (f E)+    nfd = negate (f D)+    f' E = afe+    f' D = nfd++instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis' where+  coinv = inv++instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis' where+  antipode = inv++instance (Commutative r, Rng r) => Multiplicative (Dual' r) where+  (*) = mulRep++instance (TriviallyInvolutive r, Rng r) => Commutative (Dual' r)++instance (Commutative r, Rng r) => Semiring (Dual' r)++instance (Commutative r, Ring r) => Unital (Dual' r) where+  one = oneRep++instance (Commutative r, Ring r) => Rig (Dual' r) where+  fromNatural n = Dual' (fromNatural n) zero++instance (Commutative r, Ring r) => Ring (Dual' r) where+  fromInteger n = Dual' (fromInteger n) zero++instance (Commutative r, Rng r) => LeftModule (Dual' r) (Dual' r) where (.*) = (*)+instance (Commutative r, Rng r) => RightModule (Dual' r) (Dual' r) where (*.) = (*)++instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual' r) where+  adjoint (Dual' a b) = Dual' (adjoint a) (negate b)++instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual' r)++instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual' r) where+  quadrance n = case adjoint n * n of+    Dual' a _ -> a++instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual' r) where+  recip q@(Dual' a b) = Dual' (qq \\ a) (qq \\ b)+    where qq = quadrance q
+ src/Numeric/Coalgebra/Geometric.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE +    MultiParamTypeClasses, +    GeneralizedNewtypeDeriving, +    BangPatterns,+    TypeOperators,+    DeriveDataTypeable,+    FlexibleInstances,+    TypeFamilies,+    PatternGuards,+    UndecidableInstances,+    ScopedTypeVariables #-}++module Numeric.Coalgebra.Geometric+  ( +  -- * Geometric coalgebra primitives+    BasisCoblade(..)+  , Comultivector+  -- * Operations over an eigenbasis+  , Eigenbasis(..)+  , Eigenmetric(..)+  , Euclidean(..)+  -- * 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 coalgebra with the Euclidean inner product+newtype BasisCoblade m = BasisCoblade { runBasisCoblade :: 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 (BasisCoblade m) where+  type BaseTrie (BasisCoblade m) = BaseTrie Word64+  embedKey = embedKey . runBasisCoblade+  projectKey = BasisCoblade . projectKey++-- A metric space over an eigenbasis+class Eigenbasis m where+  euclidean     :: proxy m -> Bool+  antiEuclidean :: proxy m -> Bool+  v             :: m -> BasisCoblade m+  e             :: Int -> m++-- assuming n /= 0, find the index of the least significant set bit in a basis blade+lsb :: BasisCoblade m -> Int+lsb n = fromIntegral $ ix ! shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58+  where +    -- a 64 bit deBruijn multiplication table+    ix :: UArray (BasisCoblade 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 (BasisCoblade m)++-- 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 :: BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> Int -> Comultivector r m+filterGrade b k | grade b == k = zero+                | otherwise    = return b++instance Eigenmetric r m => Coalgebra r (BasisCoblade 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 -> BasisCoblade 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 (BasisCoblade m) where+  counit f = f (BasisCoblade zero)++-- instance Group r => InvertibleModule r BasisCoblade where+  +-- reversion (A~) is an involution for the outer product+reverse :: Group r => BasisCoblade m -> Comultivector r m+reverse b = shiftR (g * (g - 1)) 1 `m1powTimes` return b where+  g = grade b++cliffordConjugate :: Group r => BasisCoblade m -> Comultivector r m+cliffordConjugate b = shiftR (g * (g + 1)) 1 `m1powTimes` return b where+  g = grade b++-- A^+gradeInversion :: Group r => BasisCoblade m -> Comultivector r m+gradeInversion b = grade b `m1powTimes` return b++geometric :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m  +geometric = multM++outer :: Eigenmetric r m => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 => BasisCoblade m -> BasisCoblade 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 :: (BasisCoblade m -> BasisCoblade 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
+ src/Numeric/Coalgebra/Hyperbolic.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}+module Numeric.Coalgebra.Hyperbolic +  ( Hyperbolic(..)+  , HyperBasis(..)+  , Hyper(..)+  ) where++import Control.Applicative+import Control.Monad.Reader.Class+import Data.Data+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Ix+import Data.Key+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup+import Data.Traversable+import Numeric.Algebra+import Numeric.Coalgebra.Hyperbolic.Class+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, cosh, sinh)++-- complex basis+data HyperBasis = Cosh | Sinh deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)+data Hyper a = Hyper a a deriving (Eq,Show,Read,Data,Typeable)++instance Hyperbolic HyperBasis where+  cosh = Cosh+  sinh = Sinh++instance Rig r => Hyperbolic (Hyper r) where+  cosh = Hyper one zero+  sinh = Hyper zero one+  +instance Rig r => Hyperbolic (HyperBasis -> r) where+  cosh Sinh = zero+  cosh Cosh = one+  sinh Sinh = one+  sinh Cosh = zero++type instance Key Hyper = HyperBasis++instance Representable Hyper where+  tabulate f = Hyper (f Cosh) (f Sinh)++instance Indexable Hyper where+  index (Hyper a _ ) Cosh = a+  index (Hyper _ b ) Sinh = b++instance Lookup Hyper where+  lookup = lookupDefault++instance Adjustable Hyper where+  adjust f Cosh (Hyper a b) = Hyper (f a) b+  adjust f Sinh (Hyper a b) = Hyper a (f b)++instance Distributive Hyper where+  distribute = distributeRep ++instance Functor Hyper where+  fmap f (Hyper a b) = Hyper (f a) (f b)++instance Zip Hyper where+  zipWith f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f a1 a2) (f b1 b2)++instance ZipWithKey Hyper where+  zipWithKey f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f Cosh a1 a2) (f Sinh b1 b2)++instance Keyed Hyper where+  mapWithKey = mapWithKeyRep++instance Apply Hyper where+  (<.>) = apRep++instance Applicative Hyper where+  pure = pureRep+  (<*>) = apRep ++instance Bind Hyper where+  (>>-) = bindRep++instance Monad Hyper where+  return = pureRep+  (>>=) = bindRep++instance MonadReader HyperBasis Hyper where+  ask = askRep+  local = localRep++instance Foldable Hyper where+  foldMap f (Hyper a b) = f a `mappend` f b++instance FoldableWithKey Hyper where+  foldMapWithKey f (Hyper a b) = f Cosh a `mappend` f Sinh b++instance Traversable Hyper where+  traverse f (Hyper a b) = Hyper <$> f a <*> f b++instance TraversableWithKey Hyper where+  traverseWithKey f (Hyper a b) = Hyper <$> f Cosh a <*> f Sinh b++instance Foldable1 Hyper where+  foldMap1 f (Hyper a b) = f a <> f b++instance FoldableWithKey1 Hyper where+  foldMapWithKey1 f (Hyper a b) = f Cosh a <> f Sinh b++instance Traversable1 Hyper where+  traverse1 f (Hyper a b) = Hyper <$> f a <.> f b++instance TraversableWithKey1 Hyper where+  traverseWithKey1 f (Hyper a b) = Hyper <$> f Cosh a <.> f Sinh b++instance HasTrie HyperBasis where+  type BaseTrie HyperBasis = Hyper+  embedKey = id+  projectKey = id++instance Additive r => Additive (Hyper r) where+  (+) = addRep +  sinnum1p = sinnum1pRep++instance LeftModule r s => LeftModule r (Hyper s) where+  r .* Hyper a b = Hyper (r .* a) (r .* b)++instance RightModule r s => RightModule r (Hyper s) where+  Hyper a b *. r = Hyper (a *. r) (b *. r)++instance Monoidal r => Monoidal (Hyper r) where+  zero = zeroRep+  sinnum = sinnumRep++instance Group r => Group (Hyper r) where+  (-) = minusRep+  negate = negateRep+  subtract = subtractRep+  times = timesRep++instance Abelian r => Abelian (Hyper r)++instance Idempotent r => Idempotent (Hyper r)++instance Partitionable r => Partitionable (Hyper r) where+  partitionWith f (Hyper a b) = id =<<+    partitionWith (\a1 a2 -> +    partitionWith (\b1 b2 -> f (Hyper a1 b1) (Hyper a2 b2)) b) a++-- | the trivial diagonal algebra+instance Semiring k => Algebra k HyperBasis where+  mult f = f' where+    fs = f Sinh Sinh+    fc = f Cosh Cosh+    f' Sinh = fs+    f' Cosh = fc++instance Semiring k => UnitalAlgebra k HyperBasis where+  unit = const++-- | the hyperbolic trigonometric coalgebra+instance (Commutative k, Semiring k) => Coalgebra k HyperBasis where+  comult f = f' where+     fs = f Sinh+     fc = f Cosh+     f' Sinh Sinh = fc+     f' Sinh Cosh = fs +     f' Cosh Sinh = fs+     f' Cosh Cosh = fc++instance (Commutative k, Semiring k) => CounitalCoalgebra k HyperBasis where+  counit f = f Cosh++instance (Commutative k, Semiring k) => Bialgebra k HyperBasis++instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis where+  inv f = f' where+    afc = adjoint (f Cosh)+    nfs = negate (f Sinh)+    f' Cosh = afc+    f' Sinh = nfs++instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis where+  coinv = inv++instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis where+  antipode = inv++instance (Commutative k, Semiring k) => Multiplicative (Hyper k) where+  (*) = mulRep++instance (Commutative k, Semiring k) => Commutative (Hyper k)++instance (Commutative k, Semiring k) => Semiring (Hyper k)++instance (Commutative k, Rig k) => Unital (Hyper k) where+  one = Hyper one zero++instance (Commutative r, Rig r) => Rig (Hyper r) where+  fromNatural n = Hyper (fromNatural n) zero++instance (Commutative r, Ring r) => Ring (Hyper r) where+  fromInteger n = Hyper (fromInteger n) zero++instance (Commutative r, Semiring r) => LeftModule (Hyper r) (Hyper r) where (.*) = (*)+instance (Commutative r, Semiring r) => RightModule (Hyper r) (Hyper r) where (*.) = (*)++instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveMultiplication (Hyper r) where+  adjoint (Hyper a b) = Hyper (adjoint a) (negate b)++instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveSemiring (Hyper r)
+ src/Numeric/Coalgebra/Hyperbolic/Class.hs view
@@ -0,0 +1,14 @@+module Numeric.Coalgebra.Hyperbolic.Class+  ( Hyperbolic(..)+  ) where++import Prelude (return)+import Numeric.Covector++class Hyperbolic r where+  cosh :: r+  sinh :: r++instance Hyperbolic a => Hyperbolic (Covector r a) where+  cosh = return cosh+  sinh = return sinh
+ src/Numeric/Coalgebra/Incidence.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE MultiParamTypeClasses+           , FlexibleInstances+           , UndecidableInstances+           , DeriveDataTypeable+           #-}++module Numeric.Coalgebra.Incidence+  ( Interval'(..)+  , zeta'+  , moebius'+  ) where++import Data.Data+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Algebra.Commutative+import Numeric.Ring.Class+import Numeric.Order.LocallyFinite++-- | the dual incidence algebra basis+data Interval' a = Interval' a a deriving (Eq,Ord,Show,Read,Data,Typeable)++instance (Eq a, Commutative r, Monoidal r, Semiring r) => Coalgebra r (Interval' a) where+  comult f (Interval' a b) (Interval' b' c) +    | b == b' = f (Interval' a c)+    | otherwise = zero++instance (Eq a, Bounded a, Commutative r, Monoidal r, Semiring r) => CounitalCoalgebra r (Interval' a) where+  counit f = f (Interval' minBound maxBound)+  +zeta' :: Unital r => Interval' a -> r+zeta' = const one++moebius' :: (Ring r, LocallyFiniteOrder a) => Interval' a -> r+moebius' (Interval' a b) = moebiusInversion a b
+ src/Numeric/Coalgebra/Quaternion.hs view
@@ -0,0 +1,316 @@+{-# LANGUAGE FlexibleInstances+           , MultiParamTypeClasses+           , TypeFamilies+           , UndecidableInstances+           , DeriveDataTypeable+           , TypeOperators #-}+module Numeric.Coalgebra.Quaternion+  ( Distinguished(..)+  , Complicated(..)+  , Hamiltonian(..)+  , QuaternionBasis'(..)+  , Quaternion'(..)+  , complicate'+  , vectorPart'+  , scalarPart'+  ) where++import Control.Applicative+import Control.Monad.Reader.Class+import Data.Ix hiding (index)+import Data.Key+import Data.Data+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Traversable+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup+import Numeric.Algebra+import Numeric.Algebra.Distinguished.Class+import Numeric.Algebra.Complex.Class+import Numeric.Algebra.Quaternion.Class+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)++instance Distinguished QuaternionBasis' where+  e = E'++instance Complicated QuaternionBasis' where+  i = I'++instance Hamiltonian QuaternionBasis' where+  j = J'+  k = K'++instance Rig r => Distinguished (Quaternion' r) where+  e = Quaternion' one zero zero zero++instance Rig r => Complicated (Quaternion' r) where+  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 => Distinguished (QuaternionBasis' :->: r) where+  e = Trie e++instance Rig r => Complicated (QuaternionBasis' :->: r) where+  i = Trie i++instance Rig r => Hamiltonian (QuaternionBasis' :->: r) where+  j = Trie j+  k = Trie k++instance Rig r => Distinguished (QuaternionBasis' -> r) where+  e E' = one+  e _ = zero++instance Rig r => Complicated (QuaternionBasis' -> r) where+  i I' = one+  i _ = zero++instance Rig r => Hamiltonian (QuaternionBasis' -> r) where+  j J' = one+  j _ = zero++  k K' = one+  k _ = zero++-- 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+  sinnum1p = sinnum1pRep++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+  sinnum = sinnumRep++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++-- | the trivial diagonal algebra+instance (TriviallyInvolutive r, Semiring r) => Algebra r QuaternionBasis' where+  mult f = f' where+    fe = f E' E'+    fi = f I' I'+    fj = f J' J'+    fk = f K' K'+    f' E' = fe+    f' I' = fi+    f' J' = fj+    f' K' = fk++instance (TriviallyInvolutive r, Semiring r) => UnitalAlgebra r QuaternionBasis' where+  unit = const+++-- | dual quaternion comultiplication+instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis' where+  comult f = f' where+    fe = f E'+    fi = f I'+    fj = f J'+    fk = f K'+    fe' = negate fe+    fi' = negate fi+    fj' = negate fj+    fk' = negate fk+    f' E' E' = fe+    f' E' I' = fi+    f' E' J' = fj+    f' E' K' = fk+    f' I' E' = fi+    f' I' I' = fe'+    f' I' J' = fk+    f' I' K' = fj'+    f' J' E' = fj+    f' J' I' = fk'+    f' J' J' = fe'+    f' J' K' = fi+    f' K' E' = fk+    f' K' I' = fj+    f' K' J' = fi'+    f' K' K' = fe'++instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis' where+  counit f = f E'++instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis'++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis' where+  inv f E' = f E'+  inv f b = negate (f b)++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis' where+  coinv = inv++instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis' where+  antipode = inv++instance (TriviallyInvolutive r, Semiring r) => Multiplicative (Quaternion' r) where+  (*) = mulRep++instance (TriviallyInvolutive r, Semiring 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' :: Complicated c => QuaternionBasis' -> (c , c)+complicate' E' = (e, e)+complicate' I' = (i, e)+complicate' J' = (e, i)+complicate' K' = (i, i)++scalarPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> r+scalarPart' f = index f E'++vectorPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> (r,r,r)+vectorPart' f = (index f I', index f J', index f K')++instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion' r) where+  quadrance n = scalarPart' (adjoint n * n)++instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion' r) where+  recip q@(Quaternion' a b c d) = Quaternion' (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)+    where qq = quadrance q
+ src/Numeric/Coalgebra/Trigonometric.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE MultiParamTypeClasses+           , FlexibleInstances+           , TypeFamilies+           , UndecidableInstances+           , DeriveDataTypeable+           , TypeOperators #-}+module Numeric.Coalgebra.Trigonometric +  ( Trigonometric(..)+  , TrigBasis(..)+  , Trig(..)+  ) where++import Control.Applicative+import Control.Monad.Reader.Class+import Data.Data+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Representable+import Data.Functor.Representable.Trie+import Data.Foldable+import Data.Ix+import Data.Key+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup+import Data.Traversable+import Numeric.Algebra+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, sin, cos)+import Numeric.Algebra.Distinguished.Class+import Numeric.Algebra.Complex.Class+import Numeric.Coalgebra.Trigonometric.Class++-- the dual complex basis+data TrigBasis = Cos | Sin deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)+data Trig a = Trig a a deriving (Eq,Show,Read,Data,Typeable)++instance Distinguished TrigBasis where+  e = Cos++instance Complicated TrigBasis where+  i = Sin++instance Trigonometric TrigBasis where+  cos = Cos+  sin = Sin++instance Rig r => Distinguished (Trig r) where+  e = Trig one zero++instance Rig r => Complicated (Trig r) where+  i = Trig zero one++instance Rig r => Trigonometric (Trig r) where+  cos = Trig one zero+  sin = Trig zero one++instance Rig r => Distinguished (TrigBasis -> r) where+  e = cos++instance Rig r => Complicated (TrigBasis -> r) where+  i = sin+  +instance Rig r => Trigonometric (TrigBasis -> r) where+  cos Sin = zero+  cos Cos = one++  sin Sin = one+  sin Cos = zero++instance Rig r => Trigonometric (TrigBasis :->: r) where+  cos = Trie cos+  sin = Trie sin++instance Rig r => Distinguished (TrigBasis :->: r) where+  e = Trie e++instance Rig r => Complicated (TrigBasis :->: r) where+  i = Trie i+  +type instance Key Trig = TrigBasis++instance Representable Trig where+  tabulate f = Trig (f Cos) (f Sin)++instance Indexable Trig where+  index (Trig a _ ) Cos = a+  index (Trig _ b ) Sin = b++instance Lookup Trig where+  lookup = lookupDefault++instance Adjustable Trig where+  adjust f Cos (Trig a b) = Trig (f a) b+  adjust f Sin (Trig a b) = Trig a (f b)++instance Distributive Trig where+  distribute = distributeRep ++instance Functor Trig where+  fmap f (Trig a b) = Trig (f a) (f b)++instance Zip Trig where+  zipWith f (Trig a1 b1) (Trig a2 b2) = Trig (f a1 a2) (f b1 b2)++instance ZipWithKey Trig where+  zipWithKey f (Trig a1 b1) (Trig a2 b2) = Trig (f Cos a1 a2) (f Sin b1 b2)++instance Keyed Trig where+  mapWithKey = mapWithKeyRep++instance Apply Trig where+  (<.>) = apRep++instance Applicative Trig where+  pure = pureRep+  (<*>) = apRep ++instance Bind Trig where+  (>>-) = bindRep++instance Monad Trig where+  return = pureRep+  (>>=) = bindRep++instance MonadReader TrigBasis Trig where+  ask = askRep+  local = localRep++instance Foldable Trig where+  foldMap f (Trig a b) = f a `mappend` f b++instance FoldableWithKey Trig where+  foldMapWithKey f (Trig a b) = f Cos a `mappend` f Sin b++instance Traversable Trig where+  traverse f (Trig a b) = Trig <$> f a <*> f b++instance TraversableWithKey Trig where+  traverseWithKey f (Trig a b) = Trig <$> f Cos a <*> f Sin b++instance Foldable1 Trig where+  foldMap1 f (Trig a b) = f a <> f b++instance FoldableWithKey1 Trig where+  foldMapWithKey1 f (Trig a b) = f Cos a <> f Sin b++instance Traversable1 Trig where+  traverse1 f (Trig a b) = Trig <$> f a <.> f b++instance TraversableWithKey1 Trig where+  traverseWithKey1 f (Trig a b) = Trig <$> f Cos a <.> f Sin b++instance HasTrie TrigBasis where+  type BaseTrie TrigBasis = Trig+  embedKey = id+  projectKey = id++instance Additive r => Additive (Trig r) where+  (+) = addRep +  sinnum1p = sinnum1pRep++instance LeftModule r s => LeftModule r (Trig s) where+  r .* Trig a b = Trig (r .* a) (r .* b)++instance RightModule r s => RightModule r (Trig s) where+  Trig a b *. r = Trig (a *. r) (b *. r)++instance Monoidal r => Monoidal (Trig r) where+  zero = zeroRep+  sinnum = sinnumRep++instance Group r => Group (Trig r) where+  (-) = minusRep+  negate = negateRep+  subtract = subtractRep+  times = timesRep++instance Abelian r => Abelian (Trig r)++instance Idempotent r => Idempotent (Trig r)++instance Partitionable r => Partitionable (Trig r) where+  partitionWith f (Trig a b) = id =<<+    partitionWith (\a1 a2 -> +    partitionWith (\b1 b2 -> f (Trig a1 b1) (Trig a2 b2)) b) a++-- the diagonal algebra+instance (Commutative k, Rng k) => Algebra k TrigBasis where+  mult f = f' where+    fc = f Cos Cos+    fs = f Sin Sin+    f' Cos = fc+    f' Sin = fs++-- +instance (Commutative k, Rng k) => UnitalAlgebra k TrigBasis where+  unit = const++-- The trigonometric coalgebra+instance (Commutative k, Rng k) => Coalgebra k TrigBasis where+  comult f = f' where+     fs = f Sin+     fc = f Cos+     fc' = negate fc+     f' Sin Sin = fc'+     f' Sin Cos = fs +     f' Cos Sin = fs+     f' Cos Cos = fc++instance (Commutative k, Rng k) => Bialgebra k TrigBasis++instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k TrigBasis where+  inv f = f' where+    afc = adjoint (f Cos)+    nfs = negate (f Sin)+    f' Cos = afc+    f' Sin = nfs++instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k TrigBasis where+  coinv = inv++instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k TrigBasis where+  antipode = inv++instance (Commutative k, Rng k) => CounitalCoalgebra k TrigBasis where+  counit f = f Cos++instance (Commutative k, Rng k) => Multiplicative (Trig k) where+  (*) = mulRep++instance (Commutative k, Rng k) => Commutative (Trig k)++instance (Commutative k, Rng k) => Semiring (Trig k)++instance (Commutative k, Ring k) => Unital (Trig k) where+  one = Trig one zero++instance (Commutative r, Ring r) => Rig (Trig r) where+  fromNatural n = Trig (fromNatural n) zero++instance (Commutative r, Ring r) => Ring (Trig r) where+  fromInteger n = Trig (fromInteger n) zero++instance (Commutative r, Rng r) => LeftModule (Trig r) (Trig r) where (.*) = (*)+instance (Commutative r, Rng r) => RightModule (Trig r) (Trig r) where (*.) = (*)++instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Trig r) where+  adjoint (Trig a b) = Trig (adjoint a) (negate b)++instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Trig r)
+ src/Numeric/Coalgebra/Trigonometric/Class.hs view
@@ -0,0 +1,14 @@+module Numeric.Coalgebra.Trigonometric.Class+  ( Trigonometric(..)+  ) where++import Prelude (return)+import Numeric.Covector++class Trigonometric r where+  cos :: r+  sin :: r++instance Trigonometric a => Trigonometric (Covector r a) where+  cos = return cos+  sin = return sin
+ src/Numeric/Covector.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE 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.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+  sinnum1p n (Covector m) = Covector $ sinnum1p n m++instance Coalgebra r m => Multiplicative (Covector r m) where+  Covector f * Covector g = Covector $ \k -> f (\m -> g (comult k m))++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+  sinnum n (Covector m) = Covector (sinnum 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
+ src/Numeric/Decidable/Associates.hs view
@@ -0,0 +1,54 @@+module Numeric.Decidable.Associates +  ( DecidableAssociates(..)+  , isAssociateIntegral+  , isAssociateWhole+  ) where++import Data.Function (on)+import Data.Int+import Data.Word+import Numeric.Algebra.Unital+import Numeric.Natural.Internal++isAssociateIntegral :: (Eq n, Num n) => n -> n -> Bool+isAssociateIntegral = (==) `on` abs++isAssociateWhole :: Eq n => n -> n -> Bool+isAssociateWhole = (==)++class Unital r => DecidableAssociates r where+  -- | b is an associate of a if there exists a unit u such that b = a*u+  --+  -- This relationship is symmetric because if u is a unit, u^-1 exists and is a unit, so+  -- +  -- > b*u^-1 = a*u*u^-1 = a+  isAssociate :: r -> r -> Bool++instance DecidableAssociates Bool where isAssociate = (==)+instance DecidableAssociates Integer where isAssociate = isAssociateIntegral+instance DecidableAssociates Int where isAssociate = isAssociateIntegral+instance DecidableAssociates Int8 where isAssociate = isAssociateIntegral+instance DecidableAssociates Int16 where isAssociate = isAssociateIntegral+instance DecidableAssociates Int32 where isAssociate = isAssociateIntegral+instance DecidableAssociates Int64 where isAssociate = isAssociateIntegral++instance DecidableAssociates Natural where isAssociate = isAssociateWhole+instance DecidableAssociates Word where isAssociate = isAssociateWhole+instance DecidableAssociates Word8 where isAssociate = isAssociateWhole+instance DecidableAssociates Word16 where isAssociate = isAssociateWhole+instance DecidableAssociates Word32 where isAssociate = isAssociateWhole+instance DecidableAssociates Word64 where isAssociate = isAssociateWhole++instance DecidableAssociates () where isAssociate _ _ = True++instance (DecidableAssociates a, DecidableAssociates b) => DecidableAssociates (a, b) where+  isAssociate (a,b) (i,j) = isAssociate a i && isAssociate b j++instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c) => DecidableAssociates (a, b, c) where+  isAssociate (a,b,c) (i,j,k) = isAssociate a i && isAssociate b j && isAssociate c k++instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c, DecidableAssociates d) => DecidableAssociates (a, b, c, d) where+  isAssociate (a,b,c,d) (i,j,k,l) = isAssociate a i && isAssociate b j && isAssociate c k && isAssociate d l++instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c, DecidableAssociates d, DecidableAssociates e) => DecidableAssociates (a, b, c, d, e) where+  isAssociate (a,b,c,d,e) (i,j,k,l,m) = isAssociate a i && isAssociate b j && isAssociate c k && isAssociate d l && isAssociate e m
+ src/Numeric/Decidable/Units.hs view
@@ -0,0 +1,73 @@+module Numeric.Decidable.Units +  ( DecidableUnits(..)+  , recipUnitIntegral+  , recipUnitWhole+  ) where++import Data.Maybe (isJust)+import Data.Int+import Data.Word+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Natural.Internal+import Control.Applicative+import Prelude hiding ((*))++class Unital r => DecidableUnits r where+  recipUnit :: r -> Maybe r++  isUnit :: DecidableUnits r => r -> Bool+  isUnit = isJust . recipUnit++  (^?) :: Integral n => r -> n -> Maybe r+  x0 ^? y0 = case compare y0 0 of+    LT -> fmap (`f` negate y0) (recipUnit x0)+    EQ -> Just one+    GT -> Just (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)++recipUnitIntegral :: Integral r => r -> Maybe r+recipUnitIntegral a@1 = Just a+recipUnitIntegral a@(-1) = Just a+recipUnitIntegral _ = Nothing++recipUnitWhole :: Integral r => r -> Maybe r+recipUnitWhole a@1 = Just a+recipUnitWhole _ = Nothing++instance DecidableUnits Bool where +  recipUnit False = Nothing+  recipUnit True = Just True+instance DecidableUnits Integer where recipUnit = recipUnitIntegral+instance DecidableUnits Int where recipUnit = recipUnitIntegral+instance DecidableUnits Int8 where recipUnit = recipUnitIntegral+instance DecidableUnits Int16 where recipUnit = recipUnitIntegral+instance DecidableUnits Int32 where recipUnit = recipUnitIntegral+instance DecidableUnits Int64 where recipUnit = recipUnitIntegral+instance DecidableUnits Natural where recipUnit = recipUnitWhole+instance DecidableUnits Word where recipUnit = recipUnitWhole+instance DecidableUnits Word8 where recipUnit = recipUnitWhole+instance DecidableUnits Word16 where recipUnit = recipUnitWhole+instance DecidableUnits Word32 where recipUnit = recipUnitWhole+instance DecidableUnits Word64 where recipUnit = recipUnitWhole+instance DecidableUnits () where recipUnit _ = Just ()++instance (DecidableUnits a, DecidableUnits b) => DecidableUnits (a, b) where+  recipUnit (a,b) = (,) <$> recipUnit a <*> recipUnit b++instance (DecidableUnits a, DecidableUnits b, DecidableUnits c) => DecidableUnits (a, b, c) where+  recipUnit (a,b,c) = (,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c++instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d) => DecidableUnits (a, b, c, d) where+  recipUnit (a,b,c,d) = (,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d++instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d, DecidableUnits e) => DecidableUnits (a, b, c, d, e) where+  recipUnit (a,b,c,d,e) = (,,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d <*> recipUnit e
+ src/Numeric/Decidable/Zero.hs view
@@ -0,0 +1,40 @@+module Numeric.Decidable.Zero +  ( DecidableZero(..)+  ) where++import Numeric.Algebra.Class+import Data.Int+import Data.Word+import Numeric.Natural.Internal++class Monoidal r => DecidableZero r where+  isZero :: r -> Bool++instance DecidableZero Bool where isZero = not+instance DecidableZero Integer where isZero = (0==)+instance DecidableZero Int where isZero = (0==)+instance DecidableZero Int8 where isZero = (0==)+instance DecidableZero Int16 where isZero = (0==)+instance DecidableZero Int32 where isZero = (0==)+instance DecidableZero Int64 where isZero = (0==)++instance DecidableZero Natural where isZero = (0==)+instance DecidableZero Word where isZero = (0==)+instance DecidableZero Word8 where isZero = (0==)+instance DecidableZero Word16 where isZero = (0==)+instance DecidableZero Word32 where isZero = (0==)+instance DecidableZero Word64 where isZero = (0==)++instance DecidableZero () where isZero _ = True++instance (DecidableZero a, DecidableZero b) => DecidableZero (a, b) where+  isZero (a,b) = isZero a && isZero b++instance (DecidableZero a, DecidableZero b, DecidableZero c) => DecidableZero (a, b, c) where+  isZero (a,b,c) = isZero a && isZero b && isZero c++instance (DecidableZero a, DecidableZero b, DecidableZero c, DecidableZero d) => DecidableZero (a, b, c, d) where+  isZero (a,b,c,d) = isZero a && isZero b && isZero c && isZero d++instance (DecidableZero a, DecidableZero b, DecidableZero c, DecidableZero d, DecidableZero e) => DecidableZero (a, b, c, d, e) where+  isZero (a,b,c,d,e) = isZero a && isZero b && isZero c && isZero d && isZero e
+ src/Numeric/Dioid/Class.hs view
@@ -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
+ src/Numeric/Exp.hs view
@@ -0,0 +1,33 @@+module Numeric.Exp+  ( Exp(..)+  ) where++import Data.Function (on)+import Numeric.Algebra++import Prelude hiding ((+),(-),negate,replicate,subtract)++newtype Exp r = Exp { runExp :: r } ++instance Additive r => Multiplicative (Exp r) where+  Exp a * Exp b = Exp (a + b)+  productWith1 f = Exp . sumWith1 (runExp . f)+  pow1p (Exp m) n = Exp (sinnum1p n m)++instance Monoidal r => Unital (Exp r) where+  one = Exp zero+  pow (Exp m) n = Exp (sinnum n m)+  productWith f = Exp . sumWith (runExp . f)++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)+  Exp m ^ n = Exp (times n m)++instance Abelian r => Commutative (Exp r)++instance Idempotent r => Band (Exp r)++instance Partitionable r => Factorable (Exp r) where+  factorWith f = partitionWith (f `on` Exp) . runExp
+ src/Numeric/Field/Class.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module Numeric.Field.Class +  ( Field+  ) where++import Numeric.Ring.Division+import Numeric.Algebra.Commutative++class (Commutative r, DivisionRing r) => Field r+instance (Commutative r, DivisionRing r) => Field r
+ src/Numeric/Log.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module Numeric.Log +  ( Log(..)+  ) where++import Data.Function (on)+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)+  sinnum1p n (Log m) = Log (pow1p m n)++instance Unital r => LeftModule Natural (Log r) where+  n .* Log m = Log (pow m n)++instance Unital r => RightModule Natural (Log r) where+  Log m *. n = Log (pow m n)++instance Unital r => Monoidal (Log r) where+  zero = Log one+  sinnum n (Log m) = Log (pow m n)+  sumWith f = Log . productWith (runLog . f)++instance Division r => LeftModule Integer (Log r) where+  n .* Log m = Log (m ^ n)++instance Division r => RightModule Integer (Log r) where+  Log m *. n = Log (m ^ n)++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)+  times n (Log m) = Log (m ^ n)++instance Commutative r => Abelian (Log r)++instance Band r => Idempotent (Log r)++instance Factorable r => Partitionable (Log r) where+  partitionWith f = factorWith (f `on` Log) . runLog
+ src/Numeric/Map.hs view
@@ -0,0 +1,294 @@+{-# 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+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)+instance QFunctor (,) (Map r) (Map r)+instance Bifunctor (,) (Map r) (Map r) (Map r) where+  bimap m n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a++instance Associative (Map r) (,) where+  associate = arr associate+  disassociate = arr disassociate++instance Braided (Map r) (,) where+  braid = arr braid++instance Symmetric (Map r) (,)++instance C.Monoidal (Map r) (,) where+  type Id (Map r) (,) = ()+  idl = arr C.idl+  idr = arr C.idr+  coidl = arr C.coidl+  coidr = arr C.coidr++instance Cartesian (Map r) where+  type Product (Map r) = (,)+  fst = arr fst+  snd = arr snd+  diag = arr diag+  f &&& g = Map $ \k a -> (f $# \b -> (g $# \c -> k (b,c)) a) a++instance CCC (Map r) where+  type Exp (Map r) = Map r+  apply = Map $ \k (f,a) -> (f $# k) a+  curry m = Map $ \k a -> k (Map $ \k' b -> (m $# k') (a, b))+  uncurry m = Map $ \k (a, b) -> (m $# (\m' -> (m' $# k) b)) a++instance Distributive (Map r) where+  distribute = Map $ \k (a,p) -> k $ bimap ((,) a) ((,)a) p++instance PFunctor Either (Map r) (Map r)+instance QFunctor Either (Map r) (Map r)+instance Bifunctor Either (Map r) (Map r) (Map r) where+  bimap m n = Map $ \k -> either (m $# k . Left) (n $# k . Right)++instance Associative (Map r) Either where+  associate = arr associate+  disassociate = arr disassociate++instance Braided (Map r) Either where+  braid = arr braid++instance Symmetric (Map r) Either++instance CoCartesian (Map r) where+  type Sum (Map r) = Either+  inl = arr inl+  inr = arr inr+  codiag = arr codiag+  m ||| n = Map $ \k -> either (m $# k) (n $# k)++instance C.Monoidal (Map r) Either where+  type Id (Map r) Either = Void+  idl = arr C.idl+  idr = arr C.idr+  coidl = arr C.coidl+  coidr = arr C.coidr++instance Arrow (Map r) where+  arr f = Map (. f)+  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a+  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+  sinnum1p n (Map m) = Map $ sinnum1p 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+  sinnum n (Map m) = Map $ sinnum 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+-}+
+ src/Numeric/Module/Class.hs view
@@ -0,0 +1,9 @@+module Numeric.Module.Class+  (  +  -- * Module over semirings+    LeftModule(..)+  , RightModule(..)+  , Module+  ) where++import Numeric.Algebra.Class
+ src/Numeric/Module/Representable.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE RebindableSyntax, FlexibleContexts #-}+module Numeric.Module.Representable +  ( +  -- * Representable Additive+    addRep, sinnum1pRep+  -- * Representable Monoidal+  , zeroRep, sinnumRep+  -- * 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.sinnum1p` default definition+sinnum1pRep :: (Whole n, Functor m, Additive r) => n -> m r -> m r+sinnum1pRep = fmap . sinnum1p++-- | `Monoidal.zero` default definition+zeroRep :: (Applicative m, Monoidal r) => m r +zeroRep = pure zero++-- | `Monoidal.sinnum` default definition+sinnumRep :: (Whole n, Functor m, Monoidal r) => n -> m r -> m r+sinnumRep = fmap . sinnum++-- | `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)
+ src/Numeric/Order/Additive.hs view
@@ -0,0 +1,21 @@+module Numeric.Order.Additive+  ( AdditiveOrder+  ) where++import Numeric.Natural.Internal+import Numeric.Additive.Class+import Numeric.Order.Class++-- An additive semigroup with a partial order (<=)++-- | z + x <= z + y = x <= y = x + z <= y + z+class (Additive r, Order r) => AdditiveOrder r++instance AdditiveOrder Integer+instance AdditiveOrder Natural+instance AdditiveOrder Bool+instance AdditiveOrder ()+instance (AdditiveOrder a, AdditiveOrder b) => AdditiveOrder (a,b)+instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c) => AdditiveOrder (a,b,c)+instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c, AdditiveOrder d) => AdditiveOrder (a,b,c,d)+instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c, AdditiveOrder d, AdditiveOrder e) => AdditiveOrder (a,b,c,d,e)
+ src/Numeric/Order/Class.hs view
@@ -0,0 +1,77 @@+module Numeric.Order.Class +  ( Order(..)+  , orderOrd+  ) where++import Data.Int+import Data.Word+import Data.Set+import Numeric.Natural.Internal++-- a partial order (a, <=)+class Order a where+  (<~) :: a -> a -> Bool+  a <~ b = maybe False (<= EQ) (order a b)++  (<) :: a -> a -> Bool+  a < b = order a b == Just LT++  (>~) :: a -> a -> Bool+  a >~ b = b <~ a++  (>) :: a -> a -> Bool+  a > b = order a b == Just GT++  (~~) :: a -> a -> Bool+  a ~~ b = order a b == Just EQ++  (/~) :: a -> a -> Bool+  a /~ b = order a b /= Just EQ++  order :: a -> a -> Maybe Ordering+  order a b +    | a <~ b = Just $ if b <~ a +               then EQ+               else LT+    | b <~ a = Just GT+    | otherwise = Nothing++  comparable :: a -> a -> Bool+  comparable a b = maybe False (const True) (order a b)+++orderOrd :: Ord a => a -> a -> Maybe Ordering+orderOrd a b = Just (compare a b)++instance Order Bool where order = orderOrd +instance Order Integer where order = orderOrd +instance Order Int where order = orderOrd +instance Order Int8 where order = orderOrd +instance Order Int16 where order = orderOrd +instance Order Int32 where order = orderOrd +instance Order Int64 where order = orderOrd +instance Order Natural where order = orderOrd +instance Order Word where order = orderOrd+instance Order Word8 where order = orderOrd+instance Order Word16 where order = orderOrd+instance Order Word32 where order = orderOrd+instance Order Word64 where order = orderOrd+instance Ord a => Order (Set a) where+  (<~) = isSubsetOf++instance Order () where +  order _ _ = Just EQ+  _ <~ _ = True+  comparable _ _ = True++instance (Order a, Order b) => Order (a, b) where +  (a,b) <~ (i,j) = a <~ i && b <~ j++instance (Order a, Order b, Order c) => Order (a, b, c) where +  (a,b,c) <~ (i,j,k) = a <~ i && b <~ j && c <~ k++instance (Order a, Order b, Order c, Order d) => Order (a, b, c, d) where +  (a,b,c,d) <~ (i,j,k,l) = a <~ i && b <~ j && c <~ k && d <~ l++instance (Order a, Order b, Order c, Order d, Order e) => Order (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
+ src/Numeric/Order/LocallyFinite.hs view
@@ -0,0 +1,227 @@+module Numeric.Order.LocallyFinite +  ( LocallyFiniteOrder(..)+  ) where++import Control.Applicative+import Numeric.Additive.Class+import Numeric.Additive.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Order.Class+import Numeric.Natural.Internal+import Numeric.Rig.Class+import Numeric.Ring.Class+import Data.Int+import Data.Bits+import Data.Word+import Data.Set (Set)+import qualified Data.Set as Set+import qualified Data.Ix as Ix+import Prelude hiding ((*),(+),fromIntegral,(<),negate,(-))++class Order a => LocallyFiniteOrder a where+  range :: a -> a -> [a]+  rangeSize :: a -> a -> Natural++  -- moebiusInversion inversion+  moebiusInversion :: Ring r => a -> a -> r+  moebiusInversion x y = case order x y of+    Just EQ -> one+    Just LT -> sumWith (\z -> if z < y then moebiusInversion x z else zero) $ range x y+    _  -> zero ++instance LocallyFiniteOrder Natural where+  range = curry Ix.range+  rangeSize a b +    | a <= b = Natural (runNatural b - runNatural a + 1)+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | unsafePred y == x -> negate one +     _ -> zero++instance LocallyFiniteOrder Integer where+  range = curry Ix.range+  rangeSize a b +    | a <= b = Natural (b - a + 1)+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance Ord a => LocallyFiniteOrder (Set a) where+  range a b +    | Set.isSubsetOf a b = go a $ Set.toList $ Set.difference b a+    | otherwise = []+    where +      go _ [] = []+      go s (x:xs) = do+        s' <- [s, Set.insert x s]+        go s' xs+  rangeSize a b +    | Set.isSubsetOf a b = fromNatural $ shiftL 1 $ Set.size b - Set.size a+    | otherwise = zero+  moebiusInversion a b +    | Set.isSubsetOf a b = +      if (Set.size b - Set.size a) .&. 1 == 0 +      then one +      else negate one+    | otherwise          = zero++instance LocallyFiniteOrder Bool where+  range False False = [False]+  range False True  = [False, True]+  range True  False = []+  range True  True  = [True]+  rangeSize False False = 1+  rangeSize False True  = 2+  rangeSize True  False = 0 +  rangeSize True  True  = 1+  moebiusInversion False False = one+  moebiusInversion False True  = negate one +  moebiusInversion True  False = zero+  moebiusInversion True  True  = one+++instance LocallyFiniteOrder Int where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Int8 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Int16 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Int32 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Int64 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word8 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word16 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word32 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word64 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder () where+  range _ _ = [()]+  rangeSize _ _ = 1+  moebiusInversion _ _ = one++instance ( LocallyFiniteOrder a+         , LocallyFiniteOrder b+         ) => LocallyFiniteOrder (a,b) where+  range (a,b) (i,j) = (,) <$> range a i <*> range b j+  rangeSize (a,b) (i,j) = rangeSize a i * rangeSize b j+  -- TODO: check this against the default definition above+  moebiusInversion (a,b) (i,j) = moebiusInversion a i * moebiusInversion b j++instance ( LocallyFiniteOrder a+         , LocallyFiniteOrder b+         , LocallyFiniteOrder c+         ) => LocallyFiniteOrder (a,b,c) where+  range (a,b,c) (i,j,k) = (,,) <$> range  a i <*> range b j <*> range c k+  rangeSize (a,b,c) (i,j,k) = rangeSize a i * rangeSize b j * rangeSize c k+  moebiusInversion (a,b,c) (i,j,k) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k+++instance ( LocallyFiniteOrder a+         , LocallyFiniteOrder b+         , LocallyFiniteOrder c+         , LocallyFiniteOrder d+         ) => LocallyFiniteOrder (a,b,c,d) where+  range (a,b,c,d) (i,j,k,l) = (,,,) <$> range  a i <*> range b j <*> range c k <*> range d l+  rangeSize (a,b,c,d) (i,j,k,l) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l+  moebiusInversion (a,b,c,d) (i,j,k,l) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l++instance ( LocallyFiniteOrder a+         , LocallyFiniteOrder b+         , LocallyFiniteOrder c+         , LocallyFiniteOrder d+         , LocallyFiniteOrder e+         ) => LocallyFiniteOrder (a, b, c, d, e) where+  range (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> range  a i <*> range b j <*> range c k <*> range d l <*> range e m+  rangeSize (a,b,c,d,e) (i,j,k,l,m) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l * rangeSize e m+  moebiusInversion (a,b,c,d,e) (i,j,k,l,m) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l * moebiusInversion e m+
+ src/Numeric/Partial/Group.hs view
@@ -0,0 +1,88 @@+module Numeric.Partial.Group+  ( PartialGroup(..)+  ) where++import Control.Applicative+import Data.Int+import Data.Word+import Numeric.Partial.Semigroup+import Numeric.Partial.Monoid+import Numeric.Natural++class PartialMonoid a => PartialGroup a where+  pnegate :: a -> Maybe a+  pnegate = pminus pzero++  pminus :: a -> a -> Maybe a+  pminus a b = padd a =<< pnegate b ++  psubtract :: a -> a -> Maybe a+  psubtract a b = pnegate a >>= (`padd` b)++instance PartialGroup Int where+  pnegate = Just . negate++instance PartialGroup Integer where+  pnegate = Just . negate++instance PartialGroup Int8 where+  pnegate = Just . negate++instance PartialGroup Int16 where+  pnegate = Just . negate++instance PartialGroup Int32 where+  pnegate = Just . negate++instance PartialGroup Int64 where+  pnegate = Just . negate++instance PartialGroup Word where+  pnegate = Just . negate++instance PartialGroup Word8 where+  pnegate = Just . negate++instance PartialGroup Word16 where+  pnegate = Just . negate++instance PartialGroup Word32 where+  pnegate = Just . negate++instance PartialGroup Word64 where+  pnegate = Just . negate++instance PartialGroup Natural where+  pnegate 0 = Just 0+  pnegate _ = Nothing+  pminus a b +    | a < b = Nothing+    | otherwise = Just (a - b)+  psubtract a b +    | a > b = Nothing+    | otherwise = Just (b - a)++instance PartialGroup () where+  pnegate _ = Just () +  pminus _ _ = Just ()+  psubtract _ _ = Just ()++instance (PartialGroup a, PartialGroup b) => PartialGroup (a, b) where+  pnegate (a, b) = (,) <$> pnegate a <*> pnegate b+  pminus (a, b) (i, j) = (,) <$> pminus a i <*> pminus b j+  psubtract (a, b) (i, j) = (,) <$> psubtract a i <*> psubtract b j++instance (PartialGroup a, PartialGroup b, PartialGroup c) => PartialGroup (a, b, c) where+  pnegate (a, b, c) = (,,) <$> pnegate a <*> pnegate b <*> pnegate c+  pminus (a, b, c) (i, j, k) = (,,) <$> pminus a i <*> pminus b j <*> pminus c k+  psubtract (a, b, c) (i, j, k) = (,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k++instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d) => PartialGroup (a, b, c, d) where+  pnegate (a, b, c, d) = (,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d+  pminus (a, b, c, d) (i, j, k, l) = (,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l+  psubtract (a, b, c, d) (i, j, k, l) = (,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l++instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d, PartialGroup e) => PartialGroup (a, b, c, d, e) where+  pnegate (a, b, c, d, e) = (,,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d <*> pnegate e+  pminus (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l <*> pminus e m+  psubtract (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l <*> psubtract e m
+ src/Numeric/Partial/Monoid.hs view
@@ -0,0 +1,68 @@+module Numeric.Partial.Monoid+  ( PartialMonoid(..)+  ) where++import Numeric.Partial.Semigroup+import Data.Int+import Data.Word+import Numeric.Natural.Internal++class PartialSemigroup a => PartialMonoid a where+  pzero :: a++instance PartialMonoid Bool where+  pzero = False++instance PartialMonoid Int where+  pzero = 0++instance PartialMonoid Integer where+  pzero = 0++instance PartialMonoid Natural where+  pzero = 0++instance PartialMonoid Int8 where+  pzero = 0++instance PartialMonoid Int16 where+  pzero = 0++instance PartialMonoid Int32 where+  pzero = 0++instance PartialMonoid Int64 where+  pzero = 0++instance PartialMonoid Word where+  pzero = 0++instance PartialMonoid Word8 where+  pzero = 0++instance PartialMonoid Word16 where+  pzero = 0++instance PartialMonoid Word32 where+  pzero = 0++instance PartialMonoid Word64 where+  pzero = 0++instance PartialMonoid () where+  pzero = () ++instance PartialSemigroup a => PartialMonoid (Maybe a) where+  pzero = Nothing++instance (PartialMonoid a, PartialMonoid b) => PartialMonoid (a, b) where+  pzero = (pzero, pzero)++instance (PartialMonoid a, PartialMonoid b, PartialMonoid c) => PartialMonoid (a, b, c) where+  pzero = (pzero, pzero, pzero)++instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d) => PartialMonoid (a, b, c, d) where+  pzero = (pzero, pzero, pzero, pzero)++instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d, PartialMonoid e) => PartialMonoid (a, b, c, d, e) where+  pzero = (pzero, pzero, pzero, pzero, pzero)
+ src/Numeric/Partial/Semigroup.hs view
@@ -0,0 +1,80 @@+module Numeric.Partial.Semigroup+  ( PartialSemigroup(..)+  ) where++import Control.Applicative+import Data.Word+import Data.Int+import Numeric.Natural.Internal++class PartialSemigroup a where+  padd :: a -> a -> Maybe a++paddNum :: Num a => a -> a -> Maybe a+paddNum a b = Just (a + b)+++instance PartialSemigroup Int where+  padd = paddNum++instance PartialSemigroup Integer where+  padd = paddNum++instance PartialSemigroup Natural where+  padd = paddNum++instance PartialSemigroup Int8 where+  padd = paddNum++instance PartialSemigroup Int16 where+  padd = paddNum++instance PartialSemigroup Int32 where+  padd = paddNum++instance PartialSemigroup Int64 where+  padd = paddNum++instance PartialSemigroup Word where+  padd = paddNum++instance PartialSemigroup Word8 where+  padd = paddNum++instance PartialSemigroup Word16 where+  padd = paddNum++instance PartialSemigroup Word32 where+  padd = paddNum++instance PartialSemigroup Word64 where+  padd = paddNum++instance PartialSemigroup a => PartialSemigroup (Maybe a) where+  padd ma mb = Just $ do+   a <- ma+   b <- mb+   padd a b++instance PartialSemigroup Bool where+  padd a b = Just (a || b)++instance PartialSemigroup () where+  padd _ _ = Just ()++instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (a, b) where+  padd (a,b) (i,j) = (,) <$> padd a i <*> padd b j++instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c) => PartialSemigroup (a, b, c) where+  padd (a,b,c) (i,j,k) = (,,) <$> padd a i <*> padd b j <*> padd c k++instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d) => PartialSemigroup (a, b, c, d) where+  padd (a,b,c,d) (i,j,k,l) = (,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l++instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d, PartialSemigroup e) => PartialSemigroup (a, b, c, d, e) where+  padd (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l <*> padd e m++instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (Either a b) where+  padd (Left a) (Left b) = Left <$> padd a b+  padd (Right a) (Right b) = Right <$> padd a b+  padd _ _ = Nothing
+ src/Numeric/Quadrance/Class.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE MultiParamTypeClasses, 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)+-}
+ src/Numeric/Rig/Characteristic.hs view
@@ -0,0 +1,81 @@+module Numeric.Rig.Characteristic+  ( Characteristic(..)+  , charInt+  , charWord+  ) where++import Data.Int+import Data.Word+import Numeric.Rig.Class+import Numeric.Natural.Internal+import Prelude hiding ((^))++data Proxy p = Proxy++class Rig r => Characteristic r where+  char :: proxy r -> Natural++charInt :: (Integral s, Bounded s) => proxy s -> Natural+charInt p = 2 * fromIntegral (maxBound `asProxyTypeOf` p) + 2++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+instance Characteristic Bool where char _ = 0+instance Characteristic Integer where char _ = 0+instance Characteristic Natural where char _ = 0+instance Characteristic Int where char = charInt+instance Characteristic Int8 where char = charInt+instance Characteristic Int16 where char = charInt+instance Characteristic Int32 where char = charInt+instance Characteristic Int64 where char = charInt+instance Characteristic Word where char = charWord+instance Characteristic Word8 where char = charWord+instance Characteristic Word16 where char = charWord+instance Characteristic Word32 where char = charWord+instance Characteristic Word64 where char = charWord+instance Characteristic () where char _ = 1++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+    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+    b :: proxy (a,b,c) -> Proxy b+    b _ = Proxy+    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+    b :: proxy (a,b,c,d) -> Proxy b+    b _ = Proxy+    c :: proxy (a,b,c,d) -> Proxy c+    c _ = Proxy+    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+    b :: proxy (a,b,c,d,e) -> Proxy b+    b _ = Proxy+    c :: proxy (a,b,c,d,e) -> Proxy c+    c _ = Proxy+    d :: proxy (a,b,c,d,e) -> Proxy d+    d _ = Proxy+    e :: proxy (a,b,c,d,e) -> Proxy e+    e _ = Proxy
+ src/Numeric/Rig/Class.hs view
@@ -0,0 +1,47 @@+module Numeric.Rig.Class+  ( Rig(..)+  , fromNaturalNum+  , fromWhole+  ) where++import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Data.Int+import Data.Word+import Prelude (Integer, Bool, Num(fromInteger),(/=),id,(.))+import Numeric.Natural.Internal++fromNaturalNum :: Num r => Natural -> r+fromNaturalNum (Natural n) = fromInteger n++-- | A Ring without (n)egation+class (Semiring r, Unital r, Monoidal r) => Rig r where+  fromNatural :: Natural -> r+  fromNatural n = sinnum n one++fromWhole :: (Whole n, Rig r) => n -> r+fromWhole = fromNatural . toNatural+-- TODO: optimize++instance Rig Integer where fromNatural = fromNaturalNum+instance Rig Natural where fromNatural = id+instance Rig Bool where fromNatural = (/=) 0+instance Rig Int where fromNatural = fromNaturalNum+instance Rig Int8 where fromNatural = fromNaturalNum+instance Rig Int16 where fromNatural = fromNaturalNum+instance Rig Int32 where fromNatural = fromNaturalNum+instance Rig Int64 where fromNatural = fromNaturalNum+instance Rig Word where fromNatural = fromNaturalNum+instance Rig Word8 where fromNatural = fromNaturalNum+instance Rig Word16 where fromNatural = fromNaturalNum+instance Rig Word32 where fromNatural = fromNaturalNum+instance Rig Word64 where fromNatural = fromNaturalNum+instance Rig () where fromNatural _ = ()+instance (Rig a, Rig b) => Rig (a, b) where+  fromNatural n = (fromNatural n, fromNatural n)+instance (Rig a, Rig b, Rig c) => Rig (a, b, c) where+  fromNatural n = (fromNatural n, fromNatural n, fromNatural n)+instance (Rig a, Rig b, Rig c, Rig d) => Rig (a, b, c, d) where+  fromNatural n = (fromNatural n, fromNatural n, fromNatural n, fromNatural n)+instance (Rig a, Rig b, Rig c, Rig d, Rig e) => Rig (a, b, c, d, e) where+  fromNatural n = (fromNatural n, fromNatural n, fromNatural n, fromNatural n, fromNatural n)
+ src/Numeric/Rig/Ordered.hs view
@@ -0,0 +1,21 @@+module Numeric.Rig.Ordered+  ( OrderedRig+  ) where++import Numeric.Rig.Class+import Numeric.Order.Additive+import Numeric.Natural.Internal++-- x <= y ==> x + z <= y + z+-- 0 <= x && y <= z implies xy <= xz+-- 0 <= x <= 1+class (AdditiveOrder r, Rig r) => OrderedRig r++instance OrderedRig Integer+instance OrderedRig Natural+instance OrderedRig Bool+instance OrderedRig ()+instance (OrderedRig a, OrderedRig b) => OrderedRig (a, b) +instance (OrderedRig a, OrderedRig b, OrderedRig c) => OrderedRig (a, b, c) +instance (OrderedRig a, OrderedRig b, OrderedRig c, OrderedRig d) => OrderedRig (a, b, c, d) +instance (OrderedRig a, OrderedRig b, OrderedRig c, OrderedRig d, OrderedRig e) => OrderedRig (a, b, c, d, e)
+ src/Numeric/Ring/Class.hs view
@@ -0,0 +1,41 @@+module Numeric.Ring.Class+  ( Ring(..)+  , fromIntegral+  ) where++import Data.Int+import Data.Word+import Numeric.Rig.Class+import Numeric.Rng.Class+import Numeric.Additive.Group+import Numeric.Algebra.Unital+import qualified Prelude+import Prelude (Integral(toInteger), Integer, (.))++class (Rig r, Rng r) => Ring r where+  fromInteger :: Integer -> r+  fromInteger n = times n one++fromIntegral :: (Integral n, Ring r) => n -> r+fromIntegral = fromInteger . toInteger++instance Ring Integer where fromInteger = Prelude.fromInteger+instance Ring Int     where fromInteger = Prelude.fromInteger+instance Ring Int8    where fromInteger = Prelude.fromInteger+instance Ring Int16   where fromInteger = Prelude.fromInteger+instance Ring Int32   where fromInteger = Prelude.fromInteger+instance Ring Int64   where fromInteger = Prelude.fromInteger+instance Ring Word    where fromInteger = Prelude.fromInteger+instance Ring Word8   where fromInteger = Prelude.fromInteger+instance Ring Word16  where fromInteger = Prelude.fromInteger+instance Ring Word32  where fromInteger = Prelude.fromInteger+instance Ring Word64  where fromInteger = Prelude.fromInteger+instance Ring () where fromInteger _ = ()+instance (Ring a, Ring b) => Ring (a, b) where+  fromInteger n = (fromInteger n, fromInteger n)+instance (Ring a, Ring b, Ring c) => Ring (a, b, c) where+  fromInteger n = (fromInteger n, fromInteger n, fromInteger n)+instance (Ring a, Ring b, Ring c, Ring d) => Ring (a, b, c, d) where+  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)+instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a, b, c, d, e) where+  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ src/Numeric/Ring/Division.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module Numeric.Ring.Division+  ( DivisionRing+  ) where++import Numeric.Algebra.Division+import Numeric.Ring.Class++class (Division r, Ring r) => DivisionRing r+instance (Division r, Ring r) => DivisionRing r
+ src/Numeric/Ring/Endomorphism.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Ring.Endomorphism +  ( End(..)+  , toEnd+  , fromEnd+  , frobenius+  ) where++import Data.Monoid+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+-- +-- http://en.wikipedia.org/wiki/Endomorphism_ring+newtype End a = End { appEnd :: a -> a }+instance Monoid (End r) where+  mappend (End a) (End b) = End (a . b)+  mempty = End id+instance Additive r => Additive (End r) where+  End f + End g = End (f + g)+instance Abelian r => Abelian (End r)+instance Monoidal r => Monoidal (End r) where+  zero = End (const zero)+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)+instance Multiplicative (End r) where+  End f * End g = End (f . g)+instance Unital (End r) where+  one = End id+instance (Abelian r, Commutative r) => Commutative (End r) +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 (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.+toEnd :: Multiplicative r => r -> End r+toEnd r = End (*r)++-- 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+
+ src/Numeric/Ring/Local.hs view
@@ -0,0 +1,10 @@+module Numeric.Ring.Local +  ( LocalRing +  ) where++import Numeric.Ring.Class++-- forall x in r, either x or 1 - x is a unit.+-- if a finite sum is a unit then so are some of its terms, so the empty sum is not a unit, and one /= zero.+class Ring r => LocalRing r+
+ src/Numeric/Ring/Opposite.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+module Numeric.Ring.Opposite +  ( Opposite(..)+  ) where++import Data.Foldable+import Data.Function (on)+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Traversable+import Numeric.Algebra+import Numeric.Decidable.Associates+import Numeric.Decidable.Units+import Numeric.Decidable.Zero+import Prelude hiding ((-),(+),(*),(/),(^),recip,negate,subtract,replicate)++-- | http://en.wikipedia.org/wiki/Opposite_ring+newtype Opposite r = Opposite { runOpposite :: r } deriving (Show,Read)+instance Eq r => Eq (Opposite r) where+  (==) = (==) `on` runOpposite+instance Ord r => Ord (Opposite r) where+  compare = compare `on` runOpposite+instance Functor Opposite where+  fmap f (Opposite r) = Opposite (f r)+instance Foldable Opposite where+  foldMap f (Opposite r) = f r+instance Traversable Opposite where+  traverse f (Opposite r) = fmap Opposite (f r)+instance Foldable1 Opposite where+  foldMap1 f (Opposite r) = f r+instance Traversable1 Opposite where+  traverse1 f (Opposite r) = fmap Opposite (f r)+instance Additive r => Additive (Opposite r) where+  Opposite a + Opposite b = Opposite (a + b)+  sinnum1p n (Opposite a) = Opposite (sinnum1p n a)+  sumWith1 f = Opposite . sumWith1 (runOpposite . f)+instance Monoidal r => Monoidal (Opposite r) where+  zero = Opposite zero+  sinnum n (Opposite a) = Opposite (sinnum n a)+  sumWith f = Opposite . sumWith (runOpposite . f)+instance Semiring r => LeftModule (Opposite r) (Opposite r) where+  (.*) = (*)+instance RightModule r s => LeftModule r (Opposite s) where+  r .* Opposite s = Opposite (s *. r)+instance LeftModule r s => RightModule r (Opposite s) where+  Opposite s *. r = Opposite (r .* s)+instance Semiring r => RightModule (Opposite r) (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)+  times n (Opposite a) = Opposite (times n a)+instance Abelian r => Abelian (Opposite r)+instance DecidableZero r => DecidableZero (Opposite r) where+  isZero = isZero . runOpposite+instance DecidableUnits r => DecidableUnits (Opposite r) where+  recipUnit = fmap Opposite . recipUnit . runOpposite+instance DecidableAssociates r => DecidableAssociates (Opposite r) where+  isAssociate (Opposite a) (Opposite b) = isAssociate a b+instance Multiplicative r => Multiplicative (Opposite r) where+  Opposite a * Opposite b = Opposite (b * a)+  pow1p (Opposite a) n = Opposite (pow1p a n)+instance Commutative r => Commutative (Opposite r)+instance Idempotent r => Idempotent (Opposite r)+instance Band r => Band (Opposite r)+instance Unital r => Unital (Opposite r) where+  one = Opposite one+  pow (Opposite a) n = Opposite (pow a n)+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 Rig r => Rig (Opposite r)+instance Ring r => Ring (Opposite r)
+ src/Numeric/Ring/Rng.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Ring.Rng+  ( RngRing(..)+  , rngRingHom+  , liftRngHom+  ) where++import Numeric.Algebra+import Prelude hiding ((+),(-),(*),(/),replicate,negate,subtract,fromIntegral)++-- | The free Ring given a Rng obtained by adjoining Z, such that+-- +-- > RngRing r = n*1 + r+--+-- This ring is commonly denoted r^.+data RngRing r = RngRing !Integer r deriving (Show,Read)++instance Abelian r => Additive (RngRing r) where+  RngRing n a + RngRing m b = RngRing (n + m) (a + b)+  sinnum1p n (RngRing m a) = RngRing ((1 + toInteger n) * m) (sinnum1p n a)++instance Abelian r => Abelian (RngRing r)++instance (Abelian r, Monoidal r) => LeftModule Natural (RngRing r) where+  n .* RngRing m a = RngRing (toInteger n * m) (sinnum n a)++instance (Abelian r, Monoidal r) => RightModule Natural (RngRing r) where+  RngRing m a *. n = RngRing (toInteger n * m) (sinnum n a)++instance (Abelian r, Monoidal r) => Monoidal (RngRing r) where+  zero = RngRing 0 zero+  sinnum n (RngRing m a) = RngRing (toInteger n * m) (sinnum n a)++instance (Abelian r, Group r) => LeftModule Integer (RngRing r) where+  n .* RngRing m a = RngRing (toInteger n * m) (times n a)++instance (Abelian r, Group r) => RightModule Integer (RngRing r) where+  RngRing m a *. n = RngRing (toInteger n * m) (times n a)++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)+  times n (RngRing m a) = RngRing (toInteger n * m) (times n a)++instance Rng r => Multiplicative (RngRing r) where+  RngRing n a * RngRing m b = RngRing (n*m) (times n b + times m a + a * b)++instance (Commutative r, Rng r) => Commutative (RngRing r)++instance Rng s => LeftModule (RngRing s) (RngRing s) where+  (.*) = (*) ++instance Rng s => RightModule (RngRing s) (RngRing s) where+  (*.) = (*) ++instance Rng r => Unital (RngRing r) where+  one = RngRing 1 zero++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 => Rig (RngRing r)++instance Rng r => Ring (RngRing r)++-- | The rng homomorphism from r to RngRing r+rngRingHom :: r -> RngRing r+rngRingHom = RngRing 0++-- | given a rng homomorphism from a rng r into a ring s, liftRngHom yields a ring homomorphism from the ring `r^` into `s`.+liftRngHom :: Ring s => (r -> s) -> RngRing r -> s+liftRngHom g (RngRing n a) = times n one + g a
+ src/Numeric/Rng/Class.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module Numeric.Rng.Class+  ( Rng+  ) where++import Numeric.Additive.Group+import Numeric.Algebra.Class++-- | A Ring without an /i/dentity.++class (Group r, Semiring r) => Rng r+instance (Group r, Semiring r) => Rng r
+ src/Numeric/Rng/Zero.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+module Numeric.Rng.Zero+  ( ZeroRng(..)+  ) where++import Numeric.Algebra+import Data.Foldable (toList)+import Prelude hiding ((+),(-),negate,subtract,replicate)++-- *** The Zero Rng for an Abelian Group, adding the trivial product+--+-- > _ * _ = zero +--+-- which distributes over (+)++-- ZeroRng/runZeroRng witness an additive Abelian group isomorphism to the zero rng.+newtype ZeroRng r = ZeroRng { runZeroRng :: r } deriving (Eq,Ord,Show,Read)++instance Additive r => Additive (ZeroRng r) where+  ZeroRng a + ZeroRng b = ZeroRng (a + b)+  sumWith1 f = ZeroRng . sumWith1 (runZeroRng . f)++instance Idempotent r => Idempotent (ZeroRng r)++instance Abelian r => Abelian (ZeroRng r)++instance Monoidal r => Monoidal (ZeroRng r) where+  zero = ZeroRng zero+  sumWith f = ZeroRng . sumWith (runZeroRng . f)+  sinnum n (ZeroRng a) = ZeroRng (sinnum n a)+  +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 Monoidal r => Multiplicative (ZeroRng r) where+  _ * _ = zero+  productWith1 f as = case toList as of+    [] -> error "productWith1: empty Foldable1"+    [a] -> f a+    _   -> zero++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+  (.*) = sinnum+instance Monoidal r => RightModule Natural (ZeroRng r) where+  m *. n = sinnum n m+instance Group r => LeftModule Integer (ZeroRng r) where+  (.*) = times+instance Group r => RightModule Integer (ZeroRng r) where+  m *. n = times n m
+ src/Numeric/Semiring/Integral.hs view
@@ -0,0 +1,15 @@+module Numeric.Semiring.Integral +  ( IntegralSemiring+  ) where++import Numeric.Algebra.Class+import Numeric.Natural.Internal++-- | 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+instance IntegralSemiring Bool
+ src/Numeric/Semiring/Involutive.hs view
@@ -0,0 +1,5 @@+module Numeric.Semiring.Involutive +  ( InvolutiveSemiring+  ) where++import Numeric.Algebra.Involutive