packages feed

algebra 0.0.0.1 → 0.1.0

raw patch · 60 files changed

+2823/−61 lines, 60 filesdep +categoriesdep +containersdep +mtldep ~basesetup-changednew-uploader

Dependencies added: categories, containers, mtl, representable-tries, semigroupoids, semigroups, tagged, transformers

Dependency ranges changed: base

Files

LICENSE view
@@ -1,25 +1,30 @@-Copyright © 2009 Wolfgang Jeltsch+Copyright 2011 Edward Kmett+ All rights reserved. -Redistribution and use in source and binary forms, with or without modification, are permitted-provided that the following conditions are met:+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met: -    * Redistributions of source code must retain the above copyright notice, this list of conditions-      and the following disclaimer.+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer. -    * Redistributions in binary form must reproduce the above copyright notice, this list of-      conditions and the following disclaimer in the documentation and/or other materials provided-      with the distribution.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution. -    * Neither the name of the copyright holders nor the names of the contributors may be used to-      endorse or promote products derived from this software without specific prior written-      permission.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR-CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER-IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF-THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Numeric/Addition.hs view
@@ -0,0 +1,15 @@+module Numeric.Addition +  ( module Numeric.Addition.Abelian+  , module Numeric.Addition.Idempotent+  , module Numeric.Addition.Partitionable+  , module Numeric.Semigroup.Additive+  , module Numeric.Monoid.Additive+  , module Numeric.Group.Additive+  ) where++import Numeric.Addition.Abelian+import Numeric.Addition.Idempotent+import Numeric.Addition.Partitionable+import Numeric.Semigroup.Additive+import Numeric.Monoid.Additive+import Numeric.Group.Additive
+ Numeric/Addition/Abelian.hs view
@@ -0,0 +1,35 @@+module Numeric.Addition.Abelian+  ( +  -- * An Addition Abelian Semigroup+    Abelian+  ) where++import Data.Int+import Data.Word+import Numeric.Semigroup.Additive+import Numeric.Natural.Internal++-- | an additive abelian semigroup+--+-- a + b = b + a+class Additive r => Abelian r++instance Abelian r => Abelian (e -> r)+instance Abelian ()+instance Abelian Bool+instance Abelian Integer+instance Abelian Natural+instance Abelian Int+instance Abelian Int8+instance Abelian Int16+instance Abelian Int32+instance Abelian Int64+instance Abelian Word+instance Abelian Word8+instance Abelian Word16+instance Abelian Word32+instance Abelian Word64+instance (Abelian a, Abelian b) => Abelian (a,b) +instance (Abelian a, Abelian b, Abelian c) => Abelian (a,b,c) +instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a,b,c,d) +instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a,b,c,d,e)
+ Numeric/Addition/Idempotent.hs view
@@ -0,0 +1,33 @@+module Numeric.Addition.Idempotent+  ( +  -- * Additive Monoids+    Idempotent+  , replicate1pIdempotent+  , replicateIdempotent+  ) where++import Numeric.Semigroup.Additive+import Numeric.Monoid.Additive+import Numeric.Natural.Internal++-- | An additive semigroup with idempotent addition.+--+-- > a + a = a+--+-- An (Idempotent r, Rig r) => r is also known as a dioid+class Additive r => Idempotent r++replicate1pIdempotent :: Natural -> r -> r+replicate1pIdempotent _ r = r++replicateIdempotent :: (Integral n, Idempotent r, AdditiveMonoid r) => n -> r -> r+replicateIdempotent 0 _ = zero+replicateIdempotent _ x = x++instance Idempotent ()+instance Idempotent Bool+instance Idempotent r => Idempotent (e -> r)+instance (Idempotent a, Idempotent b) => Idempotent (a,b)+instance (Idempotent a, Idempotent b, Idempotent c) => Idempotent (a,b,c)+instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d) => Idempotent (a,b,c,d)+instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d, Idempotent e) => Idempotent (a,b,c,d,e)
+ Numeric/Addition/Partitionable.hs view
@@ -0,0 +1,48 @@+module Numeric.Addition.Partitionable+  ( -- * Partitionable Additive Semigroups+    Partitionable(..)+  ) where++import Prelude ((-),Bool(..),($),id,(>>=))+import Numeric.Semigroup.Additive+import Numeric.Natural+import Data.List.NonEmpty (NonEmpty(..), fromList)++concat :: NonEmpty (NonEmpty a) -> NonEmpty a+concat m = m >>= id++class Additive m => Partitionable m where+  -- | partitionWith f c returns a list containing f a b for each a b such that a + b = c, +  partitionWith :: (m -> m -> r) -> m -> NonEmpty r++instance Partitionable Bool where+  partitionWith f False = f False False :| []+  partitionWith f True  = f False True :| [f True False, f True True]++instance Partitionable Natural where+  partitionWith f n = fromList [ f k (n - k) | k <- [0..n] ]++instance Partitionable () where+  partitionWith f () = f () () :| []++instance (Partitionable a, Partitionable b) => Partitionable (a,b) where+  partitionWith f (a,b) = concat $ partitionWith (\ax ay -> +                                   partitionWith (\bx by -> f (ax,bx) (ay,by)) b) a++instance (Partitionable a, Partitionable b, Partitionable c) => Partitionable (a,b,c) where+  partitionWith f (a,b,c) = concat $ partitionWith (\ax ay -> +                            concat $ partitionWith (\bx by -> +                                     partitionWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a++instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d ) => Partitionable (a,b,c,d) where+  partitionWith f (a,b,c,d) = concat $ partitionWith (\ax ay -> +                              concat $ partitionWith (\bx by -> +                              concat $ partitionWith (\cx cy -> +                                       partitionWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a++instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d, Partitionable e) => Partitionable (a,b,c,d,e) where+  partitionWith f (a,b,c,d,e) = concat $ partitionWith (\ax ay -> +                                concat $ partitionWith (\bx by -> +                                concat $ partitionWith (\cx cy -> +                                concat $ partitionWith (\dx dy -> +                                         partitionWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a
+ Numeric/Algebra/Free/Class.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Algebra.Free.Class +  ( FreeAlgebra(..)+  , FreeCoalgebra(..)+  ) where++import Numeric.Semiring.Internal+import Prelude ()++-- A coassociative coalgebra over a semiring using+class Semiring r => FreeCoalgebra r c where+  cojoin :: (c -> r) -> c -> c -> r++-- convolve :: (FreeAlgebra r a, FreeCoalgebra r c) => ((c -> r) -> a -> r) -> ((c -> r) -> a -> r) -> ((c -> r) -> a -> r++-- | Every coalgebra gives rise to an algebra by vector space duality classically.+-- Sadly, it requires vector space duality, which we cannot use constructively.+-- This is the dual, which relies in the fact that any constructive coalgebra can only inspect a finite number of coefficients.+instance FreeAlgebra r m => FreeCoalgebra r (m -> r) where+  cojoin k f g = k (f * g)++instance FreeCoalgebra () c where+  cojoin _ _ _ = ()++instance (FreeAlgebra r b, FreeCoalgebra r c) => FreeCoalgebra (b -> r) c where+  cojoin f c1 c2 b = cojoin (`f` b) c1 c2 ++instance (FreeCoalgebra r a, FreeCoalgebra r b) => FreeCoalgebra r (a, b) where+  cojoin f (a1,b1) (a2,b2) = cojoin (\a -> cojoin (\b -> f (a,b)) b1 b2) a1 a2++instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c) => FreeCoalgebra r (a, b, c) where+  cojoin f (a1,b1,c1) (a2,b2,c2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> f (a,b,c)) c1 c2) b1 b2) a1 a2++instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c, FreeCoalgebra r d) => FreeCoalgebra r (a, b, c, d) where+  cojoin f (a1,b1,c1,d1) (a2,b2,c2,d2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> cojoin (\d -> f (a,b,c,d)) d1 d2) c1 c2) b1 b2) a1 a2++instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c, FreeCoalgebra r d, FreeCoalgebra r e) => FreeCoalgebra r (a, b, c, d, e) where+  cojoin f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> cojoin (\d -> cojoin (\e -> f (a,b,c,d,e)) e1 e2) d1 d2) c1 c2) b1 b2) a1 a2
+ Numeric/Algebra/Free/Hopf.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Algebra.Free.Hopf+  ( Hopf(..)+  ) where++import Numeric.Algebra.Free.Unital++-- | a Hopf algebra on a semiring, where the module is a free.+--+-- If @antipode . antipode = id@ then we are Involutive++class (FreeUnitalAlgebra r h, FreeCounitalCoalgebra r h) => Hopf r h where+  -- > convolve id antipode = convolve antipode id = unit . counit+  antipode :: (h -> r) -> h -> r++instance (FreeUnitalAlgebra r a, Hopf r h) => Hopf (a -> r) h where+  antipode f h a = antipode (`f` a) h++instance Hopf () h where+  antipode = id++instance (Hopf r a, Hopf r b) => Hopf r (a, b) where+  antipode f (a,b) = antipode (\a' -> antipode (\b' -> f (a',b')) b) a++instance (Hopf r a, Hopf r b, Hopf r c) => Hopf r (a, b, c) where+  antipode f (a,b,c) = antipode (\a' -> antipode (\b' -> antipode (\c' -> f (a',b',c')) c) b) a++instance (Hopf r a, Hopf r b, Hopf r c, Hopf r d) => Hopf r (a, b, c, d) where+  antipode f (a,b,c,d) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> f (a',b',c',d')) d) c) b) a++instance (Hopf r a, Hopf r b, Hopf r c, Hopf r d, Hopf r e) => Hopf r (a, b, c, d, e) where+  antipode f (a,b,c,d,e) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> antipode (\e' -> f (a',b',c',d',e')) e) d) c) b) a
+ Numeric/Algebra/Free/Unital.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Algebra.Free.Unital+  ( FreeUnitalAlgebra(..)+  , FreeCounitalCoalgebra(..)+  ) where++import Numeric.Algebra.Free.Class+import Numeric.Monoid.Multiplicative.Internal+import Prelude (($))++-- A coassociative counital coalgebra over a semiring, where the module is free+class FreeCoalgebra r c => FreeCounitalCoalgebra r c where+  counit :: (c -> r) -> r++instance FreeUnitalAlgebra r m => FreeCounitalCoalgebra r (m -> r) where+  counit k = k one++instance (FreeUnitalAlgebra r a, FreeCounitalCoalgebra r c) => FreeCounitalCoalgebra (a -> r) c where +  counit k a = counit (`k` a)++instance FreeCounitalCoalgebra () a where+  counit _ = ()++instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b) => FreeCounitalCoalgebra r (a, b) where+  counit k = counit $ \a -> counit $ \b -> k (a,b)++instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c) => FreeCounitalCoalgebra r (a, b, c) where+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> k (a,b,c)++instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c, FreeCounitalCoalgebra r d) => FreeCounitalCoalgebra r (a, b, c, d) where+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> k (a,b,c,d)++instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c, FreeCounitalCoalgebra r d, FreeCounitalCoalgebra r e) => FreeCounitalCoalgebra r (a, b, c, d, e) where+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> counit $ \e -> k (a,b,c,d,e)
+ Numeric/Band.hs view
@@ -0,0 +1,7 @@+module Numeric.Band+  ( module Numeric.Band.Class+  , module Numeric.Band.Rectangular+  ) where++import Numeric.Band.Class+import Numeric.Band.Rectangular
+ Numeric/Band/Class.hs view
@@ -0,0 +1,30 @@+module Numeric.Band.Class+  ( +  -- * Multiplicative Bands+    Band+  , pow1pBand+  , powBand+  ) where++import Numeric.Semigroup.Multiplicative+import Numeric.Monoid.Multiplicative+import Numeric.Natural++-- | An multiplicative semigroup with idempotent multiplication.+--+-- > a * a = a+class Multiplicative r => Band r++pow1pBand :: Whole n => r -> n -> r+pow1pBand r _ = r ++powBand :: (Unital r, Whole n) => r -> n -> r+powBand _ 0 = one+powBand r _ = r++instance Band ()+instance Band Bool+instance (Band a, Band b) => Band (a,b)+instance (Band a, Band b, Band c) => Band (a,b,c)+instance (Band a, Band b, Band c, Band d) => Band (a,b,c,d)+instance (Band a, Band b, Band c, Band d, Band e) => Band (a,b,c,d,e)
+ Numeric/Band/Rectangular.hs view
@@ -0,0 +1,21 @@+module Numeric.Band.Rectangular +  ( Rect(..)+  ) where++import Numeric.Semigroup.Multiplicative+import Numeric.Band.Class+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/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.Monoid.Multiplicative+import Numeric.Natural++isAssociateIntegral :: 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 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.Semigroup.Multiplicative+import Numeric.Monoid.Multiplicative+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 view
@@ -0,0 +1,40 @@+module Numeric.Decidable.Zero +  ( DecidableZero(..)+  ) where++import Numeric.Monoid.Additive+import Data.Int+import Data.Word+import Numeric.Natural++class AdditiveMonoid 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/Exp.hs view
@@ -0,0 +1,35 @@+module Numeric.Exp+  ( Exp(..)+  ) where++import Data.Function (on)+import Numeric.Addition+import Numeric.Multiplication+import Numeric.Band.Class++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 (replicate1p n m)++instance AdditiveMonoid r => Unital (Exp r) where+  one = Exp zero+  pow (Exp m) n = Exp (replicate n m)+  productWith f = Exp . sumWith (runExp . f)++instance AdditiveGroup r => MultiplicativeGroup (Exp r) where+  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/Functional/Antilinear.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+module Numeric.Functional.Antilinear +  ( Antilinear(..)+  ) where++import Numeric.Module+import Numeric.Addition+import Control.Applicative+import Control.Monad+import Data.Functor.Plus hiding (zero)+import qualified Data.Functor.Plus as Plus+import Data.Functor.Bind+import qualified Prelude+import Prelude hiding ((+),(-),negate,subtract,replicate)++-- | Antilinear functionals from elements of a free module to a scalar++-- appAntilinear f (x + y) = appAntilinear f x + appAntilinear f y+-- appAntilinear f (a .* x) = adjoint a * appAntilinear f x++newtype Antilinear s a = Antilinear { appAntilinear :: (a -> s) -> s }++instance Functor (Antilinear s) where+  fmap f (Antilinear m) = Antilinear (\k -> m (k . f))++instance Apply (Antilinear s) where+  Antilinear mf <.> Antilinear ma = Antilinear (\k -> mf (\f -> ma (k . f)))++instance Applicative (Antilinear s) where+  pure a = Antilinear (\k -> k a)+  Antilinear mf <*> Antilinear ma = Antilinear (\k -> mf (\f -> ma (k . f)))++instance Bind (Antilinear s) where+  Antilinear m >>- f = Antilinear (\k -> m (\a -> appAntilinear (f a) k))+  +instance Monad (Antilinear s) where+  return a = Antilinear (\k -> k a)+  Antilinear m >>= f = Antilinear (\k -> m (\a -> appAntilinear (f a) k))++instance Additive s => Alt (Antilinear s) where+  Antilinear m <!> Antilinear n = Antilinear (m + n)++instance AdditiveMonoid s => Plus (Antilinear s) where+  zero = Antilinear zero ++instance AdditiveMonoid s => Alternative (Antilinear s) where+  Antilinear m <|> Antilinear n = Antilinear (m + n)+  empty = Antilinear zero++instance AdditiveMonoid s => MonadPlus (Antilinear s) where+  Antilinear m `mplus` Antilinear n = Antilinear (m + n)+  mzero = Antilinear zero++instance Additive s => Additive (Antilinear s a) where+  Antilinear m + Antilinear n = Antilinear (m + n)+  replicate1p n (Antilinear m) = Antilinear (replicate1p n m)++instance AdditiveMonoid s => AdditiveMonoid (Antilinear s a) where+  zero = Antilinear zero+  replicate n (Antilinear m) = Antilinear (replicate n m)++instance AdditiveGroup s => AdditiveGroup (Antilinear s a) where+  Antilinear m - Antilinear n = Antilinear (m - n)+  negate (Antilinear m) = Antilinear (negate m)+  subtract (Antilinear m) (Antilinear n) = Antilinear (subtract m n)+  times n (Antilinear m) = Antilinear (times n m)++instance Abelian s => Abelian (Antilinear s a)++-- instance (Multiplicative m, Semiring s) => LeftModule (Antilinear s m) (Antilinear s m) where (.*) = (*)++instance LeftModule r s => LeftModule r (Antilinear s m) where+  s .* Antilinear m = Antilinear (\k -> s .* m k)++-- instance (Multiplicative m, Semiring s) => RightModule (Antilinear s m) (Antilinear s m) where (*.) = (*)++instance RightModule r s => RightModule r (Antilinear s m) where+  Antilinear m *. s = Antilinear (\k -> m k *. s)+
+ Numeric/Functional/Linear.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE ImplicitParams, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+module Numeric.Functional.Linear +  ( Linear(..)+  , (.*), (*.)+  , embedHom+  , augmentHom+  ) where++import Numeric.Addition+import Numeric.Algebra.Free+import Numeric.Multiplication+import Numeric.Module+import Numeric.Semiring.Class+import Numeric.Rig.Class+import Numeric.Rng.Class+import Numeric.Ring.Class+import Control.Applicative+import Control.Monad+import Data.Functor.Plus hiding (zero)+import qualified Data.Functor.Plus as Plus+import Data.Functor.Bind+import qualified Prelude+import Prelude hiding ((+),(-),negate,subtract,replicate,(*))++-- | Linear functionals from elements of a free module to a scalar++-- appLinear f (x + y) = appLinear f x + appLinear f y+-- appLinear f (a .* x) = a * appLinear f x++newtype Linear r a = Linear { appLinear :: (a -> r) -> r }++instance Functor (Linear r) where+  fmap f (Linear m) = Linear (\k -> m (k . f))++instance Apply (Linear r) where+  Linear mf <.> Linear ma = Linear (\k -> mf (\f -> ma (k . f)))++instance Applicative (Linear r) where+  pure a = Linear (\k -> k a)+  Linear mf <*> Linear ma = Linear (\k -> mf (\f -> ma (k . f)))++instance Bind (Linear r) where+  Linear m >>- f = Linear (\k -> m (\a -> appLinear (f a) k))+  +instance Monad (Linear r) where+  return a = Linear (\k -> k a)+  Linear m >>= f = Linear (\k -> m (\a -> appLinear (f a) k))++instance Additive r => Alt (Linear r) where+  Linear m <!> Linear n = Linear (m + n)++instance AdditiveMonoid r => Plus (Linear r) where+  zero = Linear zero ++instance AdditiveMonoid r => Alternative (Linear r) where+  Linear m <|> Linear n = Linear (m + n)+  empty = Linear zero++instance AdditiveMonoid r => MonadPlus (Linear r) where+  Linear m `mplus` Linear n = Linear (m + n)+  mzero = Linear zero++instance Additive r => Additive (Linear r a) where+  Linear m + Linear n = Linear (m + n)+  replicate1p n (Linear m) = Linear (replicate1p n m)++instance FreeCoalgebra r m => Multiplicative (Linear r m) where+  Linear f * Linear g = Linear (\k -> f (g . cojoin k))+instance (Commutative m, FreeCoalgebra r m) => Commutative (Linear r m)+instance FreeCoalgebra r m => Semiring (Linear r m)+instance FreeCounitalCoalgebra r m => Unital (Linear r m) where+  one = Linear counit+instance (Rig r, FreeCounitalCoalgebra r m) => Rig (Linear r m)+instance (Rng r, FreeCounitalCoalgebra r m) => Rng (Linear r m)+instance (Ring r, FreeCounitalCoalgebra r m) => Ring (Linear r m)++-- ring homomorphism from r -> r^a+embedHom :: (Unital m, FreeCounitalCoalgebra r m) => r -> Linear r m+embedHom r = Linear (\k -> r * k one)++-- if the characteristic of s does not divide the order of a, then s[a] is semisimple+-- and if a has a length function, we can build a filtered algebra++-- | The augmentation ring homomorphism from r^a -> r+augmentHom :: Unital s => Linear s a -> s+augmentHom (Linear m) = m (const one)++-- TODO: we can also build up the augmentation ideal++instance AdditiveMonoid s => AdditiveMonoid (Linear s a) where+  zero = Linear zero+  replicate n (Linear m) = Linear (replicate n m)++instance Abelian s => Abelian (Linear s a)++instance AdditiveGroup s => AdditiveGroup (Linear s a) where+  Linear m - Linear n = Linear (m - n)+  negate (Linear m) = Linear (negate m)+  subtract (Linear m) (Linear n) = Linear (subtract m n)+  times n (Linear m) = Linear (times n m)++instance FreeCoalgebra r m => LeftModule (Linear r m) (Linear r m) where+  (.*) = (*)++instance LeftModule r s => LeftModule r (Linear s m) where+  s .* Linear m = Linear (\k -> s .* m k)++instance FreeCoalgebra r m => RightModule (Linear r m) (Linear r m) where+  (*.) = (*)++instance RightModule r s => RightModule r (Linear s m) where+  Linear m *. s = Linear (\k -> m k *. s)+
+ Numeric/Group.hs view
@@ -0,0 +1,9 @@+module Numeric.Group+  ( module Numeric.Monoid+  , module Numeric.Group.Additive+  , module Numeric.Group.Multiplicative+  ) where++import Numeric.Monoid+import Numeric.Group.Additive+import Numeric.Group.Multiplicative
+ Numeric/Group/Additive.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+module Numeric.Group.Additive+  ( +  -- * Additive Groups+    AdditiveGroup(..)+  ) where++import Data.Int+import Data.Word+import Prelude hiding ((+), (-), negate, subtract)+import qualified Prelude+import Numeric.Semigroup.Additive+import Numeric.Monoid.Additive+import Numeric.Module.Class++infixl 6 - +infixl 7 `times`++class (LeftModule Integer r, RightModule Integer r, AdditiveMonoid r) => AdditiveGroup r where+  (-)      :: r -> r -> r+  negate   :: r -> r+  subtract :: r -> r -> r+  times    :: Integral n => n -> r -> r+  times y0 x0 = case compare y0 0 of+    LT -> f (negate x0) (Prelude.negate y0)+    EQ -> zero+    GT -> f x0 y0+    where+      f x y +        | even y = f (x + x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) x+      g x y z +        | even y = g (x + x) (y `quot` 2) z+        | y == 1 = x + z+        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) (x + z)++  negate a = zero - a+  a - b  = a + negate b +  subtract a b = negate a + b++instance AdditiveGroup r => AdditiveGroup (e -> r) where+  f - g = \x -> f x - g x+  negate f x = negate (f x)+  subtract f g x = subtract (f x) (g x)+  times n f e = times n (f e)++instance AdditiveGroup Integer where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Int where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Int8 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Int16 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Int32 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Int64 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Word where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Word8 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Word16 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Word32 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup Word64 where+  (-) = (Prelude.-)+  negate = Prelude.negate+  subtract = Prelude.subtract+  times n r = fromIntegral n * r++instance AdditiveGroup () where +  _ - _   = ()+  negate _ = ()+  subtract _ _  = ()+  times _ _   = ()++instance (AdditiveGroup a, AdditiveGroup b) => AdditiveGroup (a,b) where+  negate (a,b) = (negate a, negate b)+  (a,b) - (i,j) = (a-i, b-j)+  subtract (a,b) (i,j) = (subtract a i, subtract b j)+  times n (a,b) = (times n a,times n b)++instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c) => AdditiveGroup (a,b,c) where+  negate (a,b,c) = (negate a, negate b, negate c)+  (a,b,c) - (i,j,k) = (a-i, b-j, c-k)+  subtract (a,b,c) (i,j,k) = (subtract a i, subtract b j, subtract c k)+  times n (a,b,c) = (times n a,times n b, times n c)++instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c, AdditiveGroup d) => AdditiveGroup (a,b,c,d) where+  negate (a,b,c,d) = (negate a, negate b, negate c, negate d)+  (a,b,c,d) - (i,j,k,l) = (a-i, b-j, c-k, d-l)+  subtract (a,b,c,d) (i,j,k,l) = (subtract a i, subtract b j, subtract c k, subtract d l)+  times n (a,b,c,d) = (times n a,times n b, times n c, times n d)++instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c, AdditiveGroup d, AdditiveGroup e) => AdditiveGroup (a,b,c,d,e) where+  negate (a,b,c,d,e) = (negate a, negate b, negate c, negate d, negate e)+  (a,b,c,d,e) - (i,j,k,l,m) = (a-i, b-j, c-k, d-l, e-m)+  subtract (a,b,c,d,e) (i,j,k,l,m) = (subtract a i, subtract b j, subtract c k, subtract d l, subtract e m)+  times n (a,b,c,d,e) = (times n a,times n b, times n c, times n d, times n e)
+ Numeric/Group/Multiplicative.hs view
@@ -0,0 +1,59 @@+module Numeric.Group.Multiplicative+  ( MultiplicativeGroup(..)+  ) where++import Prelude hiding ((*), recip, (/),(^))+import Numeric.Semigroup.Multiplicative+import Numeric.Monoid.Multiplicative++infixr 8 ^+infixl 7 /, \\++class Unital r => MultiplicativeGroup r where+  recip  :: r -> r+  (/)    :: r -> r -> r+  (\\)   :: r -> r -> r+  (^)    :: Integral n => r -> n -> r+  recip a = one / a+  a / b = a * recip b+  a \\ b = recip a * b+  x0 ^ y0 = case compare y0 0 of+    LT -> f (recip x0) (negate y0)+    EQ -> one+    GT -> f x0 y0+    where+       f x y +         | even y = f (x * x) (y `quot` 2)+         | y == 1 = x+         | otherwise = g (x * x) ((y - 1) `quot` 2) x+       g x y z +         | even y = g (x * x) (y `quot` 2) z+         | y == 1 = x * z+         | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)++instance MultiplicativeGroup () where +  _ / _   = ()+  recip _ = ()+  _ \\ _  = ()+  _ ^ _   = ()+instance (MultiplicativeGroup a, MultiplicativeGroup b) => MultiplicativeGroup (a,b) where+  recip (a,b) = (recip a, recip b)+  (a,b) / (i,j) = (a/i,b/j)+  (a,b) \\ (i,j) = (a\\i,b\\j)+  (a,b) ^ n = (a^n,b^n)+instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c) => MultiplicativeGroup (a,b,c) where+  recip (a,b,c) = (recip a, recip b, recip c)+  (a,b,c) / (i,j,k) = (a/i,b/j,c/k)+  (a,b,c) \\ (i,j,k) = (a\\i,b\\j,c\\k)+  (a,b,c) ^ n = (a^n,b^n,c^n)+instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c, MultiplicativeGroup d) => MultiplicativeGroup (a,b,c,d) where+  recip (a,b,c,d) = (recip a, recip b, recip c, recip d)+  (a,b,c,d) / (i,j,k,l) = (a/i,b/j,c/k,d/l)+  (a,b,c,d) \\ (i,j,k,l) = (a\\i,b\\j,c\\k,d\\l)+  (a,b,c,d) ^ n = (a^n,b^n,c^n,d^n)++instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c, MultiplicativeGroup d, MultiplicativeGroup e) => MultiplicativeGroup (a,b,c,d,e) where+  recip (a,b,c,d,e) = (recip a, recip b, recip c, recip d, recip e)+  (a,b,c,d,e) / (i,j,k,l,m) = (a/i,b/j,c/k,d/l,e/m)+  (a,b,c,d,e) \\ (i,j,k,l,m) = (a\\i,b\\j,c\\k,d\\l,e\\m)+  (a,b,c,d,e) ^ n = (a^n,b^n,c^n,d^n,e^n)
+ Numeric/Log.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module Numeric.Log +  ( Log(..)+  ) where++import Data.Function (on)+import Numeric.Addition+import Numeric.Module+import Numeric.Multiplication+import Numeric.Band.Class+import Numeric.Natural.Internal++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)+  replicate1p 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 => AdditiveMonoid (Log r) where+  zero = Log one+  replicate n (Log m) = Log (pow m n)+  sumWith f = Log . productWith (runLog . f)++instance MultiplicativeGroup r => LeftModule Integer (Log r) where+  n .* Log m = Log (m ^ n)++instance MultiplicativeGroup r => RightModule Integer (Log r) where+  Log m *. n = Log (m ^ n)++instance MultiplicativeGroup r => AdditiveGroup (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/Linear.hs view
@@ -0,0 +1,272 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}+module Numeric.Map.Linear+  ( Map(..)+  , joinMap+  , unitMap+  , memoMap+  , cojoinMap+  , counitMap+  , antipodeMap+  , convolveMap+  , embedMap+  , augmentMap+  , arrMap+  ) where++import Control.Applicative+import Control.Arrow+import Control.Categorical.Bifunctor+import Control.Category+import Control.Category.Associative+import Control.Category.Braided+import Control.Category.Cartesian+import Control.Category.Cartesian.Closed+--import Control.Category.Distributive+import Control.Category.Monoidal+import Control.Monad hiding (join)+import Control.Monad.Reader.Class+--import Data.Foldable hiding (sum, concat)+import Data.Functor.Representable.Trie+import Data.Functor.Bind hiding (join)+import Data.Functor.Plus hiding (zero)+import qualified Data.Functor.Plus as Plus+--import Data.Semigroup.Foldable+import Data.Semigroupoid+import Numeric.Addition+import Numeric.Algebra.Free+import Numeric.Multiplication+import Numeric.Module+import Numeric.Semiring.Class+import Numeric.Rig.Class+import Numeric.Ring.Class+import Numeric.Rng.Class+import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat, (.), id, curry, uncurry, fst, snd)++-- | linear maps from elements of a free module to another free module over r+--+-- > f $# x + y = (f $# x) + (f $# y)+-- > f $# (r .* x) = r .* (f $# x)+--+--+-- @Map r b a@ represents a linear mapping from a free module with basis @a@ over @r@ to a free module with basis @b@ over @r@.+-- +-- Note well the change of direction, due to the contravariance of change of basis!+--+-- This way enables we can employ arbitrary pure functions as linear maps by lifting them using `arr`, or build them+-- by using the monad instance for Map r b.  As a consequence Map is an instance of, well, almost everything.++infixr 0 $#+newtype Map r b a = Map { ($#) :: (a -> r) -> b -> r }++-- NB: due to contravariance (>>>) to get the usual notion of composition!+instance Category (Map r) where+  id = Map id+  Map f . Map g = Map (g . f)++instance Semigroupoid (Map r) where+  Map f `o` Map g = Map (g . f)++instance Functor (Map r b) where+  fmap f m = Map $ \k -> m $# k . f++instance Apply (Map r b) where+  mf <.> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b++instance Applicative (Map r b) where+  pure a = Map $ \k _ -> k a+  mf <*> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b++instance Bind (Map r b) where+  Map m >>- f = Map $ \k b -> m (\a -> (f a $# k) b) b+  +instance Monad (Map r b) where+  return a = Map $ \k _ -> k a+  m >>= f = Map $ \k b -> (m $# \a -> (f a $# k) b) b++instance PFunctor (,) (Map r) (Map r) where+  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a++instance QFunctor (,) (Map r) (Map r) where+  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a++instance Bifunctor (,) (Map r) (Map r) (Map r) where+  bimap m n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a++instance Associative (Map r) (,) where+  associate = arr associate++instance Disassociative (Map r) (,) where+  disassociate = arr disassociate++instance Braided (Map r) (,) where+  braid = arr braid++instance Symmetric (Map r) (,)++instance HasIdentity (Map r) (,) where+  type Id (Map r) (,) = ()++instance Monoidal (Map r) (,) where+  idl = arr idl+  idr = arr idr++instance PreCartesian (Map r) where+  type Product (Map r) = (,) +  fst = arr fst+  snd = arr snd+  diag = arr diag+  f &&& g = Map $ \k a -> (f $# \b -> (g $# \c -> k (b,c)) a) a++-- instance Cartesian (Map r)++{-+instance CCC (Map r) where+  type Exp (Map r) = Map r +  apply = Map $ \k (f,a) -> k $ f a+  curry m = Map $ \k a -> k $ \b -> m $# (a,b)+  uncurry m = Map $ \k (a,b) -> k $ (m $# a) b+-}++--instance Distributive (Map r) where+--  distribute = Map $ \k (a,p) -> k ((((,)a) *** ((,)a)) p)++instance PFunctor Either (Map r) (Map r) where+  first m = Map $ \k -> either (m $# k . Left) (k . Right)++instance QFunctor Either (Map r) (Map r) where+  second m = Map $ \k -> either (k . Left) (m $# k . Right)++instance Bifunctor Either (Map r) (Map r) (Map r) where+  bimap m n = Map $ \k -> either (m $# k . Left) (n $# k . Right)++instance 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 MonadReader b (Map r b) where+  ask = id+  local f m = Map $ \k -> (m $# k) . f++-- While the following typechecks, it isn't correct,+-- callCC is non-linear, the internal Map ignores the functional it is given!+--+--instance MonadCont (Map r b) where+--  callCC f = Map $ \k -> (f $# \a -> Map $ \_ _ -> k a) k++-- label :: ((a -> r) -> Map r b a) -> Map r b a+-- label f = Map $ \k -> f k $# k ++-- break :: (a -> r) -> a -> Map r b a++instance AdditiveMonoid r => ArrowZero (Map r) where+  zeroArrow = Map zero++instance AdditiveMonoid r => ArrowPlus (Map r) where+  Map m <+> Map n = Map $ m + n++-- TODO: ArrowChoice, ArrowApply & ArrowLoop++-- instance Associative (Map r) Either where+--  associate m = Map $ \k -> m $# k . associate++--instance Disassociative (Map r) Either where+--  disassociate m = Map $ \k -> m $# k . disassociate++-- TODO: more categories instances for (Map r) & Either to get to precocartesian!++instance Additive r => Additive (Map r b a) where+  Map m + Map n = Map $ m + n+  replicate1p n (Map m) = Map $ replicate1p n m++instance FreeCoalgebra r m => Multiplicative (Map r b m) where+  f * g = Map $ \k b -> (f $# \a -> (g $# cojoin k a) b) b+instance FreeCounitalCoalgebra r m => Unital (Map r b m) where+  one = Map $ \k _ -> counit k++instance FreeCoalgebra r m => Semiring (Map r b m)++instance FreeCoalgebra r m => LeftModule (Map r b m) (Map r b m) where +  (.*) = (*)++instance LeftModule r s => LeftModule r (Map s b m) where+  s .* Map m = Map $ \k b -> s .* m k b++instance FreeCoalgebra r m => RightModule (Map r b m) (Map r b m) where (*.) = (*)+instance RightModule r s => RightModule r (Map s b m) where+  Map m *. s = Map $ \k b -> m k b *. s++instance Additive r => Alt (Map r b) where+  Map m <!> Map n = Map $ m + n++instance AdditiveMonoid r => Plus (Map r b) where+  zero = Map zero ++instance AdditiveMonoid r => Alternative (Map r b) where+  Map m <|> Map n = Map $ m + n+  empty = Map zero++instance AdditiveMonoid r => MonadPlus (Map r b) where+  Map m `mplus` Map n = Map $ m + n+  mzero = Map zero++instance AdditiveMonoid s => AdditiveMonoid (Map s b a) where+  zero = Map zero+  replicate n (Map m) = Map $ replicate n m++instance Abelian s => Abelian (Map s b a)++instance AdditiveGroup s => AdditiveGroup (Map s b a) where+  Map m - Map n = Map $ m - n+  negate (Map m) = Map $ negate m+  subtract (Map m) (Map n) = Map $ subtract m n+  times n (Map m) = Map $ times n m++instance (Commutative m, FreeCoalgebra r m) => Commutative (Map r b m)++instance (Rig r, FreeCounitalCoalgebra r m) => Rig (Map r b m)+instance (Rng r, FreeCounitalCoalgebra r m) => Rng (Map r b m)+instance (Ring r, FreeCounitalCoalgebra r m) => Ring (Map r a m)++-- (inefficiently) combine a linear combination of basis vectors to make a map.+arrMap :: (AdditiveMonoid r, Semiring r) => (b -> [(r, a)]) -> Map r b a+arrMap f = Map $ \k b -> sum [ r * k a | (r, a) <- f b ]++memoMap :: HasTrie a => Map r a a+memoMap = Map memo++joinMap :: FreeAlgebra r a => Map r a (a,a)+joinMap = Map $ join . curry++cojoinMap :: FreeCoalgebra r c => Map r (c,c) c+cojoinMap = Map $ uncurry . cojoin++-- r -> a -> r+unitMap :: FreeUnitalAlgebra r a => Map r a ()+unitMap = Map $ \k -> unit $ k ()++-- counit :: (c -> r) -> r+counitMap :: FreeCounitalCoalgebra r c => Map r () c+counitMap = Map $ \k () -> counit k++-- | convolution give an associative algebra and coassociative coalgebra+convolveMap :: (FreeAlgebra r a, FreeCoalgebra r c) => Map r a c -> Map r a c -> Map r a c+convolveMap f g = joinMap >>> (f *** g) >>> cojoinMap++-- convolveMap antipodeMap id = convolveMap id antipodeMap = unit . counit+antipodeMap :: Hopf r h => Map r h h+antipodeMap = Map antipode++-- ring homomorphism from r -> r^a+embedMap :: (Unital m, FreeCounitalCoalgebra r m) => (b -> r) -> Map r b m +embedMap f = Map $ \k b -> f b * k one++-- if the characteristic of s does not divide the order of a, then s[a] is semisimple+-- and if a has a length function, we can build a filtered algebra++-- | The augmentation ring homomorphism from r^a -> r+augmentMap :: Unital s => Map s b m -> b -> s+augmentMap m = m $# const one+
+ Numeric/Module.hs view
@@ -0,0 +1,5 @@+module Numeric.Module +  ( module Numeric.Module.Class+  ) where++import Numeric.Module.Class
+ Numeric/Monoid.hs view
@@ -0,0 +1,9 @@+module Numeric.Monoid+  ( module Numeric.Semigroup+  , module Numeric.Monoid.Additive+  , module Numeric.Monoid.Multiplicative+  ) where++import Numeric.Semigroup+import Numeric.Monoid.Additive+import Numeric.Monoid.Multiplicative
+ Numeric/Monoid/Additive.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}+module Numeric.Monoid.Additive+  ( +  -- * Additive Monoids+    AdditiveMonoid(..)+  , sum+  ) where++import Data.Foldable hiding (sum)+import Data.Int+import Data.Word+import Numeric.Module.Class+import Numeric.Natural.Internal+import Numeric.Semigroup.Additive+import Prelude hiding ((+), sum, replicate)++-- | An additive monoid+--+-- > zero + a = a = a + zero+class (LeftModule Natural m, RightModule Natural m) => AdditiveMonoid m where+  zero :: m++  replicate :: Whole n => n -> m -> m+  replicate 0 _  = zero+  replicate n x0 = f x0 n+    where+      f x y+        | even y = f (x + x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x + x) (unsafePred y `quot` 2) x+      g x y z+        | even y = g (x + x) (y `quot` 2) z+        | y == 1 = x + z+        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)++  sumWith :: Foldable f => (a -> m) -> f a -> m+  sumWith f = foldl' (\b a -> b + f a) zero++sum :: (Foldable f, AdditiveMonoid m) => f m -> m+sum = sumWith id++instance AdditiveMonoid Bool where +  zero = False+  replicate 0 _ = False+  replicate _ r = r++instance AdditiveMonoid Natural where+  zero = 0+  replicate n r = toNatural n * r++instance AdditiveMonoid Integer where +  zero = 0+  replicate n r = toInteger n * r++instance AdditiveMonoid Int where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Int8 where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Int16 where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Int32 where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Int64 where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Word where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Word8 where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Word16 where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Word32 where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid Word64 where +  zero = 0+  replicate n r = fromIntegral n * r++instance AdditiveMonoid r => AdditiveMonoid (e -> r) where+  zero = const zero+  sumWith f xs e = sumWith (`f` e) xs+  replicate n r e = replicate n (r e)++instance AdditiveMonoid () where +  zero = ()+  replicate _ () = ()+  sumWith _ _ = ()++instance (AdditiveMonoid a, AdditiveMonoid b) => AdditiveMonoid (a,b) where+  zero = (zero,zero)+  replicate n (a,b) = (replicate n a, replicate n b)++instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c) => AdditiveMonoid (a,b,c) where+  zero = (zero,zero,zero)+  replicate n (a,b,c) = (replicate n a, replicate n b, replicate n c)++instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c, AdditiveMonoid d) => AdditiveMonoid (a,b,c,d) where+  zero = (zero,zero,zero,zero)+  replicate n (a,b,c,d) = (replicate n a, replicate n b, replicate n c, replicate n d)++instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c, AdditiveMonoid d, AdditiveMonoid e) => AdditiveMonoid (a,b,c,d,e) where+  zero = (zero,zero,zero,zero,zero)+  replicate n (a,b,c,d,e) = (replicate n a, replicate n b, replicate n c, replicate n d, replicate n e)
+ Numeric/Monoid/Multiplicative.hs view
@@ -0,0 +1,7 @@+module Numeric.Monoid.Multiplicative+  ( Unital(..)+  , product+  ) where++import Numeric.Monoid.Multiplicative.Internal+import Prelude ()
+ Numeric/Monoid/Multiplicative/Internal.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Monoid.Multiplicative.Internal+  ( Unital(..)+  , product+  , FreeUnitalAlgebra(..)+  ) where++import Data.Foldable hiding (product)+import Data.Int+import Data.Word+import Prelude hiding ((*), foldr, product)+import Numeric.Semiring.Internal+import Numeric.Natural.Internal++infixr 8 `pow`++class Multiplicative r => Unital r where+  one :: r+  pow :: Whole n => r -> n -> r+  pow _ 0 = one+  pow x0 y0 = f x0 y0 where+    f x y +      | even y = f (x * x) (y `quot` 2)+      | y == 1 = x+      | otherwise = g (x * x) ((y - 1) `quot` 2) x+    g x y z +      | even y = g (x * x) (y `quot` 2) z+      | y == 1 = x * z+      | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)+  productWith :: Foldable f => (a -> r) -> f a -> r+  productWith f = foldl' (\b a -> b * f a) one++product :: (Foldable f, Unital r) => f r -> r+product = productWith id++instance Unital Bool where one = True+instance Unital Integer where one = 1+instance Unital Int where one = 1+instance Unital Int8 where one = 1+instance Unital Int16 where one = 1+instance Unital Int32 where one = 1+instance Unital Int64 where one = 1+instance Unital Natural where one = 1+instance Unital Word where one = 1+instance Unital Word8 where one = 1+instance Unital Word16 where one = 1+instance Unital Word32 where one = 1+instance Unital Word64 where one = 1+instance Unital () where one = ()+instance (Unital a, Unital b) => Unital (a,b) where+  one = (one,one)++instance (Unital a, Unital b, Unital c) => Unital (a,b,c) where+  one = (one,one,one)++instance (Unital a, Unital b, Unital c, Unital d) => Unital (a,b,c,d) where+  one = (one,one,one,one)++instance (Unital a, Unital b, Unital c, Unital d, Unital e) => Unital (a,b,c,d,e) where+  one = (one,one,one,one,one)++-- | An associative unital algebra over a semiring, built using a free module+class (Unital r, FreeAlgebra r a) => FreeUnitalAlgebra r a where+  unit :: r -> a -> r++instance (FreeUnitalAlgebra r a) => Unital (a -> r) where+  one = unit one++instance FreeUnitalAlgebra () a where+  unit _ _ = ()++instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b) => FreeUnitalAlgebra (a -> r) b where+  unit f b a = unit (f a) b++instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b) => FreeUnitalAlgebra r (a,b) where+  unit r (a,b) = unit r a * unit r b++instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c) => FreeUnitalAlgebra r (a,b,c) where+  unit r (a,b,c) = unit r a * unit r b * unit r c++instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c, FreeUnitalAlgebra r d) => FreeUnitalAlgebra r (a,b,c,d) where+  unit r (a,b,c,d) = unit r a * unit r b * unit r c * unit r d++instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c, FreeUnitalAlgebra r d, FreeUnitalAlgebra r e) => FreeUnitalAlgebra r (a,b,c,d,e) where+  unit r (a,b,c,d,e) = unit r a * unit r b * unit r c * unit r d * unit r e
+ Numeric/Multiplication.hs view
@@ -0,0 +1,15 @@+module Numeric.Multiplication +  ( module Numeric.Semigroup.Multiplicative+  , module Numeric.Monoid.Multiplicative+  , module Numeric.Group.Multiplicative+  , module Numeric.Multiplication.Commutative+  , module Numeric.Multiplication.Involutive+  , module Numeric.Multiplication.Factorable+  ) where++import Numeric.Semigroup.Multiplicative+import Numeric.Monoid.Multiplicative+import Numeric.Group.Multiplicative+import Numeric.Multiplication.Commutative+import Numeric.Multiplication.Involutive+import Numeric.Multiplication.Factorable
+ Numeric/Multiplication/Commutative.hs view
@@ -0,0 +1,28 @@+module Numeric.Multiplication.Commutative where++import Data.Int+import Data.Word+import Numeric.Semigroup.Multiplicative+import Numeric.Natural++-- | A commutative multiplicative semigroup+class Multiplicative r => Commutative r++instance Commutative () +instance Commutative Bool+instance Commutative Integer+instance Commutative Int+instance Commutative Int8+instance Commutative Int16+instance Commutative Int32+instance Commutative Int64+instance Commutative Natural+instance Commutative Word+instance Commutative Word8+instance Commutative Word16+instance Commutative Word32+instance Commutative Word64+instance (Commutative a, Commutative b) => Commutative (a,b) +instance (Commutative a, Commutative b, Commutative c) => Commutative (a,b,c) +instance (Commutative a, Commutative b, Commutative c, Commutative d) => Commutative (a,b,c,d) +instance (Commutative a, Commutative b, Commutative c, Commutative d, Commutative e) => Commutative (a,b,c,d,e)
+ Numeric/Multiplication/Factorable.hs view
@@ -0,0 +1,49 @@+module Numeric.Multiplication.Factorable+  ( -- * Partitionable Additive Semigroups+    Factorable(..)+  ) where++import Data.List.NonEmpty+import Numeric.Semigroup.Multiplicative+import Prelude hiding (concat)++-- | `factorWith f c` returns a non-empty list containing `f a b` for all `a, b` such that `a * b = c`.+--+-- Results of factorWith f 0 are undefined and may result in either an error or an infinite list.++class Multiplicative m => Factorable m where+  factorWith :: (m -> m -> r) -> m -> NonEmpty r++instance Factorable Bool where+  factorWith f False = f False False :| [f False True, f True False]+  factorWith f True  = f True True :| []++instance Factorable () where+  factorWith f () = f () () :| []++concat :: NonEmpty (NonEmpty a) -> NonEmpty a+concat m = m >>= id++instance (Factorable a, Factorable b) => Factorable (a,b) where+  factorWith f (a,b) = concat $ factorWith (\ax ay ->+                                factorWith (\bx by -> f (ax,bx) (ay,by)) b) a++instance (Factorable a, Factorable b, Factorable c) => Factorable (a,b,c) where+  factorWith f (a,b,c) = concat $ factorWith (\ax ay ->+                            concat $ factorWith (\bx by ->+                                     factorWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a++instance (Factorable a, Factorable b, Factorable c,Factorable d ) => Factorable (a,b,c,d) where+  factorWith f (a,b,c,d) = concat $ factorWith (\ax ay ->+                           concat $ factorWith (\bx by ->+                           concat $ factorWith (\cx cy ->+                                    factorWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a++instance (Factorable a, Factorable b, Factorable c,Factorable d, Factorable e) => Factorable (a,b,c,d,e) where+  factorWith f (a,b,c,d,e) = concat $ factorWith (\ax ay ->+                             concat $ factorWith (\bx by ->+                             concat $ factorWith (\cx cy ->+                             concat $ factorWith (\dx dy ->+                                      factorWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a++
+ Numeric/Multiplication/Involutive.hs view
@@ -0,0 +1,42 @@+module Numeric.Multiplication.Involutive+  ( InvolutiveMultiplication(..)+  , adjointCommutative+  ) where++import Data.Int+import Data.Word+import Numeric.Natural.Internal+import Numeric.Semigroup.Multiplicative+import Numeric.Multiplication.Commutative++-- | An semigroup with involution+-- +-- > adjoint a * adjoint b = adjoint (b * a)+class Multiplicative r => InvolutiveMultiplication r where+  adjoint :: r -> r++adjointCommutative :: Commutative r => r -> r+adjointCommutative = id++instance InvolutiveMultiplication Int where adjoint = id+instance InvolutiveMultiplication Integer where adjoint = id+instance InvolutiveMultiplication Int8 where adjoint = id+instance InvolutiveMultiplication Int16 where adjoint = id+instance InvolutiveMultiplication Int32 where adjoint = id+instance InvolutiveMultiplication Int64 where adjoint = id+instance InvolutiveMultiplication Bool where adjoint = id+instance InvolutiveMultiplication Word where adjoint = id+instance InvolutiveMultiplication Natural where adjoint = id+instance InvolutiveMultiplication Word8 where adjoint = id+instance InvolutiveMultiplication Word16 where adjoint = id+instance InvolutiveMultiplication Word32 where adjoint = id+instance InvolutiveMultiplication Word64 where adjoint = id+instance InvolutiveMultiplication () where adjoint = id+instance (InvolutiveMultiplication a, InvolutiveMultiplication b) => InvolutiveMultiplication (a,b) where+  adjoint (a,b) = (adjoint a, adjoint b)+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c) => InvolutiveMultiplication (a,b,c) where+  adjoint (a,b,c) = (adjoint a, adjoint b, adjoint c)+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d) => InvolutiveMultiplication (a,b,c,d) where+  adjoint (a,b,c,d) = (adjoint a, adjoint b, adjoint c, adjoint d)+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d, InvolutiveMultiplication e) => InvolutiveMultiplication (a,b,c,d,e) where+  adjoint (a,b,c,d,e) = (adjoint a, adjoint b, adjoint c, adjoint d, adjoint e)
+ Numeric/Natural.hs view
@@ -0,0 +1,6 @@+module Numeric.Natural +  ( Natural+  , Whole(toNatural)+  ) where++import Numeric.Natural.Internal
+ Numeric/Natural/Internal.hs view
@@ -0,0 +1,77 @@+module Numeric.Natural.Internal+  ( Natural(..)+  , Whole(..)+  ) where++{-# OPTIONS_HADDOCK hide #-}++import Data.Word+import Text.Read++newtype Natural = Natural { runNatural :: Integer } deriving (Eq,Ord)++instance Show Natural where+  showsPrec d (Natural n) = showsPrec d n++instance Read Natural where+  readPrec = fmap Natural $ step readPrec++instance Num Natural where+  Natural n + Natural m = Natural (n + m)+  Natural n * Natural m = Natural (n * m)+  Natural n - Natural m | result < 0 = error "Natural.(-): negative result"+                        | otherwise  = Natural result+	where result = n - m+  abs (Natural n) = Natural n+  signum (Natural n) = Natural (signum n)+  fromInteger n +    | n >= 0 = Natural n+    | otherwise = error "Natural.fromInteger: negative"++instance Real Natural where+  toRational (Natural a) = toRational a++instance Enum Natural where+  pred (Natural 0) = error "Natural.pred: 0"+  pred (Natural n) = Natural (pred n)+  succ (Natural n) = Natural (succ n)+  fromEnum (Natural n) = fromEnum n+  toEnum n | n < 0     = error "Natural.toEnum: negative"+           | otherwise = Natural (toEnum n)++instance Integral Natural where+  quot (Natural a) (Natural b) = Natural (quot a b)+  rem (Natural a) (Natural b) = Natural (rem a b)+  div (Natural a) (Natural b) = Natural (div a b)+  mod (Natural a) (Natural b) = Natural (mod a b)+  divMod (Natural a) (Natural b) = (Natural q, Natural r) where (q,r) = divMod a b+  quotRem (Natural a) (Natural b) = (Natural q, Natural r) where (q,r) = quotRem a b+  toInteger = runNatural++class Integral n => Whole n where+  toNatural :: n -> Natural+  unsafePred :: n -> n++instance Whole Word where+  toNatural = Natural . toInteger+  unsafePred n = n - 1++instance Whole Word8 where+  toNatural = Natural . toInteger+  unsafePred n = n - 1++instance Whole Word16 where+  toNatural = Natural . toInteger+  unsafePred n = n - 1++instance Whole Word32 where+  toNatural = Natural . toInteger+  unsafePred n = n - 1++instance Whole Word64 where+  toNatural = Natural . toInteger+  unsafePred n = n - 1++instance Whole Natural where+  toNatural = id+  unsafePred (Natural n) = Natural (n - 1)
+ Numeric/Order.hs view
@@ -0,0 +1,9 @@+module Numeric.Order+  ( module Numeric.Order.Class+  , module Numeric.Order.Additive+  , module Numeric.Rig.Ordered+  ) where++import Numeric.Order.Class+import Numeric.Order.Additive+import Numeric.Rig.Ordered
+ Numeric/Order/Additive.hs view
@@ -0,0 +1,21 @@+module Numeric.Order.Additive+  ( AdditiveOrder+  ) where++import Numeric.Natural+import Numeric.Semigroup.Additive+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 view
@@ -0,0 +1,74 @@+module Numeric.Order.Class +  ( Order(..)+  , orderOrd+  ) where++import Data.Int+import Data.Word+import Numeric.Natural++-- 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 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/Rig.hs view
@@ -0,0 +1,9 @@+module Numeric.Rig+  ( module Numeric.Rig.Class+  , module Numeric.Rig.Ordered+  , module Numeric.Rig.Characteristic+  ) where++import Numeric.Rig.Class+import Numeric.Rig.Ordered+import Numeric.Rig.Characteristic
+ Numeric/Rig/Characteristic.hs view
@@ -0,0 +1,87 @@+module Numeric.Rig.Characteristic+  ( Characteristic(..)+  , charInt+  , charWord+  , frobenius+  ) where++import Data.Int+import Data.Word+import Data.Proxy+import Numeric.Rig.Class+import Numeric.Ring.Endomorphism+import Numeric.Natural.Internal+import Numeric.Monoid.Multiplicative+import Prelude hiding ((^))++class Rig r => Characteristic r where+  char :: Proxy r -> Natural++-- the frobenius ring endomorphism (assuming the characteristic is prime)+frobenius :: Characteristic r => End r+frobenius = End $ \r -> r `pow` char (ofRing r)++ofRing :: r -> Proxy r+ofRing _ = Proxy++charInt :: (Integral s, Bounded s) => Proxy s -> Natural+charInt p = 2 * fromIntegral (maxBound `asProxyTypeOf` p) + 2++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 view
@@ -0,0 +1,49 @@+module Numeric.Rig.Class+  ( Rig(..)+  , fromNaturalNum+  , fromWhole+  ) where++import Numeric.Monoid.Additive+import Numeric.Monoid.Multiplicative+import Numeric.Semiring.Class+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, AdditiveMonoid r, Unital r) => Rig r where+  fromNatural :: Natural -> r+  fromNatural n = replicate 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 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)
+ Numeric/Ring.hs view
@@ -0,0 +1,11 @@+module Numeric.Ring+  ( module Numeric.Ring.Class+  , module Numeric.Ring.Endomorphism+  , module Numeric.Ring.Opposite+  , module Numeric.Ring.Rng+  ) where++import Numeric.Ring.Class+import Numeric.Ring.Endomorphism+import Numeric.Ring.Opposite+import Numeric.Ring.Rng
+ 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.Group.Additive+import Numeric.Monoid.Multiplicative+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/Endomorphism.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Ring.Endomorphism +  ( End(..)+  , toEnd+  , fromEnd+  ) where++import Data.Monoid+import Numeric.Addition+import Numeric.Module+import Numeric.Multiplication+import Numeric.Semiring.Class+import Numeric.Rng.Class+import Numeric.Rig.Class+import Numeric.Ring.Class+import Prelude hiding ((*),(+),(-),negate,subtract)++-- | 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 AdditiveMonoid r => AdditiveMonoid (End r) where+  zero = End (const zero)+instance AdditiveGroup r => AdditiveGroup (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, AdditiveMonoid r) => Semiring (End r)+instance (Abelian r, AdditiveMonoid r) => Rig (End r)+instance (Abelian r, AdditiveGroup r) => Rng (End r)+instance (Abelian r, AdditiveGroup r) => Ring (End r)+instance (AdditiveMonoid m, Abelian m) => LeftModule (End m) (End m) where+  End f .* End g = End (f . g)+instance (AdditiveMonoid 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)++-- 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
+ Numeric/Ring/Opposite.hs view
@@ -0,0 +1,85 @@+{-# 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.Addition+import Numeric.Multiplication+import Numeric.Module+import Numeric.Band.Class+import Numeric.Semiring.Class+import Numeric.Rig.Class+import Numeric.Rng.Class+import Numeric.Ring.Class+import Numeric.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)+  replicate1p n (Opposite a) = Opposite (replicate1p n a)+  sumWith1 f = Opposite . sumWith1 (runOpposite . f)+instance AdditiveMonoid r => AdditiveMonoid (Opposite r) where+  zero = Opposite zero+  replicate n (Opposite a) = Opposite (replicate 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 AdditiveGroup r => AdditiveGroup (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 MultiplicativeGroup r => MultiplicativeGroup (Opposite r) where+  recip = Opposite . recip . runOpposite+  Opposite a / Opposite b = Opposite (b \\ a)+  Opposite a \\ Opposite b = Opposite (b / a)+  Opposite a ^ n = Opposite (a ^ n)+instance Semiring r => Semiring (Opposite r)+instance Rng r => Rng (Opposite r)+instance Rig r => Rig (Opposite r)+instance Ring r => Ring (Opposite r)
+ Numeric/Ring/Rng.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Numeric.Ring.Rng+  ( RngRing(..)+  , rngRingHom+  , liftRngHom+  ) where++import Numeric.Addition+import Numeric.Module+import Numeric.Natural.Internal+import Numeric.Multiplication+import Numeric.Rig.Class+import Numeric.Rng.Class+import Numeric.Ring.Class+import Numeric.Semiring.Class+import 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)+  replicate1p n (RngRing m a) = RngRing ((1 + toInteger n) * m) (replicate1p n a)++instance Abelian r => Abelian (RngRing r)++instance (Abelian r, AdditiveMonoid r) => LeftModule Natural (RngRing r) where+  n .* RngRing m a = RngRing (toInteger n * m) (replicate n a)++instance (Abelian r, AdditiveMonoid r) => RightModule Natural (RngRing r) where+  RngRing m a *. n = RngRing (toInteger n * m) (replicate n a)++instance (Abelian r, AdditiveMonoid r) => AdditiveMonoid (RngRing r) where+  zero = RngRing 0 zero+  replicate n (RngRing m a) = RngRing (toInteger n * m) (replicate n a)++instance (Abelian r, AdditiveGroup r) => LeftModule Integer (RngRing r) where+  n .* RngRing m a = RngRing (toInteger n * m) (times n a)++instance (Abelian r, AdditiveGroup r) => RightModule Integer (RngRing r) where+  RngRing m a *. n = RngRing (toInteger n * m) (times n a)++instance (Abelian r, AdditiveGroup r) => AdditiveGroup (RngRing r) where+  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, MultiplicativeGroup r) => MultiplicativeGroup (RngRing r) where+  RngRing n a / RngRing m b = RngRing 0 $ (times n one + a) / (times m one + b)++instance Rng r => Semiring (RngRing r) ++instance Rng r => Rng (RngRing r)++instance Rng r => Rig (RngRing r)++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.hs view
@@ -0,0 +1,11 @@+module Numeric.Rng+  ( module Numeric.Group.Additive+  , module Numeric.Semiring+  , module Numeric.Rng.Class+  , module Numeric.Rng.Zero+  ) where++import Numeric.Group.Additive+import Numeric.Semiring+import Numeric.Rng.Class+import Numeric.Rng.Zero
+ Numeric/Rng/Class.hs view
@@ -0,0 +1,28 @@+module Numeric.Rng.Class+  ( Rng+  ) where++import Numeric.Group.Additive+import Numeric.Semiring+import Data.Int+import Data.Word++-- | A Ring without an /i/dentity.++class (AdditiveGroup r, Semiring r) => Rng r where+instance Rng Integer+instance Rng Int+instance Rng Int8+instance Rng Int16+instance Rng Int32+instance Rng Int64+instance Rng Word+instance Rng Word8+instance Rng Word16+instance Rng Word32+instance Rng Word64+instance Rng ()+instance (Rng a, Rng b) => Rng (a, b)+instance (Rng a, Rng b, Rng c) => Rng (a, b, c)+instance (Rng a, Rng b, Rng c, Rng d) => Rng (a, b, c, d)+instance (Rng a, Rng b, Rng c, Rng d, Rng e) => Rng (a, b, c, d, e)
+ Numeric/Rng/Zero.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+module Numeric.Rng.Zero+  ( ZeroRng(..)+  ) where++import Numeric.Addition+import Numeric.Multiplication+import Numeric.Module+import Numeric.Semiring.Class+import Numeric.Rng.Class+import Numeric.Natural.Internal+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 AdditiveMonoid r => AdditiveMonoid (ZeroRng r) where+  zero = ZeroRng zero+  sumWith f = ZeroRng . sumWith (runZeroRng . f)+  replicate n (ZeroRng a) = ZeroRng (replicate n a)+  +instance AdditiveGroup r => AdditiveGroup (ZeroRng r) where+  ZeroRng a - ZeroRng b = ZeroRng (a - b)+  negate (ZeroRng a) = ZeroRng (negate a)+  subtract (ZeroRng a) (ZeroRng b) = ZeroRng (subtract a b)+  times n (ZeroRng a) = ZeroRng (times n a)++instance AdditiveMonoid r => Multiplicative (ZeroRng r) where+  _ * _ = zero+  productWith1 f as = case toList as of+    [] -> error "productWith1: empty Foldable1"+    [a] -> f a+    _   -> zero++instance (AdditiveMonoid r, Abelian r) => Semiring (ZeroRng r)+instance AdditiveMonoid r => Commutative (ZeroRng r)+instance (AdditiveGroup r, Abelian r) => Rng (ZeroRng r)+instance AdditiveMonoid r => LeftModule Natural (ZeroRng r) where+  (.*) = replicate+instance AdditiveMonoid r => RightModule Natural (ZeroRng r) where+  m *. n = replicate n m+instance AdditiveGroup r => LeftModule Integer (ZeroRng r) where+  (.*) = times+instance AdditiveGroup r => RightModule Integer (ZeroRng r) where+  m *. n = times n m
+ Numeric/Semigroup.hs view
@@ -0,0 +1,19 @@+module Numeric.Semigroup+  ( module Numeric.Semigroup.Additive+  , module Numeric.Semigroup.Multiplicative+  , module Numeric.Addition.Abelian+  , module Numeric.Addition.Idempotent+  , module Numeric.Order.Additive+  , module Numeric.Band+  , module Numeric.Multiplication.Commutative+  , module Numeric.Multiplication.Involutive+  ) where++import Numeric.Semigroup.Additive+import Numeric.Semigroup.Multiplicative+import Numeric.Addition.Abelian+import Numeric.Addition.Idempotent+import Numeric.Order.Additive+import Numeric.Band+import Numeric.Multiplication.Commutative+import Numeric.Multiplication.Involutive
+ Numeric/Semigroup/Additive.hs view
@@ -0,0 +1,123 @@+module Numeric.Semigroup.Additive+  ( +  -- * Additive Semigroups+    Additive(..)+  , sum1+  ) where++import qualified Prelude+import Prelude hiding ((+), replicate)+import Data.Int+import Data.Word+import Data.Semigroup.Foldable+import Data.Foldable+import Numeric.Natural.Internal++infixl 6 +++-- | +-- > (a + b) + c = a + (b + c)+-- > replicate 1 a = a+-- > replicate (2 * n) a = replicate n a + replicate n a+-- > replicate (2 * n + 1) a = replicate n a + replicate n a + a+class Additive r where+  (+) :: r -> r -> r++  -- | replicate1p n r = replicate (1 + n) r+  replicate1p :: Whole n => n -> r -> r+  replicate1p y0 x0 = f x0 (1 Prelude.+ y0)+    where+      f x y+        | even y = f (x + x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x + x) (unsafePred y  `quot` 2) x+      g x y z+        | even y = g (x + x) (y `quot` 2) z+        | y == 1 = x + z+        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)++  sumWith1 :: Foldable1 f => (a -> r) -> f a -> r+  sumWith1 f = maybe (error "Numeric.Additive.Semigroup.sumWith1: empty structure") id . foldl' mf Nothing+     where mf Nothing y = Just $! f y +           mf (Just x) y = Just $! x + f y++sum1 :: (Foldable1 f, Additive r) => f r -> r+sum1 = sumWith1 id++instance Additive r => Additive (b -> r) where+  f + g = \e -> f e + g e +  replicate1p n f e = replicate1p n (f e)+  sumWith1 f xs e = sumWith1 (`f` e) xs++instance Additive Bool where+  (+) = (||)+  replicate1p _ a = a++instance Additive Natural where+  (+) = (Prelude.+)+  replicate1p n r = (1 Prelude.+ toNatural n) * r++instance Additive Integer where +  (+) = (Prelude.+)+  replicate1p n r = (1 Prelude.+ toInteger n) * r++instance Additive Int where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int8 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int16 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int32 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Int64 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word8 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word16 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word32 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive Word64 where+  (+) = (Prelude.+)+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r++instance Additive () where+  _ + _ = ()+  replicate1p _ _ = () +  sumWith1 _ _ = ()++instance (Additive a, Additive b) => Additive (a,b) where+  (a,b) + (i,j) = (a + i, b + j)+  replicate1p n (a,b) = (replicate1p n a, replicate1p n b)++instance (Additive a, Additive b, Additive c) => Additive (a,b,c) where+  (a,b,c) + (i,j,k) = (a + i, b + j, c + k)+  replicate1p n (a,b,c) = (replicate1p n a, replicate1p n b, replicate1p n c)++instance (Additive a, Additive b, Additive c, Additive d) => Additive (a,b,c,d) where+  (a,b,c,d) + (i,j,k,l) = (a + i, b + j, c + k, d + l)+  replicate1p n (a,b,c,d) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d)++instance (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (a,b,c,d,e) where+  (a,b,c,d,e) + (i,j,k,l,m) = (a + i, b + j, c + k, d + l, e + m)+  replicate1p n (a,b,c,d,e) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d, replicate1p n e)
+ Numeric/Semigroup/Multiplicative.hs view
@@ -0,0 +1,7 @@+module Numeric.Semigroup.Multiplicative+  ( Multiplicative(..)+  , pow1pIntegral+  , product1+  ) where++import Numeric.Semiring.Internal
+ Numeric/Semiring.hs view
@@ -0,0 +1,9 @@+module Numeric.Semiring+  ( module Numeric.Semiring.Class+  , module Numeric.Semiring.Integral+  , module Numeric.Semiring.Involutive+  ) where++import Numeric.Semiring.Class+import Numeric.Semiring.Integral+import Numeric.Semiring.Involutive
+ Numeric/Semiring/Class.hs view
@@ -0,0 +1,5 @@+module Numeric.Semiring.Class+  ( Semiring+  ) where++import Numeric.Semiring.Internal
+ Numeric/Semiring/Integral.hs view
@@ -0,0 +1,14 @@+module Numeric.Semiring.Integral +  ( IntegralSemiring+  ) where++import Numeric.Semiring.Class+import Numeric.Monoid.Additive+import Numeric.Natural.Internal++-- a * b = 0 implies a == 0 || b == 0+class (AdditiveMonoid r, Semiring r) => IntegralSemiring r++instance IntegralSemiring Integer+instance IntegralSemiring Natural+instance IntegralSemiring Bool
+ Numeric/Semiring/Internal.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+-- This package is an unfortunate ball of mud forced on me by mutual dependencies+module Numeric.Semiring.Internal+  ( +  -- * Multiplicative Semigroups+    Multiplicative(..)+  , pow1pIntegral+  , product1+  -- * Semirings+  , Semiring+  -- * Associative algebras of free semigroups over semirings+  , FreeAlgebra(..)+  ) where++import Data.Foldable hiding (sum, concat)+import Data.Semigroup.Foldable+import Data.Int+import Data.Word+import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)+import qualified Prelude+import Numeric.Natural.Internal+import Numeric.Semigroup.Additive+import Numeric.Addition.Abelian++infixr 8 `pow1p`+infixl 7 *++-- | A multiplicative semigroup+class Multiplicative r where+  (*) :: r -> r -> r ++  -- pow1p x n = pow x (1 + n)+  pow1p :: Whole n => r -> n -> r+  pow1p x0 y0 = f x0 (y0 Prelude.+ 1) where+    f x y +      | even y = f (x * x) (y `quot` 2)+      | y == 1 = x+      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) x+    g x y z +      | even y = g (x * x) (y `quot` 2) z+      | y == 1 = x * z+      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) (x * z)++  productWith1 :: Foldable1 f => (a -> r) -> f a -> r+  productWith1 f = maybe (error "Numeric.Multiplicative.Semigroup.productWith1: empty structure") id . foldl' mf Nothing+    where +      mf Nothing y = Just $! f y+      mf (Just x) y = Just $! x * f y++product1 :: (Foldable1 f, Multiplicative r) => f r -> r+product1 = productWith1 id++pow1pIntegral :: (Integral r, Integral n) => r -> n -> r+pow1pIntegral r n = r ^ (1 Prelude.+ n)++instance Multiplicative Bool where+  (*) = (&&)+  pow1p m _ = m++instance Multiplicative Natural where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Integer where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int8 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int16 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int32 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Int64 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word8 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word16 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word32 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative Word64 where+  (*) = (Prelude.*)+  pow1p = pow1pIntegral++instance Multiplicative () where+  _ * _ = ()+  pow1p _ _ = ()++instance (Multiplicative a, Multiplicative b) => Multiplicative (a,b) where+  (a,b) * (c,d) = (a * c, b * d)++instance (Multiplicative a, Multiplicative b, Multiplicative c) => Multiplicative (a,b,c) where+  (a,b,c) * (i,j,k) = (a * i, b * j, c * k)++instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d) => Multiplicative (a,b,c,d) where+  (a,b,c,d) * (i,j,k,l) = (a * i, b * j, c * k, d * l)++instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d, Multiplicative e) => Multiplicative (a,b,c,d,e) where+  (a,b,c,d,e) * (i,j,k,l,m) = (a * i, b * j, c * k, d * l, e * m)++-- | A pair of an additive abelian semigroup, and a multiplicative semigroup, with the distributive laws:+-- +-- > a(b + c) = ab + ac+-- > (a + b)c = ac + bc+--+-- Common notation includes the laws for additive and multiplicative identity in semiring.+--+-- If you want that, look at 'Rig' instead.+--+-- Ideally we'd use the cyclic definition:+--+-- > class (LeftModule r r, RightModule r r, Additive r, Abelian r, Multiplicative r) => Semiring r+--+-- to enforce that every semiring r is an r-module over itself, but Haskell doesn't like that.+class (Additive r, Abelian r, Multiplicative r) => Semiring r++instance Semiring Integer+instance Semiring Natural+instance Semiring Bool+instance Semiring Int+instance Semiring Int8+instance Semiring Int16+instance Semiring Int32+instance Semiring Int64+instance Semiring Word+instance Semiring Word8+instance Semiring Word16+instance Semiring Word32+instance Semiring Word64+instance Semiring ()+instance (Semiring a, Semiring b) => Semiring (a, b)+instance (Semiring a, Semiring b, Semiring c) => Semiring (a, b, c)+instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a, b, c, d)+instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a, b, c, d, e)++-- | An associative algebra built with a free module over a semiring+class Semiring r => FreeAlgebra r a where+  join :: (a -> a -> r) -> a -> r++instance FreeAlgebra r a => Multiplicative (a -> r) where+  f * g = join $ \a b -> f a * g b++instance FreeAlgebra r a => Semiring (a -> r) ++  +instance FreeAlgebra () a where+  join _ _ = ()++-- TODO: check this+instance (FreeAlgebra r b, FreeAlgebra r a) => FreeAlgebra (b -> r) a where+  join f a b = join (\a1 a2 -> f a1 a2 b) a++instance (FreeAlgebra r a, FreeAlgebra r b) => FreeAlgebra r (a,b) where+  join f (a,b) = join (\a1 a2 -> join (\b1 b2 -> f (a1,b1) (a2,b2)) b) a++instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c) => FreeAlgebra r (a,b,c) where+  join f (a,b,c) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> f (a1,b1,c1) (a2,b2,c2)) c) b) a++instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c, FreeAlgebra r d) => FreeAlgebra r (a,b,c,d) where+  join f (a,b,c,d) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> join (\d1 d2 -> f (a1,b1,c1,d1) (a2,b2,c2,d2)) d) c) b) a++instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c, FreeAlgebra r d, FreeAlgebra r e) => FreeAlgebra r (a,b,c,d,e) where+  join f (a,b,c,d,e) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> join (\d1 d2 -> join (\e1 e2 -> f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2)) e) d) c) b) a
+ Numeric/Semiring/Involutive.hs view
@@ -0,0 +1,32 @@+module Numeric.Semiring.Involutive+  ( Involutive +  ) where++import Data.Int+import Data.Word+import Numeric.Natural+import Numeric.Multiplication.Involutive+import Numeric.Rig.Class++-- | adjoint (x + y) = adjoint x + adjoint y+class (Rig r, InvolutiveMultiplication r) => Involutive r++instance Involutive Integer+instance Involutive Int+instance Involutive Int8+instance Involutive Int16+instance Involutive Int32+instance Involutive Int64++instance Involutive Natural+instance Involutive Word+instance Involutive Word8+instance Involutive Word16+instance Involutive Word32+instance Involutive Word64++instance Involutive ()+instance (Involutive a, Involutive b) => Involutive (a, b)+instance (Involutive a, Involutive b, Involutive c) => Involutive (a, b, c)+instance (Involutive a, Involutive b, Involutive c, Involutive d) => Involutive (a, b, c, d)+instance (Involutive a, Involutive b, Involutive c, Involutive d, Involutive e) => Involutive (a, b, c, d, e)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs 
@@ -1,4 +0,0 @@-#!/usr/bin/env runghc--> import Distribution.Simple-> main = defaultMain
algebra.cabal view
@@ -1,23 +1,91 @@-Name:          algebra-Version:       0.0.0.1-Cabal-Version: >= 1.2-Build-Type:    Simple-License:       BSD3-License-File:  LICENSE-Copyright:     © 2009 Wolfgang Jeltsch-Author:        Wolfgang Jeltsch-Maintainer:    jeltsch@informatik.tu-cottbus.de-Stability:     provisional-Homepage:      http://community.haskell.org/~jeltsch/algebra/-Package-URL:   http://hackage.haskell.org/packages/archive/algebra/0.0.0.0/algebra-0.0.0.0.tar.gz-Synopsis:      Algebraic structures-Description:   This package provides common algebraic structures in the form of type classes. In the-               future, there might be other things than type classes in this package. Currently,-               there is only the class of semigroups.-Category:      Data-Tested-With:   GHC == 6.10.1+name:          algebra+category:      Math, Algebra+version:       0.1.0+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     experimental+homepage:      http://github.com/ekmett/algebra/+copyright:     Copyright (C) 2011 Edward A. Kmett+synopsis:      Constructive abstract algebra+description:   Constructive abstract algebra+build-type:    Simple -Library-    Build-Depends:   base       >= 3.0 && < 4.1-    Exposed-Modules: Data.Semigroup-    HS-Source-Dirs:  src+source-repository head+  type: git+  location: git://github.com/ekmett/algebra.git++library+  build-depends: +    base >= 4 && < 4.4,+    transformers >= 0.2.0 && < 0.3,+    tagged >= 0.2.2 && < 0.3,+    categories >= 0.57.0 && < 0.58,+    containers >= 0.3.0.0 && < 0.5,+    mtl >= 2.0 && < 2.1,+    semigroups >= 0.5 && < 0.6,+    semigroupoids >= 1.2.2 && < 1.3,+    representable-tries >= 1.8 && < 1.9++  exposed-modules:+    Numeric.Addition+    Numeric.Addition.Abelian+    Numeric.Addition.Partitionable+    Numeric.Addition.Idempotent+    Numeric.Algebra.Free.Class+    Numeric.Algebra.Free.Unital+    Numeric.Algebra.Free.Hopf+    Numeric.Band+    Numeric.Band.Rectangular+    Numeric.Band.Class+    Numeric.Decidable.Zero+    Numeric.Decidable.Units+    Numeric.Decidable.Associates+    Numeric.Exp+    Numeric.Functional.Linear+    Numeric.Functional.Antilinear+    Numeric.Group+    Numeric.Group.Additive+    Numeric.Group.Multiplicative+    Numeric.Module+    Numeric.Monoid+    Numeric.Monoid.Additive+    Numeric.Monoid.Multiplicative+    Numeric.Log+    Numeric.Multiplication+    Numeric.Multiplication.Commutative+    Numeric.Multiplication.Involutive+    Numeric.Multiplication.Factorable+    Numeric.Map.Linear+    Numeric.Natural+    Numeric.Natural.Internal+    Numeric.Order+    Numeric.Order.Additive+    Numeric.Order.Class+    Numeric.Rig+    Numeric.Rig.Class+    Numeric.Rig.Ordered+    Numeric.Rig.Characteristic+    Numeric.Rng+    Numeric.Rng.Class+    Numeric.Rng.Zero+    Numeric.Ring+    Numeric.Ring.Class+    Numeric.Ring.Rng+    Numeric.Ring.Opposite+    Numeric.Ring.Endomorphism+    Numeric.Semigroup+    Numeric.Semigroup.Additive+    Numeric.Semigroup.Multiplicative+    Numeric.Semiring+    Numeric.Semiring.Class+    Numeric.Semiring.Integral+    Numeric.Semiring.Involutive++  other-modules:+    Numeric.Semiring.Internal+    Numeric.Monoid.Multiplicative.Internal++  ghc-options: -Wall
− src/Data/Semigroup.hs 
@@ -1,16 +0,0 @@-{-|-    This module provides the class of semigroups.--    A semigroup has a single binary operation which is associative.--}-module Data.Semigroup (--    Semigroup (append)--) where--    -- |The class of semigroups.-    class Semigroup semigroup where--        -- |An associative operation.-        append :: semigroup -> semigroup -> semigroup