algebra 0.7.1 → 0.8.0

raw patch · 11 files changed

+557/−5 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Numeric/Algebra.hs +2/−0
• Numeric/Algebra/Incidence.hs +36/−0
• Numeric/Coalgebra/Categorical.hs +23/−0
• Numeric/Coalgebra/Geometric.hs +1/−0
• Numeric/Natural/Internal.hs +22/−3
• Numeric/Order/Class.hs +3/−0
• Numeric/Order/LocallyFinite.hs +227/−0
• Numeric/Partial/Group.hs +88/−0
• Numeric/Partial/Monoid.hs +68/−0
• Numeric/Partial/Semigroup.hs +80/−0
• algebra.cabal +7/−2

@@ -96,6 +96,7 @@   , Order(..)   , OrderedRig   , AdditiveOrder+  , LocallyFiniteOrder    , DecidableZero   , DecidableUnits@@ -157,6 +158,7 @@ import Numeric.Natural.Internal import Numeric.Order.Class import Numeric.Order.Additive+import Numeric.Order.LocallyFinite import Numeric.Quadrance.Class import Numeric.Rig.Class import Numeric.Rig.Characteristic

@@ -0,0 +1,36 @@+{-# LANGUAGE MultiParamTypeClasses+           , FlexibleInstances+           , UndecidableInstances+           , DeriveDataTypeable+           #-}++module Numeric.Algebra.Incidence+  ( Interval(..)+  , zeta+  , moebius+  ) where++import Data.Data+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Algebra.Commutative+import Numeric.Ring.Class+import Numeric.Order.Class+import Numeric.Order.LocallyFinite++-- the basis for an incidence algebra+data Interval a = Interval a a deriving (Eq,Ord,Show,Read,Data,Typeable)++instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => Algebra r (Interval a) where+  mult f (Interval a c) = sumWith (\b -> f (Interval a b) (Interval b c)) $ range a c+  +instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => UnitalAlgebra r (Interval a) where+  unit r (Interval a b) +    | a ~~ b = r+    | otherwise = zero++zeta :: Unital r => Interval a -> r+zeta = const one++moebius :: (Ring r, LocallyFiniteOrder a) => Interval a -> r+moebius (Interval a b) = moebiusInversion a b

@@ -0,0 +1,23 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+module Numeric.Coalgebra.Categorical +  ( Morphism(..)+  ) where++import Data.Data+import Numeric.Partial.Semigroup+import Numeric.Partial.Monoid+import Numeric.Partial.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Algebra.Commutative++-- the dual categorical algebra+newtype Morphism a = Morphism a deriving (Eq,Ord,Show,Read,PartialSemigroup,PartialMonoid,PartialGroup,Data,Typeable)++instance (Commutative r, Monoidal r, Semiring r, PartialSemigroup a) => Coalgebra r (Morphism a) where+  comult f a b +    | Just c <- padd a b = f c+    | otherwise = zero++instance (Commutative r, Monoidal r, Semiring r, PartialMonoid a) => CounitalCoalgebra r (Morphism a) where+  counit f = f pzero

@@ -17,6 +17,7 @@   -- * Operations over an eigenbasis   , Eigenbasis(..)   , Eigenmetric(..)+  , Euclidean(..)   -- * Grade   , grade   , filterGrade

@@ -3,12 +3,12 @@   , Whole(..)   ) where -{-# OPTIONS_HADDOCK hide #-}- import Data.Word+import Data.Bits import Text.Read+import Data.Ix -newtype Natural = Natural { runNatural :: Integer } deriving (Eq,Ord)+newtype Natural = Natural { runNatural :: Integer } deriving (Eq,Ord,Ix)  instance Show Natural where   showsPrec d (Natural n) = showsPrec d n@@ -27,6 +27,25 @@   fromInteger n      | n >= 0 = Natural n     | otherwise = error "Natural.fromInteger: negative"++instance Bits Natural where+  Natural n .&. Natural m = Natural (n .&. m)+  Natural n .|. Natural m = Natural (n .|. m)+  xor (Natural n) (Natural m) = Natural (xor n m)+  complement _ = error "Bits.complement: Natural complement undefined"+  shift (Natural n) = Natural . shift n+  rotate (Natural n) = Natural . rotate n+  bit = Natural . bit+  setBit (Natural n) = Natural . setBit n+  clearBit (Natural n) = Natural . clearBit n+  complementBit (Natural n) = Natural . complementBit n+  testBit = testBit . runNatural +  bitSize = bitSize . runNatural+  isSigned _ = False+  shiftL (Natural n) = Natural . shiftL n+  shiftR (Natural n) = Natural . shiftR n+  rotateL (Natural n) = Natural . rotateL n+  rotateR (Natural n) = Natural . rotateR n  instance Real Natural where   toRational (Natural a) = toRational a

@@ -5,6 +5,7 @@  import Data.Int import Data.Word+import Data.Set import Numeric.Natural.Internal  -- a partial order (a, <=)@@ -55,6 +56,8 @@ instance Order Word16 where order = orderOrd instance Order Word32 where order = orderOrd instance Order Word64 where order = orderOrd+instance Ord a => Order (Set a) where+  (<~) = isSubsetOf  instance Order () where    order _ _ = Just EQ

@@ -0,0 +1,227 @@+module Numeric.Order.LocallyFinite +  ( LocallyFiniteOrder(..)+  ) where++import Control.Applicative+import Numeric.Additive.Class+import Numeric.Additive.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Order.Class+import Numeric.Natural.Internal+import Numeric.Rig.Class+import Numeric.Ring.Class+import Data.Int+import Data.Bits+import Data.Word+import Data.Set (Set)+import qualified Data.Set as Set+import qualified Data.Ix as Ix+import Prelude hiding ((*),(+),fromIntegral,(<),negate,(-))++class Order a => LocallyFiniteOrder a where+  range :: a -> a -> [a]+  rangeSize :: a -> a -> Natural++  -- moebiusInversion inversion+  moebiusInversion :: Ring r => a -> a -> r+  moebiusInversion x y = case order x y of+    Just EQ -> one+    Just LT -> sumWith (\z -> if z < y then moebiusInversion x z else zero) $ range x y+    _  -> zero ++instance LocallyFiniteOrder Natural where+  range = curry Ix.range+  rangeSize a b +    | a <= b = Natural (runNatural b - runNatural a + 1)+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | unsafePred y == x -> negate one +     _ -> zero++instance LocallyFiniteOrder Integer where+  range = curry Ix.range+  rangeSize a b +    | a <= b = Natural (b - a + 1)+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance Ord a => LocallyFiniteOrder (Set a) where+  range a b +    | Set.isSubsetOf a b = go a $ Set.toList $ Set.difference b a+    | otherwise = []+    where +      go _ [] = []+      go s (x:xs) = do+        s' <- [s, Set.insert x s]+        go s' xs+  rangeSize a b +    | Set.isSubsetOf a b = fromNatural $ shiftL 1 $ Set.size b - Set.size a+    | otherwise = zero+  moebiusInversion a b +    | Set.isSubsetOf a b = +      if (Set.size b - Set.size a) .&. 1 == 0 +      then one +      else negate one+    | otherwise          = zero++instance LocallyFiniteOrder Bool where+  range False False = [False]+  range False True  = [False, True]+  range True  False = []+  range True  True  = [True]+  rangeSize False False = 1+  rangeSize False True  = 2+  rangeSize True  False = 0 +  rangeSize True  True  = 1+  moebiusInversion False False = one+  moebiusInversion False True  = negate one +  moebiusInversion True  False = zero+  moebiusInversion True  True  = one+++instance LocallyFiniteOrder Int where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Int8 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Int16 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Int32 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Int64 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word8 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word16 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word32 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder Word64 where+  range = curry Ix.range+  rangeSize a b+    | a <= b = Natural $ fromIntegral $ b - a + 1+    | otherwise = 0+  moebiusInversion x y = case compare x y of+     EQ -> one+     LT | y - 1 == x -> negate one +     _  -> zero++instance LocallyFiniteOrder () where+  range _ _ = [()]+  rangeSize _ _ = 1+  moebiusInversion _ _ = one++instance ( LocallyFiniteOrder a+         , LocallyFiniteOrder b+         ) => LocallyFiniteOrder (a,b) where+  range (a,b) (i,j) = (,) <$> range a i <*> range b j+  rangeSize (a,b) (i,j) = rangeSize a i * rangeSize b j+  -- TODO: check this against the default definition above+  moebiusInversion (a,b) (i,j) = moebiusInversion a i * moebiusInversion b j++instance ( LocallyFiniteOrder a+         , LocallyFiniteOrder b+         , LocallyFiniteOrder c+         ) => LocallyFiniteOrder (a,b,c) where+  range (a,b,c) (i,j,k) = (,,) <$> range  a i <*> range b j <*> range c k+  rangeSize (a,b,c) (i,j,k) = rangeSize a i * rangeSize b j * rangeSize c k+  moebiusInversion (a,b,c) (i,j,k) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k+++instance ( LocallyFiniteOrder a+         , LocallyFiniteOrder b+         , LocallyFiniteOrder c+         , LocallyFiniteOrder d+         ) => LocallyFiniteOrder (a,b,c,d) where+  range (a,b,c,d) (i,j,k,l) = (,,,) <$> range  a i <*> range b j <*> range c k <*> range d l+  rangeSize (a,b,c,d) (i,j,k,l) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l+  moebiusInversion (a,b,c,d) (i,j,k,l) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l++instance ( LocallyFiniteOrder a+         , LocallyFiniteOrder b+         , LocallyFiniteOrder c+         , LocallyFiniteOrder d+         , LocallyFiniteOrder e+         ) => LocallyFiniteOrder (a, b, c, d, e) where+  range (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> range  a i <*> range b j <*> range c k <*> range d l <*> range e m+  rangeSize (a,b,c,d,e) (i,j,k,l,m) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l * rangeSize e m+  moebiusInversion (a,b,c,d,e) (i,j,k,l,m) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l * moebiusInversion e m+

@@ -0,0 +1,88 @@+module Numeric.Partial.Group+  ( PartialGroup(..)+  ) where++import Control.Applicative+import Data.Int+import Data.Word+import Numeric.Partial.Semigroup+import Numeric.Partial.Monoid+import Numeric.Natural++class PartialMonoid a => PartialGroup a where+  pnegate :: a -> Maybe a+  pnegate = pminus pzero++  pminus :: a -> a -> Maybe a+  pminus a b = padd a =<< pnegate b ++  psubtract :: a -> a -> Maybe a+  psubtract a b = pnegate a >>= (`padd` b)++instance PartialGroup Int where+  pnegate = Just . negate++instance PartialGroup Integer where+  pnegate = Just . negate++instance PartialGroup Int8 where+  pnegate = Just . negate++instance PartialGroup Int16 where+  pnegate = Just . negate++instance PartialGroup Int32 where+  pnegate = Just . negate++instance PartialGroup Int64 where+  pnegate = Just . negate++instance PartialGroup Word where+  pnegate = Just . negate++instance PartialGroup Word8 where+  pnegate = Just . negate++instance PartialGroup Word16 where+  pnegate = Just . negate++instance PartialGroup Word32 where+  pnegate = Just . negate++instance PartialGroup Word64 where+  pnegate = Just . negate++instance PartialGroup Natural where+  pnegate 0 = Just 0+  pnegate _ = Nothing+  pminus a b +    | a < b = Nothing+    | otherwise = Just (a - b)+  psubtract a b +    | a > b = Nothing+    | otherwise = Just (b - a)++instance PartialGroup () where+  pnegate _ = Just () +  pminus _ _ = Just ()+  psubtract _ _ = Just ()++instance (PartialGroup a, PartialGroup b) => PartialGroup (a, b) where+  pnegate (a, b) = (,) <$> pnegate a <*> pnegate b+  pminus (a, b) (i, j) = (,) <$> pminus a i <*> pminus b j+  psubtract (a, b) (i, j) = (,) <$> psubtract a i <*> psubtract b j++instance (PartialGroup a, PartialGroup b, PartialGroup c) => PartialGroup (a, b, c) where+  pnegate (a, b, c) = (,,) <$> pnegate a <*> pnegate b <*> pnegate c+  pminus (a, b, c) (i, j, k) = (,,) <$> pminus a i <*> pminus b j <*> pminus c k+  psubtract (a, b, c) (i, j, k) = (,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k++instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d) => PartialGroup (a, b, c, d) where+  pnegate (a, b, c, d) = (,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d+  pminus (a, b, c, d) (i, j, k, l) = (,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l+  psubtract (a, b, c, d) (i, j, k, l) = (,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l++instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d, PartialGroup e) => PartialGroup (a, b, c, d, e) where+  pnegate (a, b, c, d, e) = (,,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d <*> pnegate e+  pminus (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l <*> pminus e m+  psubtract (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l <*> psubtract e m

@@ -0,0 +1,68 @@+module Numeric.Partial.Monoid+  ( PartialMonoid(..)+  ) where++import Numeric.Partial.Semigroup+import Data.Int+import Data.Word+import Numeric.Natural.Internal++class PartialSemigroup a => PartialMonoid a where+  pzero :: a++instance PartialMonoid Bool where+  pzero = False++instance PartialMonoid Int where+  pzero = 0++instance PartialMonoid Integer where+  pzero = 0++instance PartialMonoid Natural where+  pzero = 0++instance PartialMonoid Int8 where+  pzero = 0++instance PartialMonoid Int16 where+  pzero = 0++instance PartialMonoid Int32 where+  pzero = 0++instance PartialMonoid Int64 where+  pzero = 0++instance PartialMonoid Word where+  pzero = 0++instance PartialMonoid Word8 where+  pzero = 0++instance PartialMonoid Word16 where+  pzero = 0++instance PartialMonoid Word32 where+  pzero = 0++instance PartialMonoid Word64 where+  pzero = 0++instance PartialMonoid () where+  pzero = () ++instance PartialSemigroup a => PartialMonoid (Maybe a) where+  pzero = Nothing++instance (PartialMonoid a, PartialMonoid b) => PartialMonoid (a, b) where+  pzero = (pzero, pzero)++instance (PartialMonoid a, PartialMonoid b, PartialMonoid c) => PartialMonoid (a, b, c) where+  pzero = (pzero, pzero, pzero)++instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d) => PartialMonoid (a, b, c, d) where+  pzero = (pzero, pzero, pzero, pzero)++instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d, PartialMonoid e) => PartialMonoid (a, b, c, d, e) where+  pzero = (pzero, pzero, pzero, pzero, pzero)

@@ -0,0 +1,80 @@+module Numeric.Partial.Semigroup+  ( PartialSemigroup(..)+  ) where++import Control.Applicative+import Data.Word+import Data.Int+import Numeric.Natural.Internal++class PartialSemigroup a where+  padd :: a -> a -> Maybe a++paddNum :: Num a => a -> a -> Maybe a+paddNum a b = Just (a + b)+++instance PartialSemigroup Int where+  padd = paddNum++instance PartialSemigroup Integer where+  padd = paddNum++instance PartialSemigroup Natural where+  padd = paddNum++instance PartialSemigroup Int8 where+  padd = paddNum++instance PartialSemigroup Int16 where+  padd = paddNum++instance PartialSemigroup Int32 where+  padd = paddNum++instance PartialSemigroup Int64 where+  padd = paddNum++instance PartialSemigroup Word where+  padd = paddNum++instance PartialSemigroup Word8 where+  padd = paddNum++instance PartialSemigroup Word16 where+  padd = paddNum++instance PartialSemigroup Word32 where+  padd = paddNum++instance PartialSemigroup Word64 where+  padd = paddNum++instance PartialSemigroup a => PartialSemigroup (Maybe a) where+  padd ma mb = Just $ do+   a <- ma+   b <- mb+   padd a b++instance PartialSemigroup Bool where+  padd a b = Just (a || b)++instance PartialSemigroup () where+  padd _ _ = Just ()++instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (a, b) where+  padd (a,b) (i,j) = (,) <$> padd a i <*> padd b j++instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c) => PartialSemigroup (a, b, c) where+  padd (a,b,c) (i,j,k) = (,,) <$> padd a i <*> padd b j <*> padd c k++instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d) => PartialSemigroup (a, b, c, d) where+  padd (a,b,c,d) (i,j,k,l) = (,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l++instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d, PartialSemigroup e) => PartialSemigroup (a, b, c, d, e) where+  padd (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l <*> padd e m++instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (Either a b) where+  padd (Left a) (Left b) = Left <$> padd a b+  padd (Right a) (Right b) = Right <$> padd a b+  padd _ _ = Nothing

@@ -1,6 +1,6 @@ name:          algebra category:      Math, Algebra-version:       0.7.1+version:       0.8.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -47,6 +47,7 @@     Numeric.Algebra.Quaternion     Numeric.Algebra.Quaternion.Class     Numeric.Algebra.Hyperbolic+    Numeric.Algebra.Incidence     Numeric.Coalgebra.Dual     Numeric.Coalgebra.Hyperbolic     Numeric.Coalgebra.Hyperbolic.Class@@ -54,6 +55,7 @@     Numeric.Coalgebra.Trigonometric.Class     Numeric.Coalgebra.Geometric     Numeric.Coalgebra.Quaternion+    Numeric.Coalgebra.Categorical     Numeric.Band.Rectangular     Numeric.Exp     Numeric.Log@@ -63,7 +65,9 @@     Numeric.Ring.Rng     Numeric.Ring.Opposite     Numeric.Ring.Endomorphism-+    Numeric.Partial.Semigroup+    Numeric.Partial.Monoid+    Numeric.Partial.Group     Numeric.Additive.Class     Numeric.Additive.Group     Numeric.Algebra.Class@@ -93,5 +97,6 @@     Numeric.Rig.Characteristic     Numeric.Order.Class     Numeric.Order.Additive+    Numeric.Order.LocallyFinite    ghc-options: -Wall