algebra 4.0 → 4.1

raw patch · 5 files changed

+263/−1 lines, 5 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +9/−0
• algebra.cabal +4/−1
• src/Numeric/Domain/Class.hs +8/−0
• src/Numeric/Domain/Euclidean.hs +117/−0
• src/Numeric/Field/Fraction.hs +125/−0

@@ -1,3 +1,12 @@+4.1+---+* Added Euclidean domains and the field of fractions.++4.0+---+* Compatibility with GHC 7.8.x+* Removed `keyed` and `representable-tries` dependencies+ 3.0.2 ----- * Started CHANGELOG

@@ -1,6 +1,6 @@ name:          algebra category:      Math, Algebra-version:       4.0+version:       4.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -93,8 +93,11 @@     Numeric.Decidable.Units     Numeric.Decidable.Zero     Numeric.Dioid.Class+    Numeric.Domain.Class+    Numeric.Domain.Euclidean     Numeric.Exp     Numeric.Field.Class+    Numeric.Field.Fraction     Numeric.Log     Numeric.Map     Numeric.Module.Class

@@ -0,0 +1,8 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module Numeric.Domain.Class where+import Numeric.Ring.Class+import Numeric.Semiring.Integral++-- | (Integral) domain is the integral semiring.+class (IntegralSemiring d, Ring d) => Domain d+instance (IntegralSemiring d, Ring d) => Domain d

