algebra 4.2 → 4.3

raw patch · 21 files changed

+463/−177 lines, 21 filesdep ~basedep ~semigroupoidsdep ~transformersnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, semigroupoids, transformers

API changes (from Hackage documentation)

Files

• .travis.yml +95/−1
• CHANGELOG.markdown +7/−0
• README.markdown +1/−1
• algebra.cabal +17/−5
• src/Numeric/Algebra/Class.hs +2/−2
• src/Numeric/Algebra/Commutative.hs +13/−13
• src/Numeric/Algebra/Unital/UnitNormalForm.hs +36/−0
• src/Numeric/Decidable/Nilpotent.hs +64/−0
• src/Numeric/Decidable/Units.hs +2/−1
• src/Numeric/Domain/Class.hs +2/−6
• src/Numeric/Domain/Euclidean.hs +4/−90
• src/Numeric/Domain/GCD.hs +11/−0
• src/Numeric/Domain/Integral.hs +3/−0
• src/Numeric/Domain/Internal.hs +124/−0
• src/Numeric/Domain/PID.hs +3/−0
• src/Numeric/Domain/UFD.hs +3/−0
• src/Numeric/Field/Class.hs +4/−4
• src/Numeric/Field/Fraction.hs +56/−38
• src/Numeric/Quadrance/Class.hs +1/−1
• src/Numeric/Semiring/Integral.hs +0/−15
• src/Numeric/Semiring/ZeroProduct.hs +15/−0

@@ -1,4 +1,98 @@-language: haskell+language: c+sudo: false++cache:+  directories:+    - $HOME/.cabsnap+    - $HOME/.cabal/packages++before_cache:+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar++matrix:+  include:+    - env: CABALVER=1.24 GHCVER=7.4.2+      compiler: ": #GHC 7.4.2"+      addons: {apt: {packages: [cabal-install-1.24,ghc-7.4.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.24 GHCVER=7.6.3+      compiler: ": #GHC 7.6.3"+      addons: {apt: {packages: [cabal-install-1.24,ghc-7.6.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.8.4+      compiler: ": #GHC 7.8.4"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.22 GHCVER=7.10.3+      compiler: ": #GHC 7.10.3"+      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.24 GHCVER=8.0.1+      compiler: ": #GHC 8.0.1"+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.24 GHCVER=head+      compiler: ": #GHC head"+      addons: {apt: {packages: [cabal-install-1.24,ghc-head,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}++  allow_failures:+    - env: CABALVER=1.24 GHCVER=head++before_install:+ - unset CC+ - export HAPPYVER=1.19.5+ - export ALEXVER=3.1.4+ - export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH++install:+ - cabal --version+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];+   then+     zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >+          $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;+   fi+ - travis_retry cabal update+ - "sed -i  's/^jobs:.*$/jobs: 2/' $HOME/.cabal/config"+ - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt++# check whether current requested install-plan matches cached package-db snapshot+ - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;+   then+     echo "cabal build-cache HIT";+     rm -rfv .ghc;+     cp -a $HOME/.cabsnap/ghc $HOME/.ghc;+     cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;+   else+     echo "cabal build-cache MISS";+     rm -rf $HOME/.cabsnap;+     mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;+     cabal install --only-dependencies --enable-tests --enable-benchmarks;+     if [ "$GHCVER" = "7.10.3" ]; then cabal install Cabal-1.22.4.0; fi;+   fi++# snapshot package-db on cache miss+ - if [ ! -d $HOME/.cabsnap ];+   then+      echo "snapshotting package-db to build-cache";+      mkdir $HOME/.cabsnap;+      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;+      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;+   fi++# Here starts the actual work to be performed for the package under test;+# any command which exits with a non-zero exit code causes the build to fail.+script:+ - cabal configure --enable-tests -v2  # -v2 provides useful information for debugging+ - cabal build   # this builds all libraries and executables (including tests)+ - cabal test+ - cabal bench || true  # expected result: these will crash+ - cabal sdist || true  # tests that a source-distribution can be generated++# Check that the resulting source distribution can be built & installed.+# If there are no other `.tar.gz` files in `dist`, this can be even simpler:+# `cabal install --force-reinstalls dist/*-*.tar.gz`+ - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&+   (cd dist && cabal install --force-reinstalls "$SRC_TGZ")++ notifications:   irc:     channels:

@@ -1,3 +1,10 @@+4.3+---+* Compatibility with GHC 8.0.x+* Dropped incomplete instance for `Algebra r (Map a b)` instance+* Restructured Ring hierarchy (Thanks @dfoxfranke!)+* Added DecidableNilpotence class (Thanks @dfoxfranke!)+ 4.2 --- * Support for `nats` version 1 and `base` 4.8's version of `Numeric.Natural`. This required monomorphizing some stuff to `Natural`, but that is more accurate than the previous hack anyways.

@@ -1,7 +1,7 @@ algebra ========== -[![Build Status](https://secure.travis-ci.org/ekmett/algebra.png?branch=master)](http://travis-ci.org/ekmett/algebra)+[![Hackage](https://img.shields.io/hackage/v/algebra.svg)](https://hackage.haskell.org/package/algebra) [![Build Status](https://secure.travis-ci.org/ekmett/algebra.png?branch=master)](http://travis-ci.org/ekmett/algebra)  This is a package for exploring constructive abstract algebra in Haskell. 

@@ -1,6 +1,6 @@ name:          algebra category:      Math, Algebra-version:       4.2+version:       4.3 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -13,6 +13,8 @@ synopsis:      Constructive abstract algebra description:   Constructive abstract algebra build-type:    Simple+tested-with:   GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4,+               GHC == 7.10.3, GHC == 8.0.1 extra-source-files:   .ghci   .gitignore@@ -51,8 +53,8 @@     mtl                     >= 2.0.1   && < 2.3,     nats                    >= 0.1     && < 2,     semigroups              >= 0.9     && < 1,-    semigroupoids           >= 4       && < 5,-    transformers            >= 0.2     && < 0.5,+    semigroupoids           >= 4       && < 6,+    transformers            >= 0.2     && < 0.6,     tagged                  >= 0.4.2   && < 1,     void                    >= 0.5.5.1 && < 1 @@ -77,6 +79,7 @@     Numeric.Algebra.Quaternion     Numeric.Algebra.Quaternion.Class     Numeric.Algebra.Unital+    Numeric.Algebra.Unital.UnitNormalForm     Numeric.Band.Class     Numeric.Band.Rectangular     Numeric.Coalgebra.Categorical@@ -90,11 +93,16 @@     Numeric.Coalgebra.Trigonometric.Class     Numeric.Covector     Numeric.Decidable.Associates+    Numeric.Decidable.Nilpotent     Numeric.Decidable.Units     Numeric.Decidable.Zero     Numeric.Dioid.Class     Numeric.Domain.Class+    Numeric.Domain.GCD     Numeric.Domain.Euclidean+    Numeric.Domain.Integral+    Numeric.Domain.PID+    Numeric.Domain.UFD     Numeric.Exp     Numeric.Field.Class     Numeric.Field.Fraction@@ -120,7 +128,11 @@     Numeric.Ring.Rng     Numeric.Rng.Class     Numeric.Rng.Zero-    Numeric.Semiring.Integral+    Numeric.Semiring.ZeroProduct     Numeric.Semiring.Involutive -  ghc-options: -Wall+  other-modules: Numeric.Domain.Internal++  ghc-options: -Wall -fno-warn-unused-imports+  if impl(ghc >= 8.0.1)+     ghc-options: -Wno-redundant-constraints

@@ -215,11 +215,11 @@        Nothing -> f ls s        Just (r, rs) -> f ls s + go (IntSet.insert r ls) rs -instance (Semiring r, Monoidal r, Ord a, Partitionable b) => Algebra r (Map a b) -- where+-- instance (Semiring r, Monoidal r, Ord a, Partitionable b) => Algebra r (Map a b) -- where --  mult f xs = case minViewWithKey xs of --    Nothing -> zero  --    Just ((k, r), rs) -> ...-instance (Semiring r, Monoidal r, Partitionable a) => Algebra r (IntMap a)+-- instance (Semiring r, Monoidal r, Partitionable a) => Algebra r (IntMap a)  instance (Algebra r a, Algebra r b) => Algebra r (a,b) where   mult f (a,b) = mult (\a1 a2 -> mult (\b1 b2 -> f (a1,b1) (a2,b2)) b) a

@@ -99,20 +99,20 @@          , Semiring r          ) => CommutativeAlgebra r IntSet -instance (Commutative r-         , Monoidal r-         , Semiring r-         , Ord a-         , Abelian b-         , Partitionable b-         ) => CommutativeAlgebra r (Map a b)+-- instance (Commutative r+--          , Monoidal r+--          , Semiring r+--          , Ord a+--          , Abelian b+--          , Partitionable b+--          ) => CommutativeAlgebra r (Map a b) -instance ( Commutative r-         , Monoidal r-         , Semiring r-         , Abelian b-         , Partitionable b-         ) => CommutativeAlgebra r (IntMap b)+-- instance ( Commutative r+--          , Monoidal r+--          , Semiring r+--          , Abelian b+--          , Partitionable b+--          ) => CommutativeAlgebra r (IntMap b)   

@@ -0,0 +1,36 @@+{-# LANGUAGE DefaultSignatures #-}+module Numeric.Algebra.Unital.UnitNormalForm +    (UnitNormalForm(..), normalize, leadingUnit) where++import Numeric.Algebra.Class+import Numeric.Algebra.Division+import Numeric.Algebra.Unital+import Numeric.Decidable.Units+import Numeric.Decidable.Associates+import Numeric.Decidable.Zero+import Numeric.Semiring.ZeroProduct+import Prelude(Integer,signum,abs,fst,snd,(.), otherwise)++class (DecidableUnits r, DecidableAssociates r) => UnitNormalForm r where+    -- prop> let (u,n) = splitUnit r+    --           (u',n') = splitUnit r' in+    --           isUnit u && isUnit u' &&+    --           u*n = r && u'*n' = r' &&+    --           (isAssociate r r' ==> n = n') &&+    --           splitUnit (r * r') = (u * u', n * n')+    splitUnit :: r -> (r,r)+    default splitUnit :: (Division r, ZeroProductSemiring r, DecidableZero r) => r -> (r,r)+    splitUnit x | isZero x = (one,zero)+                | otherwise = (x,one)++instance UnitNormalForm Integer where+  splitUnit 0 = (1, 0)+  splitUnit n = (signum n, abs n)+  {-# INLINE splitUnit #-}++normalize :: UnitNormalForm r => r -> r+normalize = snd . splitUnit++leadingUnit :: UnitNormalForm r => r -> r+leadingUnit = fst . splitUnit+

@@ -0,0 +1,64 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Numeric.Decidable.Nilpotent (DecidableNilpotent(..)) where++import Data.Bits(Bits(..))+import Data.Int(Int8,Int16,Int32,Int64)+import Data.Word(Word8,Word16,Word32,Word64)+import Numeric.Algebra+import Numeric.Decidable.Zero+import Prelude hiding (Num(..), Ord(..))++-- | An element @x@ is nilpotent if there exists @n@ s.t. @pow1p x n@ is zero.+class (Monoidal r, Multiplicative r) => DecidableNilpotent r where+    isNilpotent :: r -> Bool++instance DecidableNilpotent () where+    isNilpotent _ = True++instance DecidableNilpotent Bool where+    isNilpotent = isZero+instance DecidableNilpotent Natural where+    isNilpotent = isZero+instance DecidableNilpotent Integer where+    isNilpotent = isZero++instance DecidableNilpotent Int where+    isNilpotent = signedBitsNilpotent+instance DecidableNilpotent Int8 where+    isNilpotent = signedBitsNilpotent+instance DecidableNilpotent Int16 where+    isNilpotent = signedBitsNilpotent+instance DecidableNilpotent Int32 where+    isNilpotent = signedBitsNilpotent+instance DecidableNilpotent Int64 where+    isNilpotent = signedBitsNilpotent+instance DecidableNilpotent Word8 where+    isNilpotent = unsignedBitsNilpotent+instance DecidableNilpotent Word16 where+    isNilpotent = unsignedBitsNilpotent+instance DecidableNilpotent Word32 where+    isNilpotent = unsignedBitsNilpotent+instance DecidableNilpotent Word64 where+    isNilpotent = unsignedBitsNilpotent++instance (DecidableNilpotent a, DecidableNilpotent b) => DecidableNilpotent (a,b) where+    isNilpotent (a,b) = isNilpotent a && isNilpotent b++instance (DecidableNilpotent a, DecidableNilpotent b, DecidableNilpotent c) => DecidableNilpotent (a,b,c) where+    isNilpotent (a,b,c) = isNilpotent a && isNilpotent b && isNilpotent c++instance (DecidableNilpotent a, DecidableNilpotent b, DecidableNilpotent c, DecidableNilpotent d) => DecidableNilpotent (a,b,c,d) where+    isNilpotent (a,b,c,d) = isNilpotent a && isNilpotent b && isNilpotent c && isNilpotent d++instance (DecidableNilpotent a, DecidableNilpotent b, DecidableNilpotent c, DecidableNilpotent d, DecidableNilpotent e) => DecidableNilpotent (a,b,c,d,e) where+    isNilpotent (a,b,c,d,e) = isNilpotent a && isNilpotent b && isNilpotent c && isNilpotent d && isNilpotent e++unsignedBitsNilpotent :: (Bits r, Group r, Unital r) => r -> Bool+unsignedBitsNilpotent b = (b /= one) && b .&. (b - one) == zero++signedBitsNilpotent :: (Bits r, Group r, Order r, Bounded r, Unital r) => r -> Bool+signedBitsNilpotent b | zero <~ b = unsignedBitsNilpotent b+                      | otherwise = b == minBound ||+                                    unsignedBitsNilpotent (negate b)+

@@ -1,3 +1,4 @@+{-# LANGUAGE ConstrainedClassMethods #-} module Numeric.Decidable.Units    ( DecidableUnits(..)   , recipUnitIntegral@@ -16,7 +17,7 @@ class Unital r => DecidableUnits r where   recipUnit :: r -> Maybe r -  isUnit :: DecidableUnits r => r -> Bool+  isUnit :: r -> Bool   isUnit = isJust . recipUnit    (^?) :: Integral n => r -> n -> Maybe r

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

@@ -1,77 +1,14 @@-{-# LANGUAGE CPP, ConstraintKinds, FlexibleContexts, FlexibleInstances     #-}-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes #-}-{-# LANGUAGE RebindableSyntax, UndecidableInstances                        #-}-module Numeric.Domain.Euclidean (Euclidean(..), prs, normalize, gcd', leadingUnit, chineseRemainder) where+module Numeric.Domain.Euclidean (Euclidean(..), euclid, prs, 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 Numeric.Domain.Internal+import Prelude (otherwise) 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)]+prs f g = step [(g, zero, one), (f, one, zero)]   where     step acc@((r',s',t'):(r,s,t):_)       | isZero r' = P.tail acc@@ -81,29 +18,6 @@             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)@

@@ -0,0 +1,11 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Numeric.Domain.GCD (GCDDomain(..), gcd') where++import Data.List.NonEmpty+import Numeric.Domain.Internal(GCDDomain(..))+import Numeric.Algebra.Unital.UnitNormalForm++gcd' :: GCDDomain r => NonEmpty r -> r+gcd' (x :| [])    = normalize x+gcd' (x :| [y])  = gcd x y+gcd' (x :| y:ys) = gcd x (gcd' (y:|ys))

@@ -0,0 +1,3 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module Numeric.Domain.Integral (IntegralDomain(..)) where+import Numeric.Domain.Internal(IntegralDomain(..))

@@ -0,0 +1,124 @@+{-# LANGUAGE NoImplicitPrelude, FlexibleInstances, UndecidableInstances, DefaultSignatures #-}+module Numeric.Domain.Internal where++import Data.Maybe(fromJust)+import Numeric.Additive.Group+import Numeric.Algebra.Class+import Numeric.Algebra.Commutative+import Numeric.Algebra.Division+import Numeric.Natural (Natural)+import Numeric.Semiring.ZeroProduct+import Numeric.Algebra.Unital.UnitNormalForm+import Numeric.Ring.Class+import Numeric.Decidable.Zero+import Numeric.Decidable.Units++import Prelude (Integer, Maybe (..), Bool(..),+                otherwise, fst, snd, ($), (.))+import qualified Prelude                 as P++infixl 7 `quot`, `rem`+infix  7 `divide`, `divides`, `maybeQuot`++-- | (Integral) domain is the integral semiring.+class (ZeroProductSemiring d, Ring d) => Domain d+instance (ZeroProductSemiring d, Ring d) => Domain d++-- | An integral domain is a commutative domain in which 1≠0.+class (Domain d, Commutative d) => IntegralDomain d where+    divides :: d -> d -> Bool+    default divides :: (Euclidean d) => d -> d -> Bool+    m `divides` n +        | isZero m = False+        | otherwise = isZero (n `rem` m)+    maybeQuot :: d -> d -> Maybe d+    default maybeQuot :: (Euclidean d) => d -> d -> Maybe d+    m `maybeQuot` n+        | isZero n = Nothing+        | otherwise = let (q,r) = m `divide` n in+                      if isZero r then Just q else Nothing++instance IntegralDomain Integer++class (IntegralDomain d, UnitNormalForm d, DecidableZero d) => GCDDomain d where+    gcd :: d -> d -> d+    default gcd :: (PID d) => d -> d -> d+    gcd a b = let (r,_,_) = egcd a b in r+    {-# INLINE gcd #-}++    reduceFraction :: d -> d -> (d,d)+    reduceFraction a b =+        let c = gcd a b in+        (fromJust (a `maybeQuot` c), fromJust (b `maybeQuot` c))++    lcm :: d -> d -> d+    lcm p q = fromJust $ (p * q) `maybeQuot` (gcd p q)++instance GCDDomain Integer++class (GCDDomain d) => UFD d++instance UFD Integer++class (UFD d) => PID d where+    egcd :: d -> d -> (d,d,d)+    default egcd :: (Euclidean d) => d -> d -> (d,d,d)+    egcd a b = P.head (euclid a b)+    {-# INLINE egcd #-}++instance PID Integer++class (PID d) => Euclidean d where+  -- | Euclidean (degree) function on @r@.+  degree :: d -> Maybe Natural+  default degree :: (Division d) => d -> Maybe Natural+  degree a | isZero a = Nothing+           | otherwise = Just zero+  -- | Division algorithm. @a `divide` b@ calculates+  --   quotient and remainder of @a@ divided by @b@.+  --+  -- prop> let (q, r) = divide a p in p*q + r == a && degree r < degree q+  divide :: d                   -- ^ elements divided by+         -> d                   -- ^ divisor+         -> (d,d)               -- ^ quotient and remainder+  default divide :: (Division d) => d -> d -> (d,d)+  -- Be strict in order to make sure division by zero gets caught+  divide a b = let q = a/b in (q,P.seq q zero)++  quot :: d -> d -> d+  quot a b = fst $ a `divide` b+  {-# INLINE quot #-}++  rem :: d -> d -> d+  rem a b = snd $ a `divide` b+  {-# INLINE rem #-}++instance Euclidean Integer where+  degree = Just . P.fromInteger . P.abs+  {-# INLINE degree #-}++  divide = P.divMod+  {-# INLINE divide #-}+++-- | Extended euclidean algorithm.+--+-- prop> euclid f g == xs ==> all (\(r, s, t) -> r == f * s + g * t) xs+euclid :: (Euclidean d) =>  d -> d -> [(d,d,d)]+euclid f g =+  let (ug, g') = splitUnit g+      Just t'  = recipUnit ug+      (uf, f') = splitUnit f+      Just s   = recipUnit uf+  in step [(g', zero, t'), (f', s, zero)]+  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!"

@@ -0,0 +1,3 @@+module Numeric.Domain.PID (PID(..)) where++import Numeric.Domain.Internal(PID(..))

@@ -0,0 +1,3 @@+module Numeric.Domain.UFD (UFD) where++import Numeric.Domain.Internal(UFD)

@@ -3,8 +3,8 @@   ( Field   ) where -import Numeric.Ring.Division-import Numeric.Algebra.Commutative+import Numeric.Algebra.Division+import Numeric.Domain.Euclidean -class (Commutative r, DivisionRing r) => Field r-instance (Commutative r, DivisionRing r) => Field r+class (Euclidean d, Division d) => Field d+instance (Euclidean d, Division d) => Field d

@@ -6,7 +6,6 @@   , denominator   , Ratio   , (%)-  , lcm   ) where import Data.Proxy import Numeric.Additive.Class@@ -15,17 +14,23 @@ import Numeric.Algebra.Commutative import Numeric.Algebra.Division import Numeric.Algebra.Unital+import Numeric.Algebra.Unital.UnitNormalForm+import Numeric.Decidable.Associates import Numeric.Decidable.Units import Numeric.Decidable.Zero import Numeric.Domain.Euclidean+import Numeric.Domain.GCD+import Numeric.Domain.Integral+import Numeric.Domain.PID+import Numeric.Domain.UFD import Numeric.Natural import Numeric.Rig.Characteristic import Numeric.Rig.Class import Numeric.Ring.Class-import Numeric.Semiring.Integral+import Numeric.Semiring.ZeroProduct import Prelude                     hiding (Integral (..), Num (..), gcd, lcm) --- | Fraction field @k(D)@ of 'Euclidean' domain @D@.+-- | Fraction field @k(D)@ of 'GCDDomain' domain @D@. data Fraction d = Fraction !d !d  -- Invariants: r == Fraction p q@@ -35,21 +40,19 @@ -- | 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)+(%) :: (GCDDomain d) => d -> d -> Fraction d+a % b | isZero b = error "Divide by zero"+      | otherwise = let (ua, a') = splitUnit a+                        (ub, b') = splitUnit b+                        Just ub' = recipUnit ub+                        (a'',b'') = reduceFraction a' b' in+                    Fraction (ua * ub' * a'') (b'')  numerator :: Fraction t -> t numerator (Fraction q _) = q@@ -59,67 +62,82 @@ denominator (Fraction _ p) = p {-# INLINE denominator #-} -instance Euclidean d => IntegralSemiring (Fraction d)-instance (Eq d, Multiplicative d) => Eq (Fraction d) where+instance (GCDDomain d) => ZeroProductSemiring (Fraction d)+instance (Eq d, GCDDomain 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+instance (Ord d, GCDDomain 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'+instance (GCDDomain d) => Division (Fraction d) where+  recip (Fraction p q)+      | isZero p = error "Divide by zero"+      | 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 (GCDDomain d) => Commutative (Fraction d) -instance Euclidean d => DecidableZero (Fraction d) where+instance (GCDDomain d) => DecidableZero (Fraction d) where   isZero (Fraction p _) = isZero p   {-# INLINE isZero #-} -instance Euclidean d => DecidableUnits (Fraction d) where+instance (GCDDomain 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++instance (GCDDomain d) => DecidableAssociates (Fraction d) where+    isAssociate a b = not (isZero a || isZero b)++instance (GCDDomain d) => Ring (Fraction d)+instance (GCDDomain d) => Abelian (Fraction d)+instance (GCDDomain d) => Semiring (Fraction d)+instance (GCDDomain 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+instance (GCDDomain d) => Monoidal (Fraction d) where   zero = Fraction zero one   {-# INLINE zero #-}-instance Euclidean d => LeftModule Integer (Fraction d) where+instance (GCDDomain d) => LeftModule Integer (Fraction d) where   n .* Fraction p r = (n .* p) % r   {-# INLINE (.*) #-}-instance Euclidean d => RightModule Integer (Fraction d) where+instance (GCDDomain d) => RightModule Integer (Fraction d) where   Fraction p r *. n = (p *. n) % r   {-# INLINE (*.) #-}-instance Euclidean d => LeftModule Natural (Fraction d) where+instance (GCDDomain d) => LeftModule Natural (Fraction d) where   n .* Fraction p r = (n .* p) % r   {-# INLINE (.*) #-}-instance Euclidean d => RightModule Natural (Fraction d) where+instance (GCDDomain d) => RightModule Natural (Fraction d) where   Fraction p r *. n = (p *. n) % r   {-# INLINE (*.) #-}-instance Euclidean d => Additive (Fraction d) where+instance (GCDDomain 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)+    let n = p*t + s*q+        d = q*t+        (n',d') = reduceFraction n d+    in Fraction n' d'   {-# INLINE (+) #-}-instance Euclidean d => Unital (Fraction d) where+instance (GCDDomain d) => Unital (Fraction d) where   one = Fraction one one   {-# INLINE one #-}-instance Euclidean d => Multiplicative (Fraction d) where+instance (GCDDomain d) => Multiplicative (Fraction d) where   Fraction p q * Fraction s t = (p*s) % (q*t)-instance Euclidean d => Rig (Fraction d)+instance (GCDDomain d) => Rig (Fraction d) -instance (Characteristic d, Euclidean d) => Characteristic (Fraction d) where+instance (Characteristic d, GCDDomain d) => Characteristic (Fraction d) where   char _ = char (Proxy :: Proxy d)++instance (GCDDomain d) => UnitNormalForm (Fraction d)+instance (GCDDomain d) => IntegralDomain (Fraction d)+instance (GCDDomain d) => GCDDomain (Fraction d)+instance (GCDDomain d) => UFD (Fraction d)+instance (GCDDomain d) => PID (Fraction d)+instance (GCDDomain d) => Euclidean (Fraction d)+

@@ -19,7 +19,7 @@ instance Quadrance () a where    quadrance _ = () -instance Monoidal r => Quadrance r () where+instance (Additive r, Monoidal r) => Quadrance r () where   quadrance _ = zero  instance (Quadrance r a, Quadrance r b) => Quadrance r (a,b) where

@@ -1,15 +0,0 @@-module Numeric.Semiring.Integral -  ( IntegralSemiring-  ) where--import Numeric.Algebra.Class-import Numeric.Natural---- | An integral semiring has no zero divisors------ > a * b = 0 implies a == 0 || b == 0-class (Monoidal r, Semiring r) => IntegralSemiring r--instance IntegralSemiring Integer-instance IntegralSemiring Natural-instance IntegralSemiring Bool

@@ -0,0 +1,15 @@+module Numeric.Semiring.ZeroProduct+  ( ZeroProductSemiring+  ) where++import Numeric.Algebra.Class+import Numeric.Natural++-- | A zero-product semiring has no zero divisors+--+-- > a * b = 0 implies a == 0 || b == 0+class (Monoidal r, Semiring r) => ZeroProductSemiring r++instance ZeroProductSemiring Integer+instance ZeroProductSemiring Natural+instance ZeroProductSemiring Bool