algebra 4.2 → 4.3.1
raw patch · 22 files changed
Files
- .travis.yml +141/−1
- CHANGELOG.markdown +11/−0
- README.markdown +1/−1
- algebra.cabal +18/−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/Ring/Endomorphism.hs +3/−0
- src/Numeric/Semiring/Integral.hs +0/−15
- src/Numeric/Semiring/ZeroProduct.hs +15/−0
.travis.yml view
@@ -1,4 +1,141 @@-language: haskell+# This Travis job script has been generated by a script via+#+# make_travis_yml_2.hs 'algebra.cabal'+#+# For more information, see https://github.com/hvr/multi-ghc-travis+#+language: c+sudo: false++git:+ submodules: false # whether to recursively clone submodules++cache:+ directories:+ - $HOME/.cabal/packages+ - $HOME/.cabal/store++before_cache:+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+ # remove files that are regenerated by 'cabal update'+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx++ - rm -fv $HOME/.cabal/packages/head.hackage++matrix:+ include:+ - compiler: "ghc-7.4.2"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.4.2], sources: [hvr-ghc]}}+ - compiler: "ghc-7.6.3"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.6.3], sources: [hvr-ghc]}}+ - compiler: "ghc-7.8.4"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.10.3"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}+ - compiler: "ghc-8.0.1"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.1], sources: [hvr-ghc]}}+ - compiler: "ghc-8.0.2"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}+ - compiler: "ghc-8.2.1"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}+ - compiler: "ghc-8.2.2"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}+ - compiler: "ghc-8.4.1"+ env: GHCHEAD=true+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}+ - compiler: "ghc-head"+ env: GHCHEAD=true+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}}++ allow_failures:+ - compiler: "ghc-8.4.1"+ - compiler: "ghc-head"++before_install:+ - HC=${CC}+ - HCPKG=${HC/ghc/ghc-pkg}+ - unset CC+ - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH"++install:+ - cabal --version+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"+ - BENCH=${BENCH---enable-benchmarks}+ - TEST=${TEST---enable-tests}+ - INSTALLED=${INSTALLED-true}+ - GHCHEAD=${GHCHEAD-false}+ - travis_retry cabal update+ - "sed -i.bak 's/^jobs:/-- jobs: 2/' ${HOME}/.cabal/config"+ - rm -fv cabal.project.local+ - "printf 'packages: \".\"\\n' > cabal.project"+ # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage+ - |+ if $GHCHEAD; then+ echo 'allow-newer: *:base, *:template-haskell' >> cabal.project+ echo 'repository head.hackage' >> cabal.project+ echo ' url: http://head.hackage.haskell.org/' >> cabal.project+ echo ' secure: True' >> cabal.project+ echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> cabal.project+ echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> cabal.project+ echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> cabal.project+ echo ' key-threshold: 3' >> cabal.project+ fi+ - cat cabal.project+ - if $GHCHEAD; then cabal new-update head.hackage -v; fi+ - rm -f cabal.project.freeze+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all+ - rm -rf "."/.ghc.environment.* "."/dist+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)++# 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:+ # test that source-distributions can be generated+ - (cd "." && cabal sdist)+ - mv "."/dist/algebra-*.tar.gz ${DISTDIR}/+ - cd ${DISTDIR} || false+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;+ - "printf 'packages: algebra-*/*.cabal\\n' > cabal.project"+ # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage+ - |+ if $GHCHEAD; then+ echo 'allow-newer: *:base, *:template-haskell' >> cabal.project+ echo 'repository head.hackage' >> cabal.project+ echo ' url: http://head.hackage.haskell.org/' >> cabal.project+ echo ' secure: True' >> cabal.project+ echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> cabal.project+ echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> cabal.project+ echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> cabal.project+ echo ' key-threshold: 3' >> cabal.project+ fi+ - cat cabal.project+ # this builds all libraries and executables (without tests/benchmarks)+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all++ # Build with installed constraints for packages in global-db+ - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi++ # build tests & benchmarks+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all+ # cabal new-test FAILS if there is no test-suite at all;+ # so we first test if there is any test-suite by --dry-run,+ # and, if there is any, then we actually run it.+ - |+ if cabal new-test -w ${HC} all --dry-run; then+ cabal new-test -w ${HC} all;+ else+ echo "No test-suite found.";+ fi+ # The same applies for benchmarks, but we've ignored them before switching to new-build...+ - cabal new-bench -w ${HC} all || true++ - rm -rf ./dist-newstyle+ notifications: irc: channels:@@ -6,3 +143,6 @@ skip_join: true template: - "\x0313algebra\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++# REGENDATA ["algebra.cabal"]+# EOF
CHANGELOG.markdown view
@@ -1,3 +1,14 @@+4.3.1+-----+* Compatibility with GHC 8.4.x: added `Semigroup (End r)` instance.++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.
README.markdown view
@@ -1,7 +1,7 @@ algebra ========== -[](http://travis-ci.org/ekmett/algebra)+[](https://hackage.haskell.org/package/algebra) [](http://travis-ci.org/ekmett/algebra) This is a package for exploring constructive abstract algebra in Haskell.
algebra.cabal view
@@ -1,6 +1,6 @@ name: algebra category: Math, Algebra-version: 4.2+version: 4.3.1 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE@@ -13,6 +13,9 @@ 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, GHC == 8.0.2,+ GHC == 8.2.1, GHC == 8.2.2, GHC == 8.4.1 extra-source-files: .ghci .gitignore@@ -51,8 +54,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 +80,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 +94,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 +129,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
src/Numeric/Algebra/Class.hs view
@@ -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
src/Numeric/Algebra/Commutative.hs view
@@ -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)
+ src/Numeric/Algebra/Unital/UnitNormalForm.hs view
@@ -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+
+ src/Numeric/Decidable/Nilpotent.hs view
@@ -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)+
src/Numeric/Decidable/Units.hs view
@@ -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
src/Numeric/Domain/Class.hs view
@@ -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)
src/Numeric/Domain/Euclidean.hs view
@@ -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)@
+ src/Numeric/Domain/GCD.hs view
@@ -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))
+ src/Numeric/Domain/Integral.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module Numeric.Domain.Integral (IntegralDomain(..)) where+import Numeric.Domain.Internal(IntegralDomain(..))
+ src/Numeric/Domain/Internal.hs view
@@ -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!"
+ src/Numeric/Domain/PID.hs view
@@ -0,0 +1,3 @@+module Numeric.Domain.PID (PID(..)) where++import Numeric.Domain.Internal(PID(..))
+ src/Numeric/Domain/UFD.hs view
@@ -0,0 +1,3 @@+module Numeric.Domain.UFD (UFD) where++import Numeric.Domain.Internal(UFD)
src/Numeric/Field/Class.hs view
@@ -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
src/Numeric/Field/Fraction.hs view
@@ -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)+
src/Numeric/Quadrance/Class.hs view
@@ -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
src/Numeric/Ring/Endomorphism.hs view
@@ -10,11 +10,14 @@ import Numeric.Algebra import Prelude hiding ((*),(+),(-),negate,subtract) import Data.Proxy+import Data.Semigroup (Semigroup((<>))) -- | 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 Semigroup (End r) where+ (End a) <> (End b) = End (a . b) instance Monoid (End r) where mappend (End a) (End b) = End (a . b) mempty = End id
− src/Numeric/Semiring/Integral.hs
@@ -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
+ src/Numeric/Semiring/ZeroProduct.hs view
@@ -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