@@ -0,0 +1,117 @@+{-# LANGUAGE CPP, ConstraintKinds, FlexibleContexts, FlexibleInstances     #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes #-}+{-# LANGUAGE RebindableSyntax, UndecidableInstances                        #-}+module Numeric.Domain.Euclidean (Euclidean(..), prs, normalize, gcd', leadingUnit, chineseRemainder) where+import Numeric.Additive.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Unital+import Numeric.Decidable.Units+import Numeric.Decidable.Zero+import Numeric.Domain.Class+import Numeric.Natural (Natural)+import Numeric.Ring.Class+import Prelude (Eq (..), Integer, Maybe (..), abs)+import Prelude (fst, otherwise)+import Prelude (signum, snd, ($), (.))+import qualified Prelude                 as P++infixl 7 `quot`, `rem`+infix  7 `divide`+class (Ring r, DecidableZero r, DecidableUnits r, Domain r) => Euclidean r where+  -- | @splitUnit r@ calculates its leading unit and normal form.+  --+  -- prop> let (u, n) = splitUnit r in r == u * n && fst (splitUnit n) == one && isUnit u+  splitUnit :: r -> (r, r)+  -- | Euclidean (degree) function on @r@.+  degree :: r -> Maybe Natural+  -- | Division algorithm. @a `divide` b@ calculates+  --   quotient and reminder of @a@ divided by @b@.+  --+  -- prop> let (q, r) = divide a p in p*q + r == a && degree r < degree q+  divide :: r                   -- ^ elements divided by+         -> r                   -- ^ divisor+         -> (r,r)               -- ^ quotient and remin+  quot :: r -> r -> r+  quot a b = fst $ a `divide` b+  {-# INLINE quot #-}++  rem :: r -> r -> r+  rem a b = snd $ a `divide` b+  {-# INLINE rem #-}++  -- | @'gcd' a b@ calculates greatest common divisor of @a@ and @b@.+  gcd :: r -> r -> r+  gcd a b = let (g,_,_):_ = euclid a b+            in g+  {-# INLINE gcd #-}++  -- | Extended euclidean algorithm.+  --+  -- prop> euclid f g == xs ==> all (\(r, s, t) -> r == f * s + g * t) xs+  euclid :: r -> r -> [(r,r,r)]+  euclid f g =+    let (ug, g') = splitUnit g+        Just t'  = recipUnit ug+        (uf, f') = splitUnit f+        Just s   = recipUnit uf+    in step [(g', 0, t'), (f', s, 0)]+    where+      step acc@((r',s',t'):(r,s,t):_)+        | isZero r' = P.tail acc+        | otherwise =+          let q         = r `quot` r'+              (ur, r'') = splitUnit $ r - q * r'+              Just u    = recipUnit ur+              s''       = (s - q * s') * u+              t''       = (t - q * t') * u+          in step ((r'', s'', t'') : acc)+      step _ = P.error "cannot happen!"+#if (__GLASGOW_HASKELL__ > 708)+  {-# MINIMAL splitUnit, degree, divide #-}+#endif++prs :: Euclidean r => r -> r -> [(r, r, r)]+prs f g = step [(g, 0, 1), (f, 1, 0)]+  where+    step acc@((r',s',t'):(r,s,t):_)+      | isZero r' = P.tail acc+      | otherwise =+        let q         = r `quot` r'+            s''       = (s - q * s')+            t''       = (t - q * t')+        in step ((r - q * r', s'', t'') : acc)+    step _ = P.error "cannot happen!"++gcd' :: Euclidean r => [r] -> r+gcd' []     = one+gcd' [x]    = leadingUnit x+gcd' [x,y]  = gcd x y+gcd' (x:xs) = gcd x (gcd' xs)++normalize :: Euclidean r => r -> r+normalize = snd . splitUnit++leadingUnit :: Euclidean r => r -> r+leadingUnit = fst . splitUnit++instance Euclidean Integer where+  splitUnit 0 = (1, 0)+  splitUnit n = (signum n, abs n)+  {-# INLINE splitUnit #-}++  degree = Just . P.fromInteger . abs+  {-# INLINE degree #-}++  divide = P.divMod+  {-# INLINE divide #-}++chineseRemainder :: Euclidean r+                 => [(r, r)] -- ^ List of @(m_i, v_i)@+                 -> r        -- ^ @f@ with @f@ = @v_i@ (mod @v_i@)+chineseRemainder mvs =+  let (ms, _) = P.unzip mvs+      m = product ms+  in sum [((vi*s) `rem` mi)*n | (mi, vi) <- mvs+                               , let n = m `quot` mi+                               , let (_, s, _) : _ = euclid n mi+                               ]

@@ -0,0 +1,125 @@+{-# LANGUAGE MultiParamTypeClasses, NoImplicitPrelude, RebindableSyntax #-}+{-# LANGUAGE ScopedTypeVariables, ViewPatterns                          #-}+module Numeric.Field.Fraction+  ( Fraction+  , numerator+  , denominator+  , Ratio+  , (%)+  , lcm+  ) where+import Data.Proxy+import Numeric.Additive.Class+import Numeric.Additive.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Commutative+import Numeric.Algebra.Division+import Numeric.Algebra.Unital+import Numeric.Decidable.Units+import Numeric.Decidable.Zero+import Numeric.Domain.Euclidean+import Numeric.Natural+import Numeric.Rig.Characteristic+import Numeric.Rig.Class+import Numeric.Ring.Class+import Numeric.Semiring.Integral+import Prelude                     hiding (Integral (..), Num (..), gcd, lcm)++-- | Fraction field @k(D)@ of 'Euclidean' domain @D@.+data Fraction d = Fraction !d !d++-- Invariants: r == Fraction p q+--         ==> leadingUnit q == one && q /= 0+--          && isUnit (gcd p q)++-- | Convenient synonym for 'Fraction'.+type Ratio = Fraction++lcm :: Euclidean r => r -> r -> r+lcm p q = p * q `quot` gcd p q++instance (Eq d, Show d, Unital d) => Show (Fraction d) where+  showsPrec d (Fraction p q)+   | q == one    = showsPrec d p+   | otherwise = showParen (d > 5) $ showsPrec 6 p . showString " / " . showsPrec 6 q++infixl 7 %+(%) :: Euclidean d => d -> d -> Fraction d+a % b = let (ua, a') = splitUnit a+            (ub, b') = splitUnit b+            Just ub' = recipUnit ub+            r = gcd a' b'+        in Fraction (ua * ub' * a' `quot` r) (b' `quot` r)++numerator :: Fraction t -> t+numerator (Fraction q _) = q+{-# INLINE numerator #-}++denominator :: Fraction t -> t+denominator (Fraction _ p) = p+{-# INLINE denominator #-}++instance Euclidean d => IntegralSemiring (Fraction d)+instance (Eq d, Multiplicative d) => Eq (Fraction d) where+  Fraction p q == Fraction s t = p*t == q*s+  {-# INLINE (==) #-}++instance (Ord d, Multiplicative d) => Ord (Fraction d)  where+  compare (Fraction p q) (Fraction p' q') = compare (p*q') (p'*q)+  {-# INLINE compare #-}++instance Euclidean d => Division (Fraction d) where+  recip (Fraction p q) | isZero p  = error "Ratio has zero denominator!"+                       | otherwise = let (recipUnit -> Just u, p') = splitUnit p+                                     in Fraction (q * u) p'+  Fraction p q / Fraction s t = (p*t) % (q*s)+  {-# INLINE recip #-}+  {-# INLINE (/) #-}++instance (Commutative d, Euclidean d) => Commutative (Fraction d)++instance Euclidean d => DecidableZero (Fraction d) where+  isZero (Fraction p _) = isZero p+  {-# INLINE isZero #-}++instance Euclidean d => DecidableUnits (Fraction d) where+  isUnit (Fraction p _) = not $ isZero p+  {-# INLINE isUnit #-}+  recipUnit (Fraction p q) | isZero p  = Nothing+                           | otherwise = Just (Fraction q p)+  {-# INLINE recipUnit #-}+instance Euclidean d => Ring (Fraction d)+instance Euclidean d => Abelian (Fraction d)+instance Euclidean d => Semiring (Fraction d)+instance Euclidean d => Group (Fraction d) where+  negate (Fraction p q) = Fraction (negate p) q+  Fraction p q - Fraction p' q' = (p*q'-p'*q) % (q*q')+instance Euclidean d => Monoidal (Fraction d) where+  zero = Fraction zero one+  {-# INLINE zero #-}+instance Euclidean d => LeftModule Integer (Fraction d) where+  n .* Fraction p r = (n .* p) % r+  {-# INLINE (.*) #-}+instance Euclidean d => RightModule Integer (Fraction d) where+  Fraction p r *. n = (p *. n) % r+  {-# INLINE (*.) #-}+instance Euclidean d => LeftModule Natural (Fraction d) where+  n .* Fraction p r = (n .* p) % r+  {-# INLINE (.*) #-}+instance Euclidean d => RightModule Natural (Fraction d) where+  Fraction p r *. n = (p *. n) % r+  {-# INLINE (*.) #-}+instance Euclidean d => Additive (Fraction d) where+  Fraction p q + Fraction s t =+    let u = gcd q t+    in Fraction (p * t `quot` u + s*q`quot`u) (q*t`quot`u)+  {-# INLINE (+) #-}+instance Euclidean d => Unital (Fraction d) where+  one = Fraction one one+  {-# INLINE one #-}+instance Euclidean d => Multiplicative (Fraction d) where+  Fraction p q * Fraction s t = (p*s) % (q*t)+instance Euclidean d => Rig (Fraction d)++instance (Characteristic d, Euclidean d) => Characteristic (Fraction d) where+  char _ = char (Proxy :: Proxy d)