arithmoi 0.9.0.0 → 0.13.4.0
raw patch · 146 files changed
Files
- Changes +0/−310
- GHC/TypeNats/Compat.hs +0/−34
- Math/NumberTheory/ArithmeticFunctions/Class.hs +3/−7
- Math/NumberTheory/ArithmeticFunctions/Inverse.hs +117/−34
- Math/NumberTheory/ArithmeticFunctions/Mertens.hs +8/−9
- Math/NumberTheory/ArithmeticFunctions/Moebius.hs +23/−29
- Math/NumberTheory/ArithmeticFunctions/NFreedom.hs +12/−11
- Math/NumberTheory/ArithmeticFunctions/SieveBlock.hs +124/−43
- Math/NumberTheory/ArithmeticFunctions/SieveBlock/Unboxed.hs +0/−131
- Math/NumberTheory/ArithmeticFunctions/Standard.hs +58/−23
- Math/NumberTheory/Curves/Montgomery.hs +5/−3
- Math/NumberTheory/Diophantine.hs +83/−0
- Math/NumberTheory/DirichletCharacters.hs +560/−0
- Math/NumberTheory/Euclidean.hs +0/−164
- Math/NumberTheory/Euclidean/Coprimes.hs +51/−37
- Math/NumberTheory/Moduli.hs +4/−6
- Math/NumberTheory/Moduli/Cbrt.hs +160/−0
- Math/NumberTheory/Moduli/Chinese.hs +38/−139
- Math/NumberTheory/Moduli/Class.hs +12/−314
- Math/NumberTheory/Moduli/DiscreteLogarithm.hs +0/−125
- Math/NumberTheory/Moduli/Equations.hs +27/−22
- Math/NumberTheory/Moduli/Internal.hs +159/−0
- Math/NumberTheory/Moduli/Jacobi.hs +0/−120
- Math/NumberTheory/Moduli/JacobiSymbol.hs +124/−0
- Math/NumberTheory/Moduli/Multiplicative.hs +119/−0
- Math/NumberTheory/Moduli/PrimitiveRoot.hs +0/−179
- Math/NumberTheory/Moduli/Singleton.hs +315/−0
- Math/NumberTheory/Moduli/SomeMod.hs +198/−0
- Math/NumberTheory/Moduli/Sqrt.hs +114/−87
- Math/NumberTheory/Moduli/SqrtOld.hs +0/−232
- Math/NumberTheory/MoebiusInversion.hs +53/−33
- Math/NumberTheory/MoebiusInversion/Int.hs +0/−150
- Math/NumberTheory/Powers.hs +0/−42
- Math/NumberTheory/Powers/Cubes.hs +0/−254
- Math/NumberTheory/Powers/Fourth.hs +0/−220
- Math/NumberTheory/Powers/General.hs +0/−353
- Math/NumberTheory/Powers/Modular.hs +0/−89
- Math/NumberTheory/Powers/Squares.hs +0/−261
- Math/NumberTheory/Powers/Squares/Internal.hs +0/−134
- Math/NumberTheory/Prefactored.hs +22/−13
- Math/NumberTheory/Primes.hs +62/−26
- Math/NumberTheory/Primes/Counting.hs +0/−1
- Math/NumberTheory/Primes/Counting/Approximate.hs +0/−1
- Math/NumberTheory/Primes/Counting/HowPrimeCountingWorks.md +153/−0
- Math/NumberTheory/Primes/Counting/Impl.hs +260/−350
- Math/NumberTheory/Primes/Factorisation.hs +0/−52
- Math/NumberTheory/Primes/Factorisation/Certified.hs +0/−171
- Math/NumberTheory/Primes/Factorisation/Montgomery.hs +158/−116
- Math/NumberTheory/Primes/Factorisation/TrialDivision.hs +7/−8
- Math/NumberTheory/Primes/IntSet.hs +344/−0
- Math/NumberTheory/Primes/Sieve.hs +0/−60
- Math/NumberTheory/Primes/Sieve/Eratosthenes.hs +148/−281
- Math/NumberTheory/Primes/Sieve/Indexing.hs +6/−9
- Math/NumberTheory/Primes/Small.hs +56/−0
- Math/NumberTheory/Primes/Testing.hs +0/−2
- Math/NumberTheory/Primes/Testing/Certificates.hs +0/−34
- Math/NumberTheory/Primes/Testing/Certificates/Internal.hs +0/−358
- Math/NumberTheory/Primes/Testing/Certified.hs +195/−3
- Math/NumberTheory/Primes/Testing/Probabilistic.hs +39/−31
- Math/NumberTheory/Primes/Types.hs +101/−6
- Math/NumberTheory/Quadratic/EisensteinIntegers.hs +85/−73
- Math/NumberTheory/Quadratic/GaussianIntegers.hs +86/−40
- Math/NumberTheory/Recurrences/Bilinear.hs +166/−90
- Math/NumberTheory/Recurrences/Linear.hs +37/−12
- Math/NumberTheory/Recurrences/Pentagonal.hs +30/−64
- Math/NumberTheory/Recurrencies.hs +0/−17
- Math/NumberTheory/Recurrencies/Bilinear.hs +0/−38
- Math/NumberTheory/Recurrencies/Linear.hs +0/−14
- Math/NumberTheory/RootsOfUnity.hs +68/−0
- Math/NumberTheory/SmoothNumbers.hs +70/−141
- Math/NumberTheory/UniqueFactorisation.hs +0/−13
- Math/NumberTheory/Unsafe.hs +0/−69
- Math/NumberTheory/Utils.hs +73/−67
- Math/NumberTheory/Utils/DirichletSeries.hs +15/−8
- Math/NumberTheory/Utils/FromIntegral.hs +99/−2
- Math/NumberTheory/Utils/Hyperbola.hs +10/−17
- Math/NumberTheory/Zeta.hs +10/−7
- Math/NumberTheory/Zeta/Dirichlet.hs +21/−22
- Math/NumberTheory/Zeta/Hurwitz.hs +35/−34
- Math/NumberTheory/Zeta/Riemann.hs +14/−15
- Math/NumberTheory/Zeta/Utils.hs +7/−15
- Setup.hs +0/−5
- arithmoi.cabal +75/−86
- benchmark/Bench.hs +1/−5
- benchmark/Math/NumberTheory/ArithmeticFunctionsBench.hs +1/−1
- benchmark/Math/NumberTheory/DiscreteLogarithmBench.hs +19/−16
- benchmark/Math/NumberTheory/EisensteinIntegersBench.hs +1/−1
- benchmark/Math/NumberTheory/EuclideanBench.hs +0/−19
- benchmark/Math/NumberTheory/GaussianIntegersBench.hs +1/−1
- benchmark/Math/NumberTheory/InverseBench.hs +6/−4
- benchmark/Math/NumberTheory/JacobiBench.hs +2/−2
- benchmark/Math/NumberTheory/MertensBench.hs +1/−4
- benchmark/Math/NumberTheory/PowersBench.hs +0/−31
- benchmark/Math/NumberTheory/PrimesBench.hs +5/−3
- benchmark/Math/NumberTheory/PrimitiveRootsBench.hs +19/−8
- benchmark/Math/NumberTheory/RecurrencesBench.hs +24/−23
- benchmark/Math/NumberTheory/SequenceBench.hs +10/−19
- benchmark/Math/NumberTheory/SieveBlockBench.hs +2/−7
- benchmark/Math/NumberTheory/SmoothNumbersBench.hs +7/−9
- benchmark/Math/NumberTheory/ZetaBench.hs +4/−3
- changelog.md +635/−0
- test-suite/Math/NumberTheory/ArithmeticFunctions/InverseTests.hs +161/−9
- test-suite/Math/NumberTheory/ArithmeticFunctions/MertensTests.hs +0/−4
- test-suite/Math/NumberTheory/ArithmeticFunctions/SieveBlockTests.hs +15/−23
- test-suite/Math/NumberTheory/ArithmeticFunctionsTests.hs +29/−22
- test-suite/Math/NumberTheory/CurvesTests.hs +3/−6
- test-suite/Math/NumberTheory/DiophantineTests.hs +38/−0
- test-suite/Math/NumberTheory/DirichletCharactersTests.hs +241/−0
- test-suite/Math/NumberTheory/EisensteinIntegersTests.hs +36/−49
- test-suite/Math/NumberTheory/EuclideanTests.hs +78/−45
- test-suite/Math/NumberTheory/GaussianIntegersTests.hs +37/−19
- test-suite/Math/NumberTheory/Moduli/CbrtTests.hs +89/−0
- test-suite/Math/NumberTheory/Moduli/ChineseTests.hs +7/−49
- test-suite/Math/NumberTheory/Moduli/ClassTests.hs +3/−4
- test-suite/Math/NumberTheory/Moduli/DiscreteLogarithmTests.hs +30/−19
- test-suite/Math/NumberTheory/Moduli/EquationsTests.hs +26/−17
- test-suite/Math/NumberTheory/Moduli/JacobiTests.hs +1/−7
- test-suite/Math/NumberTheory/Moduli/PrimitiveRootTests.hs +50/−53
- test-suite/Math/NumberTheory/Moduli/SingletonTests.hs +46/−0
- test-suite/Math/NumberTheory/Moduli/SqrtTests.hs +16/−15
- test-suite/Math/NumberTheory/MoebiusInversion/IntTests.hs +0/−52
- test-suite/Math/NumberTheory/MoebiusInversionTests.hs +12/−10
- test-suite/Math/NumberTheory/Powers/CubesTests.hs +0/−150
- test-suite/Math/NumberTheory/Powers/FourthTests.hs +0/−142
- test-suite/Math/NumberTheory/Powers/GeneralTests.hs +0/−127
- test-suite/Math/NumberTheory/Powers/ModularTests.hs +0/−91
- test-suite/Math/NumberTheory/Powers/SquaresTests.hs +0/−160
- test-suite/Math/NumberTheory/PrefactoredTests.hs +2/−4
- test-suite/Math/NumberTheory/Primes/CountingTests.hs +10/−11
- test-suite/Math/NumberTheory/Primes/FactorisationTests.hs +35/−13
- test-suite/Math/NumberTheory/Primes/SequenceTests.hs +28/−1
- test-suite/Math/NumberTheory/Primes/SieveTests.hs +11/−35
- test-suite/Math/NumberTheory/Primes/TestingTests.hs +3/−11
- test-suite/Math/NumberTheory/PrimesTests.hs +29/−6
- test-suite/Math/NumberTheory/Recurrences/BilinearTests.hs +140/−79
- test-suite/Math/NumberTheory/Recurrences/LinearTests.hs +30/−13
- test-suite/Math/NumberTheory/Recurrences/PentagonalTests.hs +18/−20
- test-suite/Math/NumberTheory/RootsOfUnityTests.hs +25/−0
- test-suite/Math/NumberTheory/SmoothNumbersTests.hs +64/−51
- test-suite/Math/NumberTheory/TestUtils.hs +41/−52
- test-suite/Math/NumberTheory/TestUtils/MyCompose.hs +2/−0
- test-suite/Math/NumberTheory/TestUtils/Wrappers.hs +27/−24
- test-suite/Math/NumberTheory/UniqueFactorisationTests.hs +0/−1
- test-suite/Math/NumberTheory/Zeta/DirichletTests.hs +20/−18
- test-suite/Math/NumberTheory/Zeta/RiemannTests.hs +16/−14
- test-suite/Test.hs +21/−21
− Changes
@@ -1,310 +0,0 @@-0.9.0.0- This release supports GHC 8.0, 8.2, 8.4 and 8.6.-- Breaking changes:-- Remove 'Prime' type family and introduce 'Prime' newtype. This newtype- is now used extensively in public API:-- primes :: Integral a => [Prime a]- primeList :: Integral a => PrimeSieve -> [Prime a]- sieveFrom :: Integer -> [Prime Integer]- nthPrime :: Integer -> Prime Integer-- 'sbcFunctionOnPrimePower' now accepts 'Prime Word' instead of 'Word'.-- 'Math.NumberTheory.Primes.{Factorisation,Testing,Counting,Sieve}'- are no longer re-exported from 'Math.NumberTheory.Primes'.- Merge 'Math.NumberTheory.UniqueFactorisation' into- 'Math.NumberTheory.Primes' (#135, #153).-- From now on 'Math.NumberTheory.Primes.Factorisation.factorise'- and similar functions return [(Integer, Word)] instead of [(Integer, Int)].-- Remove deprecated 'Math.NumberTheory.GCD' and 'Math.NumberTheory.GCD.LowLevel'.-- Deprecate 'Math.NumberTheory.Recurrencies.*'.- Use 'Math.NumberTheory.Recurrences.*' instead (#146).-- New features:-- New functions 'nextPrime' and 'precPrime'. Implement an instance of 'Enum' for primes (#153):-- > [nextPrime 101 .. precPrime 130]- [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127]-- Support Gaussian and Eisenstein integers in smooth numbers (#138).-- Add the Hurwitz zeta function on non-negative integer arguments (#126).-- Implement efficient tests of n-freeness: pointwise and in interval. See 'isNFree' and 'nFreesBlock' (#145).-- Generate preimages of the totient and the sum-of-divisors functions (#142):-- > inverseTotient 120 :: [Integer]- [155,310,183,366,225,450,175,350,231,462,143,286,244,372,396,308,248]-- Generate coefficients of Faulhaber polynomials 'faulhaberPoly' (#70).-- Improvements:-- Better precision for exact values of Riemann zeta and Dirichlet beta- functions (#123).-- Speed up certain cases of modular multiplication (#160).-- Extend Chinese theorem to non-coprime moduli (#71).--0.8.0.0- This release supports GHC 7.10, 8.0, 8.2, 8.4 and 8.6.-- Breaking changes:-- Stop reporting units (1, -1, i, -i) as a part of factorisation- for integers and Gaussian integers (#101). Now `factorise (-2)`- is `[(2, 1)]` and not `[(-1, 1), (2, 1)]`.-- Deprecate an old interface of 'Math.NumberTheory.Moduli.Sqrt'- and roll out a new one, more robust and type safe (#87).-- Deprecate 'Math.NumberTheory.GCD' and 'Math.NumberTheory.GCD.LowLevel' (#80).- Use 'Math.NumberTheory.Euclidean' instead (#128).- Move 'splitIntoCoprimes' to 'Math.NumberTheory.Euclidean.Coprimes'.-- Change types of 'splitIntoCoprimes', 'fromFactors' and 'prefFactors'- using newtype 'Coprimes' (#89).-- Redesign API to modular square roots (#108)-- Deprecate 'jacobi'' (#103).-- Sort Gaussian primes by norm (#124).-- Deprecate 'Math.NumberTheory.GaussianIntegers' in favor of- 'Math.NumberTheory.Quadratic.GaussianIntegers'.-- New features:-- Implement Ramanujan tau function (#112):-- > map ramanujan [1..10]- [1,-24,252,-1472,4830,-6048,-16744,84480,-113643,-115920]-- Implement partition function (#115):-- > take 10 partition- [1,1,2,3,5,7,11,15,22,30]-- Add the Dirichlet beta function on non-negative integer arguments (#120).- E. g.,-- > take 5 $ Math.NumberTheory.Zeta.Dirichlet.betas 1e-15- [0.5,0.7853981633974483,0.9159655941772191,0.9689461462593693,0.9889445517411055]-- Solve linear and quadratic congruences (#129).-- Support Eisenstein integers (#121).-- Implement discrete logarithm (#88).-- Improvements:-- Make return type of 'primes' and 'primeList' polymorphic instead of- being limited to 'Integer' only (#109).-- Speed up factorisation of Gaussian integers (#116).-- Speed up computation of primitive roots for prime powers (#127).--0.7.0.0- This release supports GHC 7.8, 7.10, 8.0, 8.2 and 8.4.-- Breaking changes:-- Remove 'Math.NumberTheory.Powers.Integer', deprecated in 0.5.0.0.-- Deprecate 'Math.NumberTheory.Primes.Heap'.- Use 'Math.NumberTheory.Primes.Sieve' instead.-- Deprecate 'FactorSieve', 'TotientSieve', 'CarmichaelSieve' and- accompanying functions. Use new general approach for bulk evaluation- of arithmetic functions instead (#77).-- Now 'moebius' returns not a number, but a value of 'Moebius' type (#90).-- New functions:-- A general framework for bulk evaluation of arithmetic functions (#77):-- > runFunctionOverBlock carmichaelA 1 10- [1,1,2,2,4,2,6,2,6,4]-- Implement a sublinear algorithm for Mertens function (#90):-- > map (mertens . (10 ^)) [0..9]- [1,-1,1,2,-23,-48,212,1037,1928,-222]-- Add basic support for cyclic groups and primitive roots (#86).-- Implement an efficient modular exponentiation (#86).-- Write routines for lazy generation of smooth numbers (#91).-- > smoothOverInRange (fromJust (fromList [3,5,7])) 1000 2000- [1029,1125,1215,1225,1323,1575,1701,1715,1875]-- Improvements:-- Now factorisation of large integers and Gaussian integers produces- factors as lazy as possible (#72, #76).--0.6.0.1:- Switch to smallcheck 1.1.3.--0.6.0.0:- This release supports GHC 7.8, 7.10, 8.0 and 8.2.-- Breaking changes:-- 'Math.NumberTheory.Moduli' was split into- 'Math.NumberTheory.Moduli.{Chinese,Class,Jacobi,Sqrt}'.-- Functions 'jacobi' and 'jacobi'' return 'JacobiSymbol'- instead of 'Int'.-- Functions 'invertMod', 'powerMod' and 'powerModInteger' were removed,- as well as their unchecked counterparts. Use new interface to- modular computations, provided by 'Math.NumberTheory.Moduli.Class'.-- New functions:-- Brand new 'Math.NumberTheory.Moduli.Class' (#56), providing- flexible and type safe modular arithmetic. Due to use of GMP built-ins- it is also significantly faster.-- New function 'divisorsList', which is lazier than 'divisors' and- does not require 'Ord' constraint (#64). Thus, it can be used- for 'GaussianInteger'.-- Improvements:-- Speed up factorisation over elliptic curve up to 15x (#65).-- Polymorphic 'fibonacci' and 'lucas' functions, which previously- were restricted to 'Integer' only (#63). This is especially useful- for modular computations, e. g., 'map fibonacci [1..10] :: [Mod 7]'.-- Make 'totientSum' more robust and idiomatic (#58).--0.5.0.1:- Switch to QuickCheck 2.10.--0.5.0.0:- This release supports GHC 7.8, 7.10 and 8.0. GHC 7.6 is no longer supported.-- Breaking changes:-- Remove deprecated interface to arithmetic functions (divisors, tau,- sigma, totient, jordan, moebius, liouville, smallOmega, bigOmega,- carmichael, expMangoldt). New interface is exposed via- Math.NumberTheory.ArithmeticFunctions (#30).-- Deprecate integerPower and integerWordPower from- Math.NumberTheory.Powers.Integer. Use (^) instead (#51).-- Math.NumberTheory.Logarithms has been moved to the separate package- integer-logarithms (#51).-- Rename Math.NumberTheory.Lucas to Math.NumberTheory.Recurrencies.Linear.-- New functions:-- Add basic combinatorial sequences: binomial coefficients, Stirling- numbers of both kinds, Eulerian numbers of both kinds, Bernoulli- numbers (#39). E. g.,-- > take 10 $ Math.NumberTheory.Recurrencies.Bilinear.bernoulli- [1 % 1,(-1) % 2,1 % 6,0 % 1,(-1) % 30,0 % 1,1 % 42,0 % 1,(-1) % 30,0 % 1]-- Add the Riemann zeta function on non-negative integer arguments (#44).- E. g.,-- > take 5 $ Math.NumberTheory.Zeta.zetas 1e-15- [-0.5,Infinity,1.6449340668482262,1.2020569031595945,1.0823232337111381]-- Improvements:-- Speed up isPrime twice; rework millerRabinV and isStrongFermatPP (#22, #25).--0.4.3.0:- This release supports GHC 7.6, 7.8, 7.10 and 8.0.-- Add Math.NumberTheory.ArithmeticFunctions with brand-new machinery- for arithmetic functions: divisors, tau, sigma, totient, jordan,- moebius, liouville, smallOmega, bigOmega, carmichael, expMangoldt (#30).- Old implementations (exposed via Math.NumberTheory.Primes.Factorisation- and Math.NumberTheory.Powers.Integer) are deprecated and will be removed- in the next major release.-- Add Karatsuba sqrt algorithm, improving performance on large integers (#6).-- Fix incorrect indexing of FactorSieve (#35).--0.4.2.0:- This release supports GHC 7.6, 7.8, 7.10 and 8.0.-- Add new cabal flag check-bounds, which replaces all unsafe array functions with safe ones.-- Add basic functions on Gaussian integers.- Add Möbius mu-function.-- Forbid non-positive moduli in Math.NumberTheory.Moduli.-- Fix out-of-bounds error in Math.NumberTheory.Primes.Heap, Math.NumberTheory.Primes.Sieve and Math.NumberTheory.MoebiusInversion.- Fix 32-bit build.- Fix binaryGCD on negative numbers.- Fix highestPower (various issues).--0.4.1.0:- Add integerLog10 variants at Bas van Dijk's request and expose- Math.NumberTheory.Powers.Integer, with an added integerWordPower.-0.4.0.4:- Update for GHC-7.8, the type of some primops changed, they return Int# now- instead of Bool.- Fixed bugs in modular square roots and factorisation.-0.4.0.3:- Relaxed dependencies on mtl and containers- Fixed warnings from GHC-7.5, Word(..) moved to GHC.Types- Removed SPECIALISE pragma from inline function (warning from 7.5, probably- pointless anyway)-0.4.0.2:- Sped up factor sieves. They need more space now, but the speedup is worth it, IMO.- Raised spec-constr limit in MoebiusInversion.Int-0.4.0.1:- Fixed Haddock bug-0.4.0.0:- Added generalised Möbius inversion, to be continued-0.3.0.0:- Added modular square roots and Chinese remainder theorem-0.2.0.6:- Performance tweaks for powerModInteger (~10%) and- invertMod (~25%).-0.2.0.5:- Fix bug in psieveFrom-0.2.0.4:- Fix bug in nthPrime-0.2.0.3:- Fix bug in powerMod-0.2.0.2:- Relax bounds on array dependency for 7.4.*-0.2.0.1:- Fix copy-pasto (only relevant for 7.3.*)- Fix imports for ghc >= 7.3-0.2.0.0:- Added certificates and certified testing/factorisation-0.1.0.2:- Fixed doc bugs-0.1.0.1:- Elaborate on overflow, work more on native Ints in Eratosthenes-0.1.0.0:- First release
− GHC/TypeNats/Compat.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE CPP #-}--{-# OPTIONS_HADDOCK hide #-}-#if MIN_VERSION_base(4,10,0)-module GHC.TypeNats.Compat- ( module GHC.TypeNats- ) where--#if MIN_VERSION_base(4,11,0)-import GHC.TypeNats hiding (Mod)-#else-import GHC.TypeNats-#endif-#else--module GHC.TypeNats.Compat- ( module GHC.TypeLits- , natVal- , someNatVal- ) where--import GHC.TypeLits hiding (natVal, someNatVal)-import qualified GHC.TypeLits as TL-import Numeric.Natural--natVal :: KnownNat n => proxy n -> Natural-natVal = fromInteger . TL.natVal--someNatVal :: Natural -> SomeNat-someNatVal n = case TL.someNatVal (toInteger n) of- Nothing -> error "someNatVal: impossible negative argument"- Just sn -> sn--#endif
Math/NumberTheory/ArithmeticFunctions/Class.hs view
@@ -8,11 +8,8 @@ -- factorisation domains. -- -{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} -{-# OPTIONS_HADDOCK hide #-}- module Math.NumberTheory.ArithmeticFunctions.Class ( ArithmeticFunction(..) , runFunction@@ -20,9 +17,7 @@ ) where import Control.Applicative-#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif+import Prelude hiding (Applicative(..)) import Math.NumberTheory.Primes @@ -61,13 +56,14 @@ = ArithmeticFunction (\_ _ -> ()) (const x) (ArithmeticFunction f1 g1) <*> (ArithmeticFunction f2 g2) = ArithmeticFunction (\p k -> (f1 p k, f2 p k)) (\(a1, a2) -> g1 a1 (g2 a2))+ liftA2 h (ArithmeticFunction f1 g1) (ArithmeticFunction f2 g2)+ = ArithmeticFunction (\p k -> (f1 p k, f2 p k)) (\(a1, a2) -> h (g1 a1) (g2 a2)) instance Semigroup a => Semigroup (ArithmeticFunction n a) where (<>) = liftA2 (<>) instance Monoid a => Monoid (ArithmeticFunction n a) where mempty = pure mempty- mappend = liftA2 mappend -- | Factorisation is expensive, so it is better to avoid doing it twice. -- Write 'runFunction (f + g) n' instead of 'runFunction f n + runFunction g n'.
Math/NumberTheory/ArithmeticFunctions/Inverse.hs view
@@ -9,12 +9,15 @@ -- <https://www.emis.de/journals/JIS/VOL19/Alekseyev/alek5.pdf Computing the Inverses, their Power Sums, and Extrema for Euler’s Totient and Other Multiplicative Functions> -- by M. A. Alekseyev. +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.ArithmeticFunctions.Inverse ( inverseTotient+ , inverseJordan , inverseSigma+ , inverseSigmaK , -- * Wrappers MinWord(..) , MaxWord(..)@@ -24,24 +27,25 @@ asSetOfPreimages ) where -import Prelude hiding (rem, quot)-import Data.List+import Prelude hiding (rem, quot, Foldable(..))+import Data.Bits (Bits)+import Data.Euclidean+import Data.Foldable+import Data.List (partition, sortOn) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe import Data.Ord (Down(..))-import Data.Semigroup-import Data.Semiring (Semiring(..))+import Data.Semiring (Semiring(..), Mul(..)) import Data.Set (Set) import qualified Data.Set as S+import Data.Traversable import Numeric.Natural import Math.NumberTheory.ArithmeticFunctions-import Math.NumberTheory.Euclidean import Math.NumberTheory.Logarithms-import Math.NumberTheory.Powers+import Math.NumberTheory.Roots (exactRoot, integerRoot) import Math.NumberTheory.Primes-import Math.NumberTheory.Primes.Sieve (primes) import Math.NumberTheory.Utils.DirichletSeries (DirichletSeries) import qualified Math.NumberTheory.Utils.DirichletSeries as DS import Math.NumberTheory.Utils.FromIntegral@@ -66,33 +70,37 @@ DS.fromDistinctAscList (map (\k -> (g (f p k), point (unPrime p ^ k))) ks) -- | See section 5.1 of the paper.-invTotient- :: forall a. (UniqueFactorisation a, Eq a)- => [(Prime a, Word)]+invJordan+ :: forall a. (Integral a, UniqueFactorisation a, Eq a)+ => Word+ -- ^ Value of k in 'jordan' k+ -> [(Prime a, Word)] -- ^ Factorisation of a value of the totient function -> [PrimePowers a] -- ^ Possible prime factors of an argument of the totient function-invTotient fs = map (\p -> PrimePowers p (doPrime p)) ps+invJordan k fs = map (\p -> PrimePowers p (doPrime p)) ps where divs :: [a] divs = runFunctionOnFactors divisorsListA fs ps :: [Prime a]- ps = mapMaybe (isPrime . (+ 1)) divs+ ps = mapMaybe (\d -> exactRoot k (d + 1) >>= isPrime) divs doPrime :: Prime a -> [Word] doPrime p = case lookup p fs of Nothing -> [1]- Just k -> [1 .. k+1]+ Just w -> [1 .. w+1] -- | See section 5.2 of the paper. invSigma- :: forall a. (Euclidean a, Integral a, UniqueFactorisation a)- => [(Prime a, Word)]+ :: forall a. (Euclidean a, Integral a, UniqueFactorisation a, Enum (Prime a), Bits a)+ => Word+ -- ^ Value of k in 'sigma' k+ -> [(Prime a, Word)] -- ^ Factorisation of a value of the sum-of-divisors function -> [PrimePowers a] -- ^ Possible prime factors of an argument of the sum-of-divisors function-invSigma fs+invSigma k fs = map (\(x, ys) -> PrimePowers x (S.toList ys)) $ M.assocs $ M.unionWith (<>) pksSmall pksLarge@@ -104,7 +112,7 @@ divs = runFunctionOnFactors divisorsListA fs n :: a- n = product $ map (\(p, k) -> unPrime p ^ k) fs+ n = factorBack fs -- There are two possible strategies to find possible prime factors -- of an argument of the sum-of-divisors function.@@ -129,7 +137,7 @@ pksSmall :: Map (Prime a) (Set Word) pksSmall = M.fromDistinctAscList [ (p, pows)- | p <- takeWhile ((< lim) . unPrime) primes+ | p <- [nextPrime 2 .. precPrime lim] , let pows = doPrime p , not (null pows) ]@@ -137,26 +145,26 @@ doPrime :: Prime a -> Set Word doPrime p' = let p = unPrime p' in S.fromDistinctAscList [ e- | e <- [1 .. intToWord (integerLogBase (toInteger p) (toInteger n))]- , n `rem` ((p ^ (e + 1) - 1) `quot` (p - 1)) == 0+ | e <- [1 .. intToWord (integerLogBase (toInteger (p ^ k)) (toInteger n))]+ , n `rem` ((p ^ (k * (e + 1)) - 1) `quot` (p ^ k - 1)) == 0 ] pksLarge :: Map (Prime a) (Set Word) pksLarge = M.unionsWith (<>)- [ maybe mempty (flip M.singleton (S.singleton e)) (isPrime p)+ [ maybe mempty (`M.singleton` S.singleton e) (isPrime p) | d <- divs- , e <- [1 .. intToWord (integerLogBase (toInteger lim) (toInteger d))]- , let p = integerRoot e (d - 1)- , p ^ (e + 1) - 1 == d * (p - 1)+ , e <- [1 .. intToWord (quot (integerLogBase (toInteger lim) (toInteger d)) (wordToInt k)) ]+ , let p = integerRoot (e * k) (d - 1)+ , p ^ (k * (e + 1)) - 1 == d * (p ^ k - 1) ] -- | Instead of multiplying all atomic series and filtering out everything, -- which is not divisible by @n@, we'd rather split all atomic series into -- a couple of batches, each of which corresponds to a prime factor of @n@. -- This allows us to crop resulting Dirichlet series (see 'filter' calls--- in 'invertFunction' below) at the end of each batch, saving time and memory.+-- in @invertFunction@ below) at the end of each batch, saving time and memory. strategy- :: forall a c. (Euclidean c, Ord c)+ :: forall a c. (GcdDomain c, Ord c) => ArithmeticFunction a c -- ^ Arithmetic function, which we aim to inverse -> [(Prime c, Word)]@@ -177,7 +185,7 @@ -> ([PrimePowers a], (Maybe (Prime c, Word), [PrimePowers a])) go ts (p, k) = (rs, (Just (p, k), qs)) where- predicate (PrimePowers q ls) = any (\l -> g (f q l) `rem` unPrime p == 0) ls+ predicate (PrimePowers q ls) = any (\l -> isJust $ g (f q l) `divide` unPrime p) ls (qs, rs) = partition predicate ts -- | Main workhorse.@@ -196,7 +204,7 @@ -- ^ Semiring element, representing preimages invertFunction point f invF n = DS.lookup n- $ foldl' (\ds b -> uncurry processBatch b ds) (DS.fromDistinctAscList []) batches+ $ foldl' (flip (uncurry processBatch)) (DS.fromDistinctAscList []) batches where factors = factorise n batches = strategy f factors $ invF factors@@ -260,16 +268,54 @@ -- >>> unMaxWord (inverseTotient MaxWord 120) -- 462 inverseTotient- :: (Semiring b, Euclidean a, UniqueFactorisation a, Ord a)+ :: (Semiring b, Integral a, Euclidean a, UniqueFactorisation a) => (a -> b) -> a -> b-inverseTotient point = invertFunction point totientA invTotient+inverseTotient = inverseJordan 1 {-# SPECIALISE inverseTotient :: Semiring b => (Int -> b) -> Int -> b #-} {-# SPECIALISE inverseTotient :: Semiring b => (Word -> b) -> Word -> b #-} {-# SPECIALISE inverseTotient :: Semiring b => (Integer -> b) -> Integer -> b #-} {-# SPECIALISE inverseTotient :: Semiring b => (Natural -> b) -> Natural -> b #-} +-- | The inverse for 'jordan' function.+--+-- Generalizes the 'inverseTotient' function, which is 'inverseJordan' 1.+--+-- The return value is parameterized by a 'Semiring', which allows+-- various applications by providing different (multiplicative) embeddings.+-- E. g., list all preimages (see a helper 'asSetOfPreimages'):+--+-- >>> import qualified Data.Set as S+-- >>> import Data.Semigroup+-- >>> S.mapMonotonic getProduct (inverseJordan 2 (S.singleton . Product) 192)+-- fromList [15,16]+--+-- Similarly to 'inverseTotient', it is possible to count and sum preimages, or+-- get the maximum/minimum preimage.+--+-- Note: it is the __user's responsibility__ to use an appropriate type for+-- 'inverseSigmaK'. Even low values of k with 'Int' or 'Word' will return+-- invalid results due to over/underflow, or throw exceptions (i.e. division by+-- zero).+--+-- >>> asSetOfPreimages (inverseJordan 15) (jordan 15 19) :: S.Set Int+-- fromList []+--+-- >>> asSetOfPreimages (inverseJordan 15) (jordan 15 19) :: S.Set Integer+-- fromList [19]+inverseJordan+ :: (Semiring b, Integral a, Euclidean a, UniqueFactorisation a)+ => Word+ -> (a -> b)+ -> a+ -> b+inverseJordan k point = invertFunction point (jordanA k) (invJordan k)+{-# SPECIALISE inverseJordan :: Semiring b => Word -> (Int -> b) -> Int -> b #-}+{-# SPECIALISE inverseJordan :: Semiring b => Word -> (Word -> b) -> Word -> b #-}+{-# SPECIALISE inverseJordan :: Semiring b => Word -> (Integer -> b) -> Integer -> b #-}+{-# SPECIALISE inverseJordan :: Semiring b => Word -> (Natural -> b) -> Natural -> b #-}+ -- | The inverse for 'sigma' 1 function. -- -- The return value is parameterized by a 'Semiring', which allows@@ -278,6 +324,7 @@ -- -- >>> import qualified Data.Set as S -- >>> import Data.Semigroup+-- >>> :set -XFlexibleContexts -- >>> S.mapMonotonic getProduct (inverseSigma (S.singleton . Product) 120) -- fromList [54,56,87,95] --@@ -298,16 +345,52 @@ -- >>> unMaxWord (inverseSigma MaxWord 120) -- 95 inverseSigma- :: (Semiring b, Euclidean a, UniqueFactorisation a, Integral a)+ :: (Semiring b, Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a) => (a -> b) -> a -> b-inverseSigma point = invertFunction point (sigmaA 1) invSigma+inverseSigma = inverseSigmaK 1 {-# SPECIALISE inverseSigma :: Semiring b => (Int -> b) -> Int -> b #-} {-# SPECIALISE inverseSigma :: Semiring b => (Word -> b) -> Word -> b #-} {-# SPECIALISE inverseSigma :: Semiring b => (Integer -> b) -> Integer -> b #-} {-# SPECIALISE inverseSigma :: Semiring b => (Natural -> b) -> Natural -> b #-} +-- | The inverse for 'sigma' function.+--+-- Generalizes the 'inverseSigma' function, which is 'inverseSigmaK' 1.+--+-- The return value is parameterized by a 'Semiring', which allows+-- various applications by providing different (multiplicative) embeddings.+-- E. g., list all preimages (see a helper 'asSetOfPreimages'):+--+-- >>> import qualified Data.Set as S+-- >>> import Data.Semigroup+-- >>> :set -XFlexibleContexts+-- >>> S.mapMonotonic getProduct (inverseSigmaK 2 (S.singleton . Product) 850)+-- fromList [24,26]+--+-- Similarly to 'inverseSigma', it is possible to count and sum preimages, or+-- get the maximum/minimum preimage.+--+-- Note: it is the __user's responsibility__ to use an appropriate type for+-- 'inverseSigmaK'. Even low values of k with 'Int' or 'Word' will return+-- invalid results due to over/underflow, or throw exceptions (i.e. division by+-- zero).+--+-- >>> asSetOfPreimages (inverseSigmaK 17) (sigma 17 13) :: S.Set Int+-- fromList *** Exception: divide by zero+inverseSigmaK+ :: (Semiring b, Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a)+ => Word+ -> (a -> b)+ -> a+ -> b+inverseSigmaK k point = invertFunction point (sigmaA k) (invSigma k)+{-# SPECIALISE inverseSigmaK :: Semiring b => Word -> (Int -> b) -> Int -> b #-}+{-# SPECIALISE inverseSigmaK :: Semiring b => Word -> (Word -> b) -> Word -> b #-}+{-# SPECIALISE inverseSigmaK :: Semiring b => Word -> (Integer -> b) -> Integer -> b #-}+{-# SPECIALISE inverseSigmaK :: Semiring b => Word -> (Natural -> b) -> Natural -> b #-}+ -------------------------------------------------------------------------------- -- Wrappers @@ -363,8 +446,8 @@ -- | Helper to extract a set of preimages for 'inverseTotient' or 'inverseSigma'. asSetOfPreimages- :: (Euclidean a, Integral a)+ :: (Ord a, Semiring a) => (forall b. Semiring b => (a -> b) -> a -> b) -> a -> S.Set a-asSetOfPreimages f = S.mapMonotonic getProduct . f (S.singleton . Product)+asSetOfPreimages f = S.mapMonotonic getMul . f (S.singleton . Mul)
Math/NumberTheory/ArithmeticFunctions/Mertens.hs view
@@ -7,7 +7,6 @@ -- Values of <https://en.wikipedia.org/wiki/Mertens_function Mertens function>. -- -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Math.NumberTheory.ArithmeticFunctions.Mertens@@ -16,11 +15,11 @@ import qualified Data.Vector.Unboxed as U -import Math.NumberTheory.Powers.Cubes-import Math.NumberTheory.Powers.Squares+import Math.NumberTheory.Roots import Math.NumberTheory.ArithmeticFunctions.Moebius+import Math.NumberTheory.Utils.FromIntegral --- | Compute individual values of Mertens function in O(n^(2/3)) time and space.+-- | Compute individual values of Mertens function in \( O(n^{2/3}) \) time and space. -- -- >>> map (mertens . (10 ^)) [0..9] -- [1,-1,1,2,-23,-48,212,1037,1928,-222]@@ -31,14 +30,14 @@ mertens 1 = 1 mertens x = sumMultMoebius lookupMus (\n -> sfunc (x `quot` n)) [1 .. x `quot` u] where- u = (integerSquareRoot x + 1) `max` ((integerCubeRoot x) ^ (2 :: Word) `quot` 2)+ u = (integerSquareRoot x + 1) `max` (integerCubeRoot x ^ (2 :: Word) `quot` 2) sfunc :: Word -> Int sfunc y = 1- - sum [ U.unsafeIndex mes (fromIntegral $ y `quot` n) | n <- [y `quot` u + 1 .. kappa] ]- + fromIntegral kappa * U.unsafeIndex mes (fromIntegral nu)- - sumMultMoebius lookupMus (\n -> fromIntegral $ y `quot` n) [1 .. nu]+ - sum [ U.unsafeIndex mes (wordToInt $ y `quot` n) | n <- [y `quot` u + 1 .. kappa] ]+ + wordToInt kappa * U.unsafeIndex mes (wordToInt nu)+ - sumMultMoebius lookupMus (\n -> wordToInt $ y `quot` n) [1 .. nu] where nu = integerSquareRoot y kappa = y `quot` (nu + 1)@@ -52,7 +51,7 @@ mus = sieveBlockMoebius 1 cacheSize lookupMus :: Word -> Moebius- lookupMus i = U.unsafeIndex mus (fromIntegral (i - 1))+ lookupMus i = U.unsafeIndex mus (wordToInt (i - 1)) -- 0-based index mes :: U.Vector Int
Math/NumberTheory/ArithmeticFunctions/Moebius.hs view
@@ -8,7 +8,6 @@ -- {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-}@@ -19,47 +18,43 @@ , sieveBlockMoebius ) where -import Control.Monad (forM_, liftM)+import Control.Monad (forM_) import Control.Monad.ST (runST) import Data.Bits import Data.Int import Data.Word-#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU import GHC.Exts-import GHC.Integer.GMP.Internals+import GHC.Num.Integer import Unsafe.Coerce -import Math.NumberTheory.Powers.Squares (integerSquareRoot)-import Math.NumberTheory.Primes (unPrime)-import Math.NumberTheory.Primes.Sieve (primes)-import Math.NumberTheory.Utils.FromIntegral (wordToInt)+import Math.NumberTheory.Roots (integerSquareRoot)+import Math.NumberTheory.Primes+import Math.NumberTheory.Utils.FromIntegral import Math.NumberTheory.Logarithms -- | Represents three possible values of <https://en.wikipedia.org/wiki/Möbius_function Möbius function>. data Moebius- = MoebiusN -- ^ -1+ = MoebiusN -- ^ \-1 | MoebiusZ -- ^ 0 | MoebiusP -- ^ 1 deriving (Eq, Ord, Show) -- | Convert to any numeric type. runMoebius :: Num a => Moebius -> a-runMoebius m = fromInteger (S# (dataToTag# m -# 1#))+runMoebius m = fromInteger (IS (dataToTag# m -# 1#)) fromMoebius :: Moebius -> Int8-fromMoebius m = fromIntegral $ I# (dataToTag# m)+fromMoebius m = intToInt8 $ I# (dataToTag# m) {-# INLINE fromMoebius #-} toMoebius :: Int8 -> Moebius-toMoebius i = let !(I# i#) = fromIntegral i in tagToEnum# i#+toMoebius i = let !(I# i#) = int8ToInt i in tagToEnum# i# {-# INLINE toMoebius #-} newtype instance U.MVector s Moebius = MV_Moebius (P.MVector s Int8)@@ -83,16 +78,16 @@ basicLength (MV_Moebius v) = M.basicLength v basicUnsafeSlice i n (MV_Moebius v) = MV_Moebius $ M.basicUnsafeSlice i n v basicOverlaps (MV_Moebius v1) (MV_Moebius v2) = M.basicOverlaps v1 v2- basicUnsafeNew n = MV_Moebius `liftM` M.basicUnsafeNew n+ basicUnsafeNew n = MV_Moebius <$> M.basicUnsafeNew n basicInitialize (MV_Moebius v) = M.basicInitialize v- basicUnsafeReplicate n x = MV_Moebius `liftM` M.basicUnsafeReplicate n (fromMoebius x)- basicUnsafeRead (MV_Moebius v) i = toMoebius `liftM` M.basicUnsafeRead v i+ basicUnsafeReplicate n x = MV_Moebius <$> M.basicUnsafeReplicate n (fromMoebius x)+ basicUnsafeRead (MV_Moebius v) i = toMoebius <$> M.basicUnsafeRead v i basicUnsafeWrite (MV_Moebius v) i x = M.basicUnsafeWrite v i (fromMoebius x) basicClear (MV_Moebius v) = M.basicClear v basicSet (MV_Moebius v) x = M.basicSet v (fromMoebius x) basicUnsafeCopy (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeCopy v1 v2 basicUnsafeMove (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeMove v1 v2- basicUnsafeGrow (MV_Moebius v) n = MV_Moebius `liftM` M.basicUnsafeGrow v n+ basicUnsafeGrow (MV_Moebius v) n = MV_Moebius <$> M.basicUnsafeGrow v n instance G.Vector U.Vector Moebius where {-# INLINE basicUnsafeFreeze #-}@@ -101,11 +96,11 @@ {-# INLINE basicUnsafeSlice #-} {-# INLINE basicUnsafeIndexM #-} {-# INLINE elemseq #-}- basicUnsafeFreeze (MV_Moebius v) = V_Moebius `liftM` G.basicUnsafeFreeze v- basicUnsafeThaw (V_Moebius v) = MV_Moebius `liftM` G.basicUnsafeThaw v+ basicUnsafeFreeze (MV_Moebius v) = V_Moebius <$> G.basicUnsafeFreeze v+ basicUnsafeThaw (V_Moebius v) = MV_Moebius <$> G.basicUnsafeThaw v basicLength (V_Moebius v) = G.basicLength v basicUnsafeSlice i n (V_Moebius v) = V_Moebius $ G.basicUnsafeSlice i n v- basicUnsafeIndexM (V_Moebius v) i = toMoebius `liftM` G.basicUnsafeIndexM v i+ basicUnsafeIndexM (V_Moebius v) i = toMoebius <$> G.basicUnsafeIndexM v i basicUnsafeCopy (MV_Moebius mv) (V_Moebius v) = G.basicUnsafeCopy mv v elemseq _ = seq @@ -118,7 +113,6 @@ instance Monoid Moebius where mempty = MoebiusP- mappend = (<>) -- | Evaluate the Möbius function over a block. -- Value of @f@ at 0, if zero falls into block, is undefined.@@ -139,12 +133,12 @@ let offset = negate lowIndex `mod` p offset2 = negate lowIndex `mod` (p * p) l :: Word8- l = fromIntegral $ intLog2 p .|. 1- forM_ [offset, offset + p .. len - 1] $ \ix -> do- MU.unsafeModify as (\y -> y + l) ix- forM_ [offset2, offset2 + p * p .. len - 1] $ \ix -> do+ l = intToWord8 $ intLog2 p .|. 1+ forM_ [offset, offset + p .. len - 1] $+ MU.unsafeModify as (+ l)+ forM_ [offset2, offset2 + p * p .. len - 1] $ \ix -> MU.unsafeWrite as ix 0- forM_ [0 .. len - 1] $ \ix -> do+ forM_ [0 .. len - 1] $ \ix -> MU.unsafeModify as (mapper ix) ix U.unsafeFreeze as @@ -161,13 +155,13 @@ -- Bit fiddling in 'mapper' is correct only -- if all sufficiently small (<= 191) primes has been sieved out. ps :: [Int]- ps = takeWhile (<= (191 `max` integerSquareRoot highIndex)) $ map unPrime primes+ ps = map unPrime [nextPrime 2 .. precPrime (191 `max` integerSquareRoot highIndex)] mapper :: Int -> Word8 -> Word8 mapper ix val | val .&. 0x80 == 0x00 = 1- | fromIntegral (val .&. 0x7F) < intLog2 (ix + lowIndex) - 5+ | word8ToInt (val .&. 0x7F) < intLog2 (ix + lowIndex) - 5 - (if ix + lowIndex >= 0x100000 then 2 else 0) - (if ix + lowIndex >= 0x10000000 then 1 else 0) = (val .&. 1) `shiftL` 1
Math/NumberTheory/ArithmeticFunctions/NFreedom.hs view
@@ -7,6 +7,7 @@ -- N-free number generation. -- +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.ArithmeticFunctions.NFreedom@@ -17,14 +18,14 @@ import Control.Monad (forM_) import Control.Monad.ST (runST)+import Data.Bits (Bits) import Data.List (scanl') import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Math.NumberTheory.Powers.Squares (integerSquareRoot)-import Math.NumberTheory.Primes (unPrime)-import Math.NumberTheory.Primes.Sieve (primes)-import Math.NumberTheory.Utils.FromIntegral (wordToInt)+import Math.NumberTheory.Roots+import Math.NumberTheory.Primes+import Math.NumberTheory.Utils.FromIntegral -- | Evaluate the `Math.NumberTheory.ArithmeticFunctions.isNFree` function over a block. -- Value at @0@, if zero falls into block, is undefined.@@ -42,7 +43,7 @@ -- >>> sieveBlockNFree 2 1 10 -- [True,True,True,False,True,True,True,False,False,True] sieveBlockNFree- :: forall a . Integral a+ :: forall a. (Integral a, Enum (Prime a), Bits a, UniqueFactorisation a) => Word -- ^ Power whose @n@-freedom will be checked. -> a@@ -70,7 +71,7 @@ -- by @nFrees@, see the comments in it. indices :: [a] indices = [offset, offset + pPow .. len - 1]- forM_ indices $ \ix -> do+ forM_ indices $ \ix -> MU.write as (fromIntegral ix) False U.freeze as @@ -82,21 +83,21 @@ highIndex = lowIndex + len - 1 ps :: [a]- ps = takeWhile (<= integerSquareRoot highIndex) $ map unPrime primes+ ps = if highIndex < 4 then [] else map unPrime [nextPrime 2 .. precPrime (integerSquareRoot highIndex)] -- | For a given nonnegative integer power @n@, generate all @n@-free -- numbers in ascending order, starting at @1@. -- -- When @n@ is @0@ or @1@, the resulting list is @[1]@. nFrees- :: forall a. Integral a+ :: forall a. (Integral a, Bits a, UniqueFactorisation a, Enum (Prime a)) => Word -- ^ Power @n@ to be used to generate @n@-free numbers. -> [a] -- ^ Generated infinite list of @n@-free numbers. nFrees 0 = [1] nFrees 1 = [1]-nFrees n = concatMap (\(lo, len) -> nFreesBlock n lo len) $ zip bounds strides+nFrees n = concatMap (uncurry (nFreesBlock n)) $ zip bounds strides where -- The 56th element of @iterate (2 *) 256@ is @2^64 :: Word == 0@, so to -- avoid overflow only the first 55 elements of this list are used.@@ -104,7 +105,7 @@ -- this value is just repeated. This means after a few dozen iterations, -- the sieve will stop increasing in size. strides :: [Word]- strides = take 55 (iterate (2 *) 256) ++ repeat (fromIntegral (maxBound :: Int))+ strides = take 55 (iterate (2 *) 256) ++ repeat (intToWord (maxBound :: Int)) -- Infinite list of lower bounds at which @sieveBlockNFree@ will be -- applied. This has type @Integral a => a@ instead of @Word@ because@@ -125,7 +126,7 @@ -- -- As with @nFrees@, passing @n = 0, 1@ results in an empty list. nFreesBlock- :: forall a . Integral a+ :: forall a . (Integral a, Bits a, UniqueFactorisation a, Enum (Prime a)) => Word -- ^ Power @n@ to be used to generate @n@-free numbers. -> a
Math/NumberTheory/ArithmeticFunctions/SieveBlock.hs view
@@ -9,10 +9,8 @@ -- {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples #-} module Math.NumberTheory.ArithmeticFunctions.SieveBlock ( runFunctionOverBlock@@ -24,23 +22,59 @@ , sieveBlockMoebius ) where -import Control.Monad (forM_)+import Control.Monad (forM_, when) import Control.Monad.ST (runST)+import Data.Bits import Data.Coerce+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as MG import qualified Data.Vector as V-import qualified Data.Vector.Mutable as MV+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as MU import GHC.Exts import Math.NumberTheory.ArithmeticFunctions.Class-import Math.NumberTheory.ArithmeticFunctions.Moebius (sieveBlockMoebius)-import Math.NumberTheory.ArithmeticFunctions.SieveBlock.Unboxed-import Math.NumberTheory.Logarithms (integerLogBase')-import Math.NumberTheory.Primes.Sieve (primes)+import Math.NumberTheory.ArithmeticFunctions.Moebius (Moebius, sieveBlockMoebius)+import Math.NumberTheory.Logarithms (wordLog2, integerLogBase')+import Math.NumberTheory.Primes import Math.NumberTheory.Primes.Types-import Math.NumberTheory.Powers.Squares (integerSquareRoot)-import Math.NumberTheory.Utils (splitOff#)+import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.Utils.FromIntegral (wordToInt, intToWord) +-- | A record, which specifies a function to evaluate over a block.+--+-- For example, here is a configuration for the totient function:+--+-- > SieveBlockConfig+-- > { sbcEmpty = 1+-- > , sbcFunctionOnPrimePower = \p a -> (unPrime p - 1) * unPrime p ^ (a - 1)+-- > , sbcAppend = (*)+-- > }+data SieveBlockConfig a = SieveBlockConfig+ { sbcEmpty :: a+ -- ^ value of a function on 1+ , sbcFunctionOnPrimePower :: Prime Word -> Word -> a+ -- ^ how to evaluate a function on prime powers+ , sbcAppend :: a -> a -> a+ -- ^ how to combine values of a function on coprime arguments+ }++-- | Create a config for a multiplicative function from its definition on prime powers.+multiplicativeSieveBlockConfig :: Num a => (Prime Word -> Word -> a) -> SieveBlockConfig a+multiplicativeSieveBlockConfig f = SieveBlockConfig+ { sbcEmpty = 1+ , sbcFunctionOnPrimePower = f+ , sbcAppend = (*)+ }++-- | Create a config for an additive function from its definition on prime powers.+additiveSieveBlockConfig :: Num a => (Prime Word -> Word -> a) -> SieveBlockConfig a+additiveSieveBlockConfig f = SieveBlockConfig+ { sbcEmpty = 0+ , sbcFunctionOnPrimePower = f+ , sbcAppend = (+)+ }+ -- | 'runFunctionOverBlock' @f@ @x@ @l@ evaluates an arithmetic function -- for integers between @x@ and @x+l-1@ and returns a vector of length @l@. -- It completely avoids factorisation, so it is asymptotically faster than@@ -61,9 +95,9 @@ -> Word -> Word -> V.Vector a-runFunctionOverBlock (ArithmeticFunction f g) = (V.map g .) . sieveBlock SieveBlockConfig+runFunctionOverBlock (ArithmeticFunction f g) = (G.map g .) . sieveBlock SieveBlockConfig { sbcEmpty = mempty- , sbcAppend = mappend+ , sbcAppend = (<>) , sbcFunctionOnPrimePower = coerce f } @@ -72,26 +106,24 @@ -- -- Based on Algorithm M of <https://arxiv.org/pdf/1305.1639.pdf Parity of the number of primes in a given interval and algorithms of the sublinear summation> by A. V. Lelechenko. See Lemma 2 on p. 5 on its algorithmic complexity. For the majority of use-cases its time complexity is O(x^(1+ε)). ----- 'sieveBlock' is similar to 'sieveBlockUnboxed' up to flavour of 'Data.Vector',--- but is typically 7x-10x slower and consumes 3x memory.--- Use unboxed version whenever possible.--- -- For example, following code lists smallest prime factors: ----- >>> sieveBlock (SieveBlockConfig maxBound (\p _ -> unPrime p) min) 2 10+-- >>> sieveBlock (SieveBlockConfig maxBound (\p _ -> unPrime p) min) 2 10 :: Data.Vector.Vector Word -- [2,3,2,5,2,7,2,3,2,11] -- -- And this is how to factorise all numbers in a block: ----- >>> sieveBlock (SieveBlockConfig [] (\p k -> [(unPrime p, k)]) (++)) 2 10+-- >>> sieveBlock (SieveBlockConfig [] (\p k -> [(unPrime p, k)]) (++)) 2 10 :: Data.Vector.Vector [(Word, Word)] -- [[(2,1)],[(3,1)],[(2,2)],[(5,1)],[(2,1),(3,1)],[(7,1)],[(2,3)],[(3,2)],[(2,1),(5,1)],[(11,1)]] sieveBlock- :: SieveBlockConfig a+ :: forall v a.+ G.Vector v a+ => SieveBlockConfig a -> Word -> Word- -> V.Vector a-sieveBlock _ _ 0 = V.empty-sieveBlock (SieveBlockConfig empty f append) lowIndex' len' = runST $ do+ -> v a+sieveBlock _ _ 0 = G.empty+sieveBlock (SieveBlockConfig empty f append) !lowIndex' len' = runST $ do let lowIndex :: Int lowIndex = wordToInt lowIndex'@@ -99,35 +131,84 @@ len :: Int len = wordToInt len' - as <- V.unsafeThaw $ V.enumFromN lowIndex' len- bs <- MV.replicate len empty-- let highIndex :: Int+ highIndex :: Int highIndex = lowIndex + len - 1 + highIndex' :: Word+ highIndex' = intToWord highIndex+ ps :: [Int]- ps = takeWhile (<= integerSquareRoot highIndex) $ map unPrime primes+ ps = if highIndex < 4 then [] else map unPrime [nextPrime 2 .. precPrime (integerSquareRoot highIndex)] - forM_ ps $ \p -> do+ as <- MU.replicate len 1+ bs <- MG.replicate len empty - let p# :: Word#- !p'@(W# p#) = intToWord p+ let doPrime 2 = do+ let fs = V.generate (wordLog2 highIndex')+ (\k -> f (Prime 2) (intToWord k + 1))+ npLow = (lowIndex' + 1) `shiftR` 1+ npHigh = highIndex' `shiftR` 1+ forM_ [npLow .. npHigh] $ \np@(W# np#) -> do+ let ix = wordToInt (np `shiftL` 1) - lowIndex :: Int+ -- Calling ctz# assumes that np /= 0, otherwise you get 64+ -- and can have an out-of-bounds read from 'fs'.+ tz = if np == 0 then 0 else I# (word2Int# (ctz# np#))+ MU.unsafeModify as (\x -> x `shiftL` (tz + 1)) ix+ MG.unsafeModify bs (\y -> y `append` V.unsafeIndex fs tz) ix - fs = V.generate- (integerLogBase' (toInteger p) (toInteger highIndex))- (\k -> f (Prime p') (intToWord k + 1))+ doPrime p = do+ let p' = intToWord p+ f0 = f (Prime p') 1+ logp = integerLogBase' (toInteger p) (toInteger highIndex) - 1+ fs = V.generate logp (\k -> f (Prime p') (intToWord k + 2))+ npLow = (lowIndex + p - 1) `quot` p+ npHigh = highIndex `quot` p - offset :: Int- offset = negate lowIndex `mod` p+ forM_ [npLow .. npHigh] $ \np -> do+ let !(I# ix#) = np * p - lowIndex+ (q, r) = np `quotRem` p+ if r /= 0+ then do+ MU.unsafeModify as (* p') (I# ix#)+ MG.unsafeModify bs (`append` f0) (I# ix#)+ else do+ let pow = highestPowerDividing p q+ MU.unsafeModify as (\x -> x * p' ^ (pow + 2)) (I# ix#)+ MG.unsafeModify bs (\y -> y `append` V.unsafeIndex fs (wordToInt pow)) (I# ix#) - forM_ [offset, offset + p .. len - 1] $ \ix -> do- W# a# <- MV.unsafeRead as ix- let !(# pow#, a'# #) = splitOff# p# (a# `quotWord#` p#)- MV.unsafeWrite as ix (W# a'#)- MV.unsafeModify bs (\y -> y `append` V.unsafeIndex fs (I# (word2Int# pow#))) ix+ forM_ ps doPrime forM_ [0 .. len - 1] $ \k -> do- a <- MV.unsafeRead as k- MV.unsafeModify bs (\b -> if a /= 1 then b `append` f (Prime a) 1 else b) k+ a <- MU.unsafeRead as k+ let a' = intToWord (k + lowIndex)+ when (a /= a') $+ MG.unsafeModify bs (\b -> b `append` f (Prime $ a' `quot` a) 1) k - V.unsafeFreeze bs+ G.unsafeFreeze bs++-- This is a variant of 'Math.NumberTheory.Utils.splitOff',+-- specialized for better performance.+highestPowerDividing :: Int -> Int -> Word+highestPowerDividing !_ 0 = 0+highestPowerDividing p n = go 0 n+ where+ go !k m = case m `quotRem` p of+ (q, 0) -> go (k + 1) q+ _ -> k++-- | This is 'sieveBlock' specialized to unboxed vectors.+--+-- >>> sieveBlockUnboxed (SieveBlockConfig 1 (\_ a -> a + 1) (*)) 1 10+-- [1,2,2,3,2,4,2,4,3,4]+sieveBlockUnboxed+ :: U.Unbox a+ => SieveBlockConfig a+ -> Word+ -> Word+ -> U.Vector a+sieveBlockUnboxed = sieveBlock++{-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Int -> Word -> Word -> U.Vector Int #-}+{-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Word -> Word -> Word -> U.Vector Word #-}+{-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Bool -> Word -> Word -> U.Vector Bool #-}+{-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Moebius -> Word -> Word -> U.Vector Moebius #-}
− Math/NumberTheory/ArithmeticFunctions/SieveBlock/Unboxed.hs
@@ -1,131 +0,0 @@--- |--- Module: Math.NumberTheory.ArithmeticFunctions.SieveBlock.Unboxed--- Copyright: (c) 2017 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Bulk evaluation of arithmetic functions without factorisation--- of arguments.-----{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples #-}--module Math.NumberTheory.ArithmeticFunctions.SieveBlock.Unboxed- ( SieveBlockConfig(..)- , multiplicativeSieveBlockConfig- , additiveSieveBlockConfig- , sieveBlockUnboxed- ) where--import Control.Monad (forM_)-import Control.Monad.ST (runST)-import qualified Data.Vector.Unboxed as V-import qualified Data.Vector.Unboxed.Mutable as MV-import GHC.Exts--import Math.NumberTheory.ArithmeticFunctions.Moebius (Moebius)-import Math.NumberTheory.Logarithms (integerLogBase')-import Math.NumberTheory.Primes.Sieve (primes)-import Math.NumberTheory.Primes.Types (Prime(..))-import Math.NumberTheory.Powers.Squares (integerSquareRoot)-import Math.NumberTheory.Utils (splitOff#)-import Math.NumberTheory.Utils.FromIntegral (wordToInt, intToWord)---- | A record, which specifies a function to evaluate over a block.------ For example, here is a configuration for the totient function:------ > SieveBlockConfig--- > { sbcEmpty = 1--- > , sbcFunctionOnPrimePower = \p a -> (unPrime p - 1) * unPrime p ^ (a - 1)--- > , sbcAppend = (*)--- > }-data SieveBlockConfig a = SieveBlockConfig- { sbcEmpty :: a- -- ^ value of a function on 1- , sbcFunctionOnPrimePower :: Prime Word -> Word -> a- -- ^ how to evaluate a function on prime powers- , sbcAppend :: a -> a -> a- -- ^ how to combine values of a function on coprime arguments- }---- | Create a config for a multiplicative function from its definition on prime powers.-multiplicativeSieveBlockConfig :: Num a => (Prime Word -> Word -> a) -> SieveBlockConfig a-multiplicativeSieveBlockConfig f = SieveBlockConfig- { sbcEmpty = 1- , sbcFunctionOnPrimePower = f- , sbcAppend = (*)- }---- | Create a config for an additive function from its definition on prime powers.-additiveSieveBlockConfig :: Num a => (Prime Word -> Word -> a) -> SieveBlockConfig a-additiveSieveBlockConfig f = SieveBlockConfig- { sbcEmpty = 0- , sbcFunctionOnPrimePower = f- , sbcAppend = (+)- }---- | Evaluate a function over a block in accordance to provided configuration.--- Value of @f@ at 0, if zero falls into block, is undefined.------ Based on Algorithm M of <https://arxiv.org/pdf/1305.1639.pdf Parity of the number of primes in a given interval and algorithms of the sublinear summation> by A. V. Lelechenko. See Lemma 2 on p. 5 on its algorithmic complexity. For the majority of use-cases its time complexity is O(x^(1+ε)).------ For example, here is an analogue of divisor function 'Math.NumberTheory.ArithmeticFunctions.tau':------ >>> sieveBlockUnboxed (SieveBlockConfig 1 (\_ a -> a + 1) (*)) 1 10--- [1,2,2,3,2,4,2,4,3,4]-sieveBlockUnboxed- :: V.Unbox a- => SieveBlockConfig a- -> Word- -> Word- -> V.Vector a-sieveBlockUnboxed _ _ 0 = V.empty-sieveBlockUnboxed (SieveBlockConfig empty f append) lowIndex' len' = runST $ do-- let lowIndex :: Int- lowIndex = wordToInt lowIndex'-- len :: Int- len = wordToInt len'-- as <- V.unsafeThaw $ V.enumFromN lowIndex' len- bs <- MV.replicate len empty-- let highIndex :: Int- highIndex = lowIndex + len - 1-- ps :: [Int]- ps = takeWhile (<= integerSquareRoot highIndex) $ map unPrime primes-- forM_ ps $ \p -> do-- let p# :: Word#- !p'@(W# p#) = intToWord p-- fs = V.generate- (integerLogBase' (toInteger p) (toInteger highIndex))- (\k -> f (Prime p') (intToWord k + 1))-- offset :: Int- offset = negate lowIndex `mod` p-- forM_ [offset, offset + p .. len - 1] $ \ix -> do- W# a# <- MV.unsafeRead as ix- let !(# pow#, a'# #) = splitOff# p# (a# `quotWord#` p#)- MV.unsafeWrite as ix (W# a'#)- MV.unsafeModify bs (\y -> y `append` V.unsafeIndex fs (I# (word2Int# pow#))) ix-- forM_ [0 .. len - 1] $ \k -> do- a <- MV.unsafeRead as k- MV.unsafeModify bs (\b -> if a /= 1 then b `append` f (Prime a) 1 else b) k-- V.unsafeFreeze bs--{-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Int -> Word -> Word -> V.Vector Int #-}-{-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Word -> Word -> Word -> V.Vector Word #-}-{-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Bool -> Word -> Word -> V.Vector Bool #-}-{-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Moebius -> Word -> Word -> V.Vector Moebius #-}
Math/NumberTheory/ArithmeticFunctions/Standard.hs view
@@ -10,11 +10,13 @@ {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.ArithmeticFunctions.Standard- ( -- * Multiplicative functions- multiplicative- , divisors, divisorsA+ ( -- * List divisors+ divisors, divisorsA , divisorsList, divisorsListA , divisorsSmall, divisorsSmallA+ , divisorsTo, divisorsToA+ -- * Multiplicative functions+ , multiplicative , divisorCount, tau, tauA , sigma, sigmaA , totient, totientA@@ -33,8 +35,10 @@ ) where import Data.Coerce+import Data.Euclidean (GcdDomain(divide)) import Data.IntSet (IntSet) import qualified Data.IntSet as IS+import Data.Maybe import Data.Set (Set) import qualified Data.Set as S import Data.Semigroup@@ -58,7 +62,7 @@ {-# SPECIALIZE divisors :: Integer -> Set Integer #-} -- | The set of all (positive) divisors of an argument.-divisorsA :: (UniqueFactorisation n, Ord n) => ArithmeticFunction n (Set n)+divisorsA :: (Ord n, Num n) => ArithmeticFunction n (Set n) divisorsA = ArithmeticFunction (\p -> SetProduct . divisorsHelper (unPrime p)) (S.insert 1 . getSetProduct) divisorsHelper :: Num n => n -> Word -> Set n@@ -72,7 +76,7 @@ divisorsList = runFunction divisorsListA -- | The unsorted list of all (positive) divisors of an argument, produced in lazy fashion.-divisorsListA :: UniqueFactorisation n => ArithmeticFunction n [n]+divisorsListA :: Num n => ArithmeticFunction n [n] divisorsListA = ArithmeticFunction (\p -> ListProduct . divisorsListHelper (unPrime p)) ((1 :) . getListProduct) divisorsListHelper :: Num n => n -> Word -> [n]@@ -95,6 +99,23 @@ divisorsHelperSmall p a = IS.fromDistinctAscList $ p : p * p : map (p ^) [3 .. wordToInt a] {-# INLINE divisorsHelperSmall #-} +-- | See 'divisorsToA'.+divisorsTo :: (UniqueFactorisation n, Integral n) => n -> n -> Set n+divisorsTo to = runFunction (divisorsToA to)++-- | The set of all (positive) divisors up to an inclusive bound.+divisorsToA :: (UniqueFactorisation n, Integral n) => n -> ArithmeticFunction n (Set n)+divisorsToA to = ArithmeticFunction f unwrap+ where f p k = BoundedSetProduct (\bound -> divisorsToHelper bound (unPrime p) k)+ unwrap (BoundedSetProduct res) = if 1 <= to then S.insert 1 (res to) else res to++-- | Generate at most @a@ powers of @p@ up to an inclusive bound @b@.+divisorsToHelper :: (Ord n, Num n) => n -> n -> Word -> Set n+divisorsToHelper _ _ 0 = S.empty+divisorsToHelper b p 1 = if p <= b then S.singleton p else S.empty+divisorsToHelper b p a = S.fromDistinctAscList $ take (wordToInt a) $ takeWhile (<=b) $ iterate (p*) p+{-# INLINE divisorsToHelper #-}+ -- | Synonym for 'tau'. -- -- >>> map divisorCount [1..10]@@ -113,33 +134,37 @@ tauA = multiplicative $ const (fromIntegral . succ) -- | See 'sigmaA'.-sigma :: (UniqueFactorisation n, Integral n) => Word -> n -> n+sigma :: (UniqueFactorisation n, Integral n, Num a, GcdDomain a) => Word -> n -> a sigma = runFunction . sigmaA+{-# INLINABLE sigma #-} -- | The sum of the @k@-th powers of (positive) divisors of an argument. -- -- > sigmaA = multiplicative (\p k -> sum $ map (p ^) [0..k]) -- > sigmaA 0 = tauA-sigmaA :: (UniqueFactorisation n, Integral n) => Word -> ArithmeticFunction n n+sigmaA :: (Integral n, Num a, GcdDomain a) => Word -> ArithmeticFunction n a sigmaA 0 = tauA-sigmaA 1 = multiplicative $ sigmaHelper . unPrime-sigmaA a = multiplicative $ sigmaHelper . (^ wordToInt a) . unPrime+sigmaA 1 = multiplicative $ sigmaHelper . fromIntegral' . unPrime+sigmaA a = multiplicative $ sigmaHelper . (^ wordToInt a) . fromIntegral' . unPrime+{-# INLINABLE sigmaA #-} -sigmaHelper :: Integral n => n -> Word -> n+sigmaHelper :: (Num a, GcdDomain a) => a -> Word -> a sigmaHelper pa 1 = pa + 1 sigmaHelper pa 2 = pa * pa + pa + 1-sigmaHelper pa k = (pa ^ wordToInt (k + 1) - 1) `quot` (pa - 1)+sigmaHelper pa k = fromJust ((pa ^ wordToInt (k + 1) - 1) `divide` (pa - 1)) {-# INLINE sigmaHelper #-} -- | See 'totientA'. totient :: UniqueFactorisation n => n -> n totient = runFunction totientA+{-# INLINABLE totient #-} -- | Calculates the totient of a positive number @n@, i.e. -- the number of @k@ with @1 <= k <= n@ and @'gcd' n k == 1@, -- in other words, the order of the group of units in @ℤ/(n)@.-totientA :: UniqueFactorisation n => ArithmeticFunction n n+totientA :: Num n => ArithmeticFunction n n totientA = multiplicative $ jordanHelper . unPrime+{-# INLINABLE totientA #-} -- | See 'jordanA'. jordan :: UniqueFactorisation n => Word -> n -> n@@ -148,7 +173,7 @@ -- | Calculates the k-th Jordan function of an argument. -- -- > jordanA 1 = totientA-jordanA :: UniqueFactorisation n => Word -> ArithmeticFunction n n+jordanA :: Num n => Word -> ArithmeticFunction n n jordanA 0 = multiplicative $ \_ _ -> 0 jordanA 1 = totientA jordanA a = multiplicative $ jordanHelper . (^ wordToInt a) . unPrime@@ -177,7 +202,7 @@ tp = ramanujanHelper p 1 paPowers = iterate (* (-pa)) 1 binomials = scanl (\acc j -> acc * (k' - 2 * j) * (k' - 2 * j - 1) `quot` (k' - j) `quot` (j + 1)) 1 [0 .. k' `quot` 2 - 1]- k' = fromIntegral k+ k' = wordToInteger k tpPowers = reverse $ take (length binomials) $ iterate (* tp^(2::Int)) (if even k then 1 else tp) {-# INLINE ramanujanHelper #-} @@ -211,7 +236,7 @@ -- | Calculates the Carmichael function for a positive integer, that is, -- the (smallest) exponent of the group of units in @ℤ/(n)@.-carmichaelA :: (UniqueFactorisation n, Integral n) => ArithmeticFunction n n+carmichaelA :: Integral n => ArithmeticFunction n n carmichaelA = ArithmeticFunction (\p -> LCM . f (unPrime p)) getLCM where f 2 1 = 1@@ -233,7 +258,7 @@ -- -- > smallOmegaA = additive (\_ _ -> 1) smallOmegaA :: Num a => ArithmeticFunction n a-smallOmegaA = additive (\_ _ -> 1)+smallOmegaA = additive $ const $ const 1 -- | See 'bigOmegaA'. bigOmega :: UniqueFactorisation n => n -> Word@@ -250,7 +275,7 @@ expMangoldt = runFunction expMangoldtA -- | The exponent of von Mangoldt function. Use @log expMangoldtA@ to recover von Mangoldt function itself.-expMangoldtA :: UniqueFactorisation n => ArithmeticFunction n n+expMangoldtA :: Num n => ArithmeticFunction n n expMangoldtA = ArithmeticFunction (const . MangoldtOne . unPrime) runMangoldt data Mangoldt a@@ -271,7 +296,6 @@ instance Monoid (Mangoldt a) where mempty = MangoldtZero- mappend = (<>) -- | See 'isNFreeA'. isNFree :: UniqueFactorisation n => Word -> n -> Bool@@ -290,7 +314,6 @@ instance Integral a => Monoid (LCM a) where mempty = LCM 1- mappend = (<>) newtype Xor = Xor { _getXor :: Bool } @@ -304,7 +327,6 @@ instance Monoid Xor where mempty = Xor False- mappend = (<>) newtype SetProduct a = SetProduct { getSetProduct :: Set a } @@ -313,7 +335,6 @@ instance (Num a, Ord a) => Monoid (SetProduct a) where mempty = SetProduct mempty- mappend = (<>) newtype ListProduct a = ListProduct { getListProduct :: [a] } @@ -322,8 +343,23 @@ instance Num a => Monoid (ListProduct a) where mempty = ListProduct mempty- mappend = (<>) +-- Represent as a Reader monad+newtype BoundedSetProduct a = BoundedSetProduct { _getBoundedSetProduct :: a -> Set a }++takeWhileLE :: Ord a => a -> Set a -> Set a+takeWhileLE b xs = if m then S.insert b ls else ls+ where (ls, m, _) = S.splitMember b xs++instance (Ord a, Num a) => Semigroup (BoundedSetProduct a) where+ BoundedSetProduct f1 <> BoundedSetProduct f2 = BoundedSetProduct f+ where f b = s1 <> s2 <> foldMap (\n -> takeWhileLE b $ S.mapMonotonic (* n) s2) s1+ where s1 = f1 b+ s2 = f2 b++instance (Ord a, Num a) => Monoid (BoundedSetProduct a) where+ mempty = BoundedSetProduct mempty+ newtype IntSetProduct = IntSetProduct { getIntSetProduct :: IntSet } instance Semigroup IntSetProduct where@@ -331,4 +367,3 @@ instance Monoid IntSetProduct where mempty = IntSetProduct mempty- mappend = (<>)
Math/NumberTheory/Curves/Montgomery.hs view
@@ -4,7 +4,8 @@ -- Licence: MIT -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> ----- Arithmetic on Montgomery elliptic curve.+-- Arithmetic on Montgomery elliptic curves.+-- This is an internal module, exposed only for purposes of testing. -- {-# LANGUAGE BangPatterns #-}@@ -15,6 +16,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Curves.Montgomery ( Point@@ -32,7 +34,7 @@ import Data.Proxy import GHC.Exts import GHC.Integer.Logarithms-import GHC.TypeNats.Compat+import GHC.TypeNats (KnownNat, SomeNat(..), Nat, natVal, someNatVal) import Math.NumberTheory.Utils (recipMod) @@ -68,7 +70,7 @@ Point _ 0 == Point _ 0 = True Point _ 0 == _ = False _ == Point _ 0 = False- p@(Point x1 z1) == Point x2 z2 = let n = pointN p in x1 * z2 `mod` n == x2 * z1 `mod` n+ p@(Point x1 z1) == Point x2 z2 = let n = pointN p in (x1 * z2 - x2 * z1) `rem` n == 0 -- | For debugging. instance (KnownNat a24, KnownNat n) => Show (Point a24 n) where
+ Math/NumberTheory/Diophantine.hs view
@@ -0,0 +1,83 @@+-- Module for Diophantine Equations and related functions++module Math.NumberTheory.Diophantine+ ( cornacchiaPrimitive+ , cornacchia+ )+where++import Data.List.Infinite (Infinite(..))+import qualified Data.List.Infinite as Inf++import Math.NumberTheory.Moduli.Sqrt ( sqrtsModFactorisation )+import Math.NumberTheory.Primes ( factorise+ , unPrime+ , UniqueFactorisation+ )+import Math.NumberTheory.Roots ( integerSquareRoot )+import Math.NumberTheory.Utils.FromIntegral++-- | See `cornacchiaPrimitive`, this is the internal algorithm implementation+-- as described at https://en.wikipedia.org/wiki/Cornacchia%27s_algorithm+cornacchiaPrimitive' :: Integer -> Integer -> [(Integer, Integer)]+cornacchiaPrimitive' d m = concatMap+ (findSolution . Inf.head . Inf.dropWhile (\r -> r * r >= m) . gcdSeq m)+ roots+ where+ roots :: [Integer]+ roots = filter (<= m `div` 2) $ sqrtsModFactorisation (m - d) (factorise m)++ gcdSeq :: Integer -> Integer -> Infinite Integer+ gcdSeq a b = a :< gcdSeq b (mod a b)++ -- If s = sqrt((m - r*r) / d) is an integer then (r, s) is a solution+ findSolution :: Integer -> [(Integer, Integer)]+ findSolution r = [ (r, s) | rem1 == 0 && s * s == s2 ]+ where+ (s2, rem1) = divMod (m - r * r) d+ s = integerSquareRoot s2++-- | @cornacchiaPrimitive d m@ finds all primitive solutions \((x, y)\) (i.e. with \(\gcd(x, y) = 1\))+-- to the Diophantine equation+-- \[ x^2 + d \cdot y^2 = m \]+-- Preconditions: \(1 \le d < m\) and \(\gcd(d, m) = 1\).+--+-- Throws error if the preconditions are not met.+--+-- When \(m\) is square-free these are all the positive integer solutions;+-- use 'cornacchia' to find all solutions for arbitrary \(m\).+cornacchiaPrimitive :: Integer -> Integer -> [(Integer, Integer)]+cornacchiaPrimitive d m+ | not (1 <= d && d < m) = error "precondition failed: 1 <= d < m"+ | gcd d m /= 1 = error "precondition failed: d and m coprime"+ |+ -- If d=1 then the algorithm doesn't generate symmetrical pairs+ d == 1 = concatMap genPairs solutions+ | otherwise = solutions+ where+ solutions = cornacchiaPrimitive' d m+ genPairs (x, y) = if x == y then [(x, y)] else [(x, y), (y, x)]++-- Find numbers whose square is a factor of the input+squareFactors :: UniqueFactorisation a => a -> [a]+squareFactors = foldl squareProducts [1] . factorise+ where+ squareProducts acc f = [ a * b | a <- acc, b <- squarePowers f ]+ squarePowers (p, a) = map (unPrime p ^) [0 .. wordToInt a `div` 2]++-- | @cornacchia d m@ finds all positive integer solutions \((x, y)\) to the Diophantine equation+-- \[ x^2 + d \cdot y^2 = m \]+-- Preconditions: \(1 \le d < m\) and \(\gcd(d, m) = 1\).+--+-- Throws error if the preconditions are not met.+--+-- Unlike 'cornacchiaPrimitive', this also finds non-primitive solutions (where \(\gcd(x, y) > 1\))+-- by solving the equation for each square divisor of \(m\) and scaling the results.+cornacchia :: Integer -> Integer -> [(Integer, Integer)]+cornacchia d m+ | not (1 <= d && d < m) = error "precondition failed: 1 <= d < m"+ | gcd d m /= 1 = error "precondition failed: d and m coprime"+ | otherwise = concatMap solve $ filter ((> d) . snd) candidates+ where+ candidates = map (\sf -> (sf, m `div` (sf * sf))) (squareFactors m)+ solve (sf, m') = map (\(x, y) -> (x * sf, y * sf)) (cornacchiaPrimitive d m')
+ Math/NumberTheory/DirichletCharacters.hs view
@@ -0,0 +1,560 @@+-- |+-- Module: Math.NumberTheory.DirichletCharacters+-- Copyright: (c) 2018 Bhavik Mehta+-- Licence: MIT+-- Maintainer: Bhavik Mehta <bhavikmehta8@gmail.com>+--+-- Implementation and enumeration of Dirichlet characters.+--++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-pattern-namespace-specifier #-}++module Math.NumberTheory.DirichletCharacters+ (+ -- * An absorbing semigroup+ OrZero, pattern Zero, pattern NonZero+ , orZeroToNum+ -- * Dirichlet characters+ , DirichletCharacter+ -- ** Construction+ , indexToChar+ , indicesToChars+ , characterNumber+ , allChars+ , fromTable+ -- ** Evaluation+ , eval+ , evalGeneral+ , evalAll+ -- ** Special Dirichlet characters+ , principalChar+ , isPrincipal+ , orderChar+ -- ** Real Dirichlet characters+ , RealCharacter+ , isRealCharacter+ , getRealChar+ , toRealFunction+ , jacobiCharacter+ -- ** Primitive characters+ , PrimitiveCharacter+ , isPrimitive+ , getPrimitiveChar+ , induced+ , makePrimitive+ , WithNat(..)+ -- * Roots of unity+ , RootOfUnity(..)+ , toRootOfUnity+ , toComplex+ -- * Debugging+ , validChar+ ) where++import Data.Bits (Bits(..))+import Data.Constraint+import Data.Foldable+import Data.Functor.Identity (Identity(..))+import Data.Kind+import Data.List (sort, unfoldr)+import Data.Maybe (mapMaybe, fromJust, fromMaybe)+import Data.Mod+import Data.Monoid (Ap(..))+import Data.Proxy (Proxy(..))+import Data.Ratio ((%), numerator, denominator)+import Data.Semigroup (Semigroup(..),Product(..))+import Data.Traversable+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV+import Data.Vector (Vector, (!))+import GHC.TypeNats (KnownNat, Nat, SomeNat(..), natVal, someNatVal)+import Numeric.Natural (Natural)++import Math.NumberTheory.ArithmeticFunctions (totient)+import Math.NumberTheory.Moduli.Chinese+import Math.NumberTheory.Moduli.Internal (discreteLogarithmPP)+import Math.NumberTheory.Moduli.Multiplicative+import Math.NumberTheory.Moduli.Singleton+import Math.NumberTheory.Primes+import Math.NumberTheory.RootsOfUnity+import Math.NumberTheory.Utils+import Math.NumberTheory.Utils.FromIntegral++-- | A Dirichlet character mod \(n\) is a group homomorphism from \((\mathbb{Z}/n\mathbb{Z})^*\)+-- to \(\mathbb{C}^*\), represented abstractly by `DirichletCharacter`. In particular, they take+-- values at roots of unity and can be evaluated using `eval`.+-- A Dirichlet character can be extended to a completely multiplicative function on \(\mathbb{Z}\)+-- by assigning the value 0 for \(a\) sharing a common factor with \(n\), using `evalGeneral`.+--+-- There are finitely many possible Dirichlet characters for a given modulus, in particular there+-- are \(\phi(n)\) characters modulo \(n\), where \(\phi\) refers to Euler's `totient` function.+-- This gives rise to `Enum` and `Bounded` instances.+newtype DirichletCharacter (n :: Nat) = Generated [DirichletFactor]++-- | The group (Z/nZ)^* decomposes to a product (Z/2^k0 Z)^* x (Z/p1^k1 Z)^* x ... x (Z/pi^ki Z)^*+-- where n = 2^k0 p1^k1 ... pi^ki, and the pj are odd primes, k0 possibly 0. Thus, a group+-- homomorphism from (Z/nZ)^* is characterised by group homomorphisms from each of these factor+-- groups. Furthermore, for odd p, we have (Z/p^k Z)^* isomorphic to Z / p^(k-1)*(p-1) Z, an+-- additive group, where an isomorphism is specified by a choice of primitive root.+-- Similarly, for k >= 2, (Z/2^k Z)^* is isomorphic to Z/2Z * (Z / 2^(k-2) Z) (and for k < 2+-- it is trivial). (See @lambda@ for this isomorphism).+-- Thus, to specify a Dirichlet character, it suffices to specify the value of generators+-- of each of these cyclic groups, when primitive roots are given. This data is given by a+-- DirichletFactor.+-- We have the invariant that the factors must be given in strictly increasing order, and the+-- generator is as given by @generator@, and are each non-trivial. These conditions are verified+-- using `validChar`.+data DirichletFactor = OddPrime { _getPrime :: Prime Natural+ , _getPower :: Word+ , _getGenerator :: Natural+ , _getValue :: RootOfUnity+ }+ | TwoPower { _getPower2 :: Int -- this ought to be Word, but many applications+ -- needed to use wordToInt, so Int is cleaner+ -- Required to be >= 2+ , _getFirstValue :: RootOfUnity+ , _getSecondValue :: RootOfUnity+ }+ | Two++instance Eq (DirichletCharacter n) where+ Generated a == Generated b = a == b++instance Eq DirichletFactor where+ TwoPower _ x1 x2 == TwoPower _ y1 y2 = x1 == y1 && x2 == y2+ OddPrime _ _ _ x == OddPrime _ _ _ y = x == y+ Two == Two = True+ _ == _ = False++-- | For primes, define the canonical primitive root as the smallest such.+generator :: Prime Natural -> Word -> Natural+generator p k = case cyclicGroupFromFactors [(p, k)] of+ Nothing -> error "illegal"+ Just (Some cg) -> case proofFromCyclicGroup cg of+ Sub Dict -> case mapMaybe (isPrimitiveRoot cg) [2..maxBound] of+ [] -> error "illegal"+ hd : _ -> unMod $ multElement $ unPrimitiveRoot hd++-- | Implement the function \(\lambda\) from page 5 of+-- https://www2.eecs.berkeley.edu/Pubs/TechRpts/1984/CSD-84-186.pdf+lambda :: Integer -> Int -> Integer+lambda x e = ((xPower - 1) `shiftR` (e+1)) .&. (modulus - 1)+ where+ modulus = 1 `shiftL` (e - 2)+ largeMod = 1 `shiftL` (2 * e - 1)+ xPower = case someNatVal largeMod of+ SomeNat (_ :: Proxy largeMod) ->+ toInteger (unMod (fromInteger x ^ (2 * modulus) :: Mod largeMod))+++-- | For elements of the multiplicative group \((\mathbb{Z}/n\mathbb{Z})^*\), a Dirichlet+-- character evaluates to a root of unity.+eval :: DirichletCharacter n -> MultMod n -> RootOfUnity+eval (Generated ds) m = foldMap (evalFactor m') ds+ where+ m' = toInteger $ unMod $ multElement m++-- | Evaluate each factor of the Dirichlet character.+evalFactor :: Integer -> DirichletFactor -> RootOfUnity+evalFactor m =+ \case+ OddPrime (toInteger . unPrime -> p) k (toInteger -> a) b ->+ discreteLogarithmPP p k a (m `rem` p^k) `stimes` b+ TwoPower k s b -> (if testBit m 1 then s else mempty)+ <> lambda (thingy k m) k `stimes` b+ Two -> mempty++thingy :: (Bits p, Num p) => Int -> p -> p+thingy k m = if testBit m 1+ then bit k - m'+ else m'+ where m' = m .&. (bit k - 1)++-- | A character can evaluate to a root of unity or zero: represented by @Nothing@.+evalGeneral :: KnownNat n => DirichletCharacter n -> Mod n -> OrZero RootOfUnity+evalGeneral chi t = case isMultElement t of+ Nothing -> Zero+ Just x -> NonZero $ eval chi x++-- | Give the principal character for this modulus: a principal character mod \(n\) is 1 for+-- \(a\) coprime to \(n\), and 0 otherwise.+principalChar :: KnownNat n => DirichletCharacter n+principalChar = minBound++mulChars :: DirichletCharacter n -> DirichletCharacter n -> DirichletCharacter n+mulChars (Generated x) (Generated y) = Generated (zipWith combine x y)+ where combine :: DirichletFactor -> DirichletFactor -> DirichletFactor+ combine Two Two = Two+ combine (OddPrime p k g n) (OddPrime _ _ _ m) =+ OddPrime p k g (n <> m)+ combine (TwoPower k a n) (TwoPower _ b m) =+ TwoPower k (a <> b) (n <> m)+ combine _ _ = error "internal error: malformed DirichletCharacter"++-- | This Semigroup is in fact a group, so @stimes@ can be called with a negative first argument.+instance Semigroup (DirichletCharacter n) where+ (<>) = mulChars+ stimes = stimesChar++instance KnownNat n => Monoid (DirichletCharacter n) where+ mempty = principalChar++stimesChar :: Integral a => a -> DirichletCharacter n -> DirichletCharacter n+stimesChar s (Generated xs) = Generated (map mult xs)+ where mult :: DirichletFactor -> DirichletFactor+ mult (OddPrime p k g n) = OddPrime p k g (s `stimes` n)+ mult (TwoPower k a b) = TwoPower k (s `stimes` a) (s `stimes` b)+ mult Two = Two++-- | We define `succ` and `pred` with more efficient implementations than+-- @`toEnum` . (+1) . `fromEnum`@.+instance KnownNat n => Enum (DirichletCharacter n) where+ toEnum = indexToChar . intToNatural+ fromEnum = integerToInt . characterNumber+ succ x = makeChar x (characterNumber x + 1)+ pred x = makeChar x (characterNumber x - 1)++ enumFromTo x y = bulkMakeChars x [fromEnum x..fromEnum y]+ enumFrom x = bulkMakeChars x [fromEnum x..]+ enumFromThenTo x y z = bulkMakeChars x [fromEnum x, fromEnum y..fromEnum z]+ enumFromThen x y = bulkMakeChars x [fromEnum x, fromEnum y..]++instance KnownNat n => Bounded (DirichletCharacter n) where+ minBound = indexToChar 0+ maxBound = indexToChar (totient n - 1)+ where n = natVal (Proxy :: Proxy n)++-- | We have a (non-canonical) enumeration of dirichlet characters.+characterNumber :: DirichletCharacter n -> Integer+characterNumber (Generated y) = foldl' go 0 y+ where go x (OddPrime p k _ a) = x * m + numerator (fromRootOfUnity a * (m % 1))+ where p' = naturalToInteger (unPrime p)+ m = p'^(k-1)*(p'-1)+ go x (TwoPower k a b) = x' * 2 + numerator (fromRootOfUnity a * 2)+ where m = bit (k-2) :: Integer+ x' = x `shiftL` (k-2) + numerator (fromRootOfUnity b * (m % 1))+ go x Two = x++-- | Give the dirichlet character from its number.+-- Inverse of `characterNumber`.+indexToChar :: forall n. KnownNat n => Natural -> DirichletCharacter n+indexToChar = runIdentity . indicesToChars . Identity++-- | Give a collection of dirichlet characters from their numbers. This may be more efficient than+-- `indexToChar` for multiple characters, as it prevents some internal recalculations.+indicesToChars :: forall n f. (KnownNat n, Functor f) => f Natural -> f (DirichletCharacter n)+indicesToChars = fmap (Generated . unroll t . (`mod` m))+ where n = natVal (Proxy :: Proxy n)+ (Product m, t) = mkTemplate n++-- | List all characters for the modulus. This is preferred to using @[minBound..maxBound]@.+allChars :: forall n. KnownNat n => [DirichletCharacter n]+allChars = indicesToChars [0..m-1]+ where m = totient $ natVal (Proxy :: Proxy n)++-- | The same as `indexToChar`, but if we're given a character we can create others more efficiently.+makeChar :: Integral a => DirichletCharacter n -> a -> DirichletCharacter n+makeChar x = runIdentity . bulkMakeChars x . Identity++-- | Use one character to make many more: better than indicesToChars since it avoids recalculating+-- some primitive roots+bulkMakeChars :: (Integral a, Functor f) => DirichletCharacter n -> f a -> f (DirichletCharacter n)+bulkMakeChars x = fmap (Generated . unroll t . (`mod` m) . fromIntegral')+ where (Product m, t) = templateFromCharacter x++-- We assign each natural a unique Template, which can be decorated (eg in `unroll`) to+-- form a DirichletCharacter. A Template effectively holds the information carried around+-- in a DirichletFactor which depends only on the modulus of the character.+data Template = OddTemplate { _getPrime' :: Prime Natural+ , _getPower' :: Word+ , _getGenerator' :: !Natural+ , _getModulus' :: !Natural+ }+ | TwoPTemplate { _getPower2' :: Int+ , _getModulus' :: !Natural+ } -- the modulus is derivable from the other values, but calculation+ -- may be expensive, so we pre-calculate it+ -- morally getModulus should be a prefactored but seems to be+ -- pointless here+ | TwoTemplate++templateFromCharacter :: DirichletCharacter n -> (Product Natural, [Template])+templateFromCharacter (Generated t) = traverse go t+ where go (OddPrime p k g _) = (Product m, OddTemplate p k g m)+ where p' = unPrime p+ m = p'^(k-1)*(p'-1)+ go (TwoPower k _ _) = (Product (2*m), TwoPTemplate k m)+ where m = bit (k-2)+ go Two = (Product 1, TwoTemplate)++mkTemplate :: Natural -> (Product Natural, [Template])+mkTemplate = go . sort . factorise+ where go :: [(Prime Natural, Word)] -> (Product Natural, [Template])+ go ((unPrime -> 2, 1): xs) = (Product 1, [TwoTemplate]) <> traverse odds xs+ go ((unPrime -> 2, wordToInt -> k): xs) = (Product (2*m), [TwoPTemplate k m]) <> traverse odds xs+ where m = bit (k-2)+ go xs = traverse odds xs+ odds :: (Prime Natural, Word) -> (Product Natural, Template)+ odds (p, k) = (Product m, OddTemplate p k (generator p k) m)+ where p' = unPrime p+ m = p'^(k-1)*(p'-1)++-- the validity of the produced dirichletfactor list here requires the template to be valid+unroll :: [Template] -> Natural -> [DirichletFactor]+unroll t m = snd (mapAccumL func m t)+ where func :: Natural -> Template -> (Natural, DirichletFactor)+ func a (OddTemplate p k g n) = (a1, OddPrime p k g (toRootOfUnity $ toInteger a2 % toInteger n))+ where (a1,a2) = quotRem a n+ func a (TwoPTemplate k n) = (b1, TwoPower k (toRootOfUnity $ toInteger a2 % 2) (toRootOfUnity $ toInteger b2 % toInteger n))+ where (a1,a2) = quotRem a 2+ (b1,b2) = quotRem a1 n+ func a TwoTemplate = (a, Two)++-- | Test if a given Dirichlet character is prinicpal for its modulus: a principal character mod+-- \(n\) is 1 for \(a\) coprime to \(n\), and 0 otherwise.+isPrincipal :: DirichletCharacter n -> Bool+isPrincipal chi = characterNumber chi == 0++-- | Induce a Dirichlet character to a higher modulus. If \(d \mid n\), then \(a \bmod{n}\) can be+-- reduced to \(a \bmod{d}\). Thus, the multiplicative function on \(\mathbb{Z}/d\mathbb{Z}\)+-- induces a multiplicative function on \(\mathbb{Z}/n\mathbb{Z}\).+--+-- >>> :set -XTypeApplications -XDataKinds+-- >>> chi = indexToChar 5 :: DirichletCharacter 45+-- >>> chi2 = induced @135 chi :: Maybe (DirichletCharacter 135)+induced :: forall n d. (KnownNat d, KnownNat n) => DirichletCharacter d -> Maybe (DirichletCharacter n)+induced (Generated start) = if n `rem` d == 0+ then Just (Generated (combine (snd $ mkTemplate n) start))+ else Nothing+ where n = natVal (Proxy :: Proxy n)+ d = natVal (Proxy :: Proxy d)+ combine :: [Template] -> [DirichletFactor] -> [DirichletFactor]+ combine [] _ = []+ combine ts [] = map newFactor ts+ combine (t:xs) (y:ys) = case (t,y) of+ (TwoTemplate, Two) -> Two: combine xs ys+ (TwoTemplate, _) -> Two: combine xs (y:ys)+ (TwoPTemplate k _, Two) -> TwoPower k mempty mempty: combine xs ys+ (TwoPTemplate k _, TwoPower _ a b) -> TwoPower k a b: combine xs ys+ (TwoPTemplate k _, _) -> TwoPower k mempty mempty: combine xs (y:ys)+ (OddTemplate p k _ _, OddPrime q _ g a) | p == q -> OddPrime p k g a: combine xs ys+ (OddTemplate p k g _, OddPrime q _ _ _) | p < q -> OddPrime p k g mempty: combine xs (y:ys)+ _ -> error "internal error in induced: please report this as a bug"+ newFactor :: Template -> DirichletFactor+ newFactor TwoTemplate = Two+ newFactor (TwoPTemplate k _) = TwoPower k mempty mempty+ newFactor (OddTemplate p k g _) = OddPrime p k g mempty++-- | The <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol> gives a real Dirichlet+-- character for odd moduli.+jacobiCharacter :: forall n. KnownNat n => Maybe (RealCharacter n)+jacobiCharacter = if odd n+ then Just $ RealChar $ Generated $ map go $ snd $ mkTemplate n+ else Nothing+ where n = natVal (Proxy :: Proxy n)+ go :: Template -> DirichletFactor+ go (OddTemplate p k g _) = OddPrime p k g $ toRootOfUnity (toInteger k % 2)+ -- jacobi symbol of a primitive root mod p over p is always -1+ go _ = error "internal error in jacobiCharacter: please report this as a bug"+ -- every factor of n should be odd++-- | A Dirichlet character is real if it is real-valued.+newtype RealCharacter n = RealChar { -- | Extract the character itself from a `RealCharacter`.+ getRealChar :: DirichletCharacter n+ }+ deriving Eq++-- | Test if a given `DirichletCharacter` is real, and if so give a `RealCharacter`.+isRealCharacter :: DirichletCharacter n -> Maybe (RealCharacter n)+isRealCharacter t@(Generated xs) = if all real xs then Just (RealChar t) else Nothing+ where real :: DirichletFactor -> Bool+ real (OddPrime _ _ _ a) = a <> a == mempty+ real (TwoPower _ _ b) = b <> b == mempty+ real Two = True++-- TODO: it should be possible to calculate this without eval/evalGeneral+-- and thus avoid using discrete log calculations: consider the order of m+-- inside each of the factor groups?+-- | Evaluate a real Dirichlet character, which can only take values \(-1,0,1\).+toRealFunction :: KnownNat n => RealCharacter n -> Mod n -> Int+toRealFunction (RealChar chi) m = case evalGeneral chi m of+ Zero -> 0+ NonZero t | t == mempty -> 1+ NonZero t | t == RootOfUnity (1 % 2) -> -1+ _ -> error "internal error in toRealFunction: please report this as a bug"+ -- A real character should not be able to evaluate to+ -- anything other than {-1,0,1}, so should not reach this branch++-- | Test if the internal DirichletCharacter structure is valid.+validChar :: forall n. KnownNat n => DirichletCharacter n -> Bool+validChar (Generated xs) = correctDecomposition && all correctPrimitiveRoot xs && all validValued xs+ where correctDecomposition = sort (factorise n) == map getPP xs+ getPP (TwoPower k _ _) = (two, intToWord k)+ getPP (OddPrime p k _ _) = (p, k)+ getPP Two = (two,1)+ correctPrimitiveRoot (OddPrime p k g _) = g == generator p k+ correctPrimitiveRoot _ = True+ validValued (TwoPower k a b) = a <> a == mempty && (bit (k-2) :: Integer) `stimes` b == mempty+ validValued (OddPrime (unPrime -> p) k _ a) = (p^(k-1)*(p-1)) `stimes` a == mempty+ validValued Two = True+ n = natVal (Proxy :: Proxy n)+ two = nextPrime 2++-- | Get the order of the Dirichlet Character.+orderChar :: DirichletCharacter n -> Integer+orderChar (Generated xs) = foldl' lcm 1 $ map orderFactor xs+ where orderFactor (TwoPower _ (RootOfUnity a) (RootOfUnity b)) = denominator a `lcm` denominator b+ orderFactor (OddPrime _ _ _ (RootOfUnity a)) = denominator a+ orderFactor Two = 1++-- | Test if a Dirichlet character is <https://en.wikipedia.org/wiki/Dirichlet_character#Primitive_characters_and_conductor primitive>.+isPrimitive :: DirichletCharacter n -> Maybe (PrimitiveCharacter n)+isPrimitive t@(Generated xs) = if all primitive xs then Just (PrimitiveCharacter t) else Nothing+ where primitive :: DirichletFactor -> Bool+ primitive Two = False+ -- for odd p, we're testing if phi(p^(k-1)) `stimes` a is 1, since this means the+ -- character can come from some the smaller modulus p^(k-1)+ primitive (OddPrime _ 1 _ a) = a /= mempty+ primitive (OddPrime (unPrime -> p) k _ a) = (p^(k-2)*(p-1)) `stimes` a /= mempty+ primitive (TwoPower 2 a _) = a /= mempty+ primitive (TwoPower k _ b) = (bit (k-3) :: Integer) `stimes` b /= mempty++-- | A Dirichlet character is primitive if cannot be 'induced' from any character with+-- strictly smaller modulus.+newtype PrimitiveCharacter n = PrimitiveCharacter { -- | Extract the character itself from a `PrimitiveCharacter`.+ getPrimitiveChar :: DirichletCharacter n+ }+ deriving Eq++-- | Wrapper to hide an unknown type-level natural.+data WithNat (a :: Nat -> Type) where+ WithNat :: KnownNat m => a m -> WithNat a++-- | This function also provides access to the new modulus on type level, with a KnownNat instance+makePrimitive :: DirichletCharacter n -> WithNat PrimitiveCharacter+makePrimitive (Generated xs) =+ case someNatVal (product mods) of+ SomeNat (Proxy :: Proxy m) -> WithNat (PrimitiveCharacter (Generated ys) :: PrimitiveCharacter m)+ where (mods,ys) = unzip (mapMaybe prim xs)+ prim :: DirichletFactor -> Maybe (Natural, DirichletFactor)+ prim Two = Nothing+ prim (OddPrime p' k g a) = case find works options of+ Nothing -> error "invalid character"+ Just (0,_) -> Nothing+ Just (i,_) -> Just (p^i, OddPrime p' i g a)+ where options = (0,1): [(i,p^(i-1)*(p-1)) | i <- [1..k]]+ works (_,phi) = phi `stimes` a == mempty+ p = unPrime p'+ prim (TwoPower k a b) = case find worksb options of+ Nothing -> error "invalid character"+ Just (2,_) | a == mempty -> Nothing+ Just (i,_) -> Just (bit i :: Natural, TwoPower i a b)+ where options = [(i, bit (i-2) :: Natural) | i <- [2..k]]+ worksb (_,phi) = phi `stimes` b == mempty++-- | Similar to Maybe, but with different Semigroup and Monoid instances.+type OrZero a = Ap Maybe a++-- | 'Ap' 'Nothing'+pattern Zero :: OrZero a+pattern Zero = Ap Nothing++-- | 'Ap' ('Just' x)+pattern NonZero :: a -> OrZero a+pattern NonZero x = Ap (Just x)++{-# COMPLETE Zero, NonZero #-}++-- | Interpret an `OrZero` as a number, taking the `Zero` case to be 0.+orZeroToNum :: Num a => (b -> a) -> OrZero b -> a+orZeroToNum _ Zero = 0+orZeroToNum f (NonZero x) = f x++-- | In general, evaluating a DirichletCharacter at a point involves solving the discrete logarithm+-- problem, which can be hard: the implementations here are around O(sqrt n).+-- However, evaluating a dirichlet character at every point amounts to solving the discrete+-- logarithm problem at every point also, which can be done together in O(n) time, better than+-- using a complex algorithm at each point separately. Thus, if a large number of evaluations+-- of a dirichlet character are required, `evalAll` will be better than `evalGeneral`, since+-- computations can be shared.+evalAll :: forall n. KnownNat n => DirichletCharacter n -> Vector (OrZero RootOfUnity)+evalAll (Generated xs) = V.generate (naturalToInt n) func+ where n = natVal (Proxy :: Proxy n)+ vectors = map mkVector xs+ func :: Int -> OrZero RootOfUnity+ func m = foldMap go vectors+ where go :: (Int, Vector (OrZero RootOfUnity)) -> OrZero RootOfUnity+ go (modulus,v) = v ! (m `mod` modulus)+ mkVector :: DirichletFactor -> (Int, Vector (OrZero RootOfUnity))+ mkVector Two = (2, V.fromList [Zero, mempty])+ mkVector (OddPrime p k (naturalToInt -> g) a) = (modulus, w)+ where+ p' = unPrime p+ modulus = naturalToInt (p'^k) :: Int+ w = V.create $ do+ v <- MV.replicate modulus Zero+ -- TODO: we're in the ST monad here anyway, could be better to use STRefs to manage+ -- this loop, the current implementation probably doesn't fuse well+ let powers = iterateMaybe go (1,mempty)+ go (m,x) = if m' > 1+ then Just (m', x<>a)+ else Nothing+ where m' = m*g `mod` modulus+ for_ powers $ \(m,x) -> MV.unsafeWrite v m (NonZero x)+ -- don't bother with bounds check since m was reduced mod p^k+ return v+ -- for powers of two we use lambda directly instead, since the generators of the cyclic+ -- groups aren't obvious; it's possible to get them though:+ -- 5^(lambda(5)^{-1} mod 2^(p-2)) mod 2^p+ mkVector (TwoPower k a b) = (modulus, w)+ where+ modulus = bit k+ w = V.generate modulus f+ f m+ | even m = Zero+ | otherwise = NonZero ((if testBit m 1 then a else mempty) <> lambda (toInteger m'') k `stimes` b)+ where m'' = thingy k m++-- somewhere between unfoldr and iterate+iterateMaybe :: (a -> Maybe a) -> a -> [a]+iterateMaybe f x = unfoldr (fmap (\t -> (t, f t))) (Just x)++-- | Attempt to construct a character from its table of values.+-- An inverse to `evalAll`, defined only on its image.+fromTable :: forall n. KnownNat n => Vector (OrZero RootOfUnity) -> Maybe (DirichletCharacter n)+fromTable v = if length v == naturalToInt n+ then traverse makeFactor tmpl >>= check . Generated+ else Nothing+ where n = natVal (Proxy :: Proxy n)+ n' = naturalToInteger n :: Integer+ tmpl = snd (mkTemplate n)+ check :: DirichletCharacter n -> Maybe (DirichletCharacter n)+ check chi = if evalAll chi == v then Just chi else Nothing+ makeFactor :: Template -> Maybe DirichletFactor+ makeFactor TwoTemplate = Just Two+ makeFactor (TwoPTemplate k _) = TwoPower k <$> getValue (-1,bit k) <*> getValue (exp4 k, bit k)+ makeFactor (OddTemplate p k g _) = OddPrime p k g <$> getValue (toInteger g, toInteger (unPrime p)^k)+ getValue :: (Integer, Integer) -> Maybe RootOfUnity+ getValue (g, m) = getAp (v ! fromInteger (fst (fromJust (chinese (g, m) (1, n' `quot` m))) `mod` n'))++exp4terms :: [Rational]+exp4terms = [4^k % product [1..k] | k <- [0..]]++-- For reasons that aren't clear to me, `exp4` gives the inverse of 1 under lambda, so it gives the generator+-- This is the same as https://oeis.org/A320814+-- In particular, lambda (exp4 n) n == 1 (for n >= 3)+-- I've verified this for 3 <= n <= 2000, so the reasoning in fromTable should be accurate for moduli below 2^2000+exp4 :: Int -> Integer+exp4 n+ = (`mod` bit n)+ $ sum+ $ map (\q -> (numerator q * fromMaybe (error "error in exp4") (recipMod (denominator q) (bit n))) `mod` bit n)+ $ take n exp4terms
− Math/NumberTheory/Euclidean.hs
@@ -1,164 +0,0 @@--- |--- Module: Math.NumberTheory.Euclidean--- Copyright: (c) 2018 Alexandre Rodrigues Baldé--- Licence: MIT--- Maintainer: Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>------ This module exports a class to represent Euclidean domains.-----{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Math.NumberTheory.Euclidean- ( Euclidean(..)- , WrappedIntegral(..)- ) where--import Prelude hiding (divMod, div, gcd, lcm, mod, quotRem, quot, rem)-import qualified Prelude as P--import GHC.Exts-import GHC.Integer.GMP.Internals-import Numeric.Natural---- | A class to represent a Euclidean domain,--- which is basically an 'Integral' without 'toInteger'.-class (Eq a, Num a) => Euclidean a where- -- | When restriced to a subring of the Euclidean domain @a@ isomorphic to- -- @Integer@, this function should match @quotRem@ for Integers.- quotRem :: a -> a -> (a, a)- -- | When restriced to a subring of the Euclidean domain @a@ isomorphic to- -- @Integer@, this function should match @divMod@ for Integers.- divMod :: a -> a -> (a, a)-- quot :: a -> a -> a- quot x y = fst (quotRem x y)-- rem :: a -> a -> a- rem x y = snd (quotRem x y)-- div :: a -> a -> a- div x y = fst (divMod x y)-- mod :: a -> a -> a- mod x y = snd (divMod x y)-- -- | @'gcd' x y@ is the greatest number that divides both @x@ and @y@.- gcd :: a -> a -> a- gcd x y = gcd' (abs x) (abs y)- where- gcd' :: a -> a -> a- gcd' a 0 = a- gcd' a b = gcd' b (abs (a `mod` b))-- -- | @'lcm' x y@ is the smallest number that both @x@ and @y@ divide.- lcm :: a -> a -> a- lcm _ 0 = 0- lcm 0 _ = 0- lcm x y = abs ((x `quot` (gcd x y)) * y)-- -- | Test whether two numbers are coprime.- coprime :: a -> a -> Bool- coprime x y = gcd x y == 1-- -- | Calculate the greatest common divisor of two numbers and coefficients- -- for the linear combination.- --- -- For signed types satisfies:- --- -- > case extendedGCD a b of- -- > (d, u, v) -> u*a + v*b == d- -- > && d == gcd a b- --- -- For unsigned and bounded types the property above holds, but since @u@ and @v@ must also be unsigned,- -- the result may look weird. E. g., on 64-bit architecture- --- -- > extendedGCD (2 :: Word) (3 :: Word) == (1, 2^64-1, 1)- --- -- For unsigned and unbounded types (like 'Numeric.Natural.Natural') the result is undefined.- --- -- For signed types we also have- --- -- > abs u < abs b || abs b <= 1- -- >- -- > abs v < abs a || abs a <= 1- --- -- (except if one of @a@ and @b@ is 'minBound' of a signed type).- extendedGCD :: a -> a -> (a, a, a)- extendedGCD a b = (d, x * signum a, y * signum b)- where- (d, x, y) = eGCD 0 1 1 0 (abs a) (abs b)- eGCD !n1 o1 !n2 o2 r s- | s == 0 = (r, o1, o2)- | otherwise = case r `quotRem` s of- (q, t) -> eGCD (o1 - q*n1) n1 (o2 - q*n2) n2 s t--coprimeIntegral :: Integral a => a -> a -> Bool-coprimeIntegral x y = (odd x || odd y) && P.gcd x y == 1---- | Wrapper around 'Integral', which has an 'Euclidean' instance.-newtype WrappedIntegral a = WrappedIntegral { unWrappedIntegral :: a }- deriving (Eq, Ord, Show, Num, Integral, Real, Enum)--instance Integral a => Euclidean (WrappedIntegral a) where- quotRem = P.quotRem- divMod = P.divMod- quot = P.quot- rem = P.rem- div = P.div- mod = P.mod- gcd = P.gcd- lcm = P.lcm- coprime = coprimeIntegral--instance Euclidean Int where- quotRem = P.quotRem- divMod = P.divMod- quot = P.quot- rem = P.rem- div = P.div- mod = P.mod- gcd (I# x) (I# y) = I# (gcdInt x y)- lcm = P.lcm- coprime = coprimeIntegral--instance Euclidean Word where- quotRem = P.quotRem- divMod = P.divMod- quot = P.quot- rem = P.rem- div = P.div- mod = P.mod- gcd (W# x) (W# y) = W# (gcdWord x y)- lcm = P.lcm- coprime = coprimeIntegral--instance Euclidean Integer where- quotRem = P.quotRem- divMod = P.divMod- quot = P.quot- rem = P.rem- div = P.div- mod = P.mod- gcd = gcdInteger- lcm = lcmInteger- coprime = coprimeIntegral- -- Blocked by GHC bug- -- https://ghc.haskell.org/trac/ghc/ticket/15350- -- extendedGCD = gcdExtInteger---- | Beware that 'extendedGCD' does not make any sense for 'Natural'.-instance Euclidean Natural where- quotRem = P.quotRem- divMod = P.divMod- quot = P.quot- rem = P.rem- div = P.div- mod = P.mod- gcd = P.gcd- lcm = P.lcm- coprime = coprimeIntegral
Math/NumberTheory/Euclidean/Coprimes.hs view
@@ -6,8 +6,8 @@ -- -- Container for pairwise coprime numbers. -{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} module Math.NumberTheory.Euclidean.Coprimes ( splitIntoCoprimes@@ -19,12 +19,11 @@ import Prelude hiding (gcd, quot, rem) import Data.Coerce-import Data.List (tails, mapAccumL)-#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif--import Math.NumberTheory.Euclidean+import Data.Euclidean+import Data.List (tails)+import Data.Maybe+import Data.Semiring (Semiring(..), isZero)+import Data.Traversable -- | A list of pairwise coprime numbers -- with their multiplicities.@@ -33,48 +32,63 @@ } deriving (Eq, Show) -doPair :: (Euclidean a, Eq b, Num b) => a -> b -> a -> b -> (a, a, [(a, b)])-doPair x xm y ym = case gcd x y of- 1 -> (x, y, [])- g -> (x', y', concat rests)+unsafeDivide :: GcdDomain a => a -> a -> a+unsafeDivide x y = case x `divide` y of+ Nothing -> error "violated prerequisite of unsafeDivide"+ Just z -> z++-- | Check whether an element is a unit of the ring.+isUnit :: (Eq a, GcdDomain a) => a -> Bool+isUnit x = not (isZero x) && isJust (one `divide` x)++doPair :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> a -> b -> (a, a, [(a, b)])+doPair x xm y ym+ | isUnit g = (x, y, [])+ | otherwise = (x', y', concat rests) where- (x', g', xgs) = doPair (x `quot` g) xm g (xm + ym)- xgs' = if g' == 1 then xgs else ((g', xm + ym) : xgs)+ g = gcd x y - (y', rests) = mapAccumL go (y `quot` g) xgs'- go w (t, tm) = (w', if t' == 1 then acc else (t', tm) : acc)+ (x', g', xgs) = doPair (x `unsafeDivide` g) xm g (xm + ym)+ xgs' = if isUnit g' then xgs else (g', xm + ym) : xgs++ (y', rests) = mapAccumL go (y `unsafeDivide` g) xgs'+ go w (t, tm) = (w', if isUnit t' || tm == 0 then acc else (t', tm) : acc) where (w', t', acc) = doPair w ym t tm -_propDoPair :: (Euclidean a, Integral b) => a -> b -> a -> b -> Bool+_propDoPair :: (Eq a, Num a, GcdDomain a, Integral b) => a -> b -> a -> b -> Bool _propDoPair x xm y ym- = x `rem` x' == 0- && y `rem` y' == 0+ = isJust (x `divide` x')+ && isJust (y `divide` y') && coprime x' y'- && all (coprime x') (map fst rest)- && all (coprime y') (map fst rest)- && all (/= 1) (map fst rest)+ && all (coprime x' . fst) rest+ && all (coprime y' . fst) rest+ && not (any (isUnit . fst) rest) && and [ coprime s t | (s, _) : ts <- tails rest, (t, _) <- ts ]- && (x ^ xm) * (y ^ ym) == (x' ^ xm) * (y' ^ ym) * product (map (\(r, k) -> r ^ k) rest)+ && abs ((x ^ xm) * (y ^ ym)) == abs ((x' ^ xm) * (y' ^ ym) * product (map (uncurry (^)) rest)) where (x', y', rest) = doPair x xm y ym insertInternal :: forall a b.- (Euclidean a, Eq b, Num b)+ (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> Coprimes a b -> (Coprimes a b, Coprimes a b)-insertInternal 0 _ = const (Coprimes [(0, 1)], Coprimes [])-insertInternal xx xm = coerce (go ([], []) xx)+insertInternal xx xm+ | isZero xx && xm == 0 = (, Coprimes [])+ | isZero xx = const (Coprimes [(zero, 1)], Coprimes [])+ | otherwise = coerce (go ([], []) xx) where go :: ([(a, b)], [(a, b)]) -> a -> [(a, b)] -> ([(a, b)], [(a, b)])- go (old, new) 1 rest = (rest ++ old, new)+ go (old, new) x rest+ | isUnit x = (rest ++ old, new) go (old, new) x [] = (old, (x, xm) : new)- go _ _ ((0, _) : _) = ([(0, 1)], [])+ go _ _ ((x, _) : _)+ | isZero x = ([(zero, 1)], []) go (old, new) x ((y, ym) : rest)- | y' == 1 = go (old, xys ++ new) x' rest+ | isUnit y' = go (old, xys ++ new) x' rest | otherwise = go ((y', ym) : old, xys ++ new) x' rest where (x', y', xys) = doPair x xm y ym@@ -83,10 +97,11 @@ -- -- >>> singleton 210 1 -- Coprimes {unCoprimes = [(210,1)]}-singleton :: (Eq a, Num a, Eq b, Num b) => a -> b -> Coprimes a b-singleton 0 0 = Coprimes []-singleton 1 _ = Coprimes []-singleton a b = Coprimes [(a, b)]+singleton :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> Coprimes a b+singleton a b+ | isZero a && b == 0 = Coprimes []+ | isUnit a = Coprimes []+ | otherwise = Coprimes [(a, b)] -- | Add a non-zero number with its multiplicity to 'Coprimes'. --@@ -94,19 +109,18 @@ -- Coprimes {unCoprimes = [(7,1),(5,2),(3,3),(2,4)]} -- >>> insert 2 4 (insert 7 1 (insert 5 2 (singleton 4 3))) -- Coprimes {unCoprimes = [(7,1),(5,2),(2,10)]}-insert :: (Euclidean a, Eq b, Num b) => a -> b -> Coprimes a b -> Coprimes a b+insert :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> Coprimes a b -> Coprimes a b insert x xm ys = Coprimes $ unCoprimes zs <> unCoprimes ws where (zs, ws) = insertInternal x xm ys -instance (Euclidean a, Eq b, Num b) => Semigroup (Coprimes a b) where+instance (Eq a, GcdDomain a, Eq b, Num b) => Semigroup (Coprimes a b) where (Coprimes xs) <> ys = Coprimes $ unCoprimes zs <> foldMap unCoprimes wss where (zs, wss) = mapAccumL (\vs (x, xm) -> insertInternal x xm vs) ys xs -instance (Euclidean a, Eq b, Num b) => Monoid (Coprimes a b) where+instance (Eq a, GcdDomain a, Eq b, Num b) => Monoid (Coprimes a b) where mempty = Coprimes []- mappend = (<>) -- | The input list is assumed to be a factorisation of some number -- into a list of powers of (possibly, composite) non-zero factors. The output@@ -120,5 +134,5 @@ -- Coprimes {unCoprimes = [(28,1),(33,1),(5,2)]} -- >>> splitIntoCoprimes [(360, 1), (210, 1)] -- Coprimes {unCoprimes = [(7,1),(5,2),(3,3),(2,4)]}-splitIntoCoprimes :: (Euclidean a, Eq b, Num b) => [(a, b)] -> Coprimes a b+splitIntoCoprimes :: (Eq a, GcdDomain a, Eq b, Num b) => [(a, b)] -> Coprimes a b splitIntoCoprimes = foldl (\acc (x, xm) -> insert x xm acc) mempty
Math/NumberTheory/Moduli.hs view
@@ -10,15 +10,13 @@ module Math.NumberTheory.Moduli ( module Math.NumberTheory.Moduli.Class , module Math.NumberTheory.Moduli.Chinese- , module Math.NumberTheory.Moduli.DiscreteLogarithm- , module Math.NumberTheory.Moduli.Jacobi- , module Math.NumberTheory.Moduli.PrimitiveRoot+ , module Math.NumberTheory.Moduli.Multiplicative+ , module Math.NumberTheory.Moduli.Singleton , module Math.NumberTheory.Moduli.Sqrt ) where import Math.NumberTheory.Moduli.Chinese import Math.NumberTheory.Moduli.Class-import Math.NumberTheory.Moduli.DiscreteLogarithm-import Math.NumberTheory.Moduli.Jacobi-import Math.NumberTheory.Moduli.PrimitiveRoot+import Math.NumberTheory.Moduli.Multiplicative+import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Moduli.Sqrt
+ Math/NumberTheory/Moduli/Cbrt.hs view
@@ -0,0 +1,160 @@+-- |+-- Module: Math.NumberTheory.Moduli.Cbrt+-- Copyright: (c) 2020 Federico Bongiorno+-- Licence: MIT+-- Maintainer: Federico Bongiorno <federicobongiorno97@gmail.com>+--+-- <https://en.wikipedia.org/wiki/Cubic_reciprocity#Cubic_residue_character Cubic symbol>+-- of two Eisenstein Integers.++{-# LANGUAGE LambdaCase #-}++module Math.NumberTheory.Moduli.Cbrt+ ( CubicSymbol(..)+ , cubicSymbol+ , symbolToNum+ ) where++import Math.NumberTheory.Quadratic.EisensteinIntegers+import Math.NumberTheory.Utils.FromIntegral+import qualified Data.Euclidean as A+import Math.NumberTheory.Utils+import Data.Semigroup++-- | Represents the+-- <https://en.wikipedia.org/wiki/Cubic_reciprocity#Cubic_residue_character cubic residue character>+-- It is either @0@, @ω@, @ω²@ or @1@.+data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq)++-- | The set of cubic symbols form a semigroup. Note `stimes`+-- is allowed to take non-positive values. In other words, the set+-- of non-zero cubic symbols is regarded as a group.+--+-- >>> import Data.Semigroup+-- >>> stimes (-1) Omega+-- ω²+-- >>> stimes 0 Zero+-- 1+instance Semigroup CubicSymbol where+ Zero <> _ = Zero+ _ <> Zero = Zero+ One <> y = y+ x <> One = x+ Omega <> Omega = OmegaSquare+ Omega <> OmegaSquare = One+ OmegaSquare <> Omega = One+ OmegaSquare <> OmegaSquare = Omega+ stimes k n = case (k `mod` 3, n) of+ (0, _) -> One+ (1, symbol) -> symbol+ (2, Omega) -> OmegaSquare+ (2, OmegaSquare) -> Omega+ (2, symbol) -> symbol+ _ -> error "Math.NumberTheory.Moduli.Cbrt: exponentiation undefined."++instance Show CubicSymbol where+ show = \case+ Zero -> "0"+ Omega -> "ω"+ OmegaSquare -> "ω²"+ One -> "1"++-- | Converts a+-- <https://en.wikipedia.org/wiki/Cubic_reciprocity#Cubic_residue_character cubic symbol>+-- to an Eisenstein Integer.+symbolToNum :: CubicSymbol -> EisensteinInteger+symbolToNum = \case+ Zero -> 0+ Omega -> ω+ OmegaSquare -> -1 - ω+ One -> 1++-- The algorithm `cubicSymbol` is adapted from+-- <https://cs.au.dk/~gudmund/Documents/cubicres.pdf here>.+-- It is divided in the following steps.+--+-- (1) Check whether @beta@ is coprime to 3.+-- (2) Replace @alpha@ by the remainder of @alpha@ mod @beta@+-- This does not affect the cubic symbol.+-- (3) Replace @alpha@ and @beta@ by their associated primary+-- divisors and keep track of how their cubic residue changes.+-- (4) Check if any of the two numbers is a zero or a unit. In this+-- case, return their cubic residue.+-- (5) Otherwise, invoke cubic reciprocity by swapping @alpha@ and+-- @beta@. Note both numbers have to be primary.+-- Return to Step 2.++-- | <https://en.wikipedia.org/wiki/Cubic_reciprocity#Cubic_residue_character Cubic symbol>+-- of two Eisenstein Integers.+-- The first argument is the numerator and the second argument+-- is the denominator. The latter must be coprime to @3@.+-- This condition is checked.+--+-- If the arguments have a common factor, the result+-- is 'Zero', otherwise it is either 'Omega', 'OmegaSquare' or 'One'.+--+-- >>> cubicSymbol (45 + 23*ω) (11 - 30*ω)+-- 0+-- >>> cubicSymbol (31 - ω) (1 +10*ω)+-- ω+cubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol+cubicSymbol alpha beta = case beta `A.rem` (1 - ω) of+ -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@+ -- In particular, it returns an error if @beta == 0@+ 0 -> error "Math.NumberTheory.Moduli.Cbrt: denominator is not coprime to 3."+ _ -> cubicSymbolHelper alpha beta++cubicSymbolHelper :: EisensteinInteger -> EisensteinInteger -> CubicSymbol+cubicSymbolHelper alpha beta = cubicReciprocity primaryRemainder primaryBeta <> newSymbol+ where+ (primaryRemainder, primaryBeta, newSymbol) = extractPrimaryContributions remainder beta+ remainder = A.rem alpha beta++cubicReciprocity :: EisensteinInteger -> EisensteinInteger -> CubicSymbol+-- Note @cubicReciprocity 0 1 = One@. It is better to adopt this convention.+cubicReciprocity _ 1 = One+-- Checks if first argument is zero. Note the second argument is never zero.+cubicReciprocity 0 _ = Zero+-- This checks if the first argument is a unit. Because it's primary,+-- it is enough to pattern match with 1.+cubicReciprocity 1 _ = One+-- Otherwise, cubic reciprocity is called.+cubicReciprocity alpha beta = cubicSymbolHelper beta alpha++-- | This function takes two Eisenstein integers @alpha@ and @beta@ and returns+-- three arguments @(gamma, delta, newSymbol)@. @gamma@ and @delta@ are the+-- associated primary numbers of alpha and beta respectively. @newSymbol@+-- is the cubic symbol measuring the discrepancy between the cubic residue+-- of @alpha@ and @beta@, and the cubic residue of @gamma@ and @delta@.+extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, CubicSymbol)+extractPrimaryContributions alpha beta = (gamma, delta, newSymbol)+ where+ newSymbol = stimes (j * m) Omega <> stimes (- m - n) i+ m :+ n = A.quot (delta - 1) 3+ (i, gamma) = getPrimaryDecomposition alphaThreeFree+ (_, delta) = getPrimaryDecomposition beta+ j = wordToInteger jIntWord+ -- This function outputs data such that+ -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@.+ (jIntWord, alphaThreeFree) = splitOff (1 - ω) alpha++-- | This function takes an Eisenstein number @e@ and returns @(symbol, delta)@+-- where @delta@ is its associated primary integer and @symbol@ is the+-- cubic symbol discrepancy between @e@ and @delta@. @delta@ is defined to be+-- the unique associated Eisenstein Integer to @e@ such that+-- \( \textrm{delta} \equiv 1 (\textrm{mod} 3) \).+-- Note that @delta@ exists if and only if @e@ is coprime to 3. In this+-- case, an error message is displayed.+getPrimaryDecomposition :: EisensteinInteger -> (CubicSymbol, EisensteinInteger)+-- This is the case where a common factor between @alpha@ and @beta@ is detected.+-- In this instance @cubicReciprocity@ will return `Zero`.+-- Strictly speaking, this is not a primary decomposition.+getPrimaryDecomposition 0 = (Zero, 0)+getPrimaryDecomposition e = case e `A.rem` 3 of+ 1 -> (One, e)+ 1 :+ 1 -> (OmegaSquare, -ω * e)+ 0 :+ 1 -> (Omega, (-1 - ω) * e)+ (-1) :+ 0 -> (One, -e)+ (-1) :+ (-1) -> (OmegaSquare, ω * e)+ 0 :+ (-1) -> (Omega, (1 + ω) * e)+ _ -> error "Math.NumberTheory.Moduli.Cbrt: primary decomposition failed."
Math/NumberTheory/Moduli/Chinese.hs view
@@ -7,147 +7,60 @@ -- Chinese remainder theorem -- -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-} -#if __GLASGOW_HASKELL__ > 805-{-# LANGUAGE NoStarIsType #-}-#endif- module Math.NumberTheory.Moduli.Chinese ( -- * Safe interface chinese- , chineseCoprime , chineseSomeMod- , chineseCoprimeSomeMod-- , -- * Unsafe interface- chineseRemainder- , chineseRemainder2 ) where -import Prelude hiding (mod, quot, gcd, lcm)+import Prelude hiding ((^), (+), (-), (*), rem, mod, quot, gcd, lcm) -import Control.Monad (foldM)-import Data.Foldable+import Data.Euclidean+import Data.Mod import Data.Ratio-import GHC.TypeNats.Compat-import Numeric.Natural--import Math.NumberTheory.Moduli.Class-import Math.NumberTheory.Euclidean-import Math.NumberTheory.Euclidean.Coprimes-import Math.NumberTheory.Utils (recipMod, splitOff)---- | 'chineseCoprime' @(n1, m1)@ @(n2, m2)@ returns @n@ such that--- @n \`mod\` m1 == n1@ and @n \`mod\` m2 == n2@.--- Moduli @m1@ and @m2@ must be coprime, otherwise 'Nothing' is returned.------ This function is slightly faster than 'chinese', but more restricted.------ >>> chineseCoprime (1, 2) (2, 3)--- Just 5--- >>> chineseCoprime (3, 4) (5, 6)--- Nothing -- moduli must be coprime-chineseCoprime :: Euclidean a => (a, a) -> (a, a) -> Maybe a-chineseCoprime (n1, m1) (n2, m2) = case d of- 1 -> Just $ ((1 - u * m1) * n1 + (1 - v * m2) * n2) `mod` (m1 * m2)- _ -> Nothing- where- (d, u, v) = extendedGCD m1 m2+import Data.Semiring (Semiring(..), (+), (-), (*), Ring)+import GHC.TypeNats (KnownNat, natVal) -{-# SPECIALISE chineseCoprime :: (Int, Int) -> (Int, Int) -> Maybe Int #-}-{-# SPECIALISE chineseCoprime :: (Word, Word) -> (Word, Word) -> Maybe Word #-}-{-# SPECIALISE chineseCoprime :: (Integer, Integer) -> (Integer, Integer) -> Maybe Integer #-}-{-# SPECIALISE chineseCoprime :: (Natural, Natural) -> (Natural, Natural) -> Maybe Natural #-}+import Math.NumberTheory.Moduli.SomeMod --- | 'chinese' @(n1, m1)@ @(n2, m2)@ returns @n@ such that+-- | 'chinese' @(n1, m1)@ @(n2, m2)@ returns @(n, lcm m1 m2)@ such that -- @n \`mod\` m1 == n1@ and @n \`mod\` m2 == n2@, if exists. -- Moduli @m1@ and @m2@ are allowed to have common factors. -- -- >>> chinese (1, 2) (2, 3)--- Just 5+-- Just (-1, 6) -- >>> chinese (3, 4) (5, 6)--- Just 11+-- Just (-1, 12) -- >>> chinese (3, 4) (2, 6) -- Nothing-chinese :: forall a. Euclidean a => (a, a) -> (a, a) -> Maybe a+chinese :: forall a. (Eq a, Ring a, Euclidean a) => (a, a) -> (a, a) -> Maybe (a, a) chinese (n1, m1) (n2, m2)- | n1 `mod` g == n2 `mod` g- = chineseCoprime (n1 `mod` m1', m1') (n2 `mod` m2', m2')+ | d == one+ = Just ((v * m2 * n1 + u * m1 * n2) `rem` m, m)+ | (n1 - n2) `rem` d == zero+ = Just ((v * (m2 `quot` d) * n1 + u * (m1 `quot` d) * n2) `rem` m, m) | otherwise = Nothing where- g :: a- g = gcd m1 m2-- ms :: [(a, Word)]- ms = unCoprimes $ splitIntoCoprimes [(m1, 1), (m2 `quot` g, 1)]-- m1', m2' :: a- (m1', m2') = foldl' go (1, 1) $ map fst ms-- go :: (a, a) -> a -> (a, a)- go (t1, t2) p- | k1 <= k2- = (t1, t2 * p ^ k2)- | otherwise- = (t1 * p ^ k1, t2)- where- (k1, _) = splitOff p m1- (k2, _) = splitOff p m2+ (d, u, v) = extendedGCD m1 m2+ m = if d == one then m1 * m2 else (m1 `quot` d) * m2 -{-# SPECIALISE chinese :: (Int, Int) -> (Int, Int) -> Maybe Int #-}-{-# SPECIALISE chinese :: (Word, Word) -> (Word, Word) -> Maybe Word #-}-{-# SPECIALISE chinese :: (Integer, Integer) -> (Integer, Integer) -> Maybe Integer #-}-{-# SPECIALISE chinese :: (Natural, Natural) -> (Natural, Natural) -> Maybe Natural #-}+{-# SPECIALISE chinese :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) #-}+{-# SPECIALISE chinese :: (Word, Word) -> (Word, Word) -> Maybe (Word, Word) #-}+{-# SPECIALISE chinese :: (Integer, Integer) -> (Integer, Integer) -> Maybe (Integer, Integer) #-} isCompatible :: KnownNat m => Mod m -> Rational -> Bool isCompatible n r = case invertMod (fromInteger (denominator r)) of Nothing -> False Just r' -> r' * fromInteger (numerator r) == n -chineseWrap- :: (Integer -> Integer -> Integer)- -> ((Integer, Integer) -> (Integer, Integer) -> Maybe Integer)- -> SomeMod- -> SomeMod- -> Maybe SomeMod-chineseWrap f g (SomeMod n1) (SomeMod n2)- = fmap (`modulo` fromInteger (f m1 m2)) (g (getVal n1, m1) (getVal n2, m2))- where- m1 = getMod n1- m2 = getMod n2-chineseWrap _ _ (SomeMod n) (InfMod r)- | isCompatible n r = Just $ InfMod r- | otherwise = Nothing-chineseWrap _ _ (InfMod r) (SomeMod n)- | isCompatible n r = Just $ InfMod r- | otherwise = Nothing-chineseWrap _ _ (InfMod r1) (InfMod r2)- | r1 == r2 = Just $ InfMod r1- | otherwise = Nothing---- | Same as 'chineseCoprime', but operates on residues.------ >>> :set -XDataKinds--- >>> import Math.NumberTheory.Moduli.Class--- >>> (1 `modulo` 2) `chineseCoprimeSomeMod` (2 `modulo` 3)--- Just (5 `modulo` 6)--- >>> (3 `modulo` 4) `chineseCoprimeSomeMod` (5 `modulo` 6)--- Nothing-chineseCoprimeSomeMod :: SomeMod -> SomeMod -> Maybe SomeMod-chineseCoprimeSomeMod = chineseWrap (*) chineseCoprime- -- | Same as 'chinese', but operates on residues. -- -- >>> :set -XDataKinds--- >>> import Math.NumberTheory.Moduli.Class+-- >>> import Data.Mod -- >>> (1 `modulo` 2) `chineseSomeMod` (2 `modulo` 3) -- Just (5 `modulo` 6) -- >>> (3 `modulo` 4) `chineseSomeMod` (5 `modulo` 6)@@ -155,39 +68,25 @@ -- >>> (3 `modulo` 4) `chineseSomeMod` (2 `modulo` 6) -- Nothing chineseSomeMod :: SomeMod -> SomeMod -> Maybe SomeMod-chineseSomeMod = chineseWrap lcm chinese+chineseSomeMod (SomeMod n1) (SomeMod n2)+ = (\(n, m) -> n `modulo` fromInteger m) <$> chinese+ (toInteger $ unMod n1, toInteger $ natVal n1)+ (toInteger $ unMod n2, toInteger $ natVal n2)+chineseSomeMod (SomeMod n) (InfMod r)+ | isCompatible n r = Just $ InfMod r+ | otherwise = Nothing+chineseSomeMod (InfMod r) (SomeMod n)+ | isCompatible n r = Just $ InfMod r+ | otherwise = Nothing+chineseSomeMod (InfMod r1) (InfMod r2)+ | r1 == r2 = Just $ InfMod r1+ | otherwise = Nothing ---------------------------------------------------------------------------------- Unsafe interface---- | Given a list @[(r_1,m_1), ..., (r_n,m_n)]@ of @(residue,modulus)@--- pairs, @chineseRemainder@ calculates the solution to the simultaneous--- congruences------ >--- > r ≡ r_k (mod m_k)--- >------ if all moduli are positive and pairwise coprime. Otherwise--- the result is @Nothing@ regardless of whether--- a solution exists.-chineseRemainder :: [(Integer, Integer)] -> Maybe Integer-chineseRemainder remainders = foldM addRem 0 remainders- where- !modulus = product (map snd remainders)- addRem acc (_,1) = Just acc- addRem acc (r,m) = do- let cf = modulus `quot` m- inv <- recipMod cf m- Just $! (acc + inv*cf*r) `mod` modulus+-- Utils --- | @chineseRemainder2 (r_1,m_1) (r_2,m_2)@ calculates the solution of------ >--- > r ≡ r_k (mod m_k)------ if @m_1@ and @m_2@ are coprime.-chineseRemainder2 :: (Integer, Integer) -> (Integer, Integer) -> Integer-chineseRemainder2 (n1, m1) (n2, m2) = ((1 - u * m1) * n1 + (1 - v * m2) * n2) `mod` (m1 * m2)+extendedGCD :: (Eq a, Ring a, Euclidean a) => a -> a -> (a, a, a)+extendedGCD a b = (g, s, t) where- (_, u, v) = extendedGCD m1 m2+ (g, s) = gcdExt a b+ t = (g - a * s) `quot` b
Math/NumberTheory/Moduli/Class.hs view
@@ -7,17 +7,11 @@ -- Safe modular arithmetic with modulo on type level. -- -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE UnboxedTuples #-} module Math.NumberTheory.Moduli.Class ( -- * Known modulo@@ -43,94 +37,12 @@ , KnownNat ) where -import Data.Proxy-import Data.Ratio-import Data.Semigroup-import Data.Type.Equality-import GHC.Exts-import GHC.Integer.GMP.Internals-import GHC.Natural (Natural(..), powModNatural)-import GHC.TypeNats.Compat---- | Wrapper for residues modulo @m@.------ @Mod 3 :: Mod 10@ stands for the class of integers, congruent to 3 modulo 10 (…−17, −7, 3, 13, 23…).--- The modulo is stored on type level, so it is impossible, for example, to add up by mistake--- residues with different moduli.------ >>> :set -XDataKinds--- >>> (3 :: Mod 10) + (4 :: Mod 12)--- error: Couldn't match type ‘12’ with ‘10’...--- >>> (3 :: Mod 10) + 8--- (1 `modulo` 10)------ Note that modulo cannot be negative.-newtype Mod (m :: Nat) = Mod Natural- deriving (Eq, Ord, Enum)--instance KnownNat m => Show (Mod m) where- show m = "(" ++ show (getVal m) ++ " `modulo` " ++ show (getMod m) ++ ")"--instance KnownNat m => Bounded (Mod m) where- minBound = Mod 0- maxBound = let mx = Mod (getNatMod mx - 1) in mx--instance KnownNat m => Num (Mod m) where- mx@(Mod x) + Mod y =- Mod $ if xy >= m then xy - m else xy- where- xy = x + y- m = getNatMod mx- {-# INLINE (+) #-}- mx@(Mod x) - Mod y =- Mod $ if x >= y then x - y else m + x - y- where- m = getNatMod mx- {-# INLINE (-) #-}- negate mx@(Mod x) =- Mod $ if x == 0 then 0 else getNatMod mx - x- {-# INLINE negate #-}-- -- If modulo is small and fits into one machine word,- -- there is no need to use long arithmetic at all- -- and we can save some allocations.- mx@(Mod (NatS# x#)) * (Mod (NatS# y#)) = case getNatMod mx of- NatS# m# -> let !(# z1#, z2# #) = timesWord2# x# y# in- let !(# _, r# #) = quotRemWord2# z1# z2# m# in- Mod (NatS# r#)- NatJ# b# -> let !(# z1#, z2# #) = timesWord2# x# y# in- let r# = wordToBigNat2 z1# z2# `remBigNat` b# in- Mod $ if isTrue# (sizeofBigNat# r# ==# 1#)- then NatS# (bigNatToWord r#)- else NatJ# r#-- mx@(Mod !x) * (Mod !y) =- Mod $ x * y `rem` getNatMod mx- -- `rem` is slightly faster than `mod`- {-# INLINE (*) #-}-- abs = id- {-# INLINE abs #-}- signum = const $ Mod 1- {-# INLINE signum #-}- fromInteger x = mx- where- mx = Mod $ fromInteger $ x `mod` getMod mx- {-# INLINE fromInteger #-}+import Data.Mod+import GHC.Natural+import GHC.TypeNats (KnownNat, natVal) --- | Beware that division by residue, which is not coprime with the modulo,--- will result in runtime error. Consider using 'invertMod' instead.-instance KnownNat m => Fractional (Mod m) where- fromRational r = case denominator r of- 1 -> num- den -> num / fromInteger den- where- num = fromInteger (numerator r)- {-# INLINE fromRational #-}- recip mx = case invertMod mx of- Nothing -> error $ "recip{Mod}: residue is not coprime with modulo"- Just y -> y- {-# INLINE recip #-}+import Math.NumberTheory.Moduli.Multiplicative+import Math.NumberTheory.Moduli.SomeMod -- | Linking type and value levels: extract modulo @m@ as a value. getMod :: KnownNat m => Mod m -> Integer@@ -142,231 +54,17 @@ getNatMod = natVal {-# INLINE getNatMod #-} --- | The canonical representative of the residue class, always between 0 and @m-1@ inclusively.+-- | The canonical representative of the residue class, always between 0 and m-1 inclusively. getVal :: Mod m -> Integer-getVal (Mod x) = toInteger x+getVal = toInteger . unMod {-# INLINE getVal #-} --- | The canonical representative of the residue class, always between 0 and @m-1@ inclusively.+-- | The canonical representative of the residue class, always between 0 and m-1 inclusively. getNatVal :: Mod m -> Natural-getNatVal (Mod x) = x+getNatVal = unMod {-# INLINE getNatVal #-} --- | Computes the modular inverse, if the residue is coprime with the modulo.------ >>> :set -XDataKinds--- >>> invertMod (3 :: Mod 10)--- Just (7 `modulo` 10) -- because 3 * 7 = 1 :: Mod 10--- >>> invertMod (4 :: Mod 10)--- Nothing-invertMod :: KnownNat m => Mod m -> Maybe (Mod m)-invertMod mx- = if y <= 0- then Nothing- else Just $ Mod $ fromInteger y- where- -- first argument of recipModInteger is guaranteed to be positive- y = recipModInteger (getVal mx) (getMod mx)-{-# INLINABLE invertMod #-}---- | Drop-in replacement for 'Prelude.^', with much better performance.------ >>> :set -XDataKinds--- >>> powMod (3 :: Mod 10) 4--- (1 `modulo` 10)+-- | Synonym of '(^%)'. powMod :: (KnownNat m, Integral a) => Mod m -> a -> Mod m-powMod mx a- | a < 0 = error $ "^{Mod}: negative exponent"- | otherwise = Mod $ powModNatural (getNatVal mx) (fromIntegral a) (getNatMod mx)-{-# INLINABLE [1] powMod #-}--{-# SPECIALISE [1] powMod ::- KnownNat m => Mod m -> Integer -> Mod m,- KnownNat m => Mod m -> Natural -> Mod m,- KnownNat m => Mod m -> Int -> Mod m,- KnownNat m => Mod m -> Word -> Mod m #-}--{-# RULES-"powMod/2/Integer" forall x. powMod x (2 :: Integer) = let u = x in u*u-"powMod/3/Integer" forall x. powMod x (3 :: Integer) = let u = x in u*u*u-"powMod/2/Int" forall x. powMod x (2 :: Int) = let u = x in u*u-"powMod/3/Int" forall x. powMod x (3 :: Int) = let u = x in u*u*u-"powMod/2/Word" forall x. powMod x (2 :: Word) = let u = x in u*u-"powMod/3/Word" forall x. powMod x (3 :: Word) = let u = x in u*u*u-#-}---- | Infix synonym of 'powMod'.-(^%) :: (KnownNat m, Integral a) => Mod m -> a -> Mod m-(^%) = powMod-{-# INLINE (^%) #-}--infixr 8 ^%---- Unfortunately, such rule never fires due to technical details--- of type classes in Core.--- {-# RULES "^%Mod" forall (x :: KnownNat m => Mod m) p. x ^ p = x ^% p #-}---- | This type represents elements of the multiplicative group mod m, i.e.--- those elements which are coprime to m. Use @toMultElement@ to construct.-newtype MultMod m = MultMod {- multElement :: Mod m -- ^ Unwrap a residue.- } deriving (Eq, Ord, Show)--instance KnownNat m => Semigroup (MultMod m) where- MultMod a <> MultMod b = MultMod (a * b)- stimes k a@(MultMod a')- | k >= 0 = MultMod (powMod a' k)- | otherwise = invertGroup $ stimes (-k) a- -- ^ This Semigroup is in fact a group, so @stimes@ can be called with a negative first argument.--instance KnownNat m => Monoid (MultMod m) where- mempty = MultMod 1- mappend = (<>)--instance KnownNat m => Bounded (MultMod m) where- minBound = MultMod 1- maxBound = MultMod (-1)---- | Attempt to construct a multiplicative group element.-isMultElement :: KnownNat m => Mod m -> Maybe (MultMod m)-isMultElement a = if getNatVal a `gcd` getNatMod a == 1- then Just $ MultMod a- else Nothing---- | For elements of the multiplicative group, we can safely perform the inverse--- without needing to worry about failure.-invertGroup :: KnownNat m => MultMod m -> MultMod m-invertGroup (MultMod a) = case invertMod a of- Just b -> MultMod b- Nothing -> error "Math.NumberTheory.Moduli.invertGroup: failed to invert element"---- | This type represents residues with unknown modulo and rational numbers.--- One can freely combine them in arithmetic expressions, but each operation--- will spend time on modulo's recalculation:------ >>> 2 `modulo` 10 + 4 `modulo` 15--- (1 `modulo` 5)--- >>> (2 `modulo` 10) * (4 `modulo` 15)--- (3 `modulo` 5)--- >>> 2 `modulo` 10 + fromRational (3 % 7)--- (1 `modulo` 10)--- >>> 2 `modulo` 10 * fromRational (3 % 7)--- (8 `modulo` 10)------ If performance is crucial, it is recommended to extract @Mod m@ for further processing--- by pattern matching. E. g.,------ > case modulo n m of--- > SomeMod k -> process k -- Here k has type Mod m--- > InfMod{} -> error "impossible"-data SomeMod where- SomeMod :: KnownNat m => Mod m -> SomeMod- InfMod :: Rational -> SomeMod--instance Eq SomeMod where- SomeMod mx == SomeMod my = getMod mx == getMod my && getVal mx == getVal my- InfMod rx == InfMod ry = rx == ry- _ == _ = False--instance Show SomeMod where- show = \case- SomeMod m -> show m- InfMod r -> show r---- | Create modular value by representative of residue class and modulo.--- One can use the result either directly (via functions from 'Num' and 'Fractional'),--- or deconstruct it by pattern matching. Note that 'modulo' never returns 'InfMod'.-modulo :: Integer -> Natural -> SomeMod-modulo n m = case someNatVal m of- SomeNat (_ :: Proxy t) -> SomeMod (fromInteger n :: Mod t)-{-# INLINABLE modulo #-}-infixl 7 `modulo`--liftUnOp- :: (forall k. KnownNat k => Mod k -> Mod k)- -> (Rational -> Rational)- -> SomeMod- -> SomeMod-liftUnOp fm fr = \case- SomeMod m -> SomeMod (fm m)- InfMod r -> InfMod (fr r)-{-# INLINEABLE liftUnOp #-}--liftBinOpMod- :: (KnownNat m, KnownNat n)- => (forall k. KnownNat k => Mod k -> Mod k -> Mod k)- -> Mod m- -> Mod n- -> SomeMod-liftBinOpMod f mx@(Mod x) my@(Mod y) = case someNatVal m of- SomeNat (_ :: Proxy t) -> SomeMod (Mod (x `mod` m) `f` Mod (y `mod` m) :: Mod t)- where- m = natVal mx `gcd` natVal my--liftBinOp- :: (forall k. KnownNat k => Mod k -> Mod k -> Mod k)- -> (Rational -> Rational -> Rational)- -> SomeMod- -> SomeMod- -> SomeMod-liftBinOp _ fr (InfMod rx) (InfMod ry) = InfMod (rx `fr` ry)-liftBinOp fm _ (InfMod rx) (SomeMod my) = SomeMod (fromRational rx `fm` my)-liftBinOp fm _ (SomeMod mx) (InfMod ry) = SomeMod (mx `fm` fromRational ry)-liftBinOp fm _ (SomeMod (mx :: Mod m)) (SomeMod (my :: Mod n))- = case (Proxy :: Proxy m) `sameNat` (Proxy :: Proxy n) of- Nothing -> liftBinOpMod fm mx my- Just Refl -> SomeMod (mx `fm` my)--instance Num SomeMod where- (+) = liftBinOp (+) (+)- (-) = liftBinOp (-) (+)- negate = liftUnOp negate negate- {-# INLINE negate #-}- (*) = liftBinOp (*) (*)- abs = id- {-# INLINE abs #-}- signum = const 1- {-# INLINE signum #-}- fromInteger = InfMod . fromInteger- {-# INLINE fromInteger #-}---- | Beware that division by residue, which is not coprime with the modulo,--- will result in runtime error. Consider using 'invertSomeMod' instead.-instance Fractional SomeMod where- fromRational = InfMod- {-# INLINE fromRational #-}- recip x = case invertSomeMod x of- Nothing -> error $ "recip{SomeMod}: residue is not coprime with modulo"- Just y -> y---- | Computes the inverse value, if it exists.------ >>> invertSomeMod (3 `modulo` 10)--- Just (7 `modulo` 10) -- because 3 * 7 = 1 :: Mod 10--- >>> invertSomeMod (4 `modulo` 10)--- Nothing--- >>> invertSomeMod (fromRational (2 % 5))--- Just 5 % 2-invertSomeMod :: SomeMod -> Maybe SomeMod-invertSomeMod = \case- SomeMod m -> fmap SomeMod (invertMod m)- InfMod r -> Just (InfMod (recip r))-{-# INLINABLE [1] invertSomeMod #-}--{-# SPECIALISE [1] powSomeMod ::- SomeMod -> Integer -> SomeMod,- SomeMod -> Natural -> SomeMod,- SomeMod -> Int -> SomeMod,- SomeMod -> Word -> SomeMod #-}---- | Drop-in replacement for 'Prelude.^', with much better performance.--- When -O is enabled, there is a rewrite rule, which specialises 'Prelude.^' to 'powSomeMod'.------ >>> powSomeMod (3 `modulo` 10) 4--- (1 `modulo` 10)-powSomeMod :: Integral a => SomeMod -> a -> SomeMod-powSomeMod (SomeMod m) a = SomeMod (m ^% a)-powSomeMod (InfMod r) a = InfMod (r ^ a)-{-# INLINABLE [1] powSomeMod #-}--{-# RULES "^%SomeMod" forall x p. x ^ p = powSomeMod x p #-}+powMod = (^%)+{-# INLINE powMod #-}
− Math/NumberTheory/Moduli/DiscreteLogarithm.hs
@@ -1,125 +0,0 @@--- |--- Module: Math.NumberTheory.Moduli.DiscreteLogarithm--- Copyright: (c) 2018 Bhavik Mehta--- License: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>-----{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}--module Math.NumberTheory.Moduli.DiscreteLogarithm- ( discreteLogarithm- ) where--import qualified Data.IntMap.Strict as M-import Data.Maybe (maybeToList)-import Data.Proxy-import Numeric.Natural (Natural)-import GHC.Integer.GMP.Internals (recipModInteger, powModInteger)-import GHC.TypeNats.Compat--import Math.NumberTheory.Moduli.Chinese (chineseRemainder2)-import Math.NumberTheory.Moduli.Class (KnownNat, MultMod(..), Mod, getVal)-import Math.NumberTheory.Moduli.Equations (solveLinear)-import Math.NumberTheory.Moduli.PrimitiveRoot (PrimitiveRoot(..), CyclicGroup(..))-import Math.NumberTheory.Powers.Squares (integerSquareRoot)-import Math.NumberTheory.Primes (unPrime)---- | Computes the discrete logarithm. Currently uses a combination of the baby-step--- giant-step method and Pollard's rho algorithm, with Bach reduction.-discreteLogarithm :: KnownNat m => PrimitiveRoot m -> MultMod m -> Natural-discreteLogarithm a b = discreteLogarithm' (getGroup a) (multElement $ unPrimitiveRoot a) (multElement b)--discreteLogarithm'- :: KnownNat m- => CyclicGroup Natural -- ^ group structure (must be the multiplicative group mod m)- -> Mod m -- ^ a- -> Mod m -- ^ b- -> Natural -- ^ result-discreteLogarithm' cg a b =- case cg of- CG2- -> 0- -- the only valid input was a=1, b=1- CG4- -> if b == 1 then 0 else 1- -- the only possible input here is a=3 with b = 1 or 3- CGOddPrimePower (toInteger . unPrime -> p) k- -> discreteLogarithmPP p k (getVal a) (getVal b)- CGDoubleOddPrimePower (toInteger . unPrime -> p) k- -> discreteLogarithmPP p k (getVal a `rem` p^k) (getVal b `rem` p^k)- -- we have the isomorphism t -> t `rem` p^k from (Z/2p^kZ)* -> (Z/p^kZ)*---- Implementation of Bach reduction (https://www2.eecs.berkeley.edu/Pubs/TechRpts/1984/CSD-84-186.pdf)-{-# INLINE discreteLogarithmPP #-}-discreteLogarithmPP :: Integer -> Word -> Integer -> Integer -> Natural-discreteLogarithmPP p 1 a b = discreteLogarithmPrime p a b-discreteLogarithmPP p k a b = fromInteger result- where- baseSol = toInteger $ discreteLogarithmPrime p (a `rem` p) (b `rem` p)- thetaA = theta p pkMinusOne a- thetaB = theta p pkMinusOne b- pkMinusOne = p^(k-1)- c = (recipModInteger thetaA pkMinusOne * thetaB) `rem` pkMinusOne- result = chineseRemainder2 (baseSol, p-1) (c, pkMinusOne)---- compute the homomorphism theta given in https://math.stackexchange.com/a/1864495/418148-{-# INLINE theta #-}-theta :: Integer -> Integer -> Integer -> Integer-theta p pkMinusOne a = (numerator `quot` pk) `rem` pkMinusOne- where- pk = pkMinusOne * p- p2kMinusOne = pkMinusOne * pk- numerator = (powModInteger a (pk - pkMinusOne) p2kMinusOne - 1) `rem` p2kMinusOne---- TODO: Use Pollig-Hellman to reduce the problem further into groups of prime order.--- While Bach reduction simplifies the problem into groups of the form (Z/pZ)*, these--- have non-prime order, and the Pollig-Hellman algorithm can reduce the problem into--- smaller groups of prime order.--- In addition, the gcd check before solveLinear is applied in Pollard below will be--- made redundant, since n would be prime.-discreteLogarithmPrime :: Integer -> Integer -> Integer -> Natural-discreteLogarithmPrime p a b- | p < 100000000 = fromIntegral $ discreteLogarithmPrimeBSGS (fromInteger p) (fromInteger a) (fromInteger b)- | otherwise = discreteLogarithmPrimePollard p a b--discreteLogarithmPrimeBSGS :: Int -> Int -> Int -> Int-discreteLogarithmPrimeBSGS p a b = head [i*m + j | (v,i) <- zip giants [0..m-1], j <- maybeToList (M.lookup v table)]- where- m = integerSquareRoot (p - 2) + 1 -- simple way of ceiling (sqrt (p-1))- babies = iterate (.* a) 1- table = M.fromList (zip babies [0..m-1])- aInv = recipModInteger (toInteger a) (toInteger p)- bigGiant = fromInteger $ powModInteger aInv (toInteger m) (toInteger p)- giants = iterate (.* bigGiant) b- x .* y = x * y `rem` p---- TODO: Use more advanced walks, in order to reduce divisions, cf--- https://maths-people.anu.edu.au/~brent/pd/rpb231.pdf--- This will slightly improve the expected time to collision, and can reduce the--- number of divisions performed.-discreteLogarithmPrimePollard :: Integer -> Integer -> Integer -> Natural-discreteLogarithmPrimePollard p a b =- case concatMap runPollard [(x,y) | x <- [0..n], y <- [0..n]] of- (t:_) -> fromInteger t- [] -> error ("discreteLogarithm: pollard's rho failed, please report this as a bug. inputs " ++ show [p,a,b])- where- n = p-1 -- order of the cyclic group- halfN = n `quot` 2- mul2 m = if m < halfN then m * 2 else m * 2 - n- sqrtN = integerSquareRoot n- step (xi,!ai,!bi) = case xi `rem` 3 of- 0 -> (xi*xi `rem` p, mul2 ai, mul2 bi)- 1 -> ( a*xi `rem` p, ai+1, bi)- _ -> ( b*xi `rem` p, ai, bi+1)- initialise (x,y) = (powModInteger a x n * powModInteger b y n `rem` n, x, y)- begin t = go (step t) (step (step t))- check t = powModInteger a t p == b- go tort@(xi,ai,bi) hare@(x2i,a2i,b2i)- | xi == x2i, gcd (bi - b2i) n < sqrtN = case someNatVal (fromInteger n) of- SomeNat (Proxy :: Proxy n) -> map getVal $ solveLinear (fromInteger (bi - b2i) :: Mod n) (fromInteger (ai - a2i))- | xi == x2i = []- | otherwise = go (step tort) (step (step hare))- runPollard = filter check . begin . initialise
Math/NumberTheory/Moduli/Equations.hs view
@@ -7,18 +7,25 @@ -- Polynomial modular equations. -- +{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedSums #-} {-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Math.NumberTheory.Moduli.Equations ( solveLinear , solveQuadratic ) where -import GHC.Integer.GMP.Internals+import Data.Constraint+import Data.Maybe+import Data.Mod+import GHC.Num.Integer+import GHC.TypeNats (KnownNat, natVal) import Math.NumberTheory.Moduli.Chinese-import Math.NumberTheory.Moduli.Class+import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Moduli.Sqrt import Math.NumberTheory.Primes import Math.NumberTheory.Utils (recipMod)@@ -36,7 +43,7 @@ => Mod m -- ^ a -> Mod m -- ^ b -> [Mod m] -- ^ list of x-solveLinear a b = map fromInteger $ solveLinear' (getMod a) (getVal a) (getVal b)+solveLinear a b = map fromInteger $ solveLinear' (toInteger (natVal a)) (toInteger (unMod a)) (toInteger (unMod b)) solveLinear' :: Integer -> Integer -> Integer -> [Integer] solveLinear' m a b = case solveLinearCoprime m' (a `quot` d) (b `quot` d) of@@ -56,29 +63,29 @@ -- | Find all solutions of ax² + bx + c ≡ 0 (mod m). -- -- >>> :set -XDataKinds--- >>> solveQuadratic (1 :: Mod 32) 0 (-17) -- solving x² - 17 ≡ 0 (mod 32)+-- >>> solveQuadratic sfactors (1 :: Mod 32) 0 (-17) -- solving x² - 17 ≡ 0 (mod 32) -- [(9 `modulo` 32),(25 `modulo` 32),(7 `modulo` 32),(23 `modulo` 32)] solveQuadratic- :: KnownNat m- => Mod m -- ^ a+ :: SFactors Integer m+ -> Mod m -- ^ a -> Mod m -- ^ b -> Mod m -- ^ c -> [Mod m] -- ^ list of x-solveQuadratic a b c- = map fromInteger- $ fst- $ combine- $ map (\(p, n) -> (solveQuadraticPrimePower a' b' c' p n, unPrime p ^ n))- $ factorise- $ getMod a+solveQuadratic sm a b c = case proofFromSFactors sm of+ Sub Dict ->+ map fromInteger+ $ fst+ $ combine+ $ map (\(p, n) -> (solveQuadraticPrimePower a' b' c' p n, unPrime p ^ n))+ $ unSFactors sm where- a' = getVal a- b' = getVal b- c' = getVal c+ a' = toInteger $ unMod a+ b' = toInteger $ unMod b+ c' = toInteger $ unMod c combine :: [([Integer], Integer)] -> ([Integer], Integer) combine = foldl- (\(xs, xm) (ys, ym) -> ([ chineseRemainder2 (x, xm) (y, ym) | x <- xs, y <- ys ], xm * ym))+ (\(xs, xm) (ys, ym) -> ([ fst $ fromJust $ chinese (x, xm) (y, ym) | x <- xs, y <- ys ], xm * ym)) ([0], 1) solveQuadraticPrimePower@@ -116,20 +123,18 @@ -> Integer -> Prime Integer -> [Integer]-solveQuadraticPrime a b c (unPrime -> 2 :: Integer)+solveQuadraticPrime a b c (unPrime -> (2 :: Integer)) = case (even c, even (a + b)) of (True, True) -> [0, 1] (True, _) -> [0] (_, False) -> [1] _ -> [] solveQuadraticPrime a b c p- | a `mod` p' == 0+ | a `rem` p' == 0 = solveLinear' p' b c | otherwise- = map (\n -> n * recipModInteger (2 * a) p' `mod` p')- $ map (subtract b)+ = map (\n -> let (# t | #) = integerRecipMod# (2 * a) (fromInteger p') in (n - b) * toInteger t `mod` p') $ sqrtsModPrime (b * b - 4 * a * c) p where p' :: Integer p' = unPrime p-
+ Math/NumberTheory/Moduli/Internal.hs view
@@ -0,0 +1,159 @@+-- |+-- Module: Math.NumberTheory.Moduli.Internal+-- Copyright: (c) 2020 Bhavik Mehta+-- Licence: MIT+-- Maintainer: Bhavik Mehta <bhavikmehta8@gmail.com>+--+-- Multiplicative groups of integers modulo m.+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}++module Math.NumberTheory.Moduli.Internal+ ( isPrimitiveRoot'+ , discreteLogarithmPP+ ) where++import qualified Data.Map as M+import Data.Maybe+import Data.Mod+import Data.Proxy+import GHC.TypeNats (SomeNat(..), someNatVal)+import GHC.Num.Integer+import Numeric.Natural++import Math.NumberTheory.Moduli.Chinese+import Math.NumberTheory.Moduli.Equations+import Math.NumberTheory.Moduli.Singleton+import Math.NumberTheory.Primes+import Math.NumberTheory.Roots+import Math.NumberTheory.Utils.FromIntegral++-- https://en.wikipedia.org/wiki/Primitive_root_modulo_n#Finding_primitive_roots+isPrimitiveRoot'+ :: (Integral a, UniqueFactorisation a)+ => CyclicGroup a m+ -> a+ -> Bool+isPrimitiveRoot' cg r =+ case cg of+ CG2 -> r == 1+ CG4 -> r == 3+ CGOddPrimePower p k -> oddPrimePowerTest (unPrime p) k r+ CGDoubleOddPrimePower p k -> doubleOddPrimePowerTest (unPrime p) k r+ where+ oddPrimePowerTest p 1 g = oddPrimeTest p (g `mod` p)+ oddPrimePowerTest p _ g = oddPrimeTest p (g `mod` p) && case someNatVal (fromIntegral' (p * p)) of+ SomeNat (_ :: Proxy pp) -> fromIntegral g ^ (p - 1) /= (1 :: Mod pp)++ doubleOddPrimePowerTest p k g = odd g && oddPrimePowerTest p k g++ oddPrimeTest p g = g /= 0 && gcd g p == 1 && case someNatVal (fromIntegral' p) of+ SomeNat (_ :: Proxy p) -> all (\x -> fromIntegral g ^ x /= (1 :: Mod p)) pows+ where+ pows = map (\(q, _) -> (p - 1) `quot` unPrime q) (factorise (p - 1))++-- Implementation of Bach reduction (https://www2.eecs.berkeley.edu/Pubs/TechRpts/1984/CSD-84-186.pdf)+{-# INLINE discreteLogarithmPP #-}+discreteLogarithmPP :: Integer -> Word -> Integer -> Integer -> Natural+discreteLogarithmPP p 1 a b = discreteLogarithmPrime p a b+discreteLogarithmPP p k a b = fromInteger $ if result < 0 then result + pkMinusPk1 else result+ where+ baseSol = toInteger $ discreteLogarithmPrime p (a `rem` p) (b `rem` p)+ thetaA = theta p pkMinusOne a+ thetaB = theta p pkMinusOne b+ pkMinusOne = p^(k-1)+ c = (toInteger t * thetaB) `rem` pkMinusOne+ where+ (# t | #) = integerRecipMod# thetaA (fromInteger pkMinusOne)+ (result, pkMinusPk1) = fromJust $ chinese (baseSol, p-1) (c, pkMinusOne)++-- compute the homomorphism theta given in https://math.stackexchange.com/a/1864495/418148+{-# INLINE theta #-}+theta :: Integer -> Integer -> Integer -> Integer+theta p pkMinusOne a = (numerator `quot` pk) `rem` pkMinusOne+ where+ pk = pkMinusOne * p+ p2kMinusOne = pkMinusOne * pk+ numerator = (toInteger t - 1) `rem` p2kMinusOne+ where+ (# t | #) = integerPowMod# a (pk - pkMinusOne) (fromInteger p2kMinusOne)++-- TODO: Use Pollig-Hellman to reduce the problem further into groups of prime order.+-- While Bach reduction simplifies the problem into groups of the form (Z/pZ)*, these+-- have non-prime order, and the Pollig-Hellman algorithm can reduce the problem into+-- smaller groups of prime order.+-- In addition, the gcd check before solveLinear is applied in Pollard below will be+-- made redundant, since n would be prime.+discreteLogarithmPrime :: Integer -> Integer -> Integer -> Natural+discreteLogarithmPrime p a b+ | p < 100000000 = intToNatural $ discreteLogarithmPrimeBSGS (fromInteger p) (fromInteger a) (fromInteger b)+ | otherwise = discreteLogarithmPrimePollard p a b++discreteLogarithmPrimeBSGS :: Int -> Int -> Int -> Int+discreteLogarithmPrimeBSGS p a b =+ case [i*m + j | (v,i) <- zip giants [0..m-1], j <- maybeToList (M.lookup v table)] of+ [] -> error ("discreteLogarithmPrimeBSGS: failed, please report this as a bug. Inputs: " ++ show [p,a,b])+ hd : _ -> hd+ where+ m :: Int+ m = integerSquareRoot (p - 2) + 1 -- simple way of ceiling (sqrt (p-1))++ babies :: [Int]+ babies = iterate (.* a) 1++ table :: M.Map Int Int+ table = M.fromList (zip babies [0..m-1])++ aInv :: Integer+ aInv = fromIntegral ap+ where+ (# ap | #) = integerRecipMod# (toInteger a) (fromIntegral p)++ bigGiant :: Int+ bigGiant = fromIntegral aInvmp+ where+ (# aInvmp | #) = integerPowMod# aInv (toInteger m) (fromIntegral p)++ giants :: [Int]+ giants = iterate (.* bigGiant) b++ (.*) :: Int -> Int -> Int+ x .* y = x * y `rem` p++-- TODO: Use more advanced walks, in order to reduce divisions, cf+-- https://maths-people.anu.edu.au/~brent/pd/rpb231.pdf+-- This will slightly improve the expected time to collision, and can reduce the+-- number of divisions performed.+discreteLogarithmPrimePollard :: Integer -> Integer -> Integer -> Natural+discreteLogarithmPrimePollard p a b =+ case concatMap runPollard [(x,y) | x <- [0..n], y <- [0..n]] of+ (t:_) -> fromInteger t+ [] -> error ("discreteLogarithm: pollard's rho failed, please report this as a bug. Inputs: " ++ show [p,a,b])+ where+ n = p-1 -- order of the cyclic group+ halfN = n `quot` 2+ mul2 m = if m < halfN then m * 2 else m * 2 - n+ sqrtN = integerSquareRoot n+ step (xi,!ai,!bi) = case xi `rem` 3 of+ 0 -> (xi*xi `rem` p, mul2 ai, mul2 bi)+ 1 -> ( a*xi `rem` p, ai+1, bi)+ _ -> ( b*xi `rem` p, ai, bi+1)+ initialise (x,y) = (toInteger axn * toInteger byn `rem` n, x, y)+ where+ (# axn | #) = integerPowMod# a x (fromInteger n)+ (# byn | #) = integerPowMod# b y (fromInteger n)+ begin t = go (step t) (step (step t))+ check t = case integerPowMod# a t (fromInteger p) of+ (# atp | #) -> toInteger atp == b+ (# | _ #) -> False+ go tort@(xi,ai,bi) hare@(x2i,a2i,b2i)+ | xi == x2i, gcd (bi - b2i) n < sqrtN = case someNatVal (fromInteger n) of+ SomeNat (Proxy :: Proxy n) -> map (toInteger . unMod) $ solveLinear (fromInteger (bi - b2i) :: Mod n) (fromInteger (ai - a2i))+ | xi == x2i = []+ | otherwise = go (step tort) (step (step hare))+ runPollard = filter check . begin . initialise
− Math/NumberTheory/Moduli/Jacobi.hs
@@ -1,120 +0,0 @@--- |--- Module: Math.NumberTheory.Moduli.Jacobi--- Copyright: (c) 2011 Daniel Fischer, 2017-2018 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol>--- is a generalization of the Legendre symbol, useful for primality--- testing and integer factorization.-----{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}--{-# OPTIONS_GHC -fno-warn-deprecations #-}--module Math.NumberTheory.Moduli.Jacobi- ( JacobiSymbol(..)- , jacobi- ) where--import Data.Bits-#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif-import Numeric.Natural--import Math.NumberTheory.Utils---- | Represents three possible values of--- <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol>.-data JacobiSymbol = MinusOne | Zero | One- deriving (Eq, Ord, Show)--instance Semigroup JacobiSymbol where- (<>) = \case- MinusOne -> negJS- Zero -> const Zero- One -> id--instance Monoid JacobiSymbol where- mempty = One- mappend = (<>)--negJS :: JacobiSymbol -> JacobiSymbol-negJS = \case- MinusOne -> One- Zero -> Zero- One -> MinusOne---- | <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol> of two arguments.--- The lower argument (\"denominator\") must be odd and positive,--- this condition is checked.------ If arguments have a common factor, the result--- is 'Zero', otherwise it is 'MinusOne' or 'One'.------ >>> jacobi 1001 9911--- Zero -- arguments have a common factor 11--- >>> jacobi 1001 9907--- MinusOne-{-# SPECIALISE jacobi :: Integer -> Integer -> JacobiSymbol,- Natural -> Natural -> JacobiSymbol,- Int -> Int -> JacobiSymbol,- Word -> Word -> JacobiSymbol- #-}-jacobi :: (Integral a, Bits a) => a -> a -> JacobiSymbol-jacobi _ 1 = One-jacobi a b- | b < 0 = error "Math.NumberTheory.Moduli.jacobi: negative denominator"- | evenI b = error "Math.NumberTheory.Moduli.jacobi: even denominator"- | otherwise = jacobi' a b -- b odd, > 1--jacobi' :: (Integral a, Bits a) => a -> a -> JacobiSymbol-jacobi' 0 _ = Zero-jacobi' 1 _ = One-jacobi' a b- | a < 0 = let n = if rem4is3 b then MinusOne else One- (z, o) = shiftToOddCount (negate a)- s = if evenI z || rem8is1or7 b then n else negJS n- in s <> jacobi' o b- | a >= b = case a `rem` b of- 0 -> Zero- r -> jacPS One r b- | evenI a = case shiftToOddCount a of- (z, o) -> let r = if rem4is3 o && rem4is3 b then MinusOne else One- s = if evenI z || rem8is1or7 b then r else negJS r- in jacOL s b o- | otherwise = jacOL (if rem4is3 a && rem4is3 b then MinusOne else One) b a---- numerator positive and smaller than denominator-jacPS :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol-jacPS !acc a b- | evenI a = case shiftToOddCount a of- (z, o)- | evenI z || rem8is1or7 b -> jacOL (if rem4is3 o && rem4is3 b then negJS acc else acc) b o- | otherwise -> jacOL (if rem4is3 o && rem4is3 b then acc else negJS acc) b o- | otherwise = jacOL (if rem4is3 a && rem4is3 b then negJS acc else acc) b a---- numerator odd, positive and larger than denominator-jacOL :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol-jacOL !acc _ 1 = acc-jacOL !acc a b = case a `rem` b of- 0 -> Zero- r -> jacPS acc r b---- Utilities---- Sadly, GHC do not optimise `Prelude.even` to a bit test automatically.-evenI :: Bits a => a -> Bool-evenI n = not (n `testBit` 0)---- For an odd input @n@ test whether n `rem` 4 == 1-rem4is3 :: Bits a => a -> Bool-rem4is3 n = n `testBit` 1---- For an odd input @n@ test whether (n `rem` 8) `elem` [1, 7]-rem8is1or7 :: Bits a => a -> Bool-rem8is1or7 n = n `testBit` 1 == n `testBit` 2
+ Math/NumberTheory/Moduli/JacobiSymbol.hs view
@@ -0,0 +1,124 @@+-- |+-- Module: Math.NumberTheory.Moduli.JacobiSymbol+-- Copyright: (c) 2011 Daniel Fischer, 2017-2018 Andrew Lelechenko+-- Licence: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+-- Description: Deprecated+--+-- <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol>+-- is a generalization of the Legendre symbol, useful for primality+-- testing and integer factorization.+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}++module Math.NumberTheory.Moduli.JacobiSymbol+ ( JacobiSymbol(..)+ , jacobi+ , symbolToNum+ ) where++import Data.Bits+import Numeric.Natural++import Math.NumberTheory.Utils++-- | Represents three possible values of+-- <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol>.+data JacobiSymbol = MinusOne | Zero | One+ deriving (Eq, Ord, Show)++instance Semigroup JacobiSymbol where+ (<>) = \case+ MinusOne -> negJS+ Zero -> const Zero+ One -> id++negJS :: JacobiSymbol -> JacobiSymbol+negJS = \case+ MinusOne -> One+ Zero -> Zero+ One -> MinusOne++-- | Convenience function to convert out of a Jacobi symbol+symbolToNum :: Num a => JacobiSymbol -> a+symbolToNum = \case+ Zero -> 0+ One -> 1+ MinusOne -> -1++{-# SPECIALISE symbolToNum :: JacobiSymbol -> Integer #-}+{-# SPECIALISE symbolToNum :: JacobiSymbol -> Int #-}+{-# SPECIALISE symbolToNum :: JacobiSymbol -> Word #-}+{-# SPECIALISE symbolToNum :: JacobiSymbol -> Natural #-}++-- | <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol> of two arguments.+-- The lower argument (\"denominator\") must be odd and positive,+-- this condition is checked.+--+-- If arguments have a common factor, the result+-- is 'Zero', otherwise it is 'MinusOne' or 'One'.+--+-- >>> jacobi 1001 9911 -- arguments have a common factor 11+-- Zero+-- >>> jacobi 1001 9907+-- MinusOne+jacobi :: (Integral a, Bits a) => a -> a -> JacobiSymbol+jacobi _ 1 = One+jacobi a b+ | b < 0 = error "Math.NumberTheory.Moduli.jacobi: negative denominator"+ | evenI b = error "Math.NumberTheory.Moduli.jacobi: even denominator"+ | otherwise = jacobi' a b -- b odd, > 1++{-# SPECIALISE jacobi :: Integer -> Integer -> JacobiSymbol #-}+{-# SPECIALISE jacobi :: Natural -> Natural -> JacobiSymbol #-}+{-# SPECIALISE jacobi :: Int -> Int -> JacobiSymbol #-}+{-# SPECIALISE jacobi :: Word -> Word -> JacobiSymbol #-}++jacobi' :: (Integral a, Bits a) => a -> a -> JacobiSymbol+jacobi' 0 _ = Zero+jacobi' 1 _ = One+jacobi' a b+ | a < 0 = let n = if rem4is3 b then MinusOne else One+ (z, o) = shiftToOddCount (negate a)+ s = if evenI z || rem8is1or7 b then n else negJS n+ in s <> jacobi' o b+ | a >= b = case a `rem` b of+ 0 -> Zero+ r -> jacPS One r b+ | evenI a = case shiftToOddCount a of+ (z, o) -> let r = if rem4is3 o && rem4is3 b then MinusOne else One+ s = if evenI z || rem8is1or7 b then r else negJS r+ in jacOL s b o+ | otherwise = jacOL (if rem4is3 a && rem4is3 b then MinusOne else One) b a++-- numerator positive and smaller than denominator+jacPS :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol+jacPS !acc a b+ | evenI a = case shiftToOddCount a of+ (z, o)+ | evenI z || rem8is1or7 b -> jacOL (if rem4is3 o && rem4is3 b then negJS acc else acc) b o+ | otherwise -> jacOL (if rem4is3 o && rem4is3 b then acc else negJS acc) b o+ | otherwise = jacOL (if rem4is3 a && rem4is3 b then negJS acc else acc) b a++-- numerator odd, positive and larger than denominator+jacOL :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol+jacOL !acc _ 1 = acc+jacOL !acc a b = case a `rem` b of+ 0 -> Zero+ r -> jacPS acc r b++-- Utilities++-- Sadly, GHC do not optimise `Prelude.even` to a bit test automatically.+evenI :: Bits a => a -> Bool+evenI n = not (n `testBit` 0)++-- For an odd input @n@ test whether n `rem` 4 == 1+rem4is3 :: Bits a => a -> Bool+rem4is3 n = n `testBit` 1++-- For an odd input @n@ test whether (n `rem` 8) `elem` [1, 7]+rem8is1or7 :: Bits a => a -> Bool+rem8is1or7 n = n `testBit` 1 == n `testBit` 2
+ Math/NumberTheory/Moduli/Multiplicative.hs view
@@ -0,0 +1,119 @@+-- |+-- Module: Math.NumberTheory.Moduli.Multiplicative+-- Copyright: (c) 2017 Andrew Lelechenko+-- Licence: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Multiplicative groups of integers modulo m.+--++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Math.NumberTheory.Moduli.Multiplicative+ ( -- * Multiplicative group+ MultMod+ , multElement+ , isMultElement+ , invertGroup+ -- * Primitive roots+ , PrimitiveRoot+ , unPrimitiveRoot+ , isPrimitiveRoot+ , discreteLogarithm+ ) where++import Control.Monad+import Data.Constraint+import Data.Mod+import Data.Semigroup+import GHC.TypeNats (KnownNat, natVal)+import Numeric.Natural++import Math.NumberTheory.Moduli.Internal+import Math.NumberTheory.Moduli.Singleton+import Math.NumberTheory.Primes++-- | This type represents elements of the multiplicative group mod m, i.e.+-- those elements which are coprime to m. Use @isMultElement@ to construct.+newtype MultMod m = MultMod {+ multElement :: Mod m -- ^ Unwrap a residue.+ } deriving (Eq, Ord, Show)++instance KnownNat m => Semigroup (MultMod m) where+ MultMod a <> MultMod b = MultMod (a * b)+ stimes k a@(MultMod a')+ | k >= 0 = MultMod (a' ^% k)+ | otherwise = invertGroup $ stimes (-k) a+ -- ^ This Semigroup is in fact a group, so @stimes@ can be called with a negative first argument.++instance KnownNat m => Monoid (MultMod m) where+ mempty = MultMod 1++instance KnownNat m => Bounded (MultMod m) where+ minBound = MultMod 1+ maxBound = MultMod (-1)++-- | Attempt to construct a multiplicative group element.+isMultElement :: KnownNat m => Mod m -> Maybe (MultMod m)+isMultElement a = if unMod a `gcd` natVal a == 1+ then Just $ MultMod a+ else Nothing++-- | For elements of the multiplicative group, we can safely perform the inverse+-- without needing to worry about failure.+invertGroup :: KnownNat m => MultMod m -> MultMod m+invertGroup (MultMod a) = case invertMod a of+ Just b -> MultMod b+ Nothing -> error "Math.NumberTheory.Moduli.invertGroup: failed to invert element"++-- | 'PrimitiveRoot' m is a type which is only inhabited+-- by <https://en.wikipedia.org/wiki/Primitive_root_modulo_n primitive roots> of m.+newtype PrimitiveRoot m = PrimitiveRoot+ { unPrimitiveRoot :: MultMod m -- ^ Extract primitive root value.+ }+ deriving (Eq, Show)++-- | Check whether a given modular residue is+-- a <https://en.wikipedia.org/wiki/Primitive_root_modulo_n primitive root>.+--+-- >>> :set -XDataKinds+-- >>> import Data.Maybe+-- >>> isPrimitiveRoot (fromJust cyclicGroup) (1 :: Mod 13)+-- Nothing+-- >>> isPrimitiveRoot (fromJust cyclicGroup) (2 :: Mod 13)+-- Just (PrimitiveRoot {unPrimitiveRoot = MultMod {multElement = (2 `modulo` 13)}})+isPrimitiveRoot+ :: (Integral a, UniqueFactorisation a)+ => CyclicGroup a m+ -> Mod m+ -> Maybe (PrimitiveRoot m)+isPrimitiveRoot cg r = case proofFromCyclicGroup cg of+ Sub Dict -> do+ r' <- isMultElement r+ guard $ isPrimitiveRoot' cg (fromIntegral (unMod r))+ return $ PrimitiveRoot r'++-- | Computes the discrete logarithm. Currently uses a combination of the baby-step+-- giant-step method and Pollard's rho algorithm, with Bach reduction.+--+-- >>> :set -XDataKinds+-- >>> import Data.Maybe+-- >>> let cg = fromJust cyclicGroup :: CyclicGroup Integer 13+-- >>> let rt = fromJust (isPrimitiveRoot cg 2)+-- >>> let x = fromJust (isMultElement 11)+-- >>> discreteLogarithm cg rt x+-- 7+discreteLogarithm :: CyclicGroup Integer m -> PrimitiveRoot m -> MultMod m -> Natural+discreteLogarithm cg (multElement . unPrimitiveRoot -> a) (multElement -> b) = case cg of+ CG2+ -> 0+ -- the only valid input was a=1, b=1+ CG4+ -> if unMod b == 1 then 0 else 1+ -- the only possible input here is a=3 with b = 1 or 3+ CGOddPrimePower (unPrime -> p) k+ -> discreteLogarithmPP p k (toInteger (unMod a)) (toInteger (unMod b))+ CGDoubleOddPrimePower (unPrime -> p) k+ -> discreteLogarithmPP p k (toInteger (unMod a) `rem` p^k) (toInteger (unMod b) `rem` p^k)+ -- we have the isomorphism t -> t `rem` p^k from (Z/2p^kZ)* -> (Z/p^kZ)*
− Math/NumberTheory/Moduli/PrimitiveRoot.hs
@@ -1,179 +0,0 @@--- |--- Module: Math.NumberTheory.Moduli.PrimitiveRoot--- Copyright: (c) 2017 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Primitive roots and cyclic groups.-----{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE UndecidableInstances #-}--module Math.NumberTheory.Moduli.PrimitiveRoot- ( -- * Cyclic groups- CyclicGroup(..)- , cyclicGroupFromModulo- , cyclicGroupToModulo- , groupSize- -- * Primitive roots- , PrimitiveRoot- , unPrimitiveRoot- , getGroup- , isPrimitiveRoot- , isPrimitiveRoot'- ) where--#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif--import Math.NumberTheory.ArithmeticFunctions (totient)-import qualified Math.NumberTheory.Euclidean as E-import Math.NumberTheory.Euclidean.Coprimes as Coprimes (singleton)-import Math.NumberTheory.Moduli.Class (getNatMod, getNatVal, KnownNat, Mod, MultMod, isMultElement)-import Math.NumberTheory.Powers.General (highestPower)-import Math.NumberTheory.Powers.Modular-import Math.NumberTheory.Prefactored-import Math.NumberTheory.Primes--import Control.DeepSeq-import Control.Monad (guard)-import GHC.Generics-import Numeric.Natural---- | A multiplicative group of residues is called cyclic,--- if there is a primitive root @g@,--- whose powers generates all elements.--- Any cyclic multiplicative group of residues--- falls into one of the following cases.-data CyclicGroup a- = CG2 -- ^ Residues modulo 2.- | CG4 -- ^ Residues modulo 4.- | CGOddPrimePower (Prime a) Word- -- ^ Residues modulo @p@^@k@ for __odd__ prime @p@.- | CGDoubleOddPrimePower (Prime a) Word- -- ^ Residues modulo 2@p@^@k@ for __odd__ prime @p@.- deriving (Eq, Show, Generic)--instance NFData a => NFData (CyclicGroup a)---- | Check whether a multiplicative group of residues,--- characterized by its modulo, is cyclic and, if yes, return its form.------ >>> cyclicGroupFromModulo 4--- Just CG4--- >>> cyclicGroupFromModulo (2 * 13 ^ 3)--- Just (CGDoubleOddPrimePower (Prime 13) 3)--- >>> cyclicGroupFromModulo (4 * 13)--- Nothing-cyclicGroupFromModulo- :: (Ord a, Integral a, UniqueFactorisation a)- => a- -> Maybe (CyclicGroup a)-cyclicGroupFromModulo = \case- 2 -> Just CG2- 4 -> Just CG4- n- | n <= 1 -> Nothing- | odd n -> uncurry CGOddPrimePower <$> isPrimePower n- | odd halfN -> uncurry CGDoubleOddPrimePower <$> isPrimePower halfN- | otherwise -> Nothing- where- halfN = n `quot` 2--isPrimePower- :: (Integral a, UniqueFactorisation a)- => a- -> Maybe (Prime a, Word)-isPrimePower n = (, k) <$> isPrime m- where- (m, k) = highestPower n---- | Extract modulo and its factorisation from--- a cyclic multiplicative group of residues.------ >>> cyclicGroupToModulo CG4--- Prefactored {prefValue = 4, prefFactors = Coprimes {unCoprimes = [(2,2)]}}------ >>> import Data.Maybe--- >>> cyclicGroupToModulo (CGDoubleOddPrimePower (fromJust (isPrime 13)) 3)--- Prefactored {prefValue = 4394, prefFactors = Coprimes {unCoprimes = [(13,3),(2,1)]}}-cyclicGroupToModulo- :: E.Euclidean a- => CyclicGroup a- -> Prefactored a-cyclicGroupToModulo = fromFactors . \case- CG2 -> Coprimes.singleton 2 1- CG4 -> Coprimes.singleton 2 2- CGOddPrimePower p k -> Coprimes.singleton (unPrime p) k- CGDoubleOddPrimePower p k -> Coprimes.singleton 2 1- <> Coprimes.singleton (unPrime p) k---- | 'PrimitiveRoot' m is a type which is only inhabited--- by <https://en.wikipedia.org/wiki/Primitive_root_modulo_n primitive roots> of m.-data PrimitiveRoot m = PrimitiveRoot- { unPrimitiveRoot :: MultMod m -- ^ Extract primitive root value.- , getGroup :: CyclicGroup Natural -- ^ Get cyclic group structure.- }- deriving (Eq, Show)---- | 'isPrimitiveRoot'' @cg@ @a@ checks whether @a@ is--- a <https://en.wikipedia.org/wiki/Primitive_root_modulo_n primitive root>--- of a given cyclic multiplicative group of residues @cg@.------ >>> let Just cg = cyclicGroupFromModulo 13--- >>> isPrimitiveRoot' cg 1--- False--- >>> isPrimitiveRoot' cg 2--- True-isPrimitiveRoot'- :: (Integral a, UniqueFactorisation a)- => CyclicGroup a- -> a- -> Bool--- https://en.wikipedia.org/wiki/Primitive_root_modulo_n#Finding_primitive_roots-isPrimitiveRoot' cg r =- case cg of- CG2 -> r == 1- CG4 -> r == 3- CGOddPrimePower p k -> oddPrimePowerTest (unPrime p) k r- CGDoubleOddPrimePower p k -> doubleOddPrimePowerTest (unPrime p) k r- where- oddPrimeTest p g = let phi = totient p- pows = map (\pk -> phi `quot` unPrime (fst pk)) (factorise phi)- exps = map (\x -> powMod g x p) pows- in g /= 0 && gcd g p == 1 && all (/= 1) exps- oddPrimePowerTest p 1 g = oddPrimeTest p (g `mod` p)- oddPrimePowerTest p _ g = oddPrimeTest p (g `mod` p) && powMod g (p-1) (p*p) /= 1- doubleOddPrimePowerTest p k g = odd g && oddPrimePowerTest p k g---- | Check whether a given modular residue is--- a <https://en.wikipedia.org/wiki/Primitive_root_modulo_n primitive root>.------ >>> :set -XDataKinds--- >>> isPrimitiveRoot (1 :: Mod 13)--- Nothing--- >>> isPrimitiveRoot (2 :: Mod 13)--- Just (PrimitiveRoot {unPrimitiveRoot = MultMod {multElement = (2 `modulo` 13)}, getGroup = CGOddPrimePower (Prime 13) 1})------ This function is a convenient wrapper around 'isPrimitiveRoot''. The latter--- provides better control and performance, if you need them.-isPrimitiveRoot- :: KnownNat n- => Mod n- -> Maybe (PrimitiveRoot n)-isPrimitiveRoot r = do- r' <- isMultElement r- cg <- cyclicGroupFromModulo (getNatMod r)- guard $ isPrimitiveRoot' cg (getNatVal r)- return $ PrimitiveRoot r' cg---- | Calculate the size of a given cyclic group.-groupSize :: (E.Euclidean a, UniqueFactorisation a) => CyclicGroup a -> Prefactored a-groupSize = totient . cyclicGroupToModulo
+ Math/NumberTheory/Moduli/Singleton.hs view
@@ -0,0 +1,315 @@+-- |+-- Module: Math.NumberTheory.Moduli.Singleton+-- Copyright: (c) 2019 Andrew Lelechenko+-- Licence: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Singleton data types.+--++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-pattern-namespace-specifier #-}++module Math.NumberTheory.Moduli.Singleton+ ( -- * SFactors singleton+ SFactors+ , sfactors+ , someSFactors+ , unSFactors+ , proofFromSFactors+ -- * CyclicGroup singleton+ , CyclicGroup+ , cyclicGroup+ , cyclicGroupFromFactors+ , cyclicGroupFromModulo+ , proofFromCyclicGroup+ , pattern CG2+ , pattern CG4+ , pattern CGOddPrimePower+ , pattern CGDoubleOddPrimePower+ -- * SFactors \<=\> CyclicGroup+ , cyclicGroupToSFactors+ , sfactorsToCyclicGroup+ -- * Some wrapper+ , Some(..)+ ) where++import Control.DeepSeq+import Data.Constraint+import Data.Kind+import Data.List (sort)+import qualified Data.Map as M+import Data.Proxy+import GHC.Generics+import GHC.TypeNats (KnownNat, Nat, natVal)+import Numeric.Natural+import Unsafe.Coerce++import Math.NumberTheory.Roots (highestPower)+import Math.NumberTheory.Primes+import Math.NumberTheory.Primes.Types+import Math.NumberTheory.Utils.FromIntegral++-- | Wrapper to hide an unknown type-level natural.+data Some (a :: Nat -> Type) where+ Some :: a m -> Some a++-- | From "Data.Constraint.Nat".+newtype Magic n = Magic (KnownNat n => Dict (KnownNat n))++-- | This singleton data type establishes a correspondence+-- between a modulo @m@ on type level+-- and its factorisation on term level.+newtype SFactors a (m :: Nat) = SFactors+ { unSFactors :: [(Prime a, Word)]+ -- ^ Factors of @m@.+ } deriving (Show, Generic)++instance Eq (SFactors a m) where+ _ == _ = True++instance Ord (SFactors a m) where+ _ `compare` _ = EQ++instance NFData a => NFData (SFactors a m)++instance Ord a => Eq (Some (SFactors a)) where+ Some (SFactors xs) == Some (SFactors ys) =+ xs == ys++instance Ord a => Ord (Some (SFactors a)) where+ Some (SFactors xs) `compare` Some (SFactors ys) =+ xs `compare` ys++instance Show a => Show (Some (SFactors a)) where+ showsPrec p (Some x) = showsPrec p x++instance NFData a => NFData (Some (SFactors a)) where+ rnf (Some x) = rnf x++-- | Create a singleton from a type-level positive modulo @m@,+-- passed in a constraint.+--+-- >>> :set -XDataKinds+-- >>> sfactors :: SFactors Integer 13+-- SFactors {unSFactors = [(Prime 13,1)]}+sfactors :: forall a m. (Ord a, UniqueFactorisation a, KnownNat m) => SFactors a m+sfactors = if m == 0+ then error "sfactors: modulo must be positive"+ else SFactors (sort (factorise m))+ where+ m = fromIntegral (natVal (Proxy :: Proxy m))++-- | Create a singleton from factors of @m@.+-- Factors must be distinct, as in output of 'factorise'.+--+-- >>> import Math.NumberTheory.Primes+-- >>> someSFactors (factorise 98)+-- SFactors {unSFactors = [(Prime 2,1),(Prime 7,2)]}+someSFactors :: (Ord a, Num a) => [(Prime a, Word)] -> Some (SFactors a)+someSFactors+ = Some+ . SFactors+ -- Just a precaution against ill-formed lists of factors+ . M.assocs+ . M.fromListWith (+)++-- | Convert a singleton to a proof that @m@ is known. Usage example:+--+-- > toModulo :: SFactors Integer m -> Natural+-- > toModulo t = case proofFromSFactors t of Sub Dict -> natVal t+proofFromSFactors :: Integral a => SFactors a m -> (() :- KnownNat m)+proofFromSFactors (SFactors fs) = Sub $ unsafeCoerce (Magic Dict) (fromIntegral' (factorBack fs) :: Natural)++-- | This singleton data type establishes a correspondence+-- between a modulo @m@ on type level+-- and a cyclic group of the same order on term level.+data CyclicGroup a (m :: Nat)+ = CG2' -- ^ Residues modulo 2.+ | CG4' -- ^ Residues modulo 4.+ | CGOddPrimePower' (Prime a) Word+ -- ^ Residues modulo @p@^@k@ for __odd__ prime @p@.+ | CGDoubleOddPrimePower' (Prime a) Word+ -- ^ Residues modulo 2@p@^@k@ for __odd__ prime @p@.+ deriving (Show, Generic)++instance Eq (CyclicGroup a m) where+ _ == _ = True++instance Ord (CyclicGroup a m) where+ _ `compare` _ = EQ++instance NFData a => NFData (CyclicGroup a m)++instance Eq a => Eq (Some (CyclicGroup a)) where+ Some CG2' == Some CG2' = True+ Some CG4' == Some CG4' = True+ Some (CGOddPrimePower' p1 k1) == Some (CGOddPrimePower' p2 k2) =+ p1 == p2 && k1 == k2+ Some (CGDoubleOddPrimePower' p1 k1) == Some (CGDoubleOddPrimePower' p2 k2) =+ p1 == p2 && k1 == k2+ _ == _ = False++instance Ord a => Ord (Some (CyclicGroup a)) where+ compare (Some x) (Some y) = case x of+ CG2' -> case y of+ CG2' -> EQ+ _ -> LT+ CG4' -> case y of+ CG2' -> GT+ CG4' -> EQ+ _ -> LT+ CGOddPrimePower' p1 k1 -> case y of+ CGDoubleOddPrimePower'{} -> LT+ CGOddPrimePower' p2 k2 ->+ p1 `compare` p2 <> k1 `compare` k2+ _ -> GT+ CGDoubleOddPrimePower' p1 k1 -> case y of+ CGDoubleOddPrimePower' p2 k2 ->+ p1 `compare` p2 <> k1 `compare` k2+ _ -> GT++instance Show a => Show (Some (CyclicGroup a)) where+ showsPrec p (Some x) = showsPrec p x++instance NFData a => NFData (Some (CyclicGroup a)) where+ rnf (Some x) = rnf x++-- | Create a singleton from a type-level positive modulo @m@,+-- passed in a constraint.+--+-- >>> :set -XDataKinds+-- >>> import Data.Maybe+-- >>> cyclicGroup :: Maybe (CyclicGroup Integer 169)+-- Just (CGOddPrimePower' (Prime 13) 2)+--+-- >>> :set -XTypeOperators -XNoStarIsType+-- >>> import GHC.TypeNats+-- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer 4)+-- Just CG4'+-- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer (2 * 13 ^ 3))+-- Just (CGDoubleOddPrimePower' (Prime 13) 3)+-- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer (4 * 13))+-- Nothing+cyclicGroup+ :: forall a m.+ (Integral a, UniqueFactorisation a, KnownNat m)+ => Maybe (CyclicGroup a m)+cyclicGroup = fromModuloInternal m+ where+ m = fromIntegral (natVal (Proxy :: Proxy m))++-- | Create a singleton from factors.+-- Factors must be distinct, as in output of 'factorise'.+cyclicGroupFromFactors+ :: (Eq a, Num a)+ => [(Prime a, Word)]+ -> Maybe (Some (CyclicGroup a))+cyclicGroupFromFactors = \case+ [(unPrime -> 2, 1)] -> Just $ Some CG2'+ [(unPrime -> 2, 2)] -> Just $ Some CG4'+ [(unPrime -> 2, _)] -> Nothing+ [(p, k)] -> Just $ Some $ CGOddPrimePower' p k+ [(unPrime -> 2, 1), (p, k)] -> Just $ Some $ CGDoubleOddPrimePower' p k+ [(p, k), (unPrime -> 2, 1)] -> Just $ Some $ CGDoubleOddPrimePower' p k+ _ -> Nothing++-- | Similar to 'cyclicGroupFromFactors' . 'factorise',+-- but much faster, because it+-- but performs only one primality test instead of full+-- factorisation.+cyclicGroupFromModulo+ :: (Integral a, UniqueFactorisation a)+ => a+ -> Maybe (Some (CyclicGroup a))+cyclicGroupFromModulo = fmap Some . fromModuloInternal++fromModuloInternal+ :: (Integral a, UniqueFactorisation a)+ => a+ -> Maybe (CyclicGroup a m)+fromModuloInternal = \case+ 2 -> Just CG2'+ 4 -> Just CG4'+ n+ | even n -> uncurry CGDoubleOddPrimePower' <$> isOddPrimePower (n `div` 2)+ | otherwise -> uncurry CGOddPrimePower' <$> isOddPrimePower n++isOddPrimePower+ :: (Integral a, UniqueFactorisation a)+ => a+ -> Maybe (Prime a, Word)+isOddPrimePower n+ | even n = Nothing+ | otherwise = (, k) <$> isPrime p+ where+ (p, k) = highestPower n++-- | Convert a cyclic group to a proof that @m@ is known. Usage example:+--+-- > toModulo :: CyclicGroup Integer m -> Natural+-- > toModulo t = case proofFromCyclicGroup t of Sub Dict -> natVal t+proofFromCyclicGroup :: Integral a => CyclicGroup a m -> (() :- KnownNat m)+proofFromCyclicGroup = proofFromSFactors . cyclicGroupToSFactors++-- | Check whether a multiplicative group of residues,+-- characterized by its modulo, is cyclic and, if yes, return its form.+--+-- >>> :set -XTypeOperators -XNoStarIsType+-- >>> import GHC.TypeNats+-- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer 4)+-- Just CG4'+-- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer (2 * 13 ^ 3))+-- Just (CGDoubleOddPrimePower' (Prime 13) 3)+-- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer (4 * 13))+-- Nothing+sfactorsToCyclicGroup :: (Eq a, Num a) => SFactors a m -> Maybe (CyclicGroup a m)+sfactorsToCyclicGroup (SFactors fs) = case fs of+ [(unPrime -> 2, 1)] -> Just CG2'+ [(unPrime -> 2, 2)] -> Just CG4'+ [(unPrime -> 2, _)] -> Nothing+ [(p, k)] -> Just $ CGOddPrimePower' p k+ [(p, k), (unPrime -> 2, 1)] -> Just $ CGDoubleOddPrimePower' p k+ [(unPrime -> 2, 1), (p, k)] -> Just $ CGDoubleOddPrimePower' p k+ _ -> Nothing++-- | Invert 'sfactorsToCyclicGroup'.+--+-- >>> import Data.Maybe+-- >>> cyclicGroupToSFactors (fromJust (sfactorsToCyclicGroup (sfactors :: SFactors Integer 4)))+-- SFactors {unSFactors = [(Prime 2,2)]}+cyclicGroupToSFactors :: Num a => CyclicGroup a m -> SFactors a m+cyclicGroupToSFactors = SFactors . \case+ CG2' -> [(Prime 2, 1)]+ CG4' -> [(Prime 2, 2)]+ CGOddPrimePower' p k -> [(p, k)]+ CGDoubleOddPrimePower' p k -> [(Prime 2, 1), (p, k)]++-- | Unidirectional pattern for residues modulo 2.+pattern CG2 :: CyclicGroup a m+pattern CG2 <- CG2'++-- | Unidirectional pattern for residues modulo 4.+pattern CG4 :: CyclicGroup a m+pattern CG4 <- CG4'++-- | Unidirectional pattern for residues modulo @p@^@k@ for __odd__ prime @p@.+pattern CGOddPrimePower :: Prime a -> Word -> CyclicGroup a m+pattern CGOddPrimePower p k <- CGOddPrimePower' p k++-- | Unidirectional pattern for residues modulo 2@p@^@k@ for __odd__ prime @p@.+pattern CGDoubleOddPrimePower :: Prime a -> Word -> CyclicGroup a m+pattern CGDoubleOddPrimePower p k <- CGDoubleOddPrimePower' p k++{-# COMPLETE CG2, CG4, CGOddPrimePower, CGDoubleOddPrimePower #-}
+ Math/NumberTheory/Moduli/SomeMod.hs view
@@ -0,0 +1,198 @@+-- |+-- Module: Math.NumberTheory.Moduli.SomeMod+-- Copyright: (c) 2017 Andrew Lelechenko+-- Licence: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Safe modular arithmetic with modulo on type level.+--++{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Math.NumberTheory.Moduli.SomeMod+ ( SomeMod(..)+ , modulo+ , invertSomeMod+ , powSomeMod+ ) where++import Data.Euclidean (GcdDomain(..), Euclidean(..), Field)+import Data.Mod (Mod, unMod, invertMod, (^%))+import Data.Proxy+import Data.Semiring (Semiring(..), Ring(..))+import Data.Type.Equality+import GHC.TypeNats (KnownNat, SomeNat(..), sameNat, natVal, someNatVal)+import Numeric.Natural++-- | This type represents residues with unknown modulo and rational numbers.+-- One can freely combine them in arithmetic expressions, but each operation+-- will spend time on modulo's recalculation:+--+-- >>> 2 `modulo` 10 + 4 `modulo` 15+-- (1 `modulo` 5)+-- >>> (2 `modulo` 10) * (4 `modulo` 15)+-- (3 `modulo` 5)+-- >>> import Data.Ratio+-- >>> 2 `modulo` 10 + fromRational (3 % 7)+-- (1 `modulo` 10)+-- >>> 2 `modulo` 10 * fromRational (3 % 7)+-- (8 `modulo` 10)+--+-- If performance is crucial, it is recommended to extract @Mod m@ for further processing+-- by pattern matching. E. g.,+--+-- > case modulo n m of+-- > SomeMod k -> process k -- Here k has type Mod m+-- > InfMod{} -> error "impossible"+data SomeMod where+ SomeMod :: KnownNat m => Mod m -> SomeMod+ InfMod :: Rational -> SomeMod++instance Eq SomeMod where+ SomeMod mx == SomeMod my =+ natVal mx == natVal my && unMod mx == unMod my+ InfMod rx == InfMod ry = rx == ry+ _ == _ = False++instance Ord SomeMod where+ SomeMod mx `compare` SomeMod my =+ natVal mx `compare` natVal my <> unMod mx `compare` unMod my+ SomeMod{} `compare` InfMod{} = LT+ InfMod{} `compare` SomeMod{} = GT+ InfMod rx `compare` InfMod ry = rx `compare` ry++instance Show SomeMod where+ show = \case+ SomeMod m -> show m+ InfMod r -> show r++-- | Create modular value by representative of residue class and modulo.+-- One can use the result either directly (via functions from 'Num' and 'Fractional'),+-- or deconstruct it by pattern matching. Note that 'modulo' never returns 'InfMod'.+modulo :: Integer -> Natural -> SomeMod+modulo n m = case someNatVal m of+ SomeNat (_ :: Proxy t) -> SomeMod (fromInteger n :: Mod t)+{-# INLINABLE modulo #-}+infixl 7 `modulo`++liftUnOp+ :: (forall k. KnownNat k => Mod k -> Mod k)+ -> (Rational -> Rational)+ -> SomeMod+ -> SomeMod+liftUnOp fm fr = \case+ SomeMod m -> SomeMod (fm m)+ InfMod r -> InfMod (fr r)+{-# INLINEABLE liftUnOp #-}++liftBinOpMod+ :: (KnownNat m, KnownNat n)+ => (forall k. KnownNat k => Mod k -> Mod k -> Mod k)+ -> Mod m+ -> Mod n+ -> SomeMod+liftBinOpMod f mx my = case someNatVal m of+ SomeNat (_ :: Proxy t) ->+ SomeMod (fromIntegral (x `mod` m) `f` fromIntegral (y `mod` m) :: Mod t)+ where+ x = unMod mx+ y = unMod my+ m = natVal mx `Prelude.gcd` natVal my++liftBinOp+ :: (forall k. KnownNat k => Mod k -> Mod k -> Mod k)+ -> (Rational -> Rational -> Rational)+ -> SomeMod+ -> SomeMod+ -> SomeMod+liftBinOp _ fr (InfMod rx) (InfMod ry) = InfMod (rx `fr` ry)+liftBinOp fm _ (InfMod rx) (SomeMod my) = SomeMod (fromRational rx `fm` my)+liftBinOp fm _ (SomeMod mx) (InfMod ry) = SomeMod (mx `fm` fromRational ry)+liftBinOp fm _ (SomeMod (mx :: Mod m)) (SomeMod (my :: Mod n))+ = case (Proxy :: Proxy m) `sameNat` (Proxy :: Proxy n) of+ Nothing -> liftBinOpMod fm mx my+ Just Refl -> SomeMod (mx `fm` my)++instance Num SomeMod where+ (+) = liftBinOp (+) (+)+ (-) = liftBinOp (-) (-)+ negate = liftUnOp Prelude.negate Prelude.negate+ {-# INLINE negate #-}+ (*) = liftBinOp (*) (*)+ abs = id+ {-# INLINE abs #-}+ signum = const 1+ {-# INLINE signum #-}+ fromInteger = InfMod . fromInteger+ {-# INLINE fromInteger #-}++instance Semiring SomeMod where+ plus = (+)+ times = (*)+ zero = InfMod 0+ one = InfMod 1+ fromNatural = fromIntegral++instance Ring SomeMod where+ negate = Prelude.negate++-- | Beware that division by residue, which is not coprime with the modulo,+-- will result in runtime error. Consider using 'invertSomeMod' instead.+instance Fractional SomeMod where+ fromRational = InfMod+ {-# INLINE fromRational #-}+ recip x = case invertSomeMod x of+ Nothing -> error "recip{SomeMod}: residue is not coprime with modulo"+ Just y -> y++-- | See the warning about division above.+instance GcdDomain SomeMod where+ divide x y = Just (x / y)+ gcd = const $ const 1+ lcm = const $ const 1+ coprime = const $ const True++-- | See the warning about division above.+instance Euclidean SomeMod where+ degree = const 0+ quotRem x y = (x / y, 0)+ quot = (/)+ rem = const $ const 0++-- | See the warning about division above.+instance Field SomeMod++-- | Computes the inverse value, if it exists.+--+-- >>> invertSomeMod (3 `modulo` 10) -- because 3 * 7 = 1 :: Mod 10+-- Just (7 `modulo` 10)+-- >>> invertSomeMod (4 `modulo` 10)+-- Nothing+-- >>> import Data.Ratio+-- >>> invertSomeMod (fromRational (2 % 5))+-- Just 5 % 2+invertSomeMod :: SomeMod -> Maybe SomeMod+invertSomeMod = \case+ SomeMod m -> fmap SomeMod (invertMod m)+ InfMod r -> Just (InfMod (recip r))+{-# INLINABLE [1] invertSomeMod #-}++{-# SPECIALISE [1] powSomeMod :: SomeMod -> Integer -> SomeMod #-}+{-# SPECIALISE [1] powSomeMod :: SomeMod -> Natural -> SomeMod #-}+{-# SPECIALISE [1] powSomeMod :: SomeMod -> Int -> SomeMod #-}+{-# SPECIALISE [1] powSomeMod :: SomeMod -> Word -> SomeMod #-}++-- | Drop-in replacement for 'Prelude.^', with much better performance.+-- When -O is enabled, there is a rewrite rule, which specialises 'Prelude.^' to 'powSomeMod'.+--+-- >>> powSomeMod (3 `modulo` 10) 4+-- (1 `modulo` 10)+powSomeMod :: Integral a => SomeMod -> a -> SomeMod+powSomeMod (SomeMod m) a = SomeMod (m ^% a)+powSomeMod (InfMod r) a = InfMod (r ^ a)+{-# INLINABLE [1] powSomeMod #-}++{-# RULES "^%SomeMod" forall x p. x ^ p = powSomeMod x p #-}
Math/NumberTheory/Moduli/Sqrt.hs view
@@ -4,52 +4,58 @@ -- Licence: MIT -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> ----- Modular square roots.+-- Modular square roots and+-- <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol>. -- {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE PostfixOperators #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE CPP #-} module Math.NumberTheory.Moduli.Sqrt- ( -- * New interface+ ( -- * Modular square roots sqrtsMod , sqrtsModFactorisation , sqrtsModPrimePower , sqrtsModPrime- -- * Old interface- , Old.sqrtModP- , Old.sqrtModPList- , Old.sqrtModP'- , Old.tonelliShanks- , Old.sqrtModPP- , Old.sqrtModPPList- , Old.sqrtModF- , Old.sqrtModFList+ -- * Jacobi symbol+ , JacobiSymbol(..)+ , jacobi+ , symbolToNum ) where import Control.Monad (liftM2) import Data.Bits+import Data.Constraint+import Data.List.Infinite (Infinite(..), (...))+import qualified Data.List.Infinite as Inf+import Data.Maybe+import Data.Mod+import Data.Proxy+import GHC.TypeNats (KnownNat, SomeNat(..), natVal, someNatVal, Nat)+import Numeric.Natural (Natural) import Math.NumberTheory.Moduli.Chinese-import Math.NumberTheory.Moduli.Class (Mod, getVal, getMod, KnownNat)-import Math.NumberTheory.Moduli.Jacobi-import Math.NumberTheory.Powers.Modular (powMod)-import Math.NumberTheory.Primes.Types-import Math.NumberTheory.Primes.Sieve (sieveFrom)-import Math.NumberTheory.Primes (Prime, factorise)-import Math.NumberTheory.Utils (shiftToOddCount, splitOff, recipMod)+import Math.NumberTheory.Moduli.JacobiSymbol+import Math.NumberTheory.Moduli.Singleton+import Math.NumberTheory.Primes+import Math.NumberTheory.Utils (shiftToOddCount, splitOff) import Math.NumberTheory.Utils.FromIntegral -import qualified Math.NumberTheory.Moduli.SqrtOld as Old- -- | List all modular square roots. -- -- >>> :set -XDataKinds--- >>> sqrtsMod (1 :: Mod 60)+-- >>> sqrtsMod sfactors (1 :: Mod 60) -- [(1 `modulo` 60),(49 `modulo` 60),(41 `modulo` 60),(29 `modulo` 60),(31 `modulo` 60),(19 `modulo` 60),(11 `modulo` 60),(59 `modulo` 60)]-sqrtsMod :: KnownNat m => Mod m -> [Mod m]-sqrtsMod a = map fromInteger $ sqrtsModFactorisation (getVal a) (factorise (getMod a))+sqrtsMod :: SFactors Integer m -> Mod m -> [Mod m]+sqrtsMod sm a = case proofFromSFactors sm of+ Sub Dict -> map fromInteger $ sqrtsModFactorisation (toInteger (unMod a)) (unSFactors sm) -- | List all square roots modulo a number, the factorisation of which is -- passed as a second argument.@@ -61,15 +67,17 @@ sqrtsModFactorisation n pps = map fst $ foldl1 (liftM2 comb) cs where ms :: [Integer]- ms = map (\(Prime p, pow) -> p ^ pow) pps+ ms = map (\(p, pow) -> unPrime p ^ pow) pps rs :: [[Integer]]- rs = map (\(p, pow) -> sqrtsModPrimePower n p pow) pps+ rs = map (uncurry (sqrtsModPrimePower n)) pps cs :: [[(Integer, Integer)]]- cs = zipWith (\l m -> map (\x -> (x, m)) l) rs ms+ cs = zipWith (\l m -> map (, m) l) rs ms - comb t1@(_, m1) t2@(_, m2) = (chineseRemainder2 t1 t2, m1 * m2)+ comb t1 t2 = (if ch < 0 then ch + m else ch, m)+ where+ (ch, m) = fromJust $ chinese t1 t2 -- | List all square roots modulo the power of a prime. --@@ -81,7 +89,7 @@ -- [3,12,21,24,6,15] sqrtsModPrimePower :: Integer -> Prime Integer -> Word -> [Integer] sqrtsModPrimePower nn p 1 = sqrtsModPrime nn p-sqrtsModPrimePower nn (Prime prime) expo = let primeExpo = prime ^ expo in+sqrtsModPrimePower nn (unPrime -> prime) expo = let primeExpo = prime ^ expo in case splitOff prime (nn `mod` primeExpo) of (_, 0) -> [0, prime ^ ((expo + 1) `quot` 2) .. primeExpo - 1] (kk, n)@@ -115,11 +123,12 @@ -- >>> sqrtsModPrime 2 (fromJust (isPrime 5)) -- [] sqrtsModPrime :: Integer -> Prime Integer -> [Integer]-sqrtsModPrime n (Prime 2) = [n `mod` 2]-sqrtsModPrime n (Prime prime) = case jacobi n prime of+sqrtsModPrime n (unPrime -> 2) = [n `mod` 2]+sqrtsModPrime n (unPrime -> prime) = case jacobi n prime of MinusOne -> [] Zero -> [0]- One -> let r = sqrtModP' (n `mod` prime) prime in [r, prime - r]+ One -> case someNatVal (fromInteger prime) of+ SomeNat (_ :: Proxy p) -> let r = toInteger (unMod (sqrtModP' @p (fromInteger n))) in [r, prime - r] ------------------------------------------------------------------------------- -- Internals@@ -127,74 +136,88 @@ -- | @sqrtModP' square prime@ finds a square root of @square@ modulo -- prime. @prime@ /must/ be a (positive) prime, and @square@ /must/ be a positive -- quadratic residue modulo @prime@, i.e. @'jacobi square prime == 1@.-sqrtModP' :: Integer -> Integer -> Integer-sqrtModP' square prime- | prime == 2 = square- | rem4 prime == 3 = powMod square ((prime + 1) `quot` 4) prime- | square `mod` prime == prime - 1- = sqrtOfMinusOne prime- | otherwise = tonelliShanks square prime+sqrtModP' :: KnownNat p => Mod p -> Mod p+sqrtModP' square+ | prime == 2 = square+ | rem4 prime == 3 = square ^ ((prime + 1) `quot` 4)+ | square == maxBound = sqrtOfMinusOne+ | otherwise = tonelliShanks square+ where+ prime = natVal square -- | @p@ must be of form @4k + 1@-sqrtOfMinusOne :: Integer -> Integer-sqrtOfMinusOne p- = head- $ filter (\n -> n /= 1 && n /= p - 1)- $ map (\n -> powMod n k p)- [2..p-2]+sqrtOfMinusOne :: forall (p :: Nat). KnownNat p => Mod p+sqrtOfMinusOne = case results of+ [] -> error "sqrtOfMinusOne: internal invariant violated"+ hd : _ -> hd where+ p :: Natural+ p = natVal (Proxy :: Proxy p)++ k :: Natural k = (p - 1) `quot` 4 + results :: [Mod p]+ results = dropWhile (\n -> n == 1 || n == maxBound) $+ map (^ k) [2 .. maxBound - 1]+ -- | @tonelliShanks square prime@ calculates a square root of @square@ -- modulo @prime@, where @prime@ is a prime of the form @4*k + 1@ and -- @square@ is a positive quadratic residue modulo @prime@, using the -- Tonelli-Shanks algorithm.-tonelliShanks :: Integer -> Integer -> Integer-tonelliShanks square prime = loop rc t1 generator log2+tonelliShanks :: forall p. KnownNat p => Mod p -> Mod p+tonelliShanks square = loop rc t1 generator log2 where- (wordToInt -> log2,q) = shiftToOddCount (prime-1)- nonSquare = findNonSquare prime- generator = powMod nonSquare q prime- rc = powMod square ((q+1) `quot` 2) prime- t1 = powMod square q prime- msqr x = (x*x) `rem` prime+ prime = natVal square+ (log2, q) = shiftToOddCount (prime - 1)+ generator = findNonSquare ^ q+ rc = square ^ ((q + 1) `quot` 2)+ t1 = square ^ q+ msquare 0 x = x- msquare k x = msquare (k-1) (msqr x)+ msquare k x = msquare (k-1) (x * x)+ findPeriod per 1 = per- findPeriod per x = findPeriod (per+1) (msqr x)+ findPeriod per x = findPeriod (per + 1) (x * x) - loop :: Integer -> Integer -> Integer -> Int -> Integer+ loop :: Mod p -> Mod p -> Mod p -> Word -> Mod p loop !r t c m | t == 1 = r | otherwise = loop nextR nextT nextC nextM where nextM = findPeriod 0 t b = msquare (m - 1 - nextM) c- nextR = (r*b) `rem` prime- nextC = msqr b- nextT = (t*nextC) `rem` prime+ nextR = r * b+ nextC = b * b+ nextT = t * nextC -- | prime must be odd, n must be coprime with prime sqrtModPP' :: Integer -> Integer -> Word -> Maybe Integer-sqrtModPP' n prime expo = case sqrtsModPrime n (Prime prime) of- [] -> Nothing- r : _ -> fixup r+sqrtModPP' n prime expo = case jacobi n prime of+ MinusOne -> Nothing+ Zero -> Nothing+ One -> case someNatVal (fromInteger prime) of+ SomeNat (_ :: Proxy p) -> Just $ fixup $ sqrtModP' @p (fromInteger n) where- fixup r = let diff' = r*r-n- in if diff' == 0- then Just r- else case splitOff prime diff' of- (e,q) | expo <= e -> Just r- | otherwise -> fmap (\inv -> hoist inv r (q `mod` prime) (prime^e)) (recipMod (2*r) prime)+ fixup :: KnownNat p => Mod p -> Integer+ fixup r+ | diff' == 0 = r'+ | expo <= e = r'+ | otherwise = hoist (recip (2 * r)) r' (fromInteger q) (prime^e)+ where+ r' = toInteger (unMod r)+ diff' = r' * r' - n+ (e, q) = splitOff prime diff' + hoist :: KnownNat p => Mod p -> Integer -> Mod p -> Integer -> Integer hoist inv root elim pp- | diff' == 0 = root'- | expo <= ex = root'- | otherwise = hoist inv root' (nelim `mod` prime) (prime^ex)- where- root' = (root + (inv*(prime-elim))*pp) `mod` (prime*pp)- diff' = root'*root' - n- (ex, nelim) = splitOff prime diff'+ | diff' == 0 = root'+ | expo <= ex = root'+ | otherwise = hoist inv root' (fromInteger nelim) (prime ^ ex)+ where+ root' = root + toInteger (unMod (inv * negate elim)) * pp+ diff' = root' * root' - n+ (ex, nelim) = splitOff prime diff' -- dirty, dirty sqM2P :: Integer -> Word -> Maybe Integer@@ -202,7 +225,7 @@ | e < 2 = Just (n `mod` 2) | n' == 0 = Just 0 | odd k = Nothing- | otherwise = fmap ((`mod` mdl) . (`shiftL` wordToInt k2)) $ solve s e2+ | otherwise = (`mod` mdl) . (`shiftL` wordToInt k2) <$> solve s e2 where mdl = 1 `shiftL` wordToInt e n' = n `mod` mdl@@ -233,14 +256,18 @@ rem8 :: Integral a => a -> Int rem8 n = fromIntegral n .&. 7 -findNonSquare :: Integer -> Integer-findNonSquare n- | rem8 n == 5 || rem8 n == 3 = 2- | otherwise = search primelist- where- primelist = [3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67]- ++ map unPrime (sieveFrom (68 + n `rem` 4)) -- prevent sharing- search (p:ps) = case jacobi p n of- MinusOne -> p- _ -> search ps- search _ = error "Should never have happened, prime list exhausted."+findNonSquare :: forall (n :: Nat). KnownNat n => Mod n+findNonSquare+ | rem8 n == 3 || rem8 n == 5 = 2+ | otherwise = fromIntegral $ Inf.head $+ Inf.dropWhile (\p -> jacobi p n /= MinusOne) candidates+ where+ n = natVal (Proxy :: Proxy n)++ -- It is enough to consider only prime candidates, but+ -- the probability that the smallest non-residue is > 67+ -- is small and 'jacobi' test is fast,+ -- so we use [71..n] instead of filter isPrime [71..n].+ candidates :: Infinite Natural+ candidates = 3 :< 5 :< 7 :< 11 :< 13 :< 17 :< 19 :< 23 :< 29 :< 31 :<+ 37 :< 41 :< 43 :< 47 :< 53 :< 59 :< 61 :< 67 :< (71...)
− Math/NumberTheory/Moduli/SqrtOld.hs
@@ -1,232 +0,0 @@--- |--- Module: Math.NumberTheory.Moduli.Sqrt--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Modular square roots.-----{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE ViewPatterns #-}--module Math.NumberTheory.Moduli.SqrtOld- ( sqrtModP- , sqrtModPList- , sqrtModP'- , tonelliShanks- , sqrtModPP- , sqrtModPPList- , sqrtModF- , sqrtModFList- ) where--import Control.Monad (liftM2)-import Data.Bits-import Data.List (nub)-import GHC.Integer.GMP.Internals--import Math.NumberTheory.Moduli.Chinese-import Math.NumberTheory.Moduli.Jacobi-import Math.NumberTheory.Primes.Sieve (sieveFrom)-import Math.NumberTheory.Primes.Types (unPrime)-import Math.NumberTheory.Utils (shiftToOddCount, splitOff)-import Math.NumberTheory.Utils.FromIntegral--{-# DEPRECATED sqrtModP, sqrtModP', sqrtModPList, tonelliShanks "Use 'Math.NumberTheory.Moduli.Sqrt.sqrtsModPrime' instead" #-}-{-# DEPRECATED sqrtModPP, sqrtModPPList "Use 'Math.NumberTheory.Moduli.Sqrt.sqrtsModPrimePower' instead" #-}-{-# DEPRECATED sqrtModF, sqrtModFList "Use 'Math.NumberTheory.Moduli.Sqrt.sqrtsModFactorisation' or 'Math.NumberTheory.Moduli.Sqrt.sqrtsMod' instead" #-}----- | @sqrtModP n prime@ calculates a modular square root of @n@ modulo @prime@--- if that exists. The second argument /must/ be a (positive) prime, otherwise--- the computation may not terminate and if it does, may yield a wrong result.--- The precondition is /not/ checked.------ If @prime@ is a prime and @n@ a quadratic residue modulo @prime@, the result--- is @Just r@ where @r^2 ≡ n (mod prime)@, if @n@ is a quadratic nonresidue,--- the result is @Nothing@.-sqrtModP :: Integer -> Integer -> Maybe Integer-sqrtModP n 2 = Just (n `mod` 2)-sqrtModP n prime = case jacobi n prime of- MinusOne -> Nothing- Zero -> Just 0- One -> Just (sqrtModP' (n `mod` prime) prime)---- | @sqrtModPList n prime@ computes the list of all square roots of @n@--- modulo @prime@. @prime@ /must/ be a (positive) prime.--- The precondition is /not/ checked.-sqrtModPList :: Integer -> Integer -> [Integer]-sqrtModPList n prime- | prime == 2 = [n `mod` 2]- | otherwise = case sqrtModP n prime of- Just 0 -> [0]- Just r -> [r,prime-r] -- The group of units in Z/(p) is cyclic- _ -> []---- | @sqrtModP' square prime@ finds a square root of @square@ modulo--- prime. @prime@ /must/ be a (positive) prime, and @square@ /must/ be a positive--- quadratic residue modulo @prime@, i.e. @'jacobi square prime == 1@.--- The precondition is /not/ checked.-sqrtModP' :: Integer -> Integer -> Integer-sqrtModP' square prime- | prime == 2 = square- | rem4 prime == 3 = powModInteger square ((prime + 1) `quot` 4) prime- | otherwise = tonelliShanks square prime---- | @tonelliShanks square prime@ calculates a square root of @square@--- modulo @prime@, where @prime@ is a prime of the form @4*k + 1@ and--- @square@ is a positive quadratic residue modulo @prime@, using the--- Tonelli-Shanks algorithm.--- No checks on the input are performed.-tonelliShanks :: Integer -> Integer -> Integer-tonelliShanks square prime = loop rc t1 generator log2- where- (log2,q) = shiftToOddCount (prime-1)- nonSquare = findNonSquare prime- generator = powModInteger nonSquare q prime- rc = powModInteger square ((q+1) `quot` 2) prime- t1 = powModInteger square q prime- msqr x = (x*x) `rem` prime- msquare 0 x = x- msquare k x = msquare (k-1) (msqr x)- findPeriod per 1 = per- findPeriod per x = findPeriod (per+1) (msqr x)- loop !r t c m- | t == 1 = r- | otherwise = loop nextR nextT nextC nextM- where- nextM = findPeriod 0 t- b = msquare (m - 1 - nextM) c- nextR = (r*b) `rem` prime- nextC = msqr b- nextT = (t*nextC) `rem` prime---- | @sqrtModPP n (prime,expo)@ calculates a square root of @n@--- modulo @prime^expo@ if one exists. @prime@ /must/ be a--- (positive) prime. @expo@ must be positive, @n@ must be coprime--- to @prime@-sqrtModPP :: Integer -> (Integer,Int) -> Maybe Integer-sqrtModPP n (2,e) = sqM2P n e-sqrtModPP n (prime,expo) = case sqrtModP n prime of- Just r -> fixup r- _ -> Nothing- where- fixup r = let diff' = r*r-n- in if diff' == 0- then Just r- else case splitOff prime diff' of- (wordToInt -> e,q) | expo <= e -> Just r- | otherwise -> fmap (\inv -> hoist inv r (q `mod` prime) (prime^e)) (recipMod (2*r) prime)-- hoist inv root elim pp- | diff' == 0 = root'- | expo <= wordToInt ex = root'- | otherwise = hoist inv root' (nelim `mod` prime) (prime^ex)- where- root' = (root + (inv*(prime-elim))*pp) `mod` (prime*pp)- diff' = root'*root' - n- (ex, nelim) = splitOff prime diff'---- dirty, dirty-sqM2P :: Integer -> Int -> Maybe Integer-sqM2P n e- | e < 2 = Just (n `mod` 2)- | n' == 0 = Just 0- | odd k = Nothing- | otherwise = fmap ((`mod` mdl) . (`shiftL` k2)) $ solve s e2- where- mdl = 1 `shiftL` e- n' = n `mod` mdl- (wordToInt -> k,s) = shiftToOddCount n'- k2 = k `quot` 2- e2 = e-k- solve _ 1 = Just 1- solve 1 _ = Just 1- solve r _- | rem4 r == 3 = Nothing -- otherwise r ≡ 1 (mod 4)- | rem8 r == 5 = Nothing -- otherwise r ≡ 1 (mod 8)- | otherwise = fixup r (wordToInt $ fst $ shiftToOddCount (r-1))- where- fixup x pw- | pw >= e2 = Just x- | otherwise = fixup x' pw'- where- x' = x + (1 `shiftL` (pw-1))- d = x'*x' - r- pw' = if d == 0 then e2 else wordToInt (fst (shiftToOddCount d))---- | @sqrtModF n primePowers@ calculates a square root of @n@ modulo--- @product [p^k | (p,k) <- primePowers]@ if one exists and all primes--- are distinct.--- The list must be non-empty, @n@ must be coprime with all primes.-sqrtModF :: Integer -> [(Integer,Int)] -> Maybe Integer-sqrtModF _ [] = Nothing-sqrtModF n pps = do roots <- mapM (sqrtModPP n) pps- chineseRemainder $ zip roots (map (uncurry (^)) pps)---- | @sqrtModFList n primePowers@ calculates all square roots of @n@ modulo--- @product [p^k | (p,k) <- primePowers]@ if all primes are distinct.--- The list must be non-empty, @n@ must be coprime with all primes.-sqrtModFList :: Integer -> [(Integer,Int)] -> [Integer]-sqrtModFList _ [] = []-sqrtModFList n pps = map fst $ foldl1 (liftM2 comb) cs- where- ms :: [Integer]- ms = map (uncurry (^)) pps- rs :: [[Integer]]- rs = map (sqrtModPPList n) pps- cs :: [[(Integer,Integer)]]- cs = zipWith (\l m -> map (\x -> (x,m)) l) rs ms- comb t1@(_,m1) t2@(_,m2) = (chineseRemainder2 t1 t2,m1*m2)---- | @sqrtModPPList n (prime,expo)@ calculates the list of all--- square roots of @n@ modulo @prime^expo@. The same restriction--- as in 'sqrtModPP' applies to the arguments.-sqrtModPPList :: Integer -> (Integer,Int) -> [Integer]-sqrtModPPList n (2,1) = [n `mod` 2]-sqrtModPPList n (2,expo)- = case sqM2P n expo of- Just r -> let m = 1 `shiftL` (expo-1)- in nub [r, (r+m) `mod` (2*m), (m-r) `mod` (2*m), 2*m-r]- _ -> []-sqrtModPPList n pe@(prime,expo)- = case sqrtModPP n pe of- Just 0 -> [0]- Just r -> [prime^expo - r, r] -- The group of units in Z/(p^e) is cyclic- _ -> []----- Utilities--{-# SPECIALISE rem4 :: Integer -> Int,- Int -> Int,- Word -> Int- #-}-rem4 :: Integral a => a -> Int-rem4 n = fromIntegral n .&. 3--{-# SPECIALISE rem8 :: Integer -> Int,- Int -> Int,- Word -> Int- #-}-rem8 :: Integral a => a -> Int-rem8 n = fromIntegral n .&. 7--findNonSquare :: Integer -> Integer-findNonSquare n- | rem8 n == 5 || rem8 n == 3 = 2- | otherwise = search primelist- where- primelist = [3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67]- ++ map unPrime (sieveFrom (68 + n `rem` 4)) -- prevent sharing- search (p:ps) = case jacobi p n of- MinusOne -> p- _ -> search ps- search _ = error "Should never have happened, prime list exhausted."--recipMod :: Integer -> Integer -> Maybe Integer-recipMod x m = case recipModInteger x m of- 0 -> Nothing- y -> Just y
Math/NumberTheory/MoebiusInversion.hs view
@@ -17,20 +17,32 @@ import Control.Monad import Control.Monad.ST-import qualified Data.Vector.Mutable as MV+import Data.Proxy+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as MG -import Math.NumberTheory.Powers.Squares+import Math.NumberTheory.Roots+import Math.NumberTheory.Utils.FromIntegral -- | @totientSum n@ is, for @n > 0@, the sum of @[totient k | k <- [1 .. n]]@, -- computed via generalised Möbius inversion. -- See <http://mathworld.wolfram.com/TotientSummatoryFunction.html> for the -- formula used for @totientSum@.-totientSum :: Int -> Integer-totientSum n- | n < 1 = 0- | otherwise = generalInversion (triangle . fromIntegral) n+--+-- >>> import Data.Proxy+-- >>> totientSum (Proxy :: Proxy Data.Vector.Unboxed.Vector) 100 :: Int+-- 3044+-- >>> totientSum (Proxy :: Proxy Data.Vector.Vector) 100 :: Integer+-- 3044+totientSum+ :: (Integral t, G.Vector v t)+ => Proxy v+ -> Word+ -> t+totientSum _ 0 = 0+totientSum proxy n = generalInversion proxy (triangle . fromIntegral) n where- triangle k = (k*(k+1)) `quot` 2+ triangle k = (k * (k + 1)) `quot` 2 -- | @generalInversion g n@ evaluates the generalised Möbius inversion of @g@ -- at the argument @n@.@@ -76,28 +88,36 @@ -- The value @f n@ is then computed by @generalInversion g n@. Note that when -- many values of @f@ are needed, there are far more efficient methods, this -- method is only appropriate to compute isolated values of @f@.-generalInversion :: (Int -> Integer) -> Int -> Integer-generalInversion fun n- | n < 1 = error "Möbius inversion only defined on positive domain"- | n == 1 = fun 1- | n == 2 = fun 2 - fun 1- | n == 3 = fun 3 - 2*fun 1- | otherwise = fastInvert fun n--fastInvert :: (Int -> Integer) -> Int -> Integer-fastInvert fun n = runST (fastInvertST fun n)+generalInversion+ :: (Num t, G.Vector v t)+ => Proxy v+ -> (Word -> t)+ -> Word+ -> t+generalInversion proxy fun n = case n of+ 0 ->error "Möbius inversion only defined on positive domain"+ 1 -> fun 1+ 2 -> fun 2 - fun 1+ 3 -> fun 3 - 2*fun 1+ _ -> runST (fastInvertST proxy (fun . intToWord) (wordToInt n)) -fastInvertST :: forall s. (Int -> Integer) -> Int -> ST s Integer-fastInvertST fun n = do+fastInvertST+ :: forall s t v.+ (Num t, G.Vector v t)+ => Proxy v+ -> (Int -> t)+ -> Int+ -> ST s t+fastInvertST _ fun n = do let !k0 = integerSquareRoot (n `quot` 2) !mk0 = n `quot` (2*k0+1) kmax a m = (a `quot` m - 1) `quot` 2 - small <- MV.unsafeNew (mk0 + 1) :: ST s (MV.MVector s Integer)- MV.unsafeWrite small 0 0- MV.unsafeWrite small 1 $! (fun 1)+ small <- MG.unsafeNew (mk0 + 1) :: ST s (G.Mutable v s t)+ MG.unsafeWrite small 0 0+ MG.unsafeWrite small 1 $! fun 1 when (mk0 >= 2) $- MV.unsafeWrite small 2 $! (fun 2 - fun 1)+ MG.unsafeWrite small 2 $! (fun 2 - fun 1) let calcit :: Int -> Int -> Int -> ST s (Int, Int) calcit switch change i@@ -107,22 +127,22 @@ let mloop !acc k !m | k < switch = kloop acc k | otherwise = do- val <- MV.unsafeRead small m+ val <- MG.unsafeRead small m let nxtk = kmax i (m+1) mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1) kloop !acc k | k == 0 = do- MV.unsafeWrite small i $! acc+ MG.unsafeWrite small i $! acc calcit switch change (i+1) | otherwise = do- val <- MV.unsafeRead small (i `quot` (2*k+1))+ val <- MG.unsafeRead small (i `quot` (2*k+1)) kloop (acc-val) (k-1) mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1 (sw, ch) <- calcit 1 8 3- large <- MV.unsafeNew k0 :: ST s (MV.MVector s Integer)+ large <- MG.unsafeNew k0 :: ST s (G.Mutable v s t) - let calcbig :: Int -> Int -> Int -> ST s (MV.MVector s Integer)+ let calcbig :: Int -> Int -> Int -> ST s (G.Mutable v s t) calcbig switch change j | j == 0 = return large | (2*j-1)*change <= n = calcbig (switch+1) (change + 4*switch+6) j@@ -131,21 +151,21 @@ mloop !acc k m | k < switch = kloop acc k | otherwise = do- val <- MV.unsafeRead small m+ val <- MG.unsafeRead small m let nxtk = kmax i (m+1) mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1) kloop !acc k | k == 0 = do- MV.unsafeWrite large (j-1) $! acc+ MG.unsafeWrite large (j-1) $! acc calcbig switch change (j-1) | otherwise = do let m = i `quot` (2*k+1) val <- if m <= mk0- then MV.unsafeRead small m- else MV.unsafeRead large (k*(2*j-1)+j-1)+ then MG.unsafeRead small m+ else MG.unsafeRead large (k*(2*j-1)+j-1) kloop (acc-val) (k-1) mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1 mvec <- calcbig sw ch k0- MV.unsafeRead mvec 0+ MG.unsafeRead mvec 0
− Math/NumberTheory/MoebiusInversion/Int.hs
@@ -1,150 +0,0 @@--- |--- Module: Math.NumberTheory.MoebiusInversion--- Copyright: (c) 2012 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Generalised Möbius inversion for 'Int' valued functions.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Math.NumberTheory.MoebiusInversion.Int- ( generalInversion- , totientSum- ) where--import Control.Monad-import Control.Monad.ST-import qualified Data.Vector.Unboxed.Mutable as MV--import Math.NumberTheory.Powers.Squares---- | @totientSum n@ is, for @n > 0@, the sum of @[totient k | k <- [1 .. n]]@,--- computed via generalised Möbius inversion.--- See <http://mathworld.wolfram.com/TotientSummatoryFunction.html> for the--- formula used for @totientSum@.-totientSum :: Int -> Int-totientSum n- | n < 1 = 0- | otherwise = generalInversion (triangle . fromIntegral) n- where- triangle k = (k*(k+1)) `quot` 2---- | @generalInversion g n@ evaluates the generalised Möbius inversion of @g@--- at the argument @n@.------ The generalised Möbius inversion implemented here allows an efficient--- calculation of isolated values of the function @f : N -> Z@ if the function--- @g@ defined by------ >--- > g n = sum [f (n `quot` k) | k <- [1 .. n]]--- >------ can be cheaply computed. By the generalised Möbius inversion formula, then------ >--- > f n = sum [moebius k * g (n `quot` k) | k <- [1 .. n]]--- >------ which allows the computation in /O/(n) steps, if the values of the--- Möbius function are known. A slightly different formula, used here,--- does not need the values of the Möbius function and allows the--- computation in /O/(n^0.75) steps, using /O/(n^0.5) memory.------ An example of a pair of such functions where the inversion allows a--- more efficient computation than the direct approach is------ >--- > f n = number of reduced proper fractions with denominator <= n--- > g n = number of proper fractions with denominator <= n--- >------ (a /proper fraction/ is a fraction @0 < n/d < 1@). Then @f n@ is the--- cardinality of the Farey sequence of order @n@ (minus 1 or 2 if 0 and/or--- 1 are included in the Farey sequence), or the sum of the totients of--- the numbers @2 <= k <= n@. @f n@ is not easily directly computable,--- but then @g n = n*(n-1)/2@ is very easy to compute, and hence the inversion--- gives an efficient method of computing @f n@.------ For 'Int' valued functions, unboxed arrays can be used for greater efficiency.--- That bears the risk of overflow, however, so be sure to use it only when it's--- safe.------ The value @f n@ is then computed by @generalInversion g n@. Note that when--- many values of @f@ are needed, there are far more efficient methods, this--- method is only appropriate to compute isolated values of @f@.-generalInversion :: (Int -> Int) -> Int -> Int-generalInversion fun n- | n < 1 = error "Möbius inversion only defined on positive domain"- | n == 1 = fun 1- | n == 2 = fun 2 - fun 1- | n == 3 = fun 3 - 2*fun 1- | otherwise = fastInvert fun n--fastInvert :: (Int -> Int) -> Int -> Int-fastInvert fun n = runST (fastInvertST fun n)--fastInvertST :: forall s. (Int -> Int) -> Int -> ST s Int-fastInvertST fun n = do- let !k0 = integerSquareRoot (n `quot` 2)- !mk0 = n `quot` (2*k0+1)- kmax a m = (a `quot` m - 1) `quot` 2-- small <- MV.unsafeNew (mk0 + 1) :: ST s (MV.MVector s Int)- MV.unsafeWrite small 0 0- MV.unsafeWrite small 1 $! (fun 1)- when (mk0 >= 2) $- MV.unsafeWrite small 2 $! (fun 2 - fun 1)-- let calcit :: Int -> Int -> Int -> ST s (Int, Int)- calcit switch change i- | mk0 < i = return (switch,change)- | i == change = calcit (switch+1) (change + 4*switch+6) i- | otherwise = do- let mloop !acc k !m- | k < switch = kloop acc k- | otherwise = do- val <- MV.unsafeRead small m- let nxtk = kmax i (m+1)- mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1)- kloop !acc k- | k == 0 = do- MV.unsafeWrite small i $! acc- calcit switch change (i+1)- | otherwise = do- val <- MV.unsafeRead small (i `quot` (2*k+1))- kloop (acc-val) (k-1)- mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1-- (sw, ch) <- calcit 1 8 3- large <- MV.unsafeNew k0 :: ST s (MV.MVector s Int)-- let calcbig :: Int -> Int -> Int -> ST s (MV.MVector s Int)- calcbig switch change j- | j == 0 = return large- | (2*j-1)*change <= n = calcbig (switch+1) (change + 4*switch+6) j- | otherwise = do- let i = n `quot` (2*j-1)- mloop !acc k m- | k < switch = kloop acc k- | otherwise = do- val <- MV.unsafeRead small m- let nxtk = kmax i (m+1)- mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1)- kloop !acc k- | k == 0 = do- MV.unsafeWrite large (j-1) $! acc- calcbig switch change (j-1)- | otherwise = do- let m = i `quot` (2*k+1)- val <- if m <= mk0- then MV.unsafeRead small m- else MV.unsafeRead large (k*(2*j-1)+j-1)- kloop (acc-val) (k-1)- mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1-- mvec <- calcbig sw ch k0- MV.unsafeRead mvec 0
− Math/NumberTheory/Powers.hs
@@ -1,42 +0,0 @@--- |--- Module: Math.NumberTheory.Powers--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Calculating integer roots, modular powers and related things.--- This module reexports the most needed functions from the implementation--- modules. The implementation modules provide some additional functions,--- in particular some unsafe functions which omit some tests for performance--- reasons.----module Math.NumberTheory.Powers- ( -- * Integer Roots- -- ** Square roots- integerSquareRoot- , isSquare- , exactSquareRoot- -- ** Cube roots- , integerCubeRoot- , isCube- , exactCubeRoot- -- ** Fourth roots- , integerFourthRoot- , isFourthPower- , exactFourthRoot- -- ** General roots- , integerRoot- , isKthPower- , exactRoot- , isPerfectPower- , highestPower- -- * Modular powers- , powMod- ) where--import Math.NumberTheory.Powers.Squares-import Math.NumberTheory.Powers.Cubes-import Math.NumberTheory.Powers.Fourth-import Math.NumberTheory.Powers.General--import Math.NumberTheory.Powers.Modular
− Math/NumberTheory/Powers/Cubes.hs
@@ -1,254 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.Cubes--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Functions dealing with cubes. Moderately efficient calculation of integer--- cube roots and testing for cubeness.-{-# LANGUAGE MagicHash, BangPatterns, CPP, FlexibleContexts #-}-module Math.NumberTheory.Powers.Cubes- ( integerCubeRoot- , integerCubeRoot'- , exactCubeRoot- , isCube- , isCube'- , isPossibleCube- ) where--#include "MachDeps.h"--import Control.Monad.ST-import Data.Bits-import qualified Data.Vector.Unboxed as V-import qualified Data.Vector.Unboxed.Mutable as MV--import GHC.Base-import GHC.Integer-import GHC.Integer.GMP.Internals-import GHC.Integer.Logarithms (integerLog2#)--import Numeric.Natural---- | Calculate the integer cube root of an integer @n@,--- that is the largest integer @r@ such that @r^3 <= n@.--- Note that this is not symmetric about @0@, for example--- @integerCubeRoot (-2) = (-2)@ while @integerCubeRoot 2 = 1@.-{-# SPECIALISE integerCubeRoot :: Int -> Int,- Word -> Word,- Integer -> Integer,- Natural -> Natural- #-}-integerCubeRoot :: Integral a => a -> a-integerCubeRoot 0 = 0-integerCubeRoot n- | n > 0 = integerCubeRoot' n- | otherwise =- let m = negate n- r = if m < 0- then negate . fromInteger $ integerCubeRoot' (negate $ fromIntegral n)- else negate (integerCubeRoot' m)- in if r*r*r == n then r else (r-1)---- | Calculate the integer cube root of a nonnegative integer @n@,--- that is, the largest integer @r@ such that @r^3 <= n@.--- The precondition @n >= 0@ is not checked.-{-# RULES-"integerCubeRoot'/Int" integerCubeRoot' = cubeRootInt'-"integerCubeRoot'/Word" integerCubeRoot' = cubeRootWord-"integerCubeRoot'/Integer" integerCubeRoot' = cubeRootIgr- #-}-{-# INLINE [1] integerCubeRoot' #-}-integerCubeRoot' :: Integral a => a -> a-integerCubeRoot' 0 = 0-integerCubeRoot' n = newton3 n (approxCuRt n)---- | Returns @Nothing@ if the argument is not a cube,--- @Just r@ if @n == r^3@.-{-# SPECIALISE exactCubeRoot :: Int -> Maybe Int,- Word -> Maybe Word,- Integer -> Maybe Integer,- Natural -> Maybe Natural- #-}-exactCubeRoot :: Integral a => a -> Maybe a-exactCubeRoot 0 = Just 0-exactCubeRoot n- | n < 0 =- if m < 0- then fmap (negate . fromInteger) $ exactCubeRoot (negate $ fromIntegral n)- else fmap negate (exactCubeRoot m)- | isPossibleCube n && r*r*r == n = Just r- | otherwise = Nothing- where- m = negate n- r = integerCubeRoot' n---- | Test whether an integer is a cube.-{-# SPECIALISE isCube :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isCube :: Integral a => a -> Bool-isCube 0 = True-isCube n- | n > 0 = isCube' n- | m > 0 = isCube' m- | otherwise = isCube' (negate (fromIntegral n) :: Integer)- where- m = negate n---- | Test whether a nonnegative integer is a cube.--- Before 'integerCubeRoot' is calculated, a few tests--- of remainders modulo small primes weed out most non-cubes.--- For testing many numbers, most of which aren't cubes,--- this is much faster than @let r = cubeRoot n in r*r*r == n@.--- The condition @n >= 0@ is /not/ checked.-{-# SPECIALISE isCube' :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isCube' :: Integral a => a -> Bool-isCube' !n = isPossibleCube n- && (r*r*r == n)- where- r = integerCubeRoot' n---- | Test whether a nonnegative number is possibly a cube.--- Only about 0.08% of all numbers pass this test.--- The precondition @n >= 0@ is /not/ checked.-{-# SPECIALISE isPossibleCube :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isPossibleCube :: Integral a => a -> Bool-isPossibleCube !n- = V.unsafeIndex cr512 (fromIntegral n .&. 511)- && V.unsafeIndex cubeRes837 (fromIntegral (n `rem` 837))- && V.unsafeIndex cubeRes637 (fromIntegral (n `rem` 637))- && V.unsafeIndex cubeRes703 (fromIntegral (n `rem` 703))--------------------------------------------------------------------------- Utility Functions ----------------------------------------------------------------------------- Special case for 'Int', a little faster.--- For @n <= 2^64@, the truncated 'Double' is never--- more than one off. Things might overflow for @n@--- close to @maxBound@, so check for overflow.-cubeRootInt' :: Int -> Int-cubeRootInt' 0 = 0-cubeRootInt' n- | n < c || c < 0 = r-1- | 0 < d && d < n = r+1- | otherwise = r- where- x = fromIntegral n :: Double- r = truncate (x ** (1/3))- c = r*r*r- d = c+3*r*(r+1)--cubeRootWord :: Word -> Word-cubeRootWord 0 = 0-cubeRootWord w-#if WORD_SIZE_IN_BITS == 64- | r > 2642245 = 2642245-#else- | r > 1625 = 1625-#endif- | w < c = r-1- | c < w && e < w && c < e = r+1- | otherwise = r- where- r = truncate ((fromIntegral w) ** (1/3) :: Double)- c = r*r*r- d = 3*r*(r+1)- e = c+d--cubeRootIgr :: Integer -> Integer-cubeRootIgr 0 = 0-cubeRootIgr n = newton3 n (approxCuRt n)--{-# SPECIALISE newton3 :: Integer -> Integer -> Integer #-}-newton3 :: Integral a => a -> a -> a-newton3 n a = go (step a)- where- step k = (2*k + n `quot` (k*k)) `quot` 3- go k- | m < k = go m- | otherwise = k- where- m = step k--{-# SPECIALISE approxCuRt :: Integer -> Integer #-}-approxCuRt :: Integral a => a -> a-approxCuRt 0 = 0-approxCuRt n = fromInteger $ appCuRt (fromIntegral n)---- threshold for shifting vs. direct fromInteger--- we shift when we expect more than 256 bits-#if WORD_SIZE_IN_BITS == 64-#define THRESH 5-#else-#define THRESH 9-#endif---- | approximate cube root, about 50 bits should be correct for large numbers-appCuRt :: Integer -> Integer-appCuRt (S# i#) = case double2Int# (int2Double# i# **## (1.0## /## 3.0##)) of- r# -> S# r#-appCuRt n@(Jp# bn#)- | isTrue# ((sizeofBigNat# bn#) <# THRESH#) =- floor (fromInteger n ** (1.0/3.0) :: Double)- | otherwise = case integerLog2# n of- l# -> case (l# `quotInt#` 3#) -# 51# of- h# -> case shiftRInteger n (3# *# h#) of- m -> case floor (fromInteger m ** (1.0/3.0) :: Double) of- r -> shiftLInteger r h#--- There's already handling for negative in integerCubeRoot,--- but integerCubeRoot' is exported directly too.-appCuRt _ = error "integerCubeRoot': negative argument"---- not very discriminating, but cheap, so it's an overall gain-cr512 :: V.Vector Bool-cr512 = runST $ do- ar <- MV.replicate 512 True- let note s i- | i < 512 = MV.unsafeWrite ar i False >> note s (i+s)- | otherwise = return ()- note 4 2- note 8 4- note 32 16- note 64 32- note 256 128- MV.unsafeWrite ar 256 False- V.unsafeFreeze ar---- Remainders modulo @3^3 * 31@-cubeRes837 :: V.Vector Bool-cubeRes837 = runST $ do- ar <- MV.replicate 837 False- let note 837 = return ()- note k = MV.unsafeWrite ar ((k*k*k) `rem` 837) True >> note (k+1)- note 0- V.unsafeFreeze ar---- Remainders modulo @7^2 * 13@-cubeRes637 :: V.Vector Bool-cubeRes637 = runST $ do- ar <- MV.replicate 637 False- let note 637 = return ()- note k = MV.unsafeWrite ar ((k*k*k) `rem` 637) True >> note (k+1)- note 0- V.unsafeFreeze ar---- Remainders modulo @19 * 37@-cubeRes703 :: V.Vector Bool-cubeRes703 = runST $ do- ar <- MV.replicate 703 False- let note 703 = return ()- note k = MV.unsafeWrite ar ((k*k*k) `rem` 703) True >> note (k+1)- note 0- V.unsafeFreeze ar
− Math/NumberTheory/Powers/Fourth.hs
@@ -1,220 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.Squares--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Functions dealing with fourth powers. Efficient calculation of integer fourth--- roots and efficient testing for being a square's square.-{-# LANGUAGE MagicHash, CPP, FlexibleContexts #-}-module Math.NumberTheory.Powers.Fourth- ( integerFourthRoot- , integerFourthRoot'- , exactFourthRoot- , isFourthPower- , isFourthPower'- , isPossibleFourthPower- ) where--#include "MachDeps.h"--import Control.Monad.ST-import Data.Bits-import qualified Data.Vector.Unboxed as V-import qualified Data.Vector.Unboxed.Mutable as MV--import GHC.Base-import GHC.Integer-import GHC.Integer.GMP.Internals-import GHC.Integer.Logarithms (integerLog2#)--import Numeric.Natural---- | Calculate the integer fourth root of a nonnegative number,--- that is, the largest integer @r@ with @r^4 <= n@.--- Throws an error on negaitve input.-{-# SPECIALISE integerFourthRoot :: Int -> Int,- Word -> Word,- Integer -> Integer,- Natural -> Natural- #-}-integerFourthRoot :: Integral a => a -> a-integerFourthRoot n- | n < 0 = error "integerFourthRoot: negative argument"- | otherwise = integerFourthRoot' n---- | Calculate the integer fourth root of a nonnegative number,--- that is, the largest integer @r@ with @r^4 <= n@.--- The condition is /not/ checked.-{-# RULES-"integerFourthRoot'/Int" integerFourthRoot' = biSqrtInt-"integerFourthRoot'/Word" integerFourthRoot' = biSqrtWord-"integerFourthRoot'/Integer" integerFourthRoot' = biSqrtIgr- #-}-{-# INLINE [1] integerFourthRoot' #-}-integerFourthRoot' :: Integral a => a -> a-integerFourthRoot' 0 = 0-integerFourthRoot' n = newton4 n (approxBiSqrt n)---- | Returns @Nothing@ if @n@ is not a fourth power,--- @Just r@ if @n == r^4@ and @r >= 0@.-{-# SPECIALISE exactFourthRoot :: Int -> Maybe Int,- Word -> Maybe Word,- Integer -> Maybe Integer,- Natural -> Maybe Natural- #-}-exactFourthRoot :: Integral a => a -> Maybe a-exactFourthRoot 0 = Just 0-exactFourthRoot n- | n < 0 = Nothing- | isPossibleFourthPower n && r2*r2 == n = Just r- | otherwise = Nothing- where- r = integerFourthRoot' n- r2 = r*r---- | Test whether an integer is a fourth power.--- First nonnegativity is checked, then the unchecked--- test is called.-{-# SPECIALISE isFourthPower :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isFourthPower :: Integral a => a -> Bool-isFourthPower 0 = True-isFourthPower n = n > 0 && isFourthPower' n---- | Test whether a nonnegative number is a fourth power.--- The condition is /not/ checked. If a number passes the--- 'isPossibleFourthPower' test, its integer fourth root--- is calculated.-{-# SPECIALISE isFourthPower' :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isFourthPower' :: Integral a => a -> Bool-isFourthPower' n = isPossibleFourthPower n && r2*r2 == n- where- r = integerFourthRoot' n- r2 = r*r---- | Test whether a nonnegative number is a possible fourth power.--- The condition is /not/ checked.--- This eliminates about 99.958% of numbers.-{-# SPECIALISE isPossibleFourthPower :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isPossibleFourthPower :: Integral a => a -> Bool-isPossibleFourthPower n- = V.unsafeIndex biSqRes256 (fromIntegral n .&. 255)- && V.unsafeIndex biSqRes425 (fromIntegral (n `rem` 425))- && V.unsafeIndex biSqRes377 (fromIntegral (n `rem` 377))--{-# SPECIALISE newton4 :: Integer -> Integer -> Integer #-}-newton4 :: Integral a => a -> a -> a-newton4 n a = go (step a)- where- step k = (3*k + n `quot` (k*k*k)) `quot` 4- go k- | m < k = go m- | otherwise = k- where- m = step k--{-# SPECIALISE approxBiSqrt :: Integer -> Integer #-}-approxBiSqrt :: Integral a => a -> a-approxBiSqrt = fromInteger . appBiSqrt . fromIntegral---- threshold for shifting vs. direct fromInteger--- we shift when we expect more than 384 bits-#if WORD_SIZE_IN_BITS == 64-#define THRESH 7-#else-#define THRESH 13-#endif---- Find a fairly good approximation to the fourth root.--- About 48 bits should be correct for large Integers.-appBiSqrt :: Integer -> Integer-appBiSqrt (S# i#) = S# (double2Int# (sqrtDouble# (sqrtDouble# (int2Double# i#))))-appBiSqrt n@(Jp# bn#)- | isTrue# ((sizeofBigNat# bn#) <# THRESH#) =- floor (sqrt . sqrt $ fromInteger n :: Double)- | otherwise = case integerLog2# n of- l# -> case uncheckedIShiftRA# l# 2# -# 47# of- h# -> case shiftRInteger n (4# *# h#) of- m -> case floor (sqrt $ sqrt $ fromInteger m :: Double) of- r -> shiftLInteger r h#--- There's already a check for negative in integerFourthRoot,--- but integerFourthRoot' is exported directly too.-appBiSqrt _ = error "integerFourthRoot': negative argument"---biSqRes256 :: V.Vector Bool-biSqRes256 = runST $ do- ar <- MV.replicate 256 False- let note 257 = return ()- note i = MV.unsafeWrite ar i True >> note (i+16)- MV.unsafeWrite ar 0 True- MV.unsafeWrite ar 16 True- note 1- V.unsafeFreeze ar--biSqRes425 :: V.Vector Bool-biSqRes425 = runST $ do- ar <- MV.replicate 425 False- let note 154 = return ()- note i = MV.unsafeWrite ar ((i*i*i*i) `rem` 425) True >> note (i+1)- note 0- V.unsafeFreeze ar--biSqRes377 :: V.Vector Bool-biSqRes377 = runST $ do- ar <- MV.replicate 377 False- let note 144 = return ()- note i = MV.unsafeWrite ar ((i*i*i*i) `rem` 377) True >> note (i+1)- note 0- V.unsafeFreeze ar--biSqrtInt :: Int -> Int-biSqrtInt 0 = 0-biSqrtInt n-#if WORD_SIZE_IN_BITS == 64- | r > 55108 = 55108-#else- | r > 215 = 215-#endif- | n < r4 = r-1- | otherwise = r- where- x :: Double- x = fromIntegral n- -- timed faster than x**0.25, never too small- r = truncate (sqrt (sqrt x))- r2 = r*r- r4 = r2*r2--biSqrtWord :: Word -> Word-biSqrtWord 0 = 0-biSqrtWord n-#if WORD_SIZE_IN_BITS == 64- | r > 65535 = 65535-#else- | r > 255 = 255-#endif- | n < r4 = r-1- | otherwise = r- where- x :: Double- x = fromIntegral n- r = truncate (sqrt (sqrt x))- r2 = r*r- r4 = r2*r2--biSqrtIgr :: Integer -> Integer-biSqrtIgr 0 = 0-biSqrtIgr n = newton4 n (approxBiSqrt n)
− Math/NumberTheory/Powers/General.hs
@@ -1,353 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.General--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Calculating integer roots and determining perfect powers.--- The algorithms are moderately efficient.----{-# LANGUAGE MagicHash, BangPatterns, CPP #-}-{-# OPTIONS_GHC -O2 -fspec-constr-count=8 #-}-module Math.NumberTheory.Powers.General- ( integerRoot- , exactRoot- , isKthPower- , isPerfectPower- , highestPower- , largePFPower- ) where--#include "MachDeps.h"--import GHC.Base-import GHC.Integer-import GHC.Integer.GMP.Internals-import GHC.Integer.Logarithms (integerLog2#)--import Data.Bits-import Data.List (foldl')-import qualified Data.Set as Set--import Numeric.Natural--import Math.NumberTheory.Logarithms (integerLogBase')-import Math.NumberTheory.Utils (shiftToOddCount- , splitOff- )-import qualified Math.NumberTheory.Powers.Squares as P2-import qualified Math.NumberTheory.Powers.Cubes as P3-import qualified Math.NumberTheory.Powers.Fourth as P4-import Math.NumberTheory.Utils.FromIntegral (intToWord, wordToInt)---- | Calculate an integer root, @'integerRoot' k n@ computes the (floor of) the @k@-th--- root of @n@, where @k@ must be positive.--- @r = 'integerRoot' k n@ means @r^k <= n < (r+1)^k@ if that is possible at all.--- It is impossible if @k@ is even and @n \< 0@, since then @r^k >= 0@ for all @r@,--- then, and if @k <= 0@, @'integerRoot'@ raises an error. For @k < 5@, a specialised--- version is called which should be more efficient than the general algorithm.--- However, it is not guaranteed that the rewrite rules for those fire, so if @k@ is--- known in advance, it is safer to directly call the specialised versions.-{-# SPECIALISE integerRoot :: Int -> Int -> Int,- Int -> Word -> Word,- Int -> Integer -> Integer,- Int -> Natural -> Natural,- Word -> Int -> Int,- Word -> Word -> Word,- Word -> Integer -> Integer,- Word -> Natural -> Natural,- Integer -> Integer -> Integer,- Natural -> Natural -> Natural- #-}-integerRoot :: (Integral a, Integral b) => b -> a -> a-integerRoot 1 n = n-integerRoot 2 n = P2.integerSquareRoot n-integerRoot 3 n = P3.integerCubeRoot n-integerRoot 4 n = P4.integerFourthRoot n-integerRoot k n- | k < 1 = error "integerRoot: negative exponent or exponent 0"- | n < 0 && even k = error "integerRoot: negative radicand for even exponent"- | n < 0 =- let r = negate . fromInteger . integerRoot k . negate $ fromIntegral n- in if r^k == n then r else (r-1)- | n == 0 = 0- | n < 31 = 1- | kTooLarge = 1- | otherwise = newtonK k' n a- where- k' = fromIntegral k- a = approxKthRoot (fromIntegral k) n- kTooLarge = (toInteger k /= toInteger (fromIntegral k `asTypeOf` n)) -- k doesn't fit in n's type- || (toInteger k > toInteger (maxBound :: Int)) -- 2^k doesn't fit in Integer- || (I# (integerLog2# (toInteger n)) < fromIntegral k) -- n < 2^k---- | @'exactRoot' k n@ returns @'Nothing'@ if @n@ is not a @k@-th power,--- @'Just' r@ if @n == r^k@. If @k@ is divisible by @4, 3@ or @2@, a--- residue test is performed to avoid the expensive calculation if it--- can thus be determined that @n@ is not a @k@-th power.-exactRoot :: (Integral a, Integral b) => b -> a -> Maybe a-exactRoot 1 n = Just n-exactRoot 2 n = P2.exactSquareRoot n-exactRoot 3 n = P3.exactCubeRoot n-exactRoot 4 n = P4.exactFourthRoot n-exactRoot k n- | n == 1 = Just 1- | k < 1 = Nothing- | n < 0 && even k = Nothing- | n < 0 = fmap negate (exactRoot k (-n))- | n < 2 = Just n- | n < 31 = Nothing- | kTooLarge = Nothing- | otherwise = case k `rem` 12 of- 0 | c4 && c3 && ok -> Just r- | otherwise -> Nothing- 2 | c2 && ok -> Just r- | otherwise -> Nothing- 3 | c3 && ok -> Just r- | otherwise -> Nothing- 4 | c4 && ok -> Just r- | otherwise -> Nothing- 6 | c3 && c2 && ok -> Just r- | otherwise -> Nothing- 8 | c4 && ok -> Just r- | otherwise -> Nothing- 9 | c3 && ok -> Just r- | otherwise -> Nothing- 10 | c2 && ok -> Just r- | otherwise -> Nothing- _ | ok -> Just r- | otherwise -> Nothing-- where- k' :: Int- k' = fromIntegral k- r = integerRoot k' n- c2 = P2.isPossibleSquare n- c3 = P3.isPossibleCube n- c4 = P4.isPossibleFourthPower n- ok = r^k == n- kTooLarge = (toInteger k /= toInteger (fromIntegral k `asTypeOf` n)) -- k doesn't fit in n's type- || (toInteger k > toInteger (maxBound :: Int)) -- 2^k doesn't fit in Integer- || (I# (integerLog2# (toInteger n)) < fromIntegral k) -- n < 2^k---- | @'isKthPower' k n@ checks whether @n@ is a @k@-th power.-isKthPower :: (Integral a, Integral b) => b -> a -> Bool-isKthPower k n = case exactRoot k n of- Just _ -> True- Nothing -> False---- | @'isPerfectPower' n@ checks whether @n == r^k@ for some @k > 1@.-isPerfectPower :: Integral a => a -> Bool-isPerfectPower n- | n == 0 || n == 1 = True- | otherwise = k > 1- where- (_,k) = highestPower n---- | @'highestPower' n@ produces the pair @(b,k)@ with the largest--- exponent @k@ such that @n == b^k@, except for @'abs' n <= 1@,--- in which case arbitrarily large exponents exist, and by an--- arbitrary decision @(n,3)@ is returned.------ First, by trial division with small primes, the range of possible--- exponents is reduced (if @p^e@ exactly divides @n@, then @k@ must--- be a divisor of @e@, if several small primes divide @n@, @k@ must--- divide the greatest common divisor of their exponents, which mostly--- will be @1@, generally small; if none of the small primes divides--- @n@, the range of possible exponents is reduced since the base is--- necessarily large), if that has not yet determined the result, the--- remaining factor is examined by trying the divisors of the @gcd@--- of the prime exponents if some have been found, otherwise by trying--- prime exponents recursively.-highestPower :: Integral a => a -> (a, Word)-highestPower n'- | abs n <= 1 = (n', 3)- | n < 0 = case integerHighPower (negate n) of- (r,e) -> case shiftToOddCount e of- (k, o) -> (negate $ fromInteger (sqr k r), o)- | otherwise = case integerHighPower n of- (r,e) -> (fromInteger r, e)- where- n :: Integer- n = toInteger n'-- sqr :: Word -> Integer -> Integer- sqr 0 m = m- sqr k m = sqr (k-1) (m*m)---- | @'largePFPower' bd n@ produces the pair @(b,k)@ with the largest--- exponent @k@ such that @n == b^k@, where @bd > 1@ (it is expected--- that @bd@ is much larger, at least @1000@ or so), @n > bd^2@ and @n@--- has no prime factors @p <= bd@, skipping the trial division phase--- of @'highestPower'@ when that is a priori known to be superfluous.--- It is only present to avoid duplication of work in factorisation--- and primality testing, it is not expected to be generally useful.--- The assumptions are not checked, if they are not satisfied, wrong--- results and wasted work may be the consequence.-largePFPower :: Integer -> Integer -> (Integer, Word)-largePFPower bd n = rawPower ln n- where- ln = intToWord (integerLogBase' (bd+1) n)----------------------------------------------------------------------------------------------- Auxiliary functions -----------------------------------------------------------------------------------------------{-# SPECIALISE newtonK :: Int -> Int -> Int -> Int,- Word -> Word -> Word -> Word,- Integer -> Integer -> Integer -> Integer,- Natural -> Natural -> Natural -> Natural- #-}-newtonK :: Integral a => a -> a -> a -> a-newtonK k n a = go (step a)- where- -- Beware integer overflow in m^(k-1)- step m = ((k-1)*m + fromInteger (toInteger n `quot` (toInteger m^(k-1)))) `quot` k- go m- | l < m = go l- | otherwise = m- where- l = step m--{-# SPECIALISE approxKthRoot :: Int -> Int -> Int,- Int -> Word -> Word,- Int -> Integer -> Integer,- Int -> Natural -> Natural- #-}-approxKthRoot :: Integral a => Int -> a -> a-approxKthRoot k = fromInteger . appKthRoot k . fromIntegral---- find an approximation to the k-th root--- here, k > 4 and n > 31-appKthRoot :: Int -> Integer -> Integer-appKthRoot (I# k#) (S# n#) = S# (double2Int# (int2Double# n# **## (1.0## /## int2Double# k#)))-appKthRoot k@(I# k#) n =- case integerLog2# n of- l# -> case l# `quotInt#` k# of- 0# -> 1- 1# -> 3- 2# -> 5- 3# -> 11- h# | isTrue# (h# <# 500#) ->- floor (scaleFloat (I# (h# -# 1#))- (fromInteger (n `shiftRInteger` (h# *# k# -# k#)) ** (1/fromIntegral k) :: Double))- | otherwise ->- floor (scaleFloat 400 (fromInteger (n `shiftRInteger` (h# *# k# -# k#)) ** (1/fromIntegral k) :: Double))- `shiftLInteger` (h# -# 401#)---- assumption: argument is > 1-integerHighPower :: Integer -> (Integer, Word)-integerHighPower n- | n < 4 = (n,1)- | otherwise = case shiftToOddCount n of- (e2,m) | m == 1 -> (2,e2)- | otherwise -> findHighPower e2 (if e2 == 0 then [] else [(2,e2)]) m r smallOddPrimes- where- r = P2.integerSquareRoot m--findHighPower :: Word -> [(Integer, Word)] -> Integer -> Integer -> [Integer] -> (Integer, Word)-findHighPower 1 pws m _ _ = (foldl' (*) m [p^e | (p,e) <- pws], 1)-findHighPower e pws 1 _ _ = (foldl' (*) 1 [p^(ex `quot` e) | (p,ex) <- pws], e)-findHighPower e pws m s (p:ps)- | s < p = findHighPower 1 pws m s []- | otherwise =- case splitOff p m of- (0,_) -> findHighPower e pws m s ps- (k,r) -> findHighPower (gcd k e) ((p,k):pws) r (P2.integerSquareRoot r) ps-findHighPower e pws m _ [] = finishPower e pws m--spBEx :: Word-spBEx = 14--spBound :: Integer-spBound = 2^spBEx--smallOddPrimes :: [Integer]-smallOddPrimes = 3:5:primes'- where- primes' = 7:11:13:17:19:23:29:filter isPrime (takeWhile (< spBound) $ scanl (+) 31 (cycle [6,4,2,4,2,4,6,2]))- isPrime n = go primes'- where- go (p:ps) = (p*p > n) || (n `rem` p /= 0 && go ps)- go [] = True---- n large, has no prime divisors < spBound-finishPower :: Word -> [(Integer, Word)] -> Integer -> (Integer, Word)-finishPower e pws n- | n < (1 `shiftL` wordToInt (2*spBEx)) = (foldl' (*) n [p^ex | (p,ex) <- pws], 1) -- n is prime- | e == 0 = rawPower maxExp n- | otherwise = go divs- where- maxExp = (W# (int2Word# (integerLog2# n))) `quot` spBEx- divs = divisorsTo maxExp e- go [] = (foldl' (*) n [p^ex | (p,ex) <- pws], 1)- go (d:ds) = case exactRoot d n of- Just r -> (foldl' (*) r [p^(ex `quot` d) | (p,ex) <- pws], d)- Nothing -> go ds--rawPower :: Word -> Integer -> (Integer, Word)-rawPower mx n- | mx < 2 = (n,1)- | mx == 2 = case P2.exactSquareRoot n of- Just r -> (r,2)- Nothing -> (n,1)-rawPower mx n = case P4.exactFourthRoot n of- Just r -> case rawPower (mx `quot` 4) r of- (m,e) -> (m, 4*e)- Nothing -> case P2.exactSquareRoot n of- Just r -> case rawOddPower (mx `quot` 2) r of- (m,e) -> (m, 2*e)- Nothing -> rawOddPower mx n--rawOddPower :: Word -> Integer -> (Integer, Word)-rawOddPower mx n- | mx < 3 = (n,1)-rawOddPower mx n = case P3.exactCubeRoot n of- Just r -> case rawOddPower (mx `quot` 3) r of- (m,e) -> (m, 3*e)- Nothing -> badPower mx n--badPower :: Word -> Integer -> (Integer, Word)-badPower mx n- | mx < 5 = (n,1)- | otherwise = go 1 mx n (takeWhile (<= mx) $ scanl (+) 5 $ cycle [2,4])- where- go !e b m (k:ks)- | b < k = (m,e)- | otherwise = case exactRoot k m of- Just r -> go (e*k) (b `quot` k) r (k:ks)- Nothing -> go e b m ks- go e _ m [] = (m,e)--divisorsTo :: Word -> Word -> [Word]-divisorsTo mx n = case shiftToOddCount n of- (k,o) | k == 0 -> go (Set.singleton 1) n iops- | otherwise -> go (Set.fromDistinctAscList $ takeWhile (<= mx) $ take (wordToInt k + 1) (iterate (*2) 1)) o iops- where- mset k st = fst (Set.split (mx+1) (Set.mapMonotonic (*k) st))- -- unP p m = (k, m / p ^ k), where k is as large as possible such that p ^ k still divides m- unP :: Word -> Word -> (Word, Word)- unP p m = goP 0 m- where- goP :: Word -> Word -> (Word, Word)- goP !i j = case j `quotRem` p of- (q,r) | r == 0 -> goP (i+1) q- | otherwise -> (i,j)- iops :: [Word]- iops = 3:5:prs- prs :: [Word]- prs = 7:filter prm (scanl (+) 11 $ cycle [2,4,2,4,6,2,6,4])- prm :: Word -> Bool- prm k = td prs- where- td (p:ps) = (p*p > k) || (k `rem` p /= 0 && td ps)- td [] = True- go !st m (p:ps)- | m == 1 = reverse $ Set.toAscList st- | m < p*p = reverse . Set.toAscList $ Set.union st (mset m st)- | otherwise =- case unP p m of- (0,_) -> go st m ps- -- iterate f x = [x, f x, f (f x)...]- (k,r) -> go (Set.unions (take (wordToInt k + 1) (iterate (mset p) st))) r ps- go st m [] = go st m [m+1]
− Math/NumberTheory/Powers/Modular.hs
@@ -1,89 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.Modular--- Copyright: (c) 2017 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Modular powers (a. k. a. modular exponentiation).-----{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}--module Math.NumberTheory.Powers.Modular- ( powMod- , powModWord- , powModInt- ) where--import qualified GHC.Integer.GMP.Internals as GMP (powModInteger)--import GHC.Exts (Word(..))-import GHC.Natural (powModNatural)-import qualified GHC.Integer.GMP.Internals as GMP (powModWord)-import Math.NumberTheory.Utils.FromIntegral---- | @powMod@ @b@ @e@ @m@ computes (@b^e@) \`mod\` @m@ in effective way.--- An exponent @e@ must be non-negative, a modulo @m@ must be positive.--- Otherwise the behaviour of @powMod@ is undefined.------ >>> powMod 2 3 5--- 3--- >>> powMod 3 12345678901234567890 1001--- 1------ See also 'Math.NumberTheory.Moduli.Class.powMod' and 'Math.NumberTheory.Moduli.Class.powSomeMod'.------ For finite numeric types ('Int', 'Word', etc.)--- modulo @m@ should be such that @m^2@ does not overflow,--- otherwise the behaviour is undefined. If you--- need both to fit into machine word and to handle large moduli,--- take a look at 'powModInt' and 'powModWord'.------ >>> powMod 3 101 (2^60-1 :: Integer)--- 1018105167100379328 -- correct--- >>> powMod 3 101 (2^60-1 :: Int)--- 1115647832265427613 -- incorrect due to overflow--- >>> powModInt 3 101 (2^60-1 :: Int)--- 1018105167100379328 -- correct-powMod :: (Integral a, Integral b) => a -> b -> a -> a-powMod x y m- | m <= 0 = error "powModInt: non-positive modulo"- | y < 0 = error "powModInt: negative exponent"- | otherwise = f (x `rem` m) y 1 `mod` m- where- f _ 0 acc = acc- f b e acc = f (b * b `rem` m) (e `quot` 2)- (if odd e then (b * acc `rem` m) else acc)--{-# INLINE [1] powMod #-}-{-# RULES-"powMod/Integer" powMod = powModInteger- #-}---- Work around https://ghc.haskell.org/trac/ghc/ticket/14085-powModInteger :: Integer -> Integer -> Integer -> Integer-powModInteger b e m = GMP.powModInteger (b `mod` m) e m--{-# RULES-"powMod/Natural" powMod = powModNatural-"powMod/Word" powMod = powModWord-"powMod/Int" powMod = powModInt- #-}---- | Specialised version of 'powMod', able to handle large moduli correctly.------ >>> powModWord 3 101 (2^60-1)--- 1018105167100379328-powModWord :: Word -> Word -> Word -> Word-powModWord (W# x) (W# y) (W# m) = W# (GMP.powModWord x y m)---- | Specialised version of 'powMod', able to handle large moduli correctly.------ >> powModInt 3 101 (2^60-1)--- 1018105167100379328-powModInt :: Int -> Int -> Int -> Int-powModInt x y m- | m <= 0 = error "powModInt: non-positive modulo"- | y < 0 = error "powModInt: negative exponent"- | otherwise = wordToInt $ powModWord (intToWord (x `mod` m)) (intToWord y) (intToWord m)
− Math/NumberTheory/Powers/Squares.hs
@@ -1,261 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.Squares--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Functions dealing with squares. Efficient calculation of integer square roots--- and efficient testing for squareness.-{-# LANGUAGE MagicHash, BangPatterns, PatternGuards, CPP, FlexibleContexts #-}-module Math.NumberTheory.Powers.Squares- ( -- * Square root calculation- integerSquareRoot- , integerSquareRoot'- , integerSquareRootRem- , integerSquareRootRem'- , exactSquareRoot- -- * Tests for squares- , isSquare- , isSquare'- , isPossibleSquare- , isPossibleSquare2- ) where--#include "MachDeps.h"--import Control.Monad.ST-import Data.Bits-import qualified Data.Vector.Unboxed as V-import qualified Data.Vector.Unboxed.Mutable as MV--import Numeric.Natural--import Math.NumberTheory.Powers.Squares.Internal---- | Calculate the integer square root of a nonnegative number @n@,--- that is, the largest integer @r@ with @r*r <= n@.--- Throws an error on negative input.-{-# SPECIALISE integerSquareRoot :: Int -> Int,- Word -> Word,- Integer -> Integer,- Natural -> Natural- #-}-integerSquareRoot :: Integral a => a -> a-integerSquareRoot n- | n < 0 = error "integerSquareRoot: negative argument"- | otherwise = integerSquareRoot' n---- | Calculate the integer square root of a nonnegative number @n@,--- that is, the largest integer @r@ with @r*r <= n@.--- The precondition @n >= 0@ is not checked.-{-# RULES-"integerSquareRoot'/Int" integerSquareRoot' = isqrtInt'-"integerSquareRoot'/Word" integerSquareRoot' = isqrtWord-"integerSquareRoot'/Integer" integerSquareRoot' = isqrtInteger- #-}-{-# INLINE [1] integerSquareRoot' #-}-integerSquareRoot' :: Integral a => a -> a-integerSquareRoot' = isqrtA---- | Calculate the integer square root of a nonnegative number as well as--- the difference of that number with the square of that root, that is if--- @(s,r) = integerSquareRootRem n@ then @s^2 <= n == s^2+r < (s+1)^2@.-{-# SPECIALISE integerSquareRootRem ::- Int -> (Int, Int),- Word -> (Word, Word),- Integer -> (Integer, Integer),- Natural -> (Natural, Natural)- #-}-integerSquareRootRem :: Integral a => a -> (a, a)-integerSquareRootRem n- | n < 0 = error "integerSquareRootRem: negative argument"- | otherwise = integerSquareRootRem' n---- | Calculate the integer square root of a nonnegative number as well as--- the difference of that number with the square of that root, that is if--- @(s,r) = integerSquareRootRem' n@ then @s^2 <= n == s^2+r < (s+1)^2@.--- The precondition @n >= 0@ is not checked.-{-# RULES-"integerSquareRootRem'/Integer" integerSquareRootRem' = karatsubaSqrt- #-}-{-# INLINE [1] integerSquareRootRem' #-}-integerSquareRootRem' :: Integral a => a -> (a, a)-integerSquareRootRem' n = (s, n - s * s)- where- s = integerSquareRoot' n---- | Returns 'Nothing' if the argument is not a square,--- @'Just' r@ if @r*r == n@ and @r >= 0@. Avoids the expensive calculation--- of the square root if @n@ is recognized as a non-square--- before, prevents repeated calculation of the square root--- if only the roots of perfect squares are needed.--- Checks for negativity and 'isPossibleSquare'.-{-# SPECIALISE exactSquareRoot :: Int -> Maybe Int,- Word -> Maybe Word,- Integer -> Maybe Integer,- Natural -> Maybe Natural- #-}-exactSquareRoot :: Integral a => a -> Maybe a-exactSquareRoot n- | n >= 0- , isPossibleSquare n- , (r, 0) <- integerSquareRootRem' n = Just r- | otherwise = Nothing---- | Test whether the argument is a square.--- After a number is found to be positive, first 'isPossibleSquare'--- is checked, if it is, the integer square root is calculated.-{-# SPECIALISE isSquare :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isSquare :: Integral a => a -> Bool-isSquare n = n >= 0 && isSquare' n---- | Test whether the input (a nonnegative number) @n@ is a square.--- The same as 'isSquare', but without the negativity test.--- Faster if many known positive numbers are tested.------ The precondition @n >= 0@ is not tested, passing negative--- arguments may cause any kind of havoc.-{-# SPECIALISE isSquare' :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isSquare' :: Integral a => a -> Bool-isSquare' n- | isPossibleSquare n- , (_, 0) <- integerSquareRootRem' n = True- | otherwise = False---- | Test whether a non-negative number may be a square.--- Non-negativity is not checked, passing negative arguments may--- cause any kind of havoc.------ First the remainder modulo 256 is checked (that can be calculated--- easily without division and eliminates about 82% of all numbers).--- After that, the remainders modulo 9, 25, 7, 11 and 13 are tested--- to eliminate altogether about 99.436% of all numbers.------ This is the test used by 'exactSquareRoot'. For large numbers,--- the slower but more discriminating test 'isPossibleSquare2' is--- faster.-{-# SPECIALISE isPossibleSquare :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isPossibleSquare :: Integral a => a -> Bool-isPossibleSquare n- = V.unsafeIndex sr256 ((fromIntegral n) .&. 255)- && V.unsafeIndex sr693 (fromIntegral (n `rem` 693))- && V.unsafeIndex sr325 (fromIntegral (n `rem` 325))---- | Test whether a non-negative number may be a square.--- Non-negativity is not checked, passing negative arguments may--- cause any kind of havoc.------ First the remainder modulo 256 is checked (that can be calculated--- easily without division and eliminates about 82% of all numbers).--- After that, the remainders modulo several small primes are tested--- to eliminate altogether about 99.98954% of all numbers.------ For smallish to medium sized numbers, this hardly performs better--- than 'isPossibleSquare', which uses smaller arrays, but for large--- numbers, where calculating the square root becomes more expensive,--- it is much faster (if the vast majority of tested numbers aren't squares).-{-# SPECIALISE isPossibleSquare2 :: Int -> Bool,- Word -> Bool,- Integer -> Bool,- Natural -> Bool- #-}-isPossibleSquare2 :: Integral a => a -> Bool-isPossibleSquare2 n- = V.unsafeIndex sr256 ((fromIntegral n) .&. 255)- && V.unsafeIndex sr819 (fromIntegral (n `rem` 819))- && V.unsafeIndex sr1025 (fromIntegral (n `rem` 1025))- && V.unsafeIndex sr2047 (fromIntegral (n `rem` 2047))- && V.unsafeIndex sr4097 (fromIntegral (n `rem` 4097))- && V.unsafeIndex sr341 (fromIntegral (n `rem` 341))---------------------------------------------------------------------------------- Auxiliary Stuff---- Make an array indicating whether a remainder is a square remainder.-sqRemArray :: Int -> V.Vector Bool-sqRemArray md = runST $ do- ar <- MV.replicate md False- let !stop = (md `quot` 2) + 1- fill k- | k < stop = MV.unsafeWrite ar ((k*k) `rem` md) True >> fill (k+1)- | otherwise = return ()- MV.unsafeWrite ar 0 True- MV.unsafeWrite ar 1 True- fill 2- V.unsafeFreeze ar--sr256 :: V.Vector Bool-sr256 = sqRemArray 256--sr819 :: V.Vector Bool-sr819 = sqRemArray 819--sr4097 :: V.Vector Bool-sr4097 = sqRemArray 4097--sr341 :: V.Vector Bool-sr341 = sqRemArray 341--sr1025 :: V.Vector Bool-sr1025 = sqRemArray 1025--sr2047 :: V.Vector Bool-sr2047 = sqRemArray 2047--sr693 :: V.Vector Bool-sr693 = sqRemArray 693--sr325 :: V.Vector Bool-sr325 = sqRemArray 325---- Specialisations for Int, Word, and Integer---- For @n <= 2^64@, the result of------ > truncate (sqrt $ fromIntegral n)------ is never too small and never more than one too large.--- The multiplication doesn't overflow for 32 or 64 bit Ints.-isqrtInt' :: Int -> Int-isqrtInt' n- | n < r*r = r-1- | otherwise = r- where- !r = (truncate :: Double -> Int) . sqrt $ fromIntegral n--- With -O2, that should be translated to the below-{--isqrtInt' n@(I# i#)- | r# *# r# ># i# = I# (r# -# 1#)- | otherwise = I# r#- where- !r# = double2Int# (sqrtDouble# (int2Double# i#))--}---- Same for Word.-isqrtWord :: Word -> Word-isqrtWord n- | n < (r*r)-#if WORD_SIZE_IN_BITS == 64- || r == 4294967296--- Double interprets values near maxBound as 2^64, we don't have that problem for 32 bits-#endif- = r-1- | otherwise = r- where- !r = (fromIntegral :: Int -> Word) . (truncate :: Double -> Int) . sqrt $ fromIntegral n--{-# INLINE isqrtInteger #-}-isqrtInteger :: Integer -> Integer-isqrtInteger = fst . karatsubaSqrt
− Math/NumberTheory/Powers/Squares/Internal.hs
@@ -1,134 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.Squares.Internal--- Copyright: (c) 2016 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Internal functions dealing with square roots. End-users should not import this module.--{-# LANGUAGE MagicHash #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}--{-# OPTIONS_HADDOCK hide #-}--module Math.NumberTheory.Powers.Squares.Internal- ( karatsubaSqrt- , isqrtA- ) where--#include "MachDeps.h"--import Data.Bits--import GHC.Base-import GHC.Integer-import GHC.Integer.GMP.Internals-import GHC.Integer.Logarithms (integerLog2#)--import Math.NumberTheory.Logarithms (integerLog2)---- Find approximation to square root in 'Integer', then--- find the integer square root by the integer variant--- of Heron's method. Takes only a handful of steps--- unless the input is really large.-{-# SPECIALISE isqrtA :: Integer -> Integer #-}-isqrtA :: Integral a => a -> a-isqrtA 0 = 0-isqrtA n = heron n (fromInteger . appSqrt . fromIntegral $ n)---- Heron's method for integers. First make one step to ensure--- the value we're working on is @>= r@, then we have--- @k == r@ iff @k <= step k@.-{-# SPECIALISE heron :: Integer -> Integer -> Integer #-}-heron :: Integral a => a -> a -> a-heron n a = go (step a)- where- step k = (k + n `quot` k) `quot` 2- go k- | m < k = go m- | otherwise = k- where- m = step k---- threshold for shifting vs. direct fromInteger--- we shift when we expect more than 256 bits-#if WORD_SIZE_IN_BITS == 64-#define THRESH 5-#else-#define THRESH 9-#endif---- Find a fairly good approximation to the square root.--- At most one off for small Integers, about 48 bits should be correct--- for large Integers.-appSqrt :: Integer -> Integer-appSqrt (S# i#) = S# (double2Int# (sqrtDouble# (int2Double# i#)))-appSqrt n@(Jp# bn#)- | isTrue# ((sizeofBigNat# bn#) <# THRESH#) =- floor (sqrt $ fromInteger n :: Double)- | otherwise = case integerLog2# n of- l# -> case uncheckedIShiftRA# l# 1# -# 47# of- h# -> case shiftRInteger n (2# *# h#) of- m -> case floor (sqrt $ fromInteger m :: Double) of- r -> shiftLInteger r h#--- There's already a check for negative in integerSquareRoot,--- but integerSquareRoot' is exported directly too.-appSqrt _ = error "integerSquareRoot': negative argument"----- Integer square root with remainder, using the Karatsuba Square Root--- algorithm from--- Paul Zimmermann. Karatsuba Square Root. [Research Report] RR-3805, 1999,--- pp.8. <inria-00072854>--karatsubaSqrt :: Integer -> (Integer, Integer)-karatsubaSqrt 0 = (0, 0)-karatsubaSqrt n- | lgN < 2300 =- let s = isqrtA n in (s, n - s * s)- | otherwise =- if lgN .&. 2 /= 0 then- karatsubaStep k (karatsubaSplit k n)- else- -- before we split n into 4 part we must ensure that the first part- -- is at least 2^k/4, since this doesn't happen here we scale n by- -- multiplying it by 4- let n' = n `unsafeShiftL` 2- (s, r) = karatsubaStep k (karatsubaSplit k n')- r' | s .&. 1 == 0 = r- | otherwise = r + double s - 1- in (s `unsafeShiftR` 1, r' `unsafeShiftR` 2)- where- k = lgN `unsafeShiftR` 2 + 1- lgN = integerLog2 n--karatsubaStep :: Int -> (Integer, Integer, Integer, Integer) -> (Integer, Integer)-karatsubaStep k (a3, a2, a1, a0)- | r >= 0 = (s, r)- | otherwise = (s - 1, r + double s - 1)- where- r = cat u a0 - q * q- s = s' `unsafeShiftL` k + q- (q, u) = cat r' a1 `quotRem` double s'- (s', r') = karatsubaSqrt (cat a3 a2)- cat x y = x `unsafeShiftL` k .|. y- {-# INLINE cat #-}--karatsubaSplit :: Int -> Integer -> (Integer, Integer, Integer, Integer)-karatsubaSplit k n0 = (a3, a2, a1, a0)- where- a3 = n3- n3 = n2 `unsafeShiftR` k- a2 = n2 .&. m- n2 = n1 `unsafeShiftR` k- a1 = n1 .&. m- n1 = n0 `unsafeShiftR` k- a0 = n0 .&. m- m = 1 `unsafeShiftL` k - 1--double :: Bits a => a -> a-double x = x `unsafeShiftL` 1-{-# INLINE double #-}
Math/NumberTheory/Prefactored.hs view
@@ -7,7 +7,6 @@ -- Type for numbers, accompanied by their factorisation. -- -{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-}@@ -18,16 +17,19 @@ , fromFactors ) where +import Prelude hiding ((^), gcd) import Control.Arrow-+import Data.Euclidean import Data.Semigroup+import Data.Semiring (Semiring(..), Mul(..), (^))+import qualified Data.Semiring as Semiring+import Unsafe.Coerce -import Math.NumberTheory.Euclidean import Math.NumberTheory.Euclidean.Coprimes import Math.NumberTheory.Primes import Math.NumberTheory.Primes.Types --- | A container for a number and its pairwise coprime (but not neccessarily prime)+-- | A container for a number and its pairwise coprime (but not necessarily prime) -- factorisation. -- It is designed to preserve information about factors under multiplication. -- One can use this representation to speed up prime factorisation@@ -63,7 +65,7 @@ -- >>> prefFactors $ totient (p^2 * q^3) -- Coprimes {unCoprimes = [(1000000000000000000000000000057,1),(41666666666666666666666666669,1),(2000000000000000000000000000071,2),(111111111111111111111111111115,1),(2,4),(3,3)]} -- >>> prefFactors $ totient $ totient (p^2 * q^3)--- Coprimes {unCoprimes = [(39521,1),(6046667,1),(22222222222222222222222222223,1),(2000000000000000000000000000071,1),(361696272343,1),(85331809838489,1),(227098769,1),(199937,1),(5,3),(41666666666666666666666666669,1),(2,22),(3,8)]}+-- Coprimes {unCoprimes = [(39521,1),(227098769,1),(22222222222222222222222222223,1),(2000000000000000000000000000071,1),(361696272343,1),(85331809838489,1),(6046667,1),(199937,1),(5,3),(41666666666666666666666666669,1),(2,22),(3,8)]} -- -- Pairwise coprimality of factors is crucial, because it allows -- us to process them independently, possibly even@@ -76,28 +78,35 @@ { prefValue :: a -- ^ Number itself. , prefFactors :: Coprimes a Word- -- ^ List of pairwise coprime (but not neccesarily prime) factors,+ -- ^ List of pairwise coprime (but not necessarily prime) factors, -- accompanied by their multiplicities.- } deriving (Show)+ } deriving (Eq, Show) -- | Create 'Prefactored' from a given number. -- -- >>> fromValue 123 -- Prefactored {prefValue = 123, prefFactors = Coprimes {unCoprimes = [(123,1)]}}-fromValue :: (Eq a, Num a) => a -> Prefactored a+fromValue :: (Eq a, GcdDomain a) => a -> Prefactored a fromValue a = Prefactored a (singleton a 1) -- | Create 'Prefactored' from a given list of pairwise coprime--- (but not neccesarily prime) factors with multiplicities.+-- (but not necessarily prime) factors with multiplicities. -- -- >>> fromFactors (splitIntoCoprimes [(140, 1), (165, 1)]) -- Prefactored {prefValue = 23100, prefFactors = Coprimes {unCoprimes = [(28,1),(33,1),(5,2)]}} -- >>> fromFactors (splitIntoCoprimes [(140, 2), (165, 3)]) -- Prefactored {prefValue = 88045650000, prefFactors = Coprimes {unCoprimes = [(28,2),(33,3),(5,5)]}}-fromFactors :: Num a => Coprimes a Word -> Prefactored a-fromFactors as = Prefactored (product (map (uncurry (^)) (unCoprimes as))) as+fromFactors :: Semiring a => Coprimes a Word -> Prefactored a+fromFactors as = Prefactored (getMul $ foldMap (\(a, k) -> Mul $ a ^ k) (unCoprimes as)) as -instance Euclidean a => Num (Prefactored a) where+instance (Eq a, GcdDomain a) => Semiring (Prefactored a) where+ Prefactored v1 _ `plus` Prefactored v2 _+ = fromValue (v1 `plus` v2)+ Prefactored v1 f1 `times` Prefactored v2 f2+ = Prefactored (v1 `times` v2) (f1 <> f2)+ fromNatural n = fromValue (fromNatural n)++instance (Eq a, Num a, GcdDomain a) => Num (Prefactored a) where Prefactored v1 _ + Prefactored v2 _ = fromValue (v1 + v2) Prefactored v1 _ - Prefactored v2 _@@ -109,7 +118,7 @@ signum (Prefactored v _) = Prefactored (signum v) mempty fromInteger n = fromValue (fromInteger n) -instance (Euclidean a, UniqueFactorisation a) => UniqueFactorisation (Prefactored a) where+instance (Eq a, GcdDomain a, UniqueFactorisation a) => UniqueFactorisation (Prefactored a) where factorise (Prefactored _ f) = concatMap (\(x, xm) -> map (\(p, k) -> (Prime $ fromValue $ unPrime p, k * xm)) (factorise x)) (unCoprimes f) isPrime (Prefactored _ f) = case unCoprimes f of
Math/NumberTheory/Primes.hs view
@@ -5,37 +5,41 @@ -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> -- -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PostfixOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Math.NumberTheory.Primes ( Prime , unPrime+ , toPrimeIntegral , nextPrime , precPrime , UniqueFactorisation(..)+ , factorBack , -- * Old interface primes ) where -import Control.Arrow import Data.Bits import Data.Coerce+import Data.List.Infinite (Infinite(..), (...), (....))+import qualified Data.List.Infinite as Inf import Data.Maybe+import Data.Word+import Numeric.Natural import Math.NumberTheory.Primes.Counting (nthPrime, primeCount)-import qualified Math.NumberTheory.Primes.Factorisation as F (factorise)+import qualified Math.NumberTheory.Primes.Factorisation.Montgomery as F (factorise) import qualified Math.NumberTheory.Primes.Testing.Probabilistic as T (isPrime) import Math.NumberTheory.Primes.Sieve.Eratosthenes (primes, sieveRange, primeList, psieveFrom, primeSieve)+import Math.NumberTheory.Primes.Small import Math.NumberTheory.Primes.Types import Math.NumberTheory.Utils (toWheel30, fromWheel30) import Math.NumberTheory.Utils.FromIntegral -import Numeric.Natural- -- | A class for unique factorisation domains. class Num a => UniqueFactorisation a where -- | Factorise a number into a product of prime powers.@@ -82,11 +86,11 @@ isPrime :: a -> Maybe (Prime a) instance UniqueFactorisation Int where- factorise = map (Prime . integerToInt *** id) . F.factorise . intToInteger+ factorise = coerce . F.factorise isPrime n = if T.isPrime (toInteger n) then Just (Prime $ abs n) else Nothing instance UniqueFactorisation Word where- factorise = map (coerce integerToWord *** id) . F.factorise . wordToInteger+ factorise = coerce . F.factorise isPrime n = if T.isPrime (toInteger n) then Just (Prime n) else Nothing instance UniqueFactorisation Integer where@@ -94,9 +98,13 @@ isPrime n = if T.isPrime n then Just (Prime $ abs n) else Nothing instance UniqueFactorisation Natural where- factorise = map (coerce integerToNatural *** id) . F.factorise . naturalToInteger+ factorise = coerce . F.factorise isPrime n = if T.isPrime (toInteger n) then Just (Prime n) else Nothing +-- | Restore a number from its factorisation.+factorBack :: Num a => [(Prime a, Word)] -> a+factorBack = product . map (\(p, k) -> unPrime p ^ k)+ -- | Smallest prime, greater or equal to argument. -- -- > nextPrime (-100) == 2@@ -107,8 +115,8 @@ | n <= 2 = Prime 2 | n <= 3 = Prime 3 | n <= 5 = Prime 5- | otherwise = head $ mapMaybe isPrime $- dropWhile (< n) $ map fromWheel30 [toWheel30 n ..]+ | otherwise = Inf.head $ mapMaybeInf isPrime $+ Inf.dropWhile (< n) $ fmap fromWheel30 (toWheel30 n ...) -- dropWhile is important, because fromWheel30 (toWheel30 n) may appear to be < n. -- E. g., fromWheel30 (toWheel30 94) == 97 @@ -118,15 +126,18 @@ -- > precPrime 97 == 97 precPrime :: (Bits a, Integral a, UniqueFactorisation a) => a -> Prime a precPrime n- | n < 2 = error $ "precPrime: tried to take `precPrime` of an argument less than 2"+ | n < 2 = error "precPrime: tried to take `precPrime` of an argument less than 2" | n < 3 = Prime 2 | n < 5 = Prime 3 | n < 7 = Prime 5- | otherwise = head $ mapMaybe isPrime $- dropWhile (> n) $ map fromWheel30 [toWheel30 n, toWheel30 n - 1 ..]+ | otherwise = Inf.head $ mapMaybeInf isPrime $+ Inf.dropWhile (> n) $ fmap fromWheel30 ((toWheel30 n, toWheel30 n - 1) ....) -- dropWhile is important, because fromWheel30 (toWheel30 n) may appear to be > n. -- E. g., fromWheel30 (toWheel30 100) == 101 +mapMaybeInf :: (a -> Maybe b) -> Infinite a -> Infinite b+mapMaybeInf = Inf.foldr . (maybe id (:<) .)+ ------------------------------------------------------------------------------- -- Prime sequences @@ -148,7 +159,7 @@ Prime 2 -> Prime 3 Prime 3 -> Prime 5 Prime 5 -> Prime 7- Prime p -> head $ mapMaybe isPrime $ map fromWheel30 [toWheel30 p + 1 ..]+ Prime p -> Inf.head $ mapMaybeInf (isPrime . fromWheel30) ((toWheel30 p + 1) ...) succGenericBounded :: (Bits a, Integral a, UniqueFactorisation a, Bounded a)@@ -158,7 +169,7 @@ Prime 2 -> Prime 3 Prime 3 -> Prime 5 Prime 5 -> Prime 7- Prime p -> case mapMaybe isPrime $ map fromWheel30 [toWheel30 p + 1 .. toWheel30 maxBound] of+ Prime p -> case mapMaybe (isPrime . fromWheel30) [toWheel30 p + 1 .. toWheel30 maxBound] of [] -> error "Enum.succ{Prime}: tried to take `succ' near `maxBound'" q : _ -> q @@ -168,7 +179,7 @@ Prime 3 -> Prime 2 Prime 5 -> Prime 3 Prime 7 -> Prime 5- Prime p -> head $ mapMaybe isPrime $ map fromWheel30 [toWheel30 p - 1, toWheel30 p - 2 ..]+ Prime p -> Inf.head $ mapMaybeInf (isPrime . fromWheel30) ((toWheel30 p - 1, toWheel30 p - 2) ....) -- 'dropWhile' is important, because 'psieveFrom' can actually contain primes less than p. enumFromGeneric :: Integral a => Prime a -> [Prime a]@@ -181,10 +192,27 @@ $ psieveFrom $ toInteger p' +smallPrimesLimit :: Integral a => a+smallPrimesLimit = fromIntegral (maxBound :: Word16)+ enumFromToGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> [Prime a]-enumFromToGeneric p@(Prime p') q@(Prime q') = takeWhile (<= q) $ dropWhile (< p) $+enumFromToGeneric p@(Prime p') q@(Prime q')+ | p' <= smallPrimesLimit, q' <= smallPrimesLimit+ = map (Prime . fromIntegral) $ smallPrimesFromTo (fromIntegral p') (fromIntegral q')+ | p' <= smallPrimesLimit+ = map (Prime . fromIntegral) (smallPrimesFromTo (fromIntegral p') smallPrimesLimit)+ ++ enumFromToGeneric' (nextPrime smallPrimesLimit) q+ | otherwise+ = enumFromToGeneric' p q++enumFromToGeneric'+ :: (Bits a, Integral a, UniqueFactorisation a)+ => Prime a+ -> Prime a+ -> [Prime a]+enumFromToGeneric' p@(Prime p') q@(Prime q') = takeWhile (<= q) $ dropWhile (< p) $ case chooseAlgorithm p' q' of- IsPrime -> Prime 2 : Prime 3 : Prime 5 : mapMaybe isPrime (map fromWheel30 [toWheel30 p' .. toWheel30 q'])+ IsPrime -> Prime 2 : Prime 3 : Prime 5 : mapMaybe (isPrime . fromWheel30) [toWheel30 p' .. toWheel30 q'] Sieve -> if q' < fromIntegral sieveRange then primeList $ primeSieve $ toInteger q'@@ -192,26 +220,26 @@ enumFromThenGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> [Prime a] enumFromThenGeneric p@(Prime p') (Prime q') = case p' `compare` q' of- LT -> filter (\(Prime r') -> (r' - p') `mod` delta == 0) $ enumFromGeneric p+ LT -> filter (\(Prime r') -> (r' - p') `rem` delta == 0) $ enumFromGeneric p where delta = q' - p' EQ -> repeat p- GT -> filter (\(Prime r') -> (p' - r') `mod` delta == 0) $ reverse $ enumFromToGeneric (Prime 2) p+ GT -> filter (\(Prime r') -> (p' - r') `rem` delta == 0) $ reverse $ enumFromToGeneric (Prime 2) p where delta = p' - q' enumFromThenToGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> Prime a -> [Prime a] enumFromThenToGeneric p@(Prime p') (Prime q') r@(Prime r') = case p' `compare` q' of- LT -> filter (\(Prime t') -> (t' - p') `mod` delta == 0) $ enumFromToGeneric p r+ LT -> filter (\(Prime t') -> (t' - p') `rem` delta == 0) $ enumFromToGeneric p r where delta = q' - p' EQ -> if p' <= r' then repeat p else []- GT -> filter (\(Prime t') -> (p' - t') `mod` delta == 0) $ reverse $ enumFromToGeneric r p+ GT -> filter (\(Prime t') -> (p' - t') `rem` delta == 0) $ reverse $ enumFromToGeneric r p where delta = p' - q' instance Enum (Prime Integer) where- toEnum = nthPrime . intToInteger+ toEnum = nthPrime fromEnum = integerToInt . primeCount . unPrime succ = succGeneric pred = predGeneric@@ -221,7 +249,7 @@ enumFromThenTo = enumFromThenToGeneric instance Enum (Prime Natural) where- toEnum = Prime . integerToNatural . unPrime . nthPrime . intToInteger+ toEnum = Prime . integerToNatural . unPrime . nthPrime fromEnum = integerToInt . primeCount . naturalToInteger . unPrime succ = succGeneric pred = predGeneric@@ -235,7 +263,7 @@ then error $ "Enum.toEnum{Prime}: " ++ show n ++ "th prime = " ++ show p ++ " is out of bounds of Int" else Prime (integerToInt p) where- Prime p = nthPrime (intToInteger n)+ Prime p = nthPrime n fromEnum = integerToInt . primeCount . intToInteger . unPrime succ = succGenericBounded pred = predGeneric@@ -244,12 +272,16 @@ enumFromThen = enumFromThenGeneric enumFromThenTo = enumFromThenToGeneric +instance Bounded (Prime Int) where+ minBound = Prime 2+ maxBound = precPrime maxBound+ instance Enum (Prime Word) where toEnum n = if p > wordToInteger maxBound then error $ "Enum.toEnum{Prime}: " ++ show n ++ "th prime = " ++ show p ++ " is out of bounds of Word" else Prime (integerToWord p) where- Prime p = nthPrime (intToInteger n)+ Prime p = nthPrime n fromEnum = integerToInt . primeCount . wordToInteger . unPrime succ = succGenericBounded pred = predGeneric@@ -257,3 +289,7 @@ enumFromTo = enumFromToGeneric enumFromThen = enumFromThenGeneric enumFromThenTo = enumFromThenToGeneric++instance Bounded (Prime Word) where+ minBound = Prime 2+ maxBound = precPrime maxBound
Math/NumberTheory/Primes/Counting.hs view
@@ -11,7 +11,6 @@ primeCount , primeCountMaxArg , nthPrime- , nthPrimeMaxArg -- * Approximations , approxPrimeCount , approxPrimeCountOverestimateLimit
Math/NumberTheory/Primes/Counting/Approximate.hs view
@@ -7,7 +7,6 @@ -- Approximations to the number of primes below a limit and the -- n-th prime. ---{-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Primes.Counting.Approximate ( approxPrimeCount , approxPrimeCountOverestimateLimit
+ Math/NumberTheory/Primes/Counting/HowPrimeCountingWorks.md view
@@ -0,0 +1,153 @@+## Algorithm and Implementation Description++### History and Formulas++This prime counting implementation is based on the work by Adrien-Marie Legendre, who in about the year 1800 observed that the count of the primes to a limit, Pi(limit), can be determined by the inclusion-exclusion principle as noted at the following link:++https://en.wikipedia.org/wiki/Prime-counting_function#Algorithms_for_evaluating_%CF%80(x)++In analysis of this series, it can be seen that it is also an expression of what the Sieve of Eratosthenes does when extended to become the Wheel Sieve where no composite number is culled more than once since the products of the unique primes must always be unique. Note that the terms with the product of odd numbers of primes on the denominator are subtracted and with even primes are added: thus the inclusion/exclusion principle. This expression can then be expressed recursively using a "Phi" expression as follows:++Phi(m, n) = Phi(m, n - 1) - Phi(floor(m / pn), n - 1) where+ `m` is the current limit for this "branch" of the Phi function and+ `n` is the one-based index of the nth prime so p1 is 2, p2 is 3, etc+ and with the terminating conditions that+ Phi(0, n) is 0 and Phi(m, 0) is m.++Now the Legendre formula for the prime count, Pi(limit), is as follows:++Pi(limit) = Phi(limit, Pi(sqrt(limit))) + Pi(sqrt(limit)) - 1++where from this it can be seen that one needs only know the primes to the square root of the range to be counted (and thus the number of them).++The above recursive solution is quite inefficient as to complexity due to the deeply nested recursion, but a further terminating condition can stop the splitting of the "tree" a little sooner as follows:++Phi(m, n) when m is less than or equal to pn must be exactly one++This can be seen to be true because Phi(m, n) expresses the number of values up to `m` that cannot be divided evenly by any of the primes up to `pn` (this includes one, which can't be divided evenly by all numbers higher than it), thus excludes the sieving primes in the range p1 to pn. Therefore, the Phi value for any `m` <= `pn` must be just one.++The computational complexity of this recursive expression is as follows:++O(limit/((log limit)^2)), which while lower than by the Sieve of Eratosthenes due to the log squared in the denominator, is practically quite slow due to the high cost of the multiple recursions and (long) divisions.++However, it has been realized quite recently (1985) that one does not have to solve that expression recursively by, instead of starting from the top of the "tree" and "splitting" first by the larger primes and building up the prime products down to the lowest primes, one can start at the bottom of the "tree" and divide by the lowest prime first on up; also, one can do all of the divisions by each of the primes in partial sieving "waves" while retaining the results in an array of intermediate results which replace the recursive method's "stack". One then finds that the results of all of the prime products already exist in the as yet unculled values in the partial sieved passes, greatly reducing the amount of computation (especially divisions) of having to build up these prime products from individual primes.++"Phi's" as described are closely related to "rough" numbers, which are the values remaining after culling of all multiples of base primes up to some "partial sieving" base prime and including a count for the one value, so the number of rough numbers up to a limit sieved by primes up to pn is exactly Phi(that limit, n). Using an array of rough numbers and a parallel array of the Phi's (or Pi's) for each of those rough numbers is an efficient way to organize the intermediate calculations.++Note that Phi's and Pi's are also closely related and can be converted one to the other because:++Phi(x, Pi(sqrt(x))) = Pi(x) - Pi(sqrt(x)) + 1++Rough numbers: https://en.wikipedia.org/wiki/Rough_number.Applicative++### Method++In general, the method is as follows:++1. All arrays are of size the square root of the counting range limit, as follows:++ a. A `roughs` array to process the remaining rough numbers in culling waves, initialized to all odds starting from 1 (ie. 1, 3, ...),++ b. A `phis` array which contains counts of remaining values after culling up to some level of base prime but is used for emulating the stack during processing initialized with the values as culled by two as in ((`limit`/roughs[`i`] + 1) `div` 2) where `i` is the zero-base index, and++ c. A `pisndxs` array that also contains a simple count of values remaining after culling up to a given culling base prime level but is in `Pi` form with the representations of the already culled base primes included in the count, and with no count for 1 just as for a normal pi; this is initialized with the index numbers as in (0, 1, ...).++ d. Variables are initialized to track the number of base primes processed initialized to zero as well as the current effective size of the `roughs`/`pis` arrays initialized to their current total size.+++ The `pisndxs` array and the `roughs` array are closely related to each other in that if one takes a given rough value at a given index, divides that rough value by two and uses the quotient as an index to this array will produce an element value that when the number of (odd) base primes already used is subtracted, produces the index in the roughs array of the original roughs element to form a connected loop; also, this array is used to look up "Pi" values that are used to add and subtract the counts in the manner as described for the phi/pi calculation. The implementation tries to reduce the number of offsets added and subtracted in the "hottest" loops.++2. The main loop takes the following recursive "bottom-up" function and+ flattens it by using the `pis` array to replace the stack used+ by this function:++ For the following function `baseprms` is an array of odd primes plus non-prime one and values from three up to the square root limit from above.++ ```haskell+ phip2 x = (x + 1) / 2++ phi pmult pilmt =+ let looppi pi acc =+ if pi >= pilmt then acc else+ p = unsafeAt baseprms pi+ npmult = pmult * p+ -- special termination condition for when p >= limit / npmult...+ if p * npmult >= limit then acc + pilmit - pi+ else looppi (pi + 1)+ (acc + phip2(limit / npmult) - phi npmult pi) -- recursion+ ```++ Phi(limit (Pi(sqrt(limit))) is the above function called with:+ phi 1 (length paseprms).++ Using the recursive function is not efficient because it doesn't have the asymptotic improvements to performance due to partial sieving.++ The loop is for each "base prime" in succession up to the square root of the square root of the `limit` in three phases:++ a. the given base prime value and all multiples of it are marked to be culled if they haven't already been eliminated in previous passes by something like the Sieve of Eratosthenes culling pass per base prime.++ b. this phase processes each of the remaining `roughs` values in turn for all remaining after being marked and splits the processing depending on whether the base prime value multiplied by the remaining rough element is:++ - less than or equal to the square root limit, in which case it compresses the `roughs` and `pis` array by subtracting the next `pis` element from the current one and writing it into an index that doesn't included the marked/skipped elements, or++ - if greater than it subtracts a value looked up by rough value index in the `pisndxs` array and again writes the result into the compression index as per above.++ - in all cases it moves the `roughs` to synchronizes with the pi's indices to move values to the left to fill the holes left by eliminating the marked rough values.++ c. the last phase is to adjust pisndxs values so they address the correct rough/pis values after the above compression of these arrays has taken place.++3. The partial sieving loop only runs the base prime values up to the square root of the square root of the limit; after that point all of the roughs are prime (other than one) and therefore, the `limit` divided by each of the unique products of pairs of these roughs are added to the final answer from the loop with the usual procedure of looking up the values to be added from the `pisndx` array by using as an index: toIndex (limit / p1 / p2) but with the limitation that p1 can not be larger than (limit / p1 / p1) which satisfies the terminating condition that `p1` must be less than or equal to the quotient:++ `limit` `div` `pi` `div` `p1`.++4. There are various offset calculations and compenstation to make sure allowance has be made for the various conversions between Phi and Pi.++### Detailed Method++In more detail, the "bottom up" partial sieving method is as follows; this implementeds the odds-only optimization so the arrays represent only the odd numbers:++1. Keep track of the number of base primes that have been processed yet and the current effective number of rough numbers; INITIALIZE `y` as the square root of the limit and three arrays each of the size `y`, with the first small counts array keeping track of the current number of possible primes up to the number represented by the index value so initialized with each element containing the index value, the second the roughs array containing the current level zero rough numbers as per the current culling passes (starts with nothing culled, so all odd values could be prime), and finally, the third containing the current Phi's/ (Pi's in this case) for each rough number in the rough numbers array (initially limit divided by the rough value corresponding to the index).++2. For each base prime in order from the lowest to the limit^(1/4) (same as the square root of `y`) do the following:++ a. Do a partial sieve culling pass of the composites boolean array by the Sieve of Eratosthenes marking all multiples of the current base prime, also marking the value representing the current base prime as "non rough". The marked values will be those that can't be rough number.++ b. Update the Phi's table for each value that is still rough, while+ eliminating and removing them from the array of roughs by moving them down the table (to the left, to lower indices). The adjustment is done differently depending whether the product of the base prime and the current rough is greater than the cube root of the limit (where limit divided by this product would be less than the square root of the limit and the counts can be just looked up in the counts table) or less than or equal to the square root in which case they can't be looked up in the counts table; however, the value in the counts table can be looked up in the counts table and that can be used to loop up the adjustment value in the phis table. All adjustments are subtracted from the current value of the phis table and, since all accumulated phi values will be subtracted from the first accumulation in the phi table, has the effect of subtracting for the first partial sieve pass, adding for the seconds, subtracting for the third, and so on, thus implementing the inclusion/exclusion principle.++ c. Adjust the counts table so the counts reflect the rough values culled in the last partial sieve culling pass.++ d. Repeat all above steps of the stop 2x steps for each base prime up to the limit where the rough values have been fully sieved, adjusting the number of base primes and the effective used sizes of the roughs and phis arrays for every pass.++3. All the accumulated phis from the roughs higher than one can be subtracted from the accumulated phi for one to get an amalgamated answer which is still not complete, as per the last steps. At this point there are no further changes made to the counts, roughs, or phis arrays.++4. The remaining base primes are now all higher than the the square root of `y` and the remaining roughs higher than these base primes are all prime so the following results can all be added (add for even number of primes in the denominator product - inclusion). Also, these products are all higher than `y` so the square root of the limit, so all counts can now be looked up in the counts table as follows:++ For each base prime from above the `y`^(1/2) to limit^(1/3) value multiplied by each value above the first to just below `y`` such that the product of the first prime squared and second primes is never higher than the limit (the terminal condition that Phi(0, n) is 0), divide the limit by this product and use the quotient to index the counts value to be added to the answer.++5. The final answer can be obtained by doing any necessary conversions from Phi to Pi.++There are some additional offset and compensation adjustments to make the array indexing and final reaults work out right, especially adjusting for whether particular count/phi values included the current base primes or not; these are negligible in computing cost.++### Asymptotic Complexity++It can easily be seen that the memory requirements are proportional to the square root of the limit; however, the computational complexity isn't quite so obvious as follows:++1. All of the 3a steps represent a Sieve of Eratosthenes to the square root of the limit, so `y` times log log `y`); this is close enough to `y` and the operations are fast, so this is not a significant portion of the time used.++2. All of the 3b steps take the number of base primes to the square root of `y` or `y`^(1/2)/(log (`y`^(1/2))) or 2*`y`^(1/2)/(log `y`) times the number of roughs which quickly reduces to about `y`/log`y` so the product is 2*`y`^(3/2)/((log `y`)^2) or 8*`limit`^(3/4)/((log `limit`)^2). For large limits, this is clearly a stronger term than the first.++3. All of the 3c stops are the product of all the base primes to the square root of `y` as above times almost all of the counts values (of size `y`) so this is 2*`y`^(3/2)/(log `y`) or 4*`limit`^(3/4)/(log `limit`), which makes this a slightly stronger term than that of 2 above due to the loss of a log factor on the dividend; however, the operations of this step are faster than those of step 2 because step 2 has divisions for almost all operations, so these two may be effectively about the same until large\counting ranges when this term will be the strongest.++4. The operations of step 4 would takes a long time at `limit`/((log `y`)^2) but are saved by the terminating condition when p >= `limit`/`p`/`p` so are about `y`^(4/3)/((log `y`)^2) or 4*`limit`^(2/3)/((log `limit`)^2), meaning that it is considerably less strong than the operations of step 2, although also slightly more complex.++5. Thus, the time complexity is likely mostly controlled by step 2 for smaller counting ranges and by step 3 for large counting ranges meaning that the asymptotic time complexity is about that of 3, which lacks one log factor on the denominator due to having to process most of the count array values for each base prime pass. Thus the asymptotic complexity for large ranges can be expressed as O(limit^(3/4)/(log limit)), although the epirical complexity won't approach that for the ranges where this algorithm is usable due to memory use constraints.++This implementation only deals with odd values (1, 3, 5 ...), thereby reducing memory storage requirements by a factor of two.++### Conclusions++In short, this is an effective implementation of the Legendre algorithm because any of the "Phi" values for the products of unique primes have already been computed simply and are available in the arrays where this isn't available for the fully recursive expression (for instance, the limit/(p1*p2*P3) value will be immediately available where the recursive expression would have to build it+up from all the combinations of limit/(p1*p2), limit/(p1*p3), and limit/(p2*p3), and so on for longer chains of base prime products).++The worst problem with this algorithm and implementation is its relatively high memory use of O(limit^(1/2)) which in this case is eight times the square root of the counting range in bytes. This means that to sieve to 1e16 takes about 800 Megabytes and to the theoretical maximum limit of 2^19 - 1 would take about 32 Gigabytes, even if one were willing to wait the hours required to return a result. For such larger counting ranges, there are much better algorithms that aren't that much more difficult to implement, such as a variation on this with the Daniel Friedrich Ernst Meissel modification in about 1870 to change `y` to the cube root of the counting range instead of the square root to use memory as the cube root of the counting range and somewhat improve on the execution asymptotic complexity to proportial to the limit to the two thirds power.
Math/NumberTheory/Primes/Counting/Impl.hs view
@@ -4,98 +4,257 @@ -- Licence: MIT -- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com> ----- Number of primes not exceeding @n@, @π(n)@, and @n@-th prime.+-- Number of primes not exceeding @limit@, @π(limit)@, and @n@-th prime. -- {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -O2 #-} {-# OPTIONS_GHC -fspec-constr-count=24 #-}-{-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module Math.NumberTheory.Primes.Counting.Impl ( primeCount , primeCountMaxArg , nthPrime- , nthPrimeMaxArg ) where -#include "MachDeps.h"- import Math.NumberTheory.Primes.Sieve.Eratosthenes-import Math.NumberTheory.Primes.Sieve.Indexing-import Math.NumberTheory.Primes.Counting.Approximate+ (PrimeSieve(..), primeSieve, psieveFrom)+import Math.NumberTheory.Primes.Sieve.Indexing (toPrim)+import Math.NumberTheory.Primes.Counting.Approximate (nthPrimeApprox) import Math.NumberTheory.Primes.Types-import Math.NumberTheory.Powers.Squares-import Math.NumberTheory.Powers.Cubes-import Math.NumberTheory.Logarithms-import Math.NumberTheory.Unsafe--import Data.Array.ST-import Control.Monad.ST-import Data.Bits-import Data.Int+import Math.NumberTheory.Roots (integerSquareRoot)+import Math.NumberTheory.Utils.FromIntegral -#if SIZEOF_HSWORD < 8-#define COUNT_T Int64-#else-#define COUNT_T Int-#endif+import Data.Word (Word64, Word32)+import Data.Bits (Bits(shiftR, (.&.), (.|.)))+import Control.Monad (forM_, when)+import Control.Monad.ST (ST, runST)+import Data.Array.Base (STUArray, MArray(unsafeNewArray_),+ unsafeAt, unsafeFreezeSTUArray, unsafeRead, unsafeWrite)+import Data.Bit (Bit(..), unBit, nthBitIndex, countBits)+import qualified Data.Vector.Unboxed as U -- | Maximal allowed argument of 'primeCount'. Currently 8e18. primeCountMaxArg :: Integer primeCountMaxArg = 8000000000000000000 --- | @'primeCount' n == π(n)@ is the number of (positive) primes not exceeding @n@.+-- | @'primeCount' limit == π(limit)@ is the number of primes not exceeding @limit@. ----- For efficiency, the calculations are done on 64-bit signed integers, therefore @n@ must--- not exceed 'primeCountMaxArg'.+-- For efficiency, the calculations are done on 64-bit unsigned integers, therefore @limit@+-- must not exceed 'primeCountMaxArg'. ----- Requires @/O/(n^0.5)@ space, the time complexity is roughly @/O/(n^0.7)@.--- For small bounds, @'primeCount' n@ simply counts the primes not exceeding @n@,--- for bounds from @30000@ on, Meissel's algorithm is used in the improved form due to--- D.H. Lehmer, cf.--- <http://en.wikipedia.org/wiki/Prime_counting_function#Algorithms_for_evaluating_.CF.80.28x.29>.+-- Requires @/O/(limit^0.5)@ space, the time complexity is roughly @/O/(limit^0.7)@.+-- @'primeCount' limit@ uses Legendre's algorithm in an improved form using "partial sieving"+-- and processing by "splitting" based on whether the product of the "base prime" and a+-- product of higher co-primes is less than or equal to, or greater than the square root of+-- @limit@ where "base primes" are lower than the square root of the square root of @limit@;+-- above this limit all remaining values are primes so are used in unique prime pairs to+-- calculate the additional amounts to add to the accumulated "Phi" for the answer.++-- NOTE: This is not related to the later work (about 1870) by Daniel Friedrich Ernst Meissel,+-- nor the extension to Meissel's work by Professor D. H. Lehmer in 1959 to adapt these types+-- of algorithms to use on a mainframe computer of that time; both of whose purpose was to+-- reduce the number of calculations for a given counting range and/or reduce the storage+-- requirements. Neither of these used "partial sieving" to get anywhere near the asymptotic+-- complexity of this implementation.++-- See the "HowPrimeCountingWorks.md" file in this directory for a more complete explanation+-- of how this implementation works.+ primeCount :: Integer -> Integer-primeCount n- | n > primeCountMaxArg = error $ "primeCount: can't handle bound " ++ show n- | n < 2 = 0- | n < 1000 = fromIntegral . length . takeWhile (<= n) . map unPrime . primeList . primeSieve $ max 242 n- | n < 30000 = runST $ do- ba <- sieveTo n- (s,e) <- getBounds ba- ct <- countFromTo s e ba- return (fromIntegral $ ct+3)- | otherwise =- let !ub = cop $ fromInteger n- !sr = integerSquareRoot' ub- !cr = nxtEnd $ integerCubeRoot' ub + 15- nxtEnd k = k - (k `rem` 30) + 31- !phn1 = calc ub cr- !cs = cr+6- !pdf = sieveCount ub cs sr- in phn1 - pdf+primeCount limit+ | limit > primeCountMaxArg = error $ "primeCount: can't handle bound " ++ show limit+ | limit < 9 = if limit < 2 then 0 else (limit + 1) `div` 2+ | otherwise =+ let+ + -- initialize constants...+ ilimit = fromIntegral limit+ sqrtlmt = fromIntegral $ integerSquareRoot ilimit+ sqrtsqrtlmt = integerSquareRoot sqrtlmt+ maxndx = toIndex sqrtlmt -- last index of arrays --- | Maximal allowed argument of 'nthPrime'. Currently 1.5e17.-nthPrimeMaxArg :: Integer-nthPrimeMaxArg = 150000000000000000+ -- `numbps` will be the number of odd base primes up to `limit`^(1/4);+ -- `roughssz` is the current effective length of `roughs` after reduction;+ -- `phindxs` is the count of odd primes to limit by index not including bps,+ -- the above is an index to the `roughs`/`phis` that repr the index;+ -- `roughs` are the values remaining after culling base primes < its index,+ -- the above values when divided by two is the index for `phindxs`;+ -- `phis` is count of odd primes to a limit set by its index...+ (numbps, roughssz, phindxs, roughs, phis) = runST $ do -- run in ST monad... + -- initialize monadic versions of `phindxs`/`roughs`/`phis`...+ mphindxs <- unsafeNewArray_ (0, maxndx) :: ST s (STUArray s Int Word32)+ -- initially is odd phi of the index repr 3 shr 1 is 1 -> value 1, etc...+ forM_ [ 0 .. maxndx ] $ \ i -> unsafeWrite mphindxs i (fromIntegral i)+ unsafeWrite mphindxs 0 1 -- for correctness, never used!+ mrs <- unsafeNewArray_ (0, maxndx) :: ST s (STUArray s Int Word32)+ -- odd values from 1 as in 1, 3 ... to maximum for roughs...+ forM_ [ 0 .. maxndx ] $ \ i ->+ unsafeWrite mrs i (fromIntegral i * 2 + 1)+ mphis <- unsafeNewArray_ (0, maxndx) :: ST s (STUArray s Int Word64)+ -- initialized to limit // roughs; are phis including count for one...+ forM_ [ 0 .. maxndx ] $ \ i -> do+ r <- unsafeRead mrs i; let d = fromIntegral r+ unsafeWrite mphis i (fromIntegral $ phip2 $ divide ilimit d)++ -- all work requiring modifying arrays and values done recursively here;+ -- the "partial sieving" loop with one `bp` sieving pass per loop;+ -- uses `roi` output and `rii` input roughs processing indices...+ let loop !nbps !rsilmt = do -- `rslmt` is maximum current ndx for `roughs`+ bpw32 <- unsafeRead mrs 1+ let bp = fromIntegral bpw32+ if bp > sqrtsqrtlmt then do -- means `bp` primes <= limit^(1/4)+ fmsops <- unsafeFreezeSTUArray mphindxs+ fmrs <- unsafeFreezeSTUArray mrs+ fmlops <- unsafeFreezeSTUArray mphis+ return (nbps, rsilmt + 1, fmsops, fmrs, fmlops) -- done loop!+ else do -- for each base prime `bp`...+ let -- mark `mrs` values that are multiples of bp if still there+ cullmrs cullpos =+ if cullpos > sqrtlmt then return () else do+ cnt <- unsafeRead mphindxs (cullpos `shiftR` 1)+ let ndx = fromIntegral cnt - nbps+ tstr <- unsafeRead mrs ndx+ when (tstr == fromIntegral cullpos)+ (unsafeWrite mrs ndx 0)+ cullmrs (cullpos + bp + bp)++ -- recursive function to process all remaining `mrs` by+ -- forming products of unique pairs with `bp`...+ split rii !roi =+ if rii > rsilmt then return (roi - 1) else do+ m <- unsafeRead mrs rii -- multiplier may not be prime!+ if m == 0 then split (rii + 1) roi else do -- skip marked+ -- only unculled values; may not be prime+ olv <- unsafeRead mphis rii -- large odd "pi" to adjust+ let mbp = fromIntegral m * fromIntegral bp+ adjv <- -- depends on condition...+ if mbp <= fromIntegral sqrtlmt then do+ -- ilimit `div` mbp too large...+ let cnti = fromIntegral mbp `shiftR` 1+ adji <- unsafeRead mphindxs cnti+ let adjndx = fromIntegral adji - nbps+ unsafeRead mphis adjndx+-- adj <- unsafeRead mphis adjndx+-- return $ adj - fromIntegral nbps+ else do+ -- ilimit `div` mbp in index range; use directly!+ let adjndx = toIndex (divide ilimit mbp)+ adj <- unsafeRead mphindxs adjndx -- phi form...+ return $ fromIntegral adj - fromIntegral nbps + 1+ -- write adjusted value into `mphis` at new offset...+ unsafeWrite mphis roi (olv - adjv)+ unsafeWrite mrs roi m -- move rougn values in sync+ split (rii + 1) (roi + 1) -- recursively loop ++ -- update `mphindxs` array for last cull pass...+ adjcnt cm !mxci = -- cull multiple and maximum index+ if cm < bp then return () else do+ ofstc <- unsafeRead mphindxs (cm `shiftR` 1)+ let c = ofstc - fromIntegral nbps+ e = (cm * bp) `shiftR` 1+ adjci ci =+ if ci < e then adjcnt (cm - 2) ci else do+ ov <- unsafeRead mphindxs ci+ unsafeWrite mphindxs ci (ov - c)+ adjci (ci - 1)+ adjci mxci+ + -- the code that uses the above "let"'s...+ unsafeWrite mrs 1 0 -- mark first non-one rough for deletion+ cullmrs (bp * bp) -- mark the other rough multiples of `bp`+ maxrsi <- split 0 0 -- adjust `roughs` and `phis` for cull+ let topcullpnt = (sqrtlmt `div` bp - 1) .|. 1 -- odd <= sqrtlmt+ adjcnt topcullpnt maxndx -- update `phindxs` for culling pass+ loop (nbps + 1) maxrsi -- recurse for all base primes++ loop 0 maxndx -- calling recursive "partial sieving" loop!++ -- the offset of the sum of the other `phis`...+ othroddpis = sum [ unsafeAt phis bpi | bpi <- [ 1 .. roughssz - 1 ] ]+ -- subtracted from the first first element of `phis`...+ phi0 = unsafeAt phis 0 - othroddpis -- + pi0crct -- to produce an intermediate phi+ + -- recursively calculate the additional odd "phis" for all pairs of+ -- unique primes/`roughs` starting above limit^(1/4) to limit^(1/2);+ -- these are exactly the remaining values in `roughs` above the "one";+ -- Note that all roughs above the first "one" element are now prime;+ -- pre-comp of all additional ones for following "pairs" calculation...+ phi0adj = fromIntegral $ (roughssz - 2) * (roughssz - 1) `div` 2+ accum p1i !ans =+ if p1i >= roughssz - 1 then ans else -- for all roughs skipping "one"...+ let p1 = fromIntegral $ unsafeAt roughs p1i -- `p1` - first of prime pair+ qp1 = ilimit `div` p1 -- pre divide for "p1" value+ ndx = unsafeAt phindxs (toIndex (fromIntegral (qp1 `div` p1)))+ endndx = fromIntegral ndx - numbps -- last `p1` index!+ adj = fromIntegral $ (endndx - p1i) * (numbps + p1i - 1)+ comp p2i !ac = -- `rii` is index of the second of the `roughs`+ if p2i > endndx then accum (p1i + 1) ac else -- exit if reach end index!+ let p2 = fromIntegral (unsafeAt roughs p2i) -- second rough+ cnti = toIndex (divide qp1 p2) -- ndx for comp "pi"+ in comp (p2i + 1) (ac + fromIntegral (unsafeAt phindxs cnti))+ in if endndx <= p1i then ans -- terminate if `p1`^3 >= `ilimit`!+ -- adjust for ones added and not used due to `endndx` termination...+ else comp (p1i + 1) (ans - adj)++ numsqrtprms = fromIntegral $ numbps + roughssz++ -- finally call addition of the phis for all pairs of unique primes added to+ -- the offset of the other odd "phis" already adjusted for the subtracting+ -- of odd "phis" from odd "phis" plus the total primes to the square root of+ -- the `limit` counting range minus one according to the formula...+ in fromIntegral $ accum 1 (phi0 + phi0adj) + numsqrtprms - 1++--------------------------------------------------------------------------------+-- Auxiliaries --+--------------------------------------------------------------------------------++{-# INLINE divide #-}+divide :: Word64 -> Word64 -> Int+divide n d = fromIntegral $ n `div` d++{-# INLINE phip2 #-}+phip2 :: Int -> Int+phip2 x = (x + 1) `shiftR` 1 ++{-# INLINE toIndex #-}+toIndex :: Int -> Int+toIndex x = (x - 1) `shiftR` 1++--------------------------------------------------------------------------------+-- Nth Prime --+--------------------------------------------------------------------------------+ -- | @'nthPrime' n@ calculates the @n@-th prime. Numbering of primes is -- @1@-based, so @'nthPrime' 1 == 2@. -- -- Requires @/O/((n*log n)^0.5)@ space, the time complexity is roughly @/O/((n*log n)^0.7@.--- The argument must be strictly positive, and must not exceed 'nthPrimeMaxArg'.-nthPrime :: Integer -> Prime Integer+-- The argument must be strictly positive.+nthPrime :: Int -> Prime Integer+nthPrime 1 = Prime 2+nthPrime 2 = Prime 3+nthPrime 3 = Prime 5+nthPrime 4 = Prime 7+nthPrime 5 = Prime 11+nthPrime 6 = Prime 13 nthPrime n- | n < 1 = error "Prime indexing starts at 1"- | n > nthPrimeMaxArg = error $ "nthPrime: can't handle index " ++ show n- | n < 200000 = Prime $ nthPrimeCt n- | ct0 < n = Prime $ tooLow n p0 (n-ct0) approxGap- | otherwise = Prime $ tooHigh n p0 (ct0-n) approxGap+ | n < 1+ = error "Prime indexing starts at 1"+ | n < 200000+ = Prime $ countToNth (n - 3) [primeSieve (p0 + p0 `quot` 32 + 37)]+ | p0 > toInteger (maxBound :: Int)+ = error $ "nthPrime: index " ++ show n ++ " is too large to handle"+ | miss > 0+ = Prime $ tooLow n (fromInteger p0) miss+ | otherwise+ = Prime $ tooHigh n (fromInteger p0) (negate miss) where- p0 = nthPrimeApprox n- approxGap = (7 * fromIntegral (integerLog2' p0)) `quot` 10- ct0 = primeCount p0+ p0 = nthPrimeApprox (toInteger n)+ miss = n - fromInteger (primeCount p0) -------------------------------------------------------------------------------- -- The Works --@@ -105,303 +264,54 @@ -- Not too pressing, since I think a) nthPrimeApprox always underestimates -- in the range we can handle, and b) it's always "goodEnough" -tooLow :: Integer -> Integer -> Integer -> Integer -> Integer-tooLow n a miss gap- | goodEnough = lowSieve a miss- | c1 < n = lowSieve p1 (n-c1)- | otherwise = lowSieve a miss -- a third count wouldn't make it faster, I think- where- est = miss*gap- p1 = a + (est * 19) `quot` 20- goodEnough = 3*est*est*est < 2*p1*p1 -- a second counting would be more work than sieving- c1 = primeCount p1+tooLow :: Int -> Int -> Int -> Integer+tooLow n p0 shortage+ | p1 > toInteger (maxBound :: Int)+ = error $ "nthPrime: index " ++ show n ++ " is too large to handle"+ | goodEnough+ = lowSieve p0 shortage+ | c1 < n+ = lowSieve (fromInteger p1) (n-c1)+ | otherwise+ = lowSieve p0 shortage -- a third count wouldn't make it faster, I think+ where+ gap = truncate (log (intToDouble p0 :: Double))+ est = toInteger shortage * gap+ p1 = toInteger p0 + est+ goodEnough = 3*est*est*est < 2*p1*p1 -- a second counting would be more work than sieving+ c1 = fromInteger (primeCount p1) -tooHigh :: Integer -> Integer -> Integer -> Integer -> Integer-tooHigh n a surp gap- | c < n = lowSieve b (n-c)- | otherwise = tooHigh n b (c-n) gap- where- b = a - (surp * gap * 11) `quot` 10- c = primeCount b+tooHigh :: Int -> Int -> Int -> Integer+tooHigh n p0 surplus+ | c < n+ = lowSieve b (n-c)+ | otherwise+ = tooHigh n b (c-n)+ where+ gap = truncate (log (intToDouble p0 :: Double))+ b = p0 - (surplus * gap * 11) `quot` 10+ c = fromInteger (primeCount (toInteger b)) -lowSieve :: Integer -> Integer -> Integer+lowSieve :: Int -> Int -> Integer lowSieve a miss = countToNth (miss+rep) psieves where- strt = if (fromInteger a .&. (1 :: Int)) == 1- then a+2- else a+1- psieves@(PS vO ba:_) = psieveFrom strt+ strt = a + 1 + (a .&. 1)+ psieves@(PS vO ba:_) = psieveFrom (toInteger strt) rep | o0 < 0 = 0- | otherwise = sum [1 | i <- [0 .. r2], ba `unsafeAt` i]+ | otherwise = sum [1 | i <- [0 .. r2], unBit (ba `U.unsafeIndex` i)] where- o0 = strt - vO - 9 -- (strt - 2) - v0 - 7+ o0 = toInteger strt - vO - 9 -- (strt - 2) - v0 - 7 r0 = fromInteger o0 `rem` 30 r1 = r0 `quot` 3 r2 = min 7 (if r1 > 5 then r1-1 else r1) --- highSieve :: Integer -> Integer -> Integer -> Integer--- highSieve a surp gap = error "Oh shit"--sieveCount :: COUNT_T -> COUNT_T -> COUNT_T -> Integer-sieveCount ub cr sr = runST (sieveCountST ub cr sr)--sieveCountST :: forall s. COUNT_T -> COUNT_T -> COUNT_T -> ST s Integer-sieveCountST ub cr sr = do- let psieves = psieveFrom (fromIntegral cr)- pisr = approxPrimeCount sr- picr = approxPrimeCount cr- diff = pisr - picr- size = fromIntegral (diff + diff `quot` 50) + 30- store <- unsafeNewArray_ (0,size-1) :: ST s (STUArray s Int COUNT_T)- let feed :: COUNT_T -> Int -> Int -> UArray Int Bool -> [PrimeSieve] -> ST s Integer- feed voff !wi !ri uar sves- | ri == sieveBits = case sves of- (PS vO ba : more) -> feed (fromInteger vO) wi 0 ba more- _ -> error "prime stream ended prematurely"- | pval > sr = do- stu <- unsafeThaw uar- eat 0 0 voff (wi-1) ri stu sves- | uar `unsafeAt` ri = do- unsafeWrite store wi (ub `quot` pval)- feed voff (wi+1) (ri+1) uar sves- | otherwise = feed voff wi (ri+1) uar sves- where- pval = voff + toPrim ri- eat :: Integer -> Integer -> COUNT_T -> Int -> Int -> STUArray s Int Bool -> [PrimeSieve] -> ST s Integer- eat !acc !btw voff !wi !si stu sves- | si == sieveBits =- case sves of- [] -> error "Premature end of prime stream"- (PS vO ba : more) -> do- nstu <- unsafeThaw ba- eat acc btw (fromInteger vO) wi 0 nstu more- | wi < 0 = return acc- | otherwise = do- qb <- unsafeRead store wi- let dist = qb - voff - 7- if dist < fromIntegral sieveRange- then do- let (b,j) = idxPr (dist+7)- !li = (b `shiftL` 3) .|. j- new <- if li < si then return 0 else countFromTo si li stu- let nbtw = btw + fromIntegral new + 1- eat (acc+nbtw) nbtw voff (wi-1) (li+1) stu sves- else do- let (cpl,fds) = dist `quotRem` fromIntegral sieveRange- (b,j) = idxPr (fds+7)- !li = (b `shiftL` 3) .|. j- ctLoop !lac 0 (PS vO ba : more) = do- nstu <- unsafeThaw ba- new <- countFromTo 0 li nstu- let nbtw = btw + lac + 1 + fromIntegral new- eat (acc+nbtw) nbtw (fromIntegral vO) (wi-1) (li+1) nstu more- ctLoop lac s (ps : more) = do- !new <- countAll ps- ctLoop (lac + fromIntegral new) (s-1) more- ctLoop _ _ [] = error "Primes ended"- new <- countFromTo si (sieveBits-1) stu- ctLoop (fromIntegral new) (cpl-1) sves- case psieves of- (PS vO ba : more) -> feed (fromInteger vO) 0 0 ba more- _ -> error "No primes sieved"--calc :: COUNT_T -> COUNT_T -> Integer-calc lim plim = runST (calcST lim plim)--calcST :: forall s. COUNT_T -> COUNT_T -> ST s Integer-calcST lim plim = do- !parr <- sieveTo (fromIntegral plim)- (plo,phi) <- getBounds parr- !pct <- countFromTo plo phi parr- !ar1 <- unsafeNewArray_ (0,end-1)- unsafeWrite ar1 0 lim- unsafeWrite ar1 1 1- !ar2 <- unsafeNewArray_ (0,end-1)- let go :: Int -> Int -> STUArray s Int COUNT_T -> STUArray s Int COUNT_T -> ST s Integer- go cap pix old new- | pix == 2 = coll cap old- | otherwise = do- isp <- unsafeRead parr pix- if isp- then do- let !n = fromInteger (toPrim pix)- !ncap <- treat cap n old new- go ncap (pix-1) new old- else go cap (pix-1) old new- coll :: Int -> STUArray s Int COUNT_T -> ST s Integer- coll stop ar =- let cgo !acc i- | i < stop = do- !k <- unsafeRead ar i- !v <- unsafeRead ar (i+1)- cgo (acc + fromIntegral v*cp6 k) (i+2)- | otherwise = return (acc+fromIntegral pct+2)- in cgo 0 0- go 2 start ar1 ar2- where- (bt,ri) = idxPr plim- !start = 8*bt + ri- !size = fromIntegral $ (integerSquareRoot lim) `quot` 4- !end = 2*size--treat :: Int -> COUNT_T -> STUArray s Int COUNT_T -> STUArray s Int COUNT_T -> ST s Int-treat end n old new = do- qi0 <- locate n 0 (end `quot` 2 - 1) old- let collect stop !acc ix- | ix < end = do- !k <- unsafeRead old ix- if k < stop- then do- v <- unsafeRead old (ix+1)- collect stop (acc-v) (ix+2)- else return (acc,ix)- | otherwise = return (acc,ix)- goTreat !wi !ci qi- | qi < end = do- !key <- unsafeRead old qi- !val <- unsafeRead old (qi+1)- let !q0 = key `quot` n- !r0 = fromIntegral (q0 `rem` 30030)- !nkey = q0 - fromIntegral (cpDfAr `unsafeAt` r0)- nk0 = q0 + fromIntegral (cpGpAr `unsafeAt` (r0+1) + 1)- !nlim = n*nk0- (wi1,ci1) <- copyTo end nkey old ci new wi- ckey <- unsafeRead old ci1- (!acc, !ci2) <- if ckey == nkey- then do- !ov <- unsafeRead old (ci1+1)- return (ov-val,ci1+2)- else return (-val,ci1)- (!tot, !nqi) <- collect nlim acc (qi+2)- unsafeWrite new wi1 nkey- unsafeWrite new (wi1+1) tot- goTreat (wi1+2) ci2 nqi- | otherwise = copyRem end old ci new wi- goTreat 0 0 qi0------------------------------------------------------------------------------------- Auxiliaries -------------------------------------------------------------------------------------locate :: COUNT_T -> Int -> Int -> STUArray s Int COUNT_T -> ST s Int-locate p low high arr = do- let go lo hi- | lo < hi = do- let !md = (lo+hi) `quot` 2- v <- unsafeRead arr (2*md)- case compare p v of- LT -> go lo md- EQ -> return (2*md)- GT -> go (md+1) hi- | otherwise = return (2*lo)- go low high--{-# INLINE copyTo #-}-copyTo :: Int -> COUNT_T -> STUArray s Int COUNT_T -> Int- -> STUArray s Int COUNT_T -> Int -> ST s (Int,Int)-copyTo end lim old oi new ni = do- let go ri wi- | ri < end = do- ok <- unsafeRead old ri- if ok < lim- then do- !ov <- unsafeRead old (ri+1)- unsafeWrite new wi ok- unsafeWrite new (wi+1) ov- go (ri+2) (wi+2)- else return (wi,ri)- | otherwise = return (wi,ri)- go oi ni--{-# INLINE copyRem #-}-copyRem :: Int -> STUArray s Int COUNT_T -> Int -> STUArray s Int COUNT_T -> Int -> ST s Int-copyRem end old oi new ni = do- let go ri wi- | ri < end = do- unsafeRead old ri >>= unsafeWrite new wi- go (ri+1) (wi+1)- | otherwise = return wi- go oi ni--{-# INLINE cp6 #-}-cp6 :: COUNT_T -> Integer-cp6 k =- case k `quotRem` 30030 of- (q,r) -> 5760*fromIntegral q +- fromIntegral (cpCtAr `unsafeAt` fromIntegral r)--cop :: COUNT_T -> COUNT_T-cop m = m - fromIntegral (cpDfAr `unsafeAt` fromIntegral (m `rem` 30030))-------------------------------------------------------------------------------------- Ugly helper arrays -------------------------------------------------------------------------------------cpCtAr :: UArray Int Int16-cpCtAr = runSTUArray $ do- ar <- newArray (0,30029) 1- let zilch s i- | i < 30030 = unsafeWrite ar i 0 >> zilch s (i+s)- | otherwise = return ()- accumulate ct i- | i < 30030 = do- v <- unsafeRead ar i- let !ct' = ct+v- unsafeWrite ar i ct'- accumulate ct' (i+1)- | otherwise = return ar- zilch 2 0- zilch 6 3- zilch 10 5- zilch 14 7- zilch 22 11- zilch 26 13- accumulate 1 2--cpDfAr :: UArray Int Int8-cpDfAr = runSTUArray $ do- ar <- newArray (0,30029) 0- let note s i- | i < 30029 = unsafeWrite ar i 1 >> note s (i+s)- | otherwise = return ()- accumulate d i- | i < 30029 = do- v <- unsafeRead ar i- if v == 0- then accumulate 2 (i+2)- else do unsafeWrite ar i d- accumulate (d+1) (i+1)- | otherwise = return ar- note 2 0- note 6 3- note 10 5- note 14 7- note 22 11- note 26 13- accumulate 2 3--cpGpAr :: UArray Int Int8-cpGpAr = runSTUArray $ do- ar <- newArray (0,30030) 0- unsafeWrite ar 30030 1- let note s i- | i < 30029 = unsafeWrite ar i 1 >> note s (i+s)- | otherwise = return ()- accumulate d i- | i < 1 = return ar- | otherwise = do- v <- unsafeRead ar i- if v == 0- then accumulate 2 (i-2)- else do unsafeWrite ar i d- accumulate (d+1) (i-1)- | otherwise = return ar- note 2 0- note 6 3- note 10 5- note 14 7- note 22 11- note 26 13- accumulate 2 30027+-------------------------------------------------------------------------------+-- Prime counting +-- find the n-th set bit in a list of PrimeSieves,+-- aka find the (n+3)-rd prime+countToNth :: Int -> [PrimeSieve] -> Integer+countToNth !_ [] = error "countToNth: Prime stream ended prematurely"+countToNth !n (PS v0 bs : more) = case nthBitIndex (Bit True) n bs of+ Just i -> v0 + toPrim i+ Nothing -> countToNth (n - countBits bs) more
− Math/NumberTheory/Primes/Factorisation.hs
@@ -1,52 +0,0 @@--- |--- Module: Math.NumberTheory.Primes.Factorisation--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Various functions related to prime factorisation.--- Many of these functions use the prime factorisation of an 'Integer'.--- If several of them are used on the same 'Integer', it would be inefficient--- to recalculate the factorisation, hence there are also functions working--- on the canonical factorisation, these require that the number be positive--- and in the case of the Carmichael function that the list of prime factors--- with their multiplicities is ascending.--module Math.NumberTheory.Primes.Factorisation- ( -- * Factorisation functions- -- $algorithm- -- ** Complete factorisation- factorise- , defaultStdGenFactorisation- , stepFactorisation- , factorise'- , defaultStdGenFactorisation'- -- *** Trial division- , trialDivisionTo- -- ** Partial factorisation- , smallFactors- , stdGenFactorisation- , curveFactorisation- -- *** Single curve worker- , montgomeryFactorisation- ) where--import Math.NumberTheory.Primes.Factorisation.Montgomery-import Math.NumberTheory.Primes.Factorisation.TrialDivision---- $algorithm------ Factorisation of 'Integer's by the elliptic curve algorithm after Montgomery.--- The algorithm is explained at--- <http://programmingpraxis.com/2010/04/23/modern-elliptic-curve-factorization-part-1/>--- and--- <http://programmingpraxis.com/2010/04/27/modern-elliptic-curve-factorization-part-2/>------ The implementation is not very optimised, so it is not suitable for factorising numbers--- with several huge prime divisors. However, factors of 20-25 digits are normally found in--- acceptable time. The time taken depends, however, strongly on how lucky the curve-picking--- is. With luck, even large factors can be found in seconds; on the other hand, finding small--- factors (about 12-15 digits) can take minutes when the curve-picking is bad.------ Given enough time, the algorithm should be able to factor numbers of 100-120 digits, but it--- is best suited for numbers of up to 50-60 digits.
− Math/NumberTheory/Primes/Factorisation/Certified.hs
@@ -1,171 +0,0 @@--- |--- Module: Math.NumberTheory.Primes.Factorisation.Certified--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Factorisation proving the primality of the found factors.------ For large numbers, this will be very slow in general.--- Use only if you're paranoid or must be /really/ sure.-{-# LANGUAGE BangPatterns, CPP #-}-module Math.NumberTheory.Primes.Factorisation.Certified- ( certifiedFactorisation- , certificateFactorisation- , provenFactorisation- ) where--import System.Random-import Control.Monad.Trans.State.Strict-import Data.Maybe-import Data.Bits-import Data.Traversable--import Math.NumberTheory.Moduli.Class-import Math.NumberTheory.Primes.Factorisation.Montgomery-import Math.NumberTheory.Primes.Testing.Certificates.Internal-import Math.NumberTheory.Primes.Testing.Probabilistic---- | @'certifiedFactorisation' n@ produces the prime factorisation--- of @n@, proving the primality of the factors, but doesn't report the proofs.-certifiedFactorisation :: Integer -> [(Integer, Word)]-certifiedFactorisation = map fst . certificateFactorisation---- | @'certificateFactorisation' n@ produces a 'provenFactorisation'--- with a default bound of @100000@.-certificateFactorisation :: Integer -> [((Integer, Word),PrimalityProof)]-certificateFactorisation n = provenFactorisation 100000 n---- | @'provenFactorisation' bound n@ constructs a the prime factorisation of @n@--- (which must be positive) together with proofs of primality of the factors,--- using trial division up to @bound@ (which is arbitrarily replaced by @2000@--- if the supplied value is smaller) and elliptic curve factorisation for the--- remaining factors if necessary.------ Construction of primality proofs can take a /very/ long time, so this--- will usually be slow (but should be faster than using 'factorise' and--- proving the primality of the factors from scratch).-provenFactorisation :: Integer -> Integer -> [((Integer, Word),PrimalityProof)]-provenFactorisation _ 1 = []-provenFactorisation bd n- | n < 2 = error "provenFactorisation: argument not positive"- | bd < 2000 = provenFactorisation 2000 n- | otherwise = test $- case smallFactors bd n of- (sfs,mb) -> map (\t@(p,_) -> (t, smallCert p)) sfs- ++ case mb of- Nothing -> []- Just k -> certiFactorisation (Just $ bd*(bd+2)) primeCheck (randomR . (,) 6)- (mkStdGen $ fromIntegral n `xor` 0xdeadbeef) Nothing k---- | verify that we indeed have a correct primality proof-test :: [((Integer, Word),PrimalityProof)] -> [((Integer, Word),PrimalityProof)]-test (t@((p,_),prf):more)- | p == cprime prf && checkPrimalityProof prf = t : test more- | otherwise = error (invalid p prf)-test [] = []---- | produce a proof of primality for primes--- Only called for (not too small) numbers known to have no small prime factors,--- so we can directly use BPSW without trial division.-primeCheck :: Integer -> Maybe PrimalityProof-primeCheck n- | bailliePSW n = case certifyBPSW n of- proof@Pocklington{} -> Just proof- _ -> Nothing- | otherwise = Nothing---- | produce a certified factorisation--- Assumes all small prime factors have been stripped before.--- Since it is not exported, that is known to hold.--- This is a near duplicate of 'curveFactorisation', I should some time--- clean this up.-certiFactorisation :: Maybe Integer -- ^ Lower bound for composite divisors- -> (Integer -> Maybe PrimalityProof)- -- ^ A primality test- -> (Integer -> g -> (Integer,g)) -- ^ A PRNG- -> g -- ^ Initial PRNG state- -> Maybe Int -- ^ Estimated number of digits of the smallest prime factor- -> Integer -- ^ The number to factorise- -> [((Integer, Word),PrimalityProof)]- -- ^ List of prime factors, exponents and primality proofs-certiFactorisation primeBound primeTest prng seed mbdigs n- = case ptest n of- Just proof -> [((n,1),proof)]- Nothing -> evalState (fact n digits) seed- where- digits = fromMaybe 8 mbdigs- mult 1 xs = xs- mult j xs = [((p,j*k),c) | ((p,k),c) <- xs]- vdb xs = [(p,2*e) | (p,e) <- xs]- dbl (u,v) = (mult 2 u, vdb v)- ptest = case primeBound of- Just bd -> \k -> if k <= bd then (Just $ smallCert k) else primeTest k- Nothing -> primeTest- rndR k = state (\gen -> prng k gen)- fact m digs = do let (b1,b2,ct) = findParms digs- (pfs,cfs) <- repFact m b1 b2 ct- if null cfs- then return pfs- else do- nfs <- forM cfs $ \(k,j) ->- mult j <$> fact k (if null pfs then digs+4 else digs)- return (mergeAll $ pfs:nfs)- repFact m b1 b2 count- | count < 0 = return ([],[(m,1)])- | otherwise = do- s <- rndR m- case s `modulo` fromInteger m of- InfMod{} -> error "impossible case"- SomeMod sm -> case montgomeryFactorisation b1 b2 sm of- Nothing -> repFact m b1 b2 (count-1)- Just d -> do- let !cof = m `quot` d- case gcd cof d of- 1 -> do- (dp,dc) <- case ptest d of- Just proof -> return ([((d,1),proof)],[])- Nothing -> repFact d b1 b2 (count-1)- (cp,cc) <- case ptest cof of- Just proof -> return ([((cof,1),proof)],[])- Nothing -> repFact cof b1 b2 (count-1)- return (merge dp cp, dc ++ cc)- g -> do- let d' = d `quot` g- c' = cof `quot` g- (dp,dc) <- case ptest d' of- Just proof -> return ([((d',1),proof)],[])- Nothing -> repFact d' b1 b2 (count-1)- (cp,cc) <- case ptest c' of- Just proof -> return ([((c',1),proof)],[])- Nothing -> repFact c' b1 b2 (count-1)- (gp,gc) <- case ptest g of- Just proof -> return ([((g,2),proof)],[])- Nothing -> dbl <$> repFact g b1 b2 (count-1)- return (mergeAll [dp,cp,gp], dc ++ cc ++ gc)---- | merge two lists of factors, so that the result is strictly increasing (wrt the primes)-merge :: [((Integer, Word), PrimalityProof)] -> [((Integer, Word), PrimalityProof)] -> [((Integer, Word), PrimalityProof)]-merge xxs@(x@((p,e),c):xs) yys@(y@((q,d),_):ys)- = case compare p q of- LT -> x : merge xs yys- EQ -> ((p,e+d),c) : merge xs ys- GT -> y : merge xxs ys-merge [] ys = ys-merge xs _ = xs---- | merge a list of lists of factors so that the result is strictly increasing (wrt the primes)-mergeAll :: [[((Integer, Word), PrimalityProof)]] -> [((Integer, Word), PrimalityProof)]-mergeAll [] = []-mergeAll [xs] = xs-mergeAll (xs:ys:zss) = merge (merge xs ys) (mergeAll zss)---- | message for an invalid proof, should never be used-invalid :: Integer -> PrimalityProof -> String-invalid p prf = unlines- [ "\nInvalid primality proof constructed, please report this to the package maintainer!"- , "The supposed prime was:\n"- , show p- , "\nThe presumed proof was:\n"- , show prf- ]
Math/NumberTheory/Primes/Factorisation/Montgomery.hs view
@@ -10,122 +10,75 @@ -- and -- <http://programmingpraxis.com/2010/04/27/modern-elliptic-curve-factorization-part-2/> ----- The implementation is not very optimised, so it is not suitable for factorising numbers--- with only huge prime divisors. However, factors of 20-25 digits are normally found in--- acceptable time. The time taken depends, however, strongly on how lucky the curve-picking--- is. With luck, even large factors can be found in seconds; on the other hand, finding small--- factors (about 10 digits) can take minutes when the curve-picking is bad.------ Given enough time, the algorithm should be able to factor numbers of 100-120 digits, but it--- is best suited for numbers of up to 50-60 digits. {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}-{-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Primes.Factorisation.Montgomery ( -- * Complete factorisation functions -- ** Functions with input checking factorise- , defaultStdGenFactorisation- -- ** Functions without input checking- , factorise'- , stepFactorisation- , defaultStdGenFactorisation'- -- * Partial factorisation+ -- -- * Partial factorisation , smallFactors- , stdGenFactorisation- , curveFactorisation- -- ** Single curve worker+ -- -- ** Single curve worker , montgomeryFactorisation , findParms ) where +import Prelude hiding (Foldable(..)) import Control.Arrow import Control.Monad.Trans.State.Lazy-import System.Random+import Data.Bit import Data.Bits+import Data.Foldable import Data.IntMap (IntMap) import qualified Data.IntMap as IM-import Data.List (foldl') import Data.Maybe-#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif+import Data.Mod+import Data.Proxy import Data.Traversable--import GHC.TypeNats.Compat+import qualified Data.Vector.Unboxed as U+import GHC.Exts+import GHC.Num.BigNat+import GHC.Natural+import GHC.TypeNats (KnownNat, SomeNat(..), natVal, someNatVal)+import System.Random import Math.NumberTheory.Curves.Montgomery import Math.NumberTheory.Euclidean.Coprimes (splitIntoCoprimes, unCoprimes)-import Math.NumberTheory.Moduli.Class-import Math.NumberTheory.Powers.General (highestPower, largePFPower)-import Math.NumberTheory.Powers.Squares (integerSquareRoot')-import Math.NumberTheory.Primes.Sieve.Eratosthenes-import Math.NumberTheory.Primes.Sieve.Indexing+import Math.NumberTheory.Logarithms (integerLogBase')+import Math.NumberTheory.Roots+import Math.NumberTheory.Primes.Sieve.Eratosthenes (PrimeSieve(..), psieveFrom)+import Math.NumberTheory.Primes.Sieve.Indexing (toPrim)+import Math.NumberTheory.Primes.Small import Math.NumberTheory.Primes.Testing.Probabilistic-import Math.NumberTheory.Primes.Types (unPrime)-import Math.NumberTheory.Unsafe-import Math.NumberTheory.Utils+import Math.NumberTheory.Utils hiding (splitOff)+import Math.NumberTheory.Utils.FromIntegral -- | @'factorise' n@ produces the prime factorisation of @n@. @'factorise' 0@ is -- an error and the factorisation of @1@ is empty. Uses a 'StdGen' produced in -- an arbitrary manner from the bit-pattern of @n@. -- -- __Warning:__ there are no guarantees of any particular--- order of prime factors, do not expect them to be ascending. E. g.,------ >>> factorise 10251562501--- [(101701,1),(100801,1)]-factorise :: Integer -> [(Integer, Word)]-factorise n- | abs n == 1 = []- | n < 0 = factorise (-n)- | n == 0 = error "0 has no prime factorisation"- | otherwise = factorise' n---- | Like 'factorise', but without input checking, hence @n > 1@ is required.-factorise' :: Integer -> [(Integer, Word)]-factorise' n = defaultStdGenFactorisation' (mkStdGen $ fromInteger n `xor` 0xdeadbeef) n---- | @'stepFactorisation'@ is like 'factorise'', except that it doesn't use a--- pseudo random generator but steps through the curves in order.--- This strategy turns out to be surprisingly fast, on average it doesn't--- seem to be slower than the 'StdGen' based variant.-stepFactorisation :: Integer -> [(Integer, Word)]-stepFactorisation n- = let (sfs,mb) = smallFactors 100000 n- in sfs ++ case mb of- Nothing -> []- Just r -> curveFactorisation (Just 10000000000) bailliePSW- (\m k -> (if k < (m-1) then k else error "Curves exhausted",k+1)) 6 Nothing r---- | @'defaultStdGenFactorisation'@ first strips off all small prime factors and then,--- if the factorisation is not complete, proceeds to curve factorisation.--- For negative numbers, a factor of @-1@ is included, the factorisation of @1@--- is empty. Since @0@ has no prime factorisation, a zero argument causes--- an error.-defaultStdGenFactorisation :: StdGen -> Integer -> [(Integer, Word)]-defaultStdGenFactorisation sg n- | n == 0 = error "0 has no prime factorisation"- | n < 0 = (-1,1) : defaultStdGenFactorisation sg (-n)- | n == 1 = []- | otherwise = defaultStdGenFactorisation' sg n---- | Like 'defaultStdGenFactorisation', but without input checking, so--- @n@ must be larger than @1@.-defaultStdGenFactorisation' :: StdGen -> Integer -> [(Integer, Word)]-defaultStdGenFactorisation' sg n- = let (sfs,mb) = smallFactors 100000 n- in sfs ++ case mb of- Nothing -> []- Just m -> stdGenFactorisation (Just 10000000000) sg Nothing m+-- order of prime factors, do not expect them to be ascending.+factorise :: Integral a => a -> [(a, Word)]+factorise 0 = error "0 has no prime factorisation"+factorise n' = map (first fromIntegral) sfs <> map (first fromInteger) rest+ where+ n = abs n'+ (sfs, mb) = smallFactors (fromIntegral' n)+ sg = mkStdGen (fromIntegral n `xor` 0xdeadbeef)+ rest = case mb of+ Nothing -> []+ Just m -> stdGenFactorisation (Just $ 65536 * 65536) sg Nothing (toInteger m) ---------------------------------------------------------------------------------------------------- -- Factorisation wrappers --@@ -140,8 +93,8 @@ -> Maybe Int -- ^ Estimated number of digits of smallest prime factor -> Integer -- ^ The number to factorise -> [(Integer, Word)] -- ^ List of prime factors and exponents-stdGenFactorisation primeBound sg digits n- = curveFactorisation primeBound bailliePSW (\m -> randomR (6,m-2)) sg digits n+stdGenFactorisation primeBound =+ curveFactorisation primeBound bailliePSW (\m -> randomR (6, m - 2)) -- | 'curveFactorisation' is the driver for the factorisation. Its performance (and success) -- can be influenced by passing appropriate arguments. If you know that @n@ has no prime divisors@@ -155,9 +108,8 @@ -- make a huge difference. So, if the default takes too long, try another one; or you can improve your -- chances for a quick result by running several instances in parallel. ----- 'curveFactorisation' @n@ requires that small (< 100000) prime factors of @n@--- have been stripped before. Otherwise it is likely to cycle forever. When in doubt,--- use 'defaultStdGenFactorisation'.+-- 'curveFactorisation' @n@ requires that small (< 65536) prime factors of @n@+-- have been stripped before. Otherwise it is likely to cycle forever. -- -- 'curveFactorisation' is unlikely to succeed if @n@ has more than one (really) large prime factor. --@@ -185,7 +137,7 @@ rndR k = state (prng k) perfPw :: Integer -> (Integer, Word)- perfPw = maybe highestPower (largePFPower . integerSquareRoot') primeBound+ perfPw = maybe highestPower (largePFPower . integerSquareRoot) primeBound fact :: Integer -> Int -> State g [(Integer, Word)] fact 1 _ = return mempty@@ -217,24 +169,23 @@ workFact m _ _ 0 = return $ singleCompositeFactor m 1 workFact m b1 b2 count = do s <- rndR m- case s `modulo` fromInteger m of- InfMod{} -> error "impossible case"- SomeMod sm -> case montgomeryFactorisation b1 b2 sm of+ case someNatVal (fromInteger m) of+ SomeNat (_ :: Proxy t) -> case montgomeryFactorisation b1 b2 (fromInteger s :: Mod t) of Nothing -> workFact m b1 b2 (count - 1) Just d -> do let cs = unCoprimes $ splitIntoCoprimes [(d, 1), (m `quot` d, 1)] -- Since all @cs@ are coprime, we can factor each of -- them and just concat results, without summing up -- powers of the same primes in different elements.- fmap mconcat $ flip mapM cs $+ fmap mconcat $ forM cs $ \(x, xm) -> if ptest x then pure $ singlePrimeFactor x xm- else repFact x b1 b2 (count - 1)+ else fmap (modifyPowers (* xm)) (repFact x b1 b2 (count - 1)) data Factors = Factors { _primeFactors :: [(Integer, Word)] , _compositeFactors :: [(Integer, Word)]- }+ } deriving (Show) singlePrimeFactor :: Integer -> Word -> Factors singlePrimeFactor a b = Factors [(a, b)] []@@ -248,12 +199,57 @@ instance Monoid Factors where mempty = Factors [] []- mappend = (<>) modifyPowers :: (Word -> Word) -> Factors -> Factors modifyPowers f (Factors pfs cfs) = Factors (map (second f) pfs) (map (second f) cfs) +-------------------------------------------------------------------------------+-- largePFPower++-- | @'largePFPower' bd n@ produces the pair @(b,k)@ with the largest+-- exponent @k@ such that @n == b^k@, where @bd > 1@ (it is expected+-- that @bd@ is much larger, at least @1000@ or so), @n > bd^2@ and @n@+-- has no prime factors @p <= bd@, skipping the trial division phase+-- of @'highestPower'@ when that is a priori known to be superfluous.+-- It is only present to avoid duplication of work in factorisation+-- and primality testing, it is not expected to be generally useful.+-- The assumptions are not checked, if they are not satisfied, wrong+-- results and wasted work may be the consequence.+largePFPower :: Integer -> Integer -> (Integer, Word)+largePFPower bd n = rawPower ln n+ where+ ln = intToWord (integerLogBase' (bd+1) n)++rawPower :: Word -> Integer -> (Integer, Word)+rawPower mx n = case exactRoot 4 n of+ Just r -> case rawPower (mx `quot` 4) r of+ (m,e) -> (m, 4*e)+ Nothing -> case exactSquareRoot n of+ Just r -> case rawOddPower (mx `quot` 2) r of+ (m,e) -> (m, 2*e)+ Nothing -> rawOddPower mx n++rawOddPower :: Word -> Integer -> (Integer, Word)+rawOddPower mx n+ | mx < 3 = (n,1)+rawOddPower mx n = case exactCubeRoot n of+ Just r -> case rawOddPower (mx `quot` 3) r of+ (m,e) -> (m, 3*e)+ Nothing -> badPower mx n++badPower :: Word -> Integer -> (Integer, Word)+badPower mx n+ | mx < 5 = (n,1)+ | otherwise = go 1 mx n (takeWhile (<= mx) $ scanl (+) 5 $ cycle [2,4])+ where+ go !e b m (k:ks)+ | b < k = (m,e)+ | otherwise = case exactRoot k m of+ Just r -> go (e*k) (b `quot` k) r (k:ks)+ Nothing -> go e b m ks+ go e _ m [] = (m,e)+ ---------------------------------------------------------------------------------------------------- -- The workhorse -- ----------------------------------------------------------------------------------------------------@@ -272,7 +268,7 @@ -- -- The result is maybe a nontrivial divisor of @n@. montgomeryFactorisation :: KnownNat n => Word -> Word -> Mod n -> Maybe Integer-montgomeryFactorisation b1 b2 s = case newPoint (getVal s) n of+montgomeryFactorisation b1 b2 s = case newPoint (toInteger (unMod s)) n of Nothing -> Nothing Just (SomePoint p0) -> do -- Small step: for each prime p <= b1@@ -280,16 +276,17 @@ let q = foldl (flip multiply) p0 smallPowers z = pointZ q - fromIntegral <$> case gcd n z of+ case gcd n z of -- If small step did not succeed, perform a big step. 1 -> case gcd n (bigStep q b1 b2) of 1 -> Nothing g -> Just g g -> Just g where- n = getMod s- smallPrimes = takeWhile (<= b1) (2 : 3 : 5 : list primeStore)- smallPowers = map findPower smallPrimes+ n = toInteger (natVal s)+ smallPowers+ = map findPower+ $ takeWhile (<= b1) (2 : 3 : 5 : list primeStore) findPower p = go p where go acc@@ -305,7 +302,7 @@ n = pointN q b0 = b1 - b1 `rem` wheel- qks = zip [0..] $ map (\k -> multiply k q) wheelCoprimes+ qks = zip [0..] $ map (`multiply` q) wheelCoprimes qs = enumAndMultiplyFromThenTo q b0 (b0 + wheel) b2 rs = foldl' (\ts (_cHi, p) -> foldl' (\us (_cLo, pq) ->@@ -335,7 +332,7 @@ pThen = multiply thn p pStep = multiply step p - progression = pFrom : pThen : zipWith (\x0 x1 -> add x0 pStep x1) progression (tail progression)+ progression = pFrom : pThen : zipWith (`add` pStep) progression (drop 1 progression) -- primes, compactly stored as a bit sieve primeStore :: [PrimeSieve]@@ -343,26 +340,71 @@ -- generate list of primes from arrays list :: [PrimeSieve] -> [Word]-list sieves = concat [[off + toPrim i | i <- [0 .. li], unsafeAt bs i]- | PS vO bs <- sieves, let { (_,li) = bounds bs; off = fromInteger vO; }]+list sieves = concat [[off + toPrim i | i <- [0 .. li], unBit (U.unsafeIndex bs i)]+ | PS vO bs <- sieves, let { li = U.length bs - 1; off = fromInteger vO; }] --- | @'smallFactors' bound n@ finds all prime divisors of @n > 1@ up to @bound@ by trial division and returns the+-- | @'smallFactors' n@ finds all prime divisors of @n > 1@ up to 2^16 by trial division and returns the -- list of these together with their multiplicities, and a possible remaining factor which may be composite.-smallFactors :: Integer -> Integer -> ([(Integer, Word)], Maybe Integer)-smallFactors bd n = case shiftToOddCount n of- (0,m) -> go m prms- (k,m) -> (2,k) <: if m == 1 then ([],Nothing) else go m prms+smallFactors :: Natural -> ([(Natural, Word)], Maybe Natural)+smallFactors = \case+ NatS# 0## -> error "0 has no prime factorisation"+ NatS# n# -> case shiftToOddCount# n# of+ (# 0##, m# #) -> goWord m# 1+ (# k#, m# #) -> (2, W# k#) <: goWord m# 1+ NatJ# (BN# n) -> case shiftToOddCountBigNat n of+ (# 0, m #) -> goBigNat m 1+ (# k, m #) -> (2, k) <: goBigNat m 1 where- prms = map unPrime $ tail (primeStore >>= primeList) x <: ~(l,b) = (x:l,b)- go m (p:ps)- | m < p*p = ([(m,1)], Nothing)- | bd < p = ([], Just m)- | otherwise = case splitOff p m of- (0,_) -> go m ps- (k,r) | r == 1 -> ([(p,k)], Nothing)- | otherwise -> (p,k) <: go r ps- go m [] = ([(m,1)], Nothing)++ !(Ptr smallPrimesAddr#) = smallPrimesPtr++ goBigNat :: BigNat# -> Int -> ([(Natural, Word)], Maybe Natural)+ goBigNat !m i@(I# i#)+ | isTrue# (bigNatSize# m ==# 1#)+ = goWord (bigNatToWord# m) i+ | i >= smallPrimesLength+ = ([], Just (NatJ# (BN# m)))+ | otherwise+ = let p# =+#if MIN_VERSION_base(4,16,0)+ word16ToWord#+#endif+ (indexWord16OffAddr# smallPrimesAddr# i#) in+ case m `bigNatQuotRemWord#` p# of+ (# mp, 0## #) ->+ let !(# k, r #) = splitOff 1 mp in+ (NatS# p#, k) <: goBigNat r (i + 1)+ where+ splitOff !k x = case x `bigNatQuotRemWord#` p# of+ (# xp, 0## #) -> splitOff (k + 1) xp+ _ -> (# k, x #)+ _ -> goBigNat m (i + 1)++ goWord :: Word# -> Int -> ([(Natural, Word)], Maybe Natural)+ goWord 1## !_ = ([], Nothing)+ goWord m# !i+ | i >= smallPrimesLength+ = if isTrue# (m# `leWord#` 4294967295##) -- 65536 * 65536 - 1+ then ([(NatS# m#, 1)], Nothing)+ else ([], Just (NatS# m#))+ goWord m# i@(I# i#)+ = let p# =+#if MIN_VERSION_base(4,16,0)+ word16ToWord#+#endif+ (indexWord16OffAddr# smallPrimesAddr# i#) in+ if isTrue# (m# `ltWord#` (p# `timesWord#` p#))+ then ([(NatS# m#, 1)], Nothing)+ else case m# `quotRemWord#` p# of+ (# mp#, 0## #) ->+ let !(# k#, r# #) = splitOff 1## mp# in+ (NatS# p#, W# k#) <: goWord r# (i + 1)+ where+ splitOff k# x# = case x# `quotRemWord#` p# of+ (# xp#, 0## #) -> splitOff (k# `plusWord#` 1##) xp#+ _ -> (# k#, x# #)+ _ -> goWord m# (i + 1) -- | For a given estimated decimal length of the smallest prime factor -- ("tier") return parameters B1, B2 and the number of curves to try
Math/NumberTheory/Primes/Factorisation/TrialDivision.hs view
@@ -13,12 +13,11 @@ module Math.NumberTheory.Primes.Factorisation.TrialDivision ( trialDivisionWith , trialDivisionTo- , trialDivisionPrimeWith , trialDivisionPrimeTo ) where -import Math.NumberTheory.Primes.Sieve.Eratosthenes-import Math.NumberTheory.Powers.Squares+import Math.NumberTheory.Primes.Sieve.Eratosthenes (primeList, primeSieve, psieveList)+import Math.NumberTheory.Roots import Math.NumberTheory.Primes.Types import Math.NumberTheory.Utils @@ -30,7 +29,7 @@ | n < 0 = trialDivisionWith prs (-n) | n == 0 = error "trialDivision of 0" | n == 1 = []- | otherwise = go n (integerSquareRoot' n) prs+ | otherwise = go n (integerSquareRoot n) prs where go !m !r (p:ps) | r < p = [(m,1)]@@ -39,7 +38,7 @@ (0,_) -> go m r ps (k,q) -> (p,k) : if q == 1 then []- else go q (integerSquareRoot' q) ps+ else go q (integerSquareRoot q) ps go m _ _ = [(m,1)] -- | @'trialDivisionTo' bound n@ produces a factorisation of @n@ using the@@ -50,7 +49,7 @@ trialDivisionTo bd | bd < 100 = trialDivisionTo 100 | bd < 10000000 = trialDivisionWith (map unPrime $ primeList $ primeSieve bd)- | otherwise = trialDivisionWith (takeWhile (<= bd) $ map unPrime $ (psieveList >>= primeList))+ | otherwise = trialDivisionWith (takeWhile (<= bd) $ map unPrime $ psieveList >>= primeList) -- | Check whether a number is coprime to all of the numbers in the list -- (assuming that list contains only numbers > 1 and is ascending).@@ -58,7 +57,7 @@ trialDivisionPrimeWith prs n | n < 0 = trialDivisionPrimeWith prs (-n) | n < 2 = False- | otherwise = go n (integerSquareRoot' n) prs+ | otherwise = go n (integerSquareRoot n) prs where go !m !r (p:ps) = r < p || m `rem` p /= 0 && go m r ps go _ _ _ = True@@ -69,4 +68,4 @@ trialDivisionPrimeTo bd | bd < 100 = trialDivisionPrimeTo 100 | bd < 10000000 = trialDivisionPrimeWith (map unPrime $ primeList $ primeSieve bd)- | otherwise = trialDivisionPrimeWith (takeWhile (<= bd) $ map unPrime $ (psieveList >>= primeList))+ | otherwise = trialDivisionPrimeWith (takeWhile (<= bd) $ map unPrime $ psieveList >>= primeList)
+ Math/NumberTheory/Primes/IntSet.hs view
@@ -0,0 +1,344 @@+-- |+-- Module: Math.NumberTheory.Primes.IntSet+-- Copyright: (c) 2020 Andrew Lelechenko+-- Licence: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- A newtype wrapper around 'IntSet'.+--+-- This module is intended to be imported qualified, e. g.,+--+-- > import Math.NumberTheory.Primes.IntSet (PrimeIntSet)+-- > import qualified Math.NumberTheory.Primes.IntSet as PrimeIntSet+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Math.NumberTheory.Primes.IntSet+ ( -- * Set type+ PrimeIntSet+ , unPrimeIntSet+ -- * Construction+ -- | Use 'Data.Monoid.mempty' to create an empty set.+ , singleton+ , fromList+ , fromAscList+ , fromDistinctAscList+ -- * Insertion+ , insert+ -- * Deletion+ , delete+ -- * Query+ , member+ , notMember+ , lookupEQ+ , lookupLT+ , lookupGT+ , lookupLE+ , lookupGE+ , null+ , size+ , isSubsetOf+ , isProperSubsetOf+ , disjoint+ -- * Combine+ -- | Use 'Data.Semigroup.<>' for unions.+ , difference+ , (\\)+ , symmetricDifference+ , intersection+ -- * Filter+ , filter+ , partition+ , split+ , splitMember+ , splitLookupEQ+ , splitRoot+ -- * Folds+ , foldr+ , foldl+ , foldr'+ , foldl'+ -- * Min/Max+ , deleteMin+ , deleteMax+ , minView+ , maxView+ -- * Conversion+ , toAscList+ , toDescList+ ) where++import Prelude (Eq, Ord, Show, Monoid, Bool, Maybe(..), Int, otherwise)+import Control.DeepSeq (NFData)+import Data.Coerce (coerce)+import Data.Data (Data)+import Data.IntSet (IntSet)+import qualified Data.IntSet.Internal as IS+import Data.Semigroup (Semigroup)+import qualified GHC.Exts (IsList(..))++import Math.NumberTheory.Primes.Types (Prime(..))++#if !MIN_VERSION_containers(0,8,0)+import Prelude ((>), (/=), (==), (-), Word)+import Data.Function (on)+import Math.NumberTheory.Utils.FromIntegral (wordToInt, intToWord)+import Data.Bits (Bits(..))+import Utils.Containers.Internal.BitUtil (highestBitMask)+#endif++-- | A set of 'Prime' integers.+newtype PrimeIntSet = PrimeIntSet {+ -- | Convert to a set of integers.+ unPrimeIntSet :: IntSet+ }+ deriving (Eq, Ord, Data, Show, Semigroup, Monoid, NFData)++instance GHC.Exts.IsList PrimeIntSet where+ type Item PrimeIntSet = Prime Int+ fromList = coerce IS.fromList+ toList = coerce IS.toList++-- | Build a singleton set.+singleton :: Prime Int -> PrimeIntSet+singleton = coerce IS.singleton++-- | Build a set from a list of primes.+fromList :: [Prime Int] -> PrimeIntSet+fromList = coerce IS.fromList++-- | Build a set from an ascending list of primes+-- (the precondition is not checked).+fromAscList :: [Prime Int] -> PrimeIntSet+fromAscList = coerce IS.fromAscList++-- | Build a set from an ascending list of distinct primes+-- (the precondition is not checked).+fromDistinctAscList :: [Prime Int] -> PrimeIntSet+fromDistinctAscList = coerce IS.fromDistinctAscList++-- | Insert a prime into the set.+insert :: Prime Int -> PrimeIntSet -> PrimeIntSet+insert = coerce IS.insert++-- | Delete an integer from the set.+delete :: Int -> PrimeIntSet -> PrimeIntSet+delete = coerce IS.delete++-- | Check whether the given prime is a member of the set.+member :: Prime Int -> PrimeIntSet -> Bool+member = coerce IS.member++-- | Check whether the given prime is not a member of the set.+notMember :: Prime Int -> PrimeIntSet -> Bool+notMember = coerce IS.notMember++-- | Find a prime in the set,+-- equal to the given integer, if any exists.+lookupEQ :: Int -> PrimeIntSet -> Maybe (Prime Int)+lookupEQ x xs+ | coerce member x xs = Just (Prime x)+ | otherwise = Nothing++-- | Find the largest prime in the set,+-- smaller than the given integer, if any exists.+lookupLT :: Int -> PrimeIntSet -> Maybe (Prime Int)+lookupLT = coerce IS.lookupLT++-- | Find the smallest prime in the set,+-- greater than the given integer, if any exists.+lookupGT :: Int -> PrimeIntSet -> Maybe (Prime Int)+lookupGT = coerce IS.lookupGT++-- | Find the largest prime in the set,+-- smaller or equal to the given integer, if any exists.+lookupLE :: Int -> PrimeIntSet -> Maybe (Prime Int)+lookupLE = coerce IS.lookupLE++-- | Find the smallest prime in the set,+-- greater or equal to the given integer, if any exists.+lookupGE :: Int -> PrimeIntSet -> Maybe (Prime Int)+lookupGE = coerce IS.lookupGE++-- | Check whether the set is empty.+null :: PrimeIntSet -> Bool+null = coerce IS.null++-- | Cardinality of the set.+size :: PrimeIntSet -> Int+size = coerce IS.size++-- | Check whether the first argument is a subset of the second one.+isSubsetOf :: PrimeIntSet -> PrimeIntSet -> Bool+isSubsetOf = coerce IS.isSubsetOf++-- | Check whether the first argument is a proper subset of the second one.+isProperSubsetOf :: PrimeIntSet -> PrimeIntSet -> Bool+isProperSubsetOf = coerce IS.isProperSubsetOf++-- | Check whether two sets are disjoint.+disjoint :: PrimeIntSet -> PrimeIntSet -> Bool+disjoint = coerce IS.disjoint++-- | Difference between a set of primes and a set of integers.+difference :: PrimeIntSet -> IntSet -> PrimeIntSet+difference = coerce IS.difference++-- | An alias to 'difference'.+(\\) :: PrimeIntSet -> IntSet -> PrimeIntSet+(\\) = coerce (IS.\\)++infixl 9 \\{- -}++-- | Symmetric difference of two sets of primes.+symmetricDifference :: PrimeIntSet -> PrimeIntSet -> PrimeIntSet+#if MIN_VERSION_containers(0,8,0)+symmetricDifference = coerce IS.symmetricDifference+#else+symmetricDifference = coerce symmDiff+#endif++-- | Intersection of a set of primes and a set of integers.+intersection :: PrimeIntSet -> IntSet -> PrimeIntSet+intersection = coerce IS.intersection++-- | Filter primes satisfying a predicate.+filter :: (Prime Int -> Bool) -> PrimeIntSet -> PrimeIntSet+filter = coerce IS.filter++-- | Partition primes according to a predicate.+partition :: (Prime Int -> Bool) -> PrimeIntSet -> (PrimeIntSet, PrimeIntSet)+partition = coerce IS.partition++-- | Split into primes strictly less and strictly greater+-- than the first argument.+split :: Int -> PrimeIntSet -> (PrimeIntSet, PrimeIntSet)+split = coerce IS.split++-- | Simultaneous 'split' and 'member'.+splitMember :: Prime Int -> PrimeIntSet -> (PrimeIntSet, Bool, PrimeIntSet)+splitMember = coerce IS.splitMember++-- | Simultaneous 'split' and 'lookupEQ'.+splitLookupEQ :: Int -> PrimeIntSet -> (PrimeIntSet, Maybe (Prime Int), PrimeIntSet)+splitLookupEQ x xs = (lt, if eq then Just (Prime x) else Nothing, gt)+ where+ (lt, eq, gt) = coerce IS.splitMember x xs++-- | Decompose a set into pieces based on the structure of the underlying tree.+splitRoot :: PrimeIntSet -> [PrimeIntSet]+splitRoot = coerce IS.splitRoot++-- | Fold a set using the given right-associative operator.+foldr :: forall b. (Prime Int -> b -> b) -> b -> PrimeIntSet -> b+foldr = coerce (IS.foldr @b)++-- | Fold a set using the given left-associative operator.+foldl :: forall a. (a -> Prime Int -> a) -> a -> PrimeIntSet -> a+foldl = coerce (IS.foldl @a)++-- | A strict version of 'foldr'.+foldr' :: forall b. (Prime Int -> b -> b) -> b -> PrimeIntSet -> b+foldr' = coerce (IS.foldr' @b)++-- | A strict version of 'foldl'.+foldl' :: forall a. (a -> Prime Int -> a) -> a -> PrimeIntSet -> a+foldl' = coerce (IS.foldl' @a)++-- | Delete the smallest prime in the set.+deleteMin :: PrimeIntSet -> PrimeIntSet+deleteMin = coerce IS.deleteMin++-- | Delete the largest prime in the set.+deleteMax :: PrimeIntSet -> PrimeIntSet+deleteMax = coerce IS.deleteMax++-- | Split a set into the smallest prime and the rest, if non-empty.+minView :: PrimeIntSet -> Maybe (Prime Int, PrimeIntSet)+minView = coerce IS.minView++-- | Split a set into the largest prime and the rest, if non-empty.+maxView :: PrimeIntSet -> Maybe (Prime Int, PrimeIntSet)+maxView = coerce IS.maxView++-- | Convert the set to a list of ascending primes.+toAscList :: PrimeIntSet -> [Prime Int]+toAscList = coerce IS.toAscList++-- | Convert the set to a list of descending primes.+toDescList :: PrimeIntSet -> [Prime Int]+toDescList = coerce IS.toDescList++-------------------------------------------------------------------------------+-- IntSet helpers++#if !MIN_VERSION_containers(0,8,0)++-- | Symmetric difference of two sets.+-- Implementation is inspired by 'Data.IntSet.union'+-- and 'Data.IntSet.difference'.+symmDiff :: IntSet -> IntSet -> IntSet+symmDiff t1 t2 = case t1 of+ IS.Bin p1 m1 l1 r1 -> case t2 of+ IS.Bin p2 m2 l2 r2+ | shorter m1 m2 -> symmDiff1+ | shorter m2 m1 -> symmDiff2+ | p1 == p2 -> bin p1 m1 (symmDiff l1 l2) (symmDiff r1 r2)+ | otherwise -> link p1 t1 p2 t2+ where+ symmDiff1+ | mask p2 m1 /= p1 = link p1 t1 p2 t2+ | p2 .&. m1 == 0 = bin p1 m1 (symmDiff l1 t2) r1+ | otherwise = bin p1 m1 l1 (symmDiff r1 t2)+ symmDiff2+ | mask p1 m2 /= p2 = link p1 t1 p2 t2+ | p1 .&. m2 == 0 = bin p2 m2 (symmDiff t1 l2) r2+ | otherwise = bin p2 m2 l2 (symmDiff t1 r2)+ IS.Tip kx bm -> symmDiffBM kx bm t1+ IS.Nil -> t1+ IS.Tip kx bm -> symmDiffBM kx bm t2+ IS.Nil -> t2++shorter :: Int -> Int -> Bool+shorter = (>) `on` intToWord++symmDiffBM :: Int -> Word -> IntSet -> IntSet+symmDiffBM !kx !bm t = case t of+ IS.Bin p m l r+ | mask kx m /= p -> link kx (IS.Tip kx bm) p t+ | kx .&. m == 0 -> bin p m (symmDiffBM kx bm l) r+ | otherwise -> bin p m l (symmDiffBM kx bm r)+ IS.Tip kx' bm'+ | kx' == kx -> if bm' == bm then IS.Nil else IS.Tip kx (bm' `xor` bm)+ | otherwise -> link kx (IS.Tip kx bm) kx' t+ IS.Nil -> IS.Tip kx bm++link :: Int -> IntSet -> Int -> IntSet -> IntSet+link p1 t1 p2 t2+ | p1 .&. m == 0 = IS.Bin p m t1 t2+ | otherwise = IS.Bin p m t2 t1+ where+ m = wordToInt (highestBitMask (intToWord p1 `xor` intToWord p2))+ p = mask p1 m+{-# INLINE link #-}++bin :: Int -> Int -> IntSet -> IntSet -> IntSet+bin p m l r = case r of+ IS.Nil -> l+ _ -> case l of+ IS.Nil -> r+ _ -> IS.Bin p m l r+{-# INLINE bin #-}++mask :: Int -> Int -> Int+mask i m = i .&. (complement (m - 1) `xor` m)+{-# INLINE mask #-}++#endif
− Math/NumberTheory/Primes/Sieve.hs
@@ -1,60 +0,0 @@--- |--- Module: Math.NumberTheory.Primes.Sieve--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Prime generation using a sieve.--- Currently, an enhanced sieve of Eratosthenes is used, switching to an--- Atkin sieve is planned (if I get around to implementing it and it's not slower).------ The sieve used is segmented, with a chunk size chosen to give good (enough)--- cache locality while still getting something substantial done per chunk.--- However, that means we must store data for primes up to the square root of--- where sieving is done, thus sieving primes up to @n@ requires--- @/O/(sqrt n/log n)@ space.-module Math.NumberTheory.Primes.Sieve- ( -- * Limitations- -- $limits-- -- * Sieves and lists- primes- , sieveFrom- , PrimeSieve- , primeSieve- , psieveList- , psieveFrom- , primeList- ) where--import Math.NumberTheory.Primes.Sieve.Eratosthenes---- $limits------ There are three factors limiting the range of these sieves.------ (1) Memory------ (2) Overflow------ (3) The internal representation of the state------ An Eratosthenes type sieve needs to store the primes up to the square root of--- the currently sieved region, thus requires @/O/(sqrt n\/log n)@ space.We store @16@ bytes--- of information per prime, thus a Gigabyte of memory takes you to about @1.6*10^18@.--- The @log@ doesn't change much in that range, so as a first approximation, doubling--- the storage increases the sieve range by a factor of four.------ On a 64-bit system, this is (currently) the only limitation to be concerned with, but--- with more than four Terabyte of memory, the fact that the internal representation--- currently limits the sieve range to about @6.8*10^25@ could become relevant.--- Overflow in array indexing doesn't become a concern before memory and internal--- representation would allow to sieve past @10^37@.------ On a 32-bit system, the internal representation imposes no additional limits,--- but overflow has to be reckoned with. On the one hand, the fact that arrays are--- 'Int'-indexed restricts the size of the prime store, on the other hand, overflow--- in calculating the indices to cross off multiples is possible before running out--- of memory. The former limits the upper bound of the monolithic 'primeSieve' to--- shortly above @8*10^9@, the latter limits the range of the segmented sieves to--- about @1.7*10^18@.
Math/NumberTheory/Primes/Sieve/Eratosthenes.hs view
@@ -7,68 +7,65 @@ -- Sieve -- {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fspec-constr-count=8 #-}-{-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Primes.Sieve.Eratosthenes ( primes- , sieveFrom , psieveFrom , PrimeSieve(..) , psieveList , primeList , primeSieve- , nthPrimeCt- , countFromTo- , countAll- , countToNth , sieveBits , sieveRange , sieveTo ) where -#include "MachDeps.h"-+import Control.Monad (when) import Control.Monad.ST-import Data.Array.ST-import Data.Array.Unboxed+import Data.Bit+import Data.Bits import Data.Coerce import Data.Proxy-import Control.Monad (when)-import Data.Bits-#if WORD_SIZE_IN_BITS == 32+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as MU import Data.Word-#endif -import Math.NumberTheory.Powers.Squares (integerSquareRoot)-import Math.NumberTheory.Unsafe-import Math.NumberTheory.Utils-import Math.NumberTheory.Utils.FromIntegral-import Math.NumberTheory.Primes.Counting.Approximate import Math.NumberTheory.Primes.Sieve.Indexing import Math.NumberTheory.Primes.Types+import Math.NumberTheory.Roots+import Math.NumberTheory.Utils.FromIntegral -#define IX_MASK 0xFFFFF-#define IX_BITS 20-#define IX_J_MASK 0x7FFFFF-#define IX_J_BITS 23-#define J_MASK 7-#define J_BITS 3-#define SIEVE_KB 128+iXMASK :: Num a => a+iXMASK = 0xFFFFF +iXBITS :: Int+iXBITS = 20++iXJMASK :: Num a => a+iXJMASK = 0x7FFFFF++iXJBITS :: Int+iXJBITS = 23++jMASK :: Int+jMASK = 7++jBITS :: Int+jBITS = 3+ -- Sieve in 128K chunks. -- Large enough to get something done per chunk -- and hopefully small enough to fit in the cache. sieveBytes :: Int-sieveBytes = SIEVE_KB*1024+sieveBytes = 128 * 1024 -- Number of bits per chunk. sieveBits :: Int-sieveBits = 8*sieveBytes+sieveBits = 8 * sieveBytes -- Last index of chunk. lastIndex :: Int@@ -76,27 +73,10 @@ -- Range of a chunk. sieveRange :: Int-sieveRange = 30*sieveBytes--sieveWords :: Int-sieveWords = sieveBytes `quot` SIZEOF_HSWORD--#if SIZEOF_HSWORD == 8-type CacheWord = Word-#define RMASK 63-#define WSHFT 6-#define TOPB 32-#define TOPM 0xFFFFFFFF-#else-type CacheWord = Word64-#define RMASK 31-#define WSHFT 5-#define TOPB 16-#define TOPM 0xFFFF-#endif+sieveRange = 30 * sieveBytes -- | Compact store of primality flags.-data PrimeSieve = PS !Integer {-# UNPACK #-} !(UArray Int Bool)+data PrimeSieve = PS !Integer {-# UNPACK #-} !(U.Vector Bit) -- | Sieve primes up to (and including) a bound (or 7, if bound is smaller). -- For small enough bounds, this is more efficient than@@ -108,7 +88,7 @@ -- is often within memory limits, so don't give bounds larger than -- @8*10^9@ there. primeSieve :: Integer -> PrimeSieve-primeSieve bound = PS 0 (runSTUArray $ sieveTo bound)+primeSieve bound = PS 0 (runST $ sieveTo bound >>= U.unsafeFreeze) -- | Generate a list of primes for consumption from a -- 'PrimeSieve'.@@ -124,9 +104,9 @@ primeListInternal :: Num a => PrimeSieve -> [a] primeListInternal (PS v0 bs) = map ((+ fromInteger v0) . toPrim)- $ filter (unsafeAt bs) [lo..hi]+ $ filter (unBit . U.unsafeIndex bs) [lo..hi] where- (lo, hi) = bounds bs+ (lo, hi) = (0, U.length bs - 1) -- | Returns true if integer is beyond representation range of type a. doesNotFit :: forall a. Integral a => Proxy a -> Integer -> Bool@@ -150,23 +130,18 @@ -- 'primes' is a polymorphic list, so the results of computations are not retained in memory. -- Make it monomorphic to take advantages of memoization. Compare ----- >>> :set +s--- >>> primes !! 1000000 :: Prime Int+-- >>> primes !! 1000000 :: Prime Int -- (5.32 secs, 6,945,267,496 bytes) -- Prime 15485867--- (5.32 secs, 6,945,267,496 bytes)--- >>> primes !! 1000000 :: Prime Int+-- >>> primes !! 1000000 :: Prime Int -- (5.19 secs, 6,945,267,496 bytes) -- Prime 15485867--- (5.19 secs, 6,945,267,496 bytes) -- -- against -- -- >>> let primes' = primes :: [Prime Int]--- >>> primes' !! 1000000 :: Prime Int+-- >>> primes' !! 1000000 :: Prime Int -- (5.29 secs, 6,945,269,856 bytes) -- Prime 15485867--- (5.29 secs, 6,945,269,856 bytes)--- >>> primes' !! 1000000 :: Prime Int+-- >>> primes' !! 1000000 :: Prime Int -- (0.02 secs, 336,232 bytes) -- Prime 15485867--- (0.02 secs, 336,232 bytes) primes :: Integral a => [Prime a] primes = (coerce :: [a] -> [Prime a])@@ -180,35 +155,36 @@ where plim = 4801 -- prime #647, 644 of them to use sqlim = plim*plim- cache = runSTUArray $ do+ cache = runST $ do sieve <- sieveTo (4801 :: Integer)- new <- unsafeNewArray_ (0,1287) :: ST s (STUArray s Int CacheWord)+ new <- MU.unsafeNew 1288 :: ST s (MU.MVector s Word64) let fill j indx | 1279 < indx = return new -- index of 4801 = 159*30 + 31 ~> 159*8+7 | otherwise = do- p <- unsafeRead sieve indx+ Bit p <- MU.unsafeRead sieve indx if p then do- let !i = indx .&. J_MASK- k = indx `shiftR` J_BITS- strt1 = (k*(30*k + 2*rho i) + byte i) `shiftL` J_BITS + fromIntegral (idx i)- !strt = fromIntegral (strt1 .&. IX_MASK)- !skip = fromIntegral (strt1 `shiftR` IX_BITS)- !ixes = fromIntegral indx `shiftL` IX_J_BITS + strt `shiftL` J_BITS + fromIntegral i- unsafeWrite new j skip- unsafeWrite new (j+1) ixes+ let !i = indx .&. jMASK+ k = indx `shiftR` jBITS+ strt1 = (k*(30*k + 2*rho i) + byte i) `shiftL` jBITS + idx i+ !strt = intToWord64 (strt1 .&. iXMASK)+ !skip = intToWord64 (strt1 `shiftR` iXBITS)+ !ixes = intToWord64 indx `shiftL` iXJBITS + strt `shiftL` jBITS + intToWord64 i+ MU.unsafeWrite new j skip+ MU.unsafeWrite new (j+1) ixes fill (j+2) (indx+1) else fill j (indx+1)- fill 0 0+ vec <- fill 0 0+ U.unsafeFreeze vec -makeSieves :: Integer -> Integer -> Integer -> Integer -> UArray Int CacheWord -> [PrimeSieve]+makeSieves :: Integer -> Integer -> Integer -> Integer -> U.Vector Word64 -> [PrimeSieve] makeSieves plim sqlim bitOff valOff cache | valOff' < sqlim = let (nc, bs) = runST $ do- cch <- unsafeThaw cache :: ST s (STUArray s Int CacheWord)+ cch <- U.unsafeThaw cache :: ST s (MU.MVector s Word64) bs0 <- slice cch- fcch <- unsafeFreeze cch- fbs0 <- unsafeFreeze bs0+ fcch <- U.unsafeFreeze cch+ fbs0 <- U.unsafeFreeze bs0 return (fcch, fbs0) in PS valOff bs : makeSieves plim sqlim bitOff' valOff' nc | otherwise =@@ -217,162 +193,121 @@ (nc,bs) = runST $ do cch <- growCache bitOff plim cache bs0 <- slice cch- fcch <- unsafeFreeze cch- fbs0 <- unsafeFreeze bs0+ fcch <- U.unsafeFreeze cch+ fbs0 <- U.unsafeFreeze bs0 return (fcch, fbs0) in PS valOff bs : makeSieves plim' sqlim' bitOff' valOff' nc where- valOff' = valOff + fromIntegral sieveRange- bitOff' = bitOff + fromIntegral sieveBits+ valOff' = valOff + intToInteger sieveRange+ bitOff' = bitOff + intToInteger sieveBits -slice :: STUArray s Int CacheWord -> ST s (STUArray s Int Bool)+slice :: MU.MVector s Word64 -> ST s (MU.MVector s Bit) slice cache = do- hi <- snd `fmap` getBounds cache- sieve <- newArray (0,lastIndex) True+ let hi = MU.length cache - 1+ sieve <- MU.replicate (lastIndex + 1) (Bit True) let treat pr | hi < pr = return sieve | otherwise = do- w <- unsafeRead cache pr+ w <- MU.unsafeRead cache pr if w /= 0- then unsafeWrite cache pr (w-1)+ then MU.unsafeWrite cache pr (w-1) else do- ixes <- unsafeRead cache (pr+1)- let !stj = fromIntegral ixes .&. IX_J_MASK -- position of multiple and index of cofactor- !ixw = fromIntegral (ixes `shiftR` IX_J_BITS) -- prime data, up to 41 bits- !i = ixw .&. J_MASK+ ixes <- MU.unsafeRead cache (pr+1)+ let !stj = word64ToInt ixes .&. iXJMASK -- position of multiple and index of cofactor+ !ixw = word64ToInt (ixes `shiftR` iXJBITS) -- prime data, up to 41 bits+ !i = ixw .&. jMASK !k = ixw - i -- On 32-bits, k > 44717396 means overflow is possible in tick- !o = i `shiftL` J_BITS- !j = stj .&. J_MASK -- index of cofactor- !s = stj `shiftR` J_BITS -- index of first multiple to tick off+ !o = i `shiftL` jBITS+ !j = stj .&. jMASK -- index of cofactor+ !s = stj `shiftR` jBITS -- index of first multiple to tick off (n, u) <- tick k o j s- let !skip = fromIntegral (n `shiftR` IX_BITS)- !strt = fromIntegral (n .&. IX_MASK)- unsafeWrite cache pr skip- unsafeWrite cache (pr+1) ((ixes .&. complement IX_J_MASK) .|. strt `shiftL` J_BITS .|. fromIntegral u)+ let !skip = intToWord64 (n `shiftR` iXBITS)+ !strt = intToWord64 (n .&. iXMASK)+ MU.unsafeWrite cache pr skip+ MU.unsafeWrite cache (pr+1) ((ixes .&. complement iXJMASK) .|. strt `shiftL` jBITS .|. intToWord64 u) treat (pr+2) tick stp off j ix | lastIndex < ix = return (ix - sieveBits, j) | otherwise = do- p <- unsafeRead sieve ix- when p (unsafeWrite sieve ix False)- tick stp off ((j+1) .&. J_MASK) (ix + stp*delta j + tau (off+j))+ Bit p <- MU.unsafeRead sieve ix+ when p (MU.unsafeWrite sieve ix (Bit False))+ tick stp off ((j+1) .&. jMASK) (ix + stp*delta j + tau (off+j)) treat 0 -- | Sieve up to bound in one go.-sieveTo :: Integer -> ST s (STUArray s Int Bool)+sieveTo :: Integer -> ST s (MU.MVector s Bit) sieveTo bound = arr where (bytes,lidx) = idxPr bound !mxidx = 8*bytes+lidx mxval :: Integer- mxval = 30*fromIntegral bytes + fromIntegral (rho lidx)+ mxval = 30*intToInteger bytes + intToInteger (rho lidx) !mxsve = integerSquareRoot mxval (kr,r) = idxPr mxsve !svbd = 8*kr+r arr = do- ar <- newArray (0,mxidx) True+ ar <- MU.replicate (mxidx + 1) (Bit True) let start k i = 8*(k*(30*k+2*rho i) + byte i) + idx i tick stp off j ix | mxidx < ix = return () | otherwise = do- p <- unsafeRead ar ix- when p (unsafeWrite ar ix False)- tick stp off ((j+1) .&. J_MASK) (ix + stp*delta j + tau (off+j))+ Bit p <- MU.unsafeRead ar ix+ when p (MU.unsafeWrite ar ix (Bit False))+ tick stp off ((j+1) .&. jMASK) (ix + stp*delta j + tau (off+j)) sift ix | svbd < ix = return ar | otherwise = do- p <- unsafeRead ar ix- when p (do let i = ix .&. J_MASK- k = ix `shiftR` J_BITS- !off = i `shiftL` J_BITS+ Bit p <- MU.unsafeRead ar ix+ when p (do let i = ix .&. jMASK+ k = ix `shiftR` jBITS+ !off = i `shiftL` jBITS !stp = ix - i tick stp off i (start k i)) sift (ix+1) sift 0 -growCache :: Integer -> Integer -> UArray Int CacheWord -> ST s (STUArray s Int CacheWord)+growCache :: Integer -> Integer -> U.Vector Word64 -> ST s (MU.MVector s Word64) growCache offset plim old = do- let (_,num) = bounds old+ let num = U.length old - 1 (bt,ix) = idxPr plim !start = 8*bt+ix+1 !nlim = plim+4800 sieve <- sieveTo nlim -- Implement SieveFromTo for this, it's pretty wasteful when nlim isn't- (_,hi) <- getBounds sieve -- very small anymore+ let hi = MU.length sieve - 1 more <- countFromToWd start hi sieve- new <- unsafeNewArray_ (0,num+2*more) :: ST s (STUArray s Int CacheWord)+ new <- MU.unsafeNew (1 + num + 2 * more) :: ST s (MU.MVector s Word64) let copy i | num < i = return () | otherwise = do- unsafeWrite new i (old `unsafeAt` i)+ MU.unsafeWrite new i (old `U.unsafeIndex` i) copy (i+1) copy 0 let fill j indx | hi < indx = return new | otherwise = do- p <- unsafeRead sieve indx+ Bit p <- MU.unsafeRead sieve indx if p then do- let !i = indx .&. J_MASK+ let !i = indx .&. jMASK k :: Integer- k = fromIntegral (indx `shiftR` J_BITS)- strt0 = ((k*(30*k + fromIntegral (2*rho i))- + fromIntegral (byte i)) `shiftL` J_BITS)- + fromIntegral (idx i)+ k = intToInteger (indx `shiftR` jBITS)+ strt0 = ((k*(30*k + intToInteger (2*rho i))+ + intToInteger (byte i)) `shiftL` jBITS)+ + intToInteger (idx i) strt1 = strt0 - offset- !strt = fromIntegral strt1 .&. IX_MASK- !skip = fromIntegral (strt1 `shiftR` IX_BITS)- !ixes = fromIntegral indx `shiftL` IX_J_BITS .|. strt `shiftL` J_BITS .|. fromIntegral i- unsafeWrite new j skip- unsafeWrite new (j+1) ixes+ !strt = integerToWord64 strt1 .&. iXMASK+ !skip = integerToWord64 (strt1 `shiftR` iXBITS)+ !ixes = intToWord64 indx `shiftL` iXJBITS .|. strt `shiftL` jBITS .|. intToWord64 i+ MU.unsafeWrite new j skip+ MU.unsafeWrite new (j+1) ixes fill (j+2) (indx+1) else fill j (indx+1) fill (num+1) start --- Danger: relies on start and end being the first resp. last--- index in a Word--- Do not use except in growCache and psieveFrom {-# INLINE countFromToWd #-}-countFromToWd :: Int -> Int -> STUArray s Int Bool -> ST s Int-countFromToWd start end ba = do- wa <- (castSTUArray :: STUArray s Int Bool -> ST s (STUArray s Int Word)) ba- let !sb = start `shiftR` WSHFT- !eb = end `shiftR` WSHFT- count !acc i- | eb < i = return acc- | otherwise = do- w <- unsafeRead wa i- count (acc + bitCountWord w) (i+1)- count 0 sb---- count set bits between two indices (inclusive)--- start and end must both be valid indices and start <= end-countFromTo :: Int -> Int -> STUArray s Int Bool -> ST s Int-countFromTo start end ba = do- wa <- (castSTUArray :: STUArray s Int Bool -> ST s (STUArray s Int Word)) ba- let !sb = start `shiftR` WSHFT- !si = start .&. RMASK- !eb = end `shiftR` WSHFT- !ei = end .&. RMASK- count !acc i- | i == eb = do- w <- unsafeRead wa i- return (acc + bitCountWord (w `shiftL` (RMASK - ei)))- | otherwise = do- w <- unsafeRead wa i- count (acc + bitCountWord w) (i+1)- if sb < eb- then do- w <- unsafeRead wa sb- count (bitCountWord (w `shiftR` si)) (sb+1)- else do- w <- unsafeRead wa sb- let !w1 = w `shiftR` si- return (bitCountWord (w1 `shiftL` (RMASK - ei + si)))---- | @'sieveFrom' n@ creates the list of primes not less than @n@.-sieveFrom :: Integer -> [Prime Integer]-sieveFrom n = case psieveFrom n of- ps -> dropWhile ((< n) . unPrime) (ps >>= primeList)+countFromToWd :: Int -> Int -> MU.MVector s Bit -> ST s Int+countFromToWd start end =+ fmap countBits . U.unsafeFreeze . MU.slice start (end - start + 1) -- | @'psieveFrom' n@ creates the list of 'PrimeSieve's starting roughly -- at @n@. Due to the organisation of the sieve, the list may contain@@ -387,136 +322,68 @@ bitOff = 8*k0 start = valOff+7 ssr = integerSquareRoot (start-1) + 1- end1 = start - 6 + fromIntegral sieveRange+ end1 = start - 6 + intToInteger sieveRange plim0 = integerSquareRoot end1 plim = plim0 + 4801 - (plim0 `rem` 4800) sqlim = plim*plim- cache = runSTUArray $ do+ cache = runST $ do sieve <- sieveTo plim- (lo,hi) <- getBounds sieve+ let (lo,hi) = (0, MU.length sieve - 1) pct <- countFromToWd lo hi sieve- new <- unsafeNewArray_ (0,2*pct-1) :: ST s (STUArray s Int CacheWord)+ new <- MU.unsafeNew (2 * pct) :: ST s (MU.MVector s Word64) let fill j indx | hi < indx = return new | otherwise = do- isPr <- unsafeRead sieve indx+ Bit isPr <- MU.unsafeRead sieve indx if isPr then do- let !i = indx .&. J_MASK- !moff = i `shiftL` J_BITS+ let !i = indx .&. jMASK+ !moff = i `shiftL` jBITS k :: Integer- k = fromIntegral (indx `shiftR` J_BITS)- p = 30*k+fromIntegral (rho i)+ k = intToInteger (indx `shiftR` jBITS)+ p = 30*k+intToInteger (rho i) q0 = (start-1) `quot` p- (skp0,q1) = q0 `quotRem` fromIntegral sieveRange+ (skp0,q1) = q0 `quotRem` intToInteger sieveRange (b0,r0) | q1 == 0 = (-1,6) | q1 < 7 = (-1,7)- | otherwise = idxPr (fromIntegral q1 :: Int)+ | otherwise = idxPr (integerToInt q1 :: Int) (b1,r1) | r0 == 7 = (b0+1,0) | otherwise = (b0,r0+1)- b2 = skp0*fromIntegral sieveBytes + fromIntegral b1- strt0 = ((k*(30*b2 + fromIntegral (rho r1))- + b2 * fromIntegral (rho i)- + fromIntegral (mu (moff + r1))) `shiftL` J_BITS)- + fromIntegral (nu (moff + r1))- strt1 = ((k*(30*k + fromIntegral (2*rho i))- + fromIntegral (byte i)) `shiftL` J_BITS)- + fromIntegral (idx i)+ b2 = skp0*intToInteger sieveBytes + intToInteger b1+ strt0 = ((k*(30*b2 + intToInteger (rho r1))+ + b2 * intToInteger (rho i)+ + intToInteger (mu (moff + r1))) `shiftL` jBITS)+ + intToInteger (nu (moff + r1))+ strt1 = ((k*(30*k + intToInteger (2*rho i))+ + intToInteger (byte i)) `shiftL` jBITS)+ + intToInteger (idx i) (strt2,r2) | p < ssr = (strt0 - bitOff,r1) | otherwise = (strt1 - bitOff, i)- !strt = fromIntegral strt2 .&. IX_MASK- !skip = fromIntegral (strt2 `shiftR` IX_BITS)- !ixes = fromIntegral indx `shiftL` IX_J_BITS .|. strt `shiftL` J_BITS .|. fromIntegral r2- unsafeWrite new j skip- unsafeWrite new (j+1) ixes+ !strt = integerToWord64 strt2 .&. iXMASK+ !skip = integerToWord64 (strt2 `shiftR` iXBITS)+ !ixes = intToWord64 indx `shiftL` iXJBITS .|. strt `shiftL` jBITS .|. intToWord64 r2+ MU.unsafeWrite new j skip+ MU.unsafeWrite new (j+1) ixes fill (j+2) (indx+1) else fill j (indx+1)- fill 0 0---- prime counting--nthPrimeCt :: Integer -> Integer-nthPrimeCt 1 = 2-nthPrimeCt 2 = 3-nthPrimeCt 3 = 5-nthPrimeCt 4 = 7-nthPrimeCt 5 = 11-nthPrimeCt 6 = 13-nthPrimeCt n- | n < 1 = error "nthPrimeCt: negative argument"- | n < 200000 = let bd0 = nthPrimeApprox n- bnd = bd0 + bd0 `quot` 32 + 37- !sv = primeSieve bnd- in countToNth (n-3) [sv]- | otherwise = countToNth (n-3) (psieveFrom (intToInteger $ fromInteger n .&. (7 :: Int)))---- find the n-th set bit in a list of PrimeSieves,--- aka find the (n+3)-rd prime-countToNth :: Integer -> [PrimeSieve] -> Integer-countToNth !n ps = runST (countDown n ps)--countDown :: Integer -> [PrimeSieve] -> ST s Integer-countDown !n (ps@(PS v0 bs) : more)- | n > 278734 || (v0 /= 0 && n > 253000) = do- ct <- countAll ps- countDown (n - fromIntegral ct) more- | otherwise = do- stu <- unsafeThaw bs- wa <- (castSTUArray :: STUArray s Int Bool -> ST s (STUArray s Int Word)) stu- let go !k i- | i == sieveWords = countDown k more- | otherwise = do- w <- unsafeRead wa i- let !bc = fromIntegral $ bitCountWord w- if bc < k- then go (k-bc) (i+1)- else let !j = fromIntegral (bc - k)- !px = top w j (fromIntegral bc)- in return (v0 + toPrim (px+(i `shiftL` WSHFT)))- go n 0-countDown _ [] = error "Prime stream ended prematurely"---- count all set bits in a chunk, do it wordwise for speed.-countAll :: PrimeSieve -> ST s Int-countAll (PS _ bs) = do- stu <- unsafeThaw bs- wa <- (castSTUArray :: STUArray s Int Bool -> ST s (STUArray s Int Word)) stu- let go !ct i- | i == sieveWords = return ct- | otherwise = do- w <- unsafeRead wa i- go (ct + bitCountWord w) (i+1)- go 0 0---- Find the j-th highest of bc set bits in the Word w.-top :: Word -> Int -> Int -> Int-top w j bc = go 0 TOPB TOPM bn w- where- !bn = bc-j- go !_ _ !_ !_ 0 = error "Too few bits set"- go bs 0 _ _ wd = if wd .&. 1 == 0 then error "Too few bits, shift 0" else bs- go bs a msk ix wd =- case bitCountWord (wd .&. msk) of- lc | lc < ix -> go (bs+a) a msk (ix-lc) (wd `uncheckedShiftR` a)- | otherwise ->- let !na = a `shiftR` 1- in go bs na (msk `uncheckedShiftR` na) ix wd+ vec <- fill 0 0+ U.unsafeFreeze vec {-# INLINE delta #-} delta :: Int -> Int-delta i = unsafeAt deltas i+delta = U.unsafeIndex deltas -deltas :: UArray Int Int-deltas = listArray (0,7) [4,2,4,2,4,6,2,6]+deltas :: U.Vector Int+deltas = U.fromList [4,2,4,2,4,6,2,6] {-# INLINE tau #-} tau :: Int -> Int-tau i = unsafeAt taus i+tau = U.unsafeIndex taus -taus :: UArray Int Int-taus = listArray (0,63)+taus :: U.Vector Int+taus = U.fromList [ 7, 4, 7, 4, 7, 12, 3, 12 , 12, 6, 11, 6, 12, 18, 5, 18 , 14, 7, 13, 7, 14, 21, 7, 21@@ -529,28 +396,28 @@ {-# INLINE byte #-} byte :: Int -> Int-byte i = unsafeAt startByte i+byte = U.unsafeIndex startByte -startByte :: UArray Int Int-startByte = listArray (0,7) [1,3,5,9,11,17,27,31]+startByte :: U.Vector Int+startByte = U.fromList [1,3,5,9,11,17,27,31] {-# INLINE idx #-} idx :: Int -> Int-idx i = unsafeAt startIdx i+idx = U.unsafeIndex startIdx -startIdx :: UArray Int Int-startIdx = listArray (0,7) [4,7,4,4,7,4,7,7]+startIdx :: U.Vector Int+startIdx = U.fromList [4,7,4,4,7,4,7,7] {-# INLINE mu #-} mu :: Int -> Int-mu i = unsafeAt mArr i+mu = U.unsafeIndex mArr {-# INLINE nu #-} nu :: Int -> Int-nu i = unsafeAt nArr i+nu = U.unsafeIndex nArr -mArr :: UArray Int Int-mArr = listArray (0,63)+mArr :: U.Vector Int+mArr = U.fromList [ 1, 2, 2, 3, 4, 5, 6, 7 , 2, 3, 4, 6, 6, 8, 10, 11 , 2, 4, 5, 7, 8, 9, 12, 13@@ -561,8 +428,8 @@ , 7, 11, 13, 17, 19, 23, 29, 31 ] -nArr :: UArray Int Int-nArr = listArray (0,63)+nArr :: U.Vector Int+nArr = U.fromList [ 4, 3, 7, 6, 2, 1, 5, 0 , 3, 7, 5, 0, 6, 2, 4, 1 , 7, 5, 4, 1, 0, 6, 3, 2
Math/NumberTheory/Primes/Sieve/Indexing.hs view
@@ -6,17 +6,14 @@ -- -- Auxiliary stuff, conversion between number and index, -- remainders modulo 30 and related things.-{-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Primes.Sieve.Indexing ( idxPr , toPrim , rho ) where -import Data.Array.Unboxed import Data.Bits--import Math.NumberTheory.Unsafe+import qualified Data.Vector.Unboxed as U {-# INLINE idxPr #-} idxPr :: Integral a => a -> (Int,Int)@@ -24,8 +21,8 @@ | n0 < 7 = (0, 0) | otherwise = (fromIntegral bytes0, rm3) where- n = if (fromIntegral n0 .&. 1 == (1 :: Int))- then n0 else (n0-1)+ n = if fromIntegral n0 .&. 1 == (1 :: Int)+ then n0 else n0 - 1 (bytes0,rm0) = (n-7) `quotRem` 30 rm1 = fromIntegral rm0 rm2 = rm1 `quot` 3@@ -40,7 +37,7 @@ {-# INLINE rho #-} rho :: Int -> Int-rho i = unsafeAt residues i+rho = U.unsafeIndex residues -residues :: UArray Int Int-residues = listArray (0,7) [7,11,13,17,19,23,29,31]+residues :: U.Vector Int+residues = U.fromList [7,11,13,17,19,23,29,31]
+ Math/NumberTheory/Primes/Small.hs view
@@ -0,0 +1,56 @@+-- |+-- Module: Math.NumberTheory.Primes.Small+-- Copyright: (c) 2019 Andrew Lelechenko+-- Licence: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- This is an internal module,+-- defining an array of precalculated primes < 2^16.+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}++module Math.NumberTheory.Primes.Small+ ( smallPrimesPtr+ , smallPrimesLength+ , smallPrimesFromTo+ ) where++import GHC.Exts hiding (fromList)+import GHC.Word++smallPrimesFromTo :: Word16 -> Word16 -> [Word16]+smallPrimesFromTo from to = go k0#+ where+ !(Ptr smallPrimesAddr#) = smallPrimesPtr+ !(D# fromD#) = fromIntegral from+ k0#+ | from <= 5+ = 0#+ | otherwise+ = double2Int# (fromD# /## logDouble# fromD#)++ go k#+ | I# k# >= smallPrimesLength+ = []+ | p > to+ = []+ | p < from+ = go (k# +# 1#)+ | otherwise+ = p : go (k# +# 1#)+ where+ p = W16# (indexWord16OffAddr# smallPrimesAddr# k#)++-- length smallPrimes+smallPrimesLength :: Int+smallPrimesLength = 6542++-- concatMap (\x -> map Data.Char.chr [x `mod` 256, x `quot` 256]) smallPrimes+smallPrimesPtr :: Ptr Word16+smallPrimesPtr = Ptr "\STX\NUL\ETX\NUL\ENQ\NUL\a\NUL\v\NUL\r\NUL\DC1\NUL\DC3\NUL\ETB\NUL\GS\NUL\US\NUL%\NUL)\NUL+\NUL/\NUL5\NUL;\NUL=\NULC\NULG\NULI\NULO\NULS\NULY\NULa\NULe\NULg\NULk\NULm\NULq\NUL\DEL\NUL\131\NUL\137\NUL\139\NUL\149\NUL\151\NUL\157\NUL\163\NUL\167\NUL\173\NUL\179\NUL\181\NUL\191\NUL\193\NUL\197\NUL\199\NUL\211\NUL\223\NUL\227\NUL\229\NUL\233\NUL\239\NUL\241\NUL\251\NUL\SOH\SOH\a\SOH\r\SOH\SI\SOH\NAK\SOH\EM\SOH\ESC\SOH%\SOH3\SOH7\SOH9\SOH=\SOHK\SOHQ\SOH[\SOH]\SOHa\SOHg\SOHo\SOHu\SOH{\SOH\DEL\SOH\133\SOH\141\SOH\145\SOH\153\SOH\163\SOH\165\SOH\175\SOH\177\SOH\183\SOH\187\SOH\193\SOH\201\SOH\205\SOH\207\SOH\211\SOH\223\SOH\231\SOH\235\SOH\243\SOH\247\SOH\253\SOH\t\STX\v\STX\GS\STX#\STX-\STX3\STX9\STX;\STXA\STXK\STXQ\STXW\STXY\STX_\STXe\STXi\STXk\STXw\STX\129\STX\131\STX\135\STX\141\STX\147\STX\149\STX\161\STX\165\STX\171\STX\179\STX\189\STX\197\STX\207\STX\215\STX\221\STX\227\STX\231\STX\239\STX\245\STX\249\STX\SOH\ETX\ENQ\ETX\DC3\ETX\GS\ETX)\ETX+\ETX5\ETX7\ETX;\ETX=\ETXG\ETXU\ETXY\ETX[\ETX_\ETXm\ETXq\ETXs\ETXw\ETX\139\ETX\143\ETX\151\ETX\161\ETX\169\ETX\173\ETX\179\ETX\185\ETX\199\ETX\203\ETX\209\ETX\215\ETX\223\ETX\229\ETX\241\ETX\245\ETX\251\ETX\253\ETX\a\EOT\t\EOT\SI\EOT\EM\EOT\ESC\EOT%\EOT'\EOT-\EOT?\EOTC\EOTE\EOTI\EOTO\EOTU\EOT]\EOTc\EOTi\EOT\DEL\EOT\129\EOT\139\EOT\147\EOT\157\EOT\163\EOT\169\EOT\177\EOT\189\EOT\193\EOT\199\EOT\205\EOT\207\EOT\213\EOT\225\EOT\235\EOT\253\EOT\255\EOT\ETX\ENQ\t\ENQ\v\ENQ\DC1\ENQ\NAK\ENQ\ETB\ENQ\ESC\ENQ'\ENQ)\ENQ/\ENQQ\ENQW\ENQ]\ENQe\ENQw\ENQ\129\ENQ\143\ENQ\147\ENQ\149\ENQ\153\ENQ\159\ENQ\167\ENQ\171\ENQ\173\ENQ\179\ENQ\191\ENQ\201\ENQ\203\ENQ\207\ENQ\209\ENQ\213\ENQ\219\ENQ\231\ENQ\243\ENQ\251\ENQ\a\ACK\r\ACK\DC1\ACK\ETB\ACK\US\ACK#\ACK+\ACK/\ACK=\ACKA\ACKG\ACKI\ACKM\ACKS\ACKU\ACK[\ACKe\ACKy\ACK\DEL\ACK\131\ACK\133\ACK\157\ACK\161\ACK\163\ACK\173\ACK\185\ACK\187\ACK\197\ACK\205\ACK\211\ACK\217\ACK\223\ACK\241\ACK\247\ACK\251\ACK\253\ACK\t\a\DC3\a\US\a'\a7\aE\aK\aO\aQ\aU\aW\aa\am\as\ay\a\139\a\141\a\157\a\159\a\181\a\187\a\195\a\201\a\205\a\207\a\211\a\219\a\225\a\235\a\237\a\247\a\ENQ\b\SI\b\NAK\b!\b#\b'\b)\b3\b?\bA\bQ\bS\bY\b]\b_\bi\bq\b\131\b\155\b\159\b\165\b\173\b\189\b\191\b\195\b\203\b\219\b\221\b\225\b\233\b\239\b\245\b\249\b\ENQ\t\a\t\GS\t#\t%\t+\t/\t5\tC\tI\tM\tO\tU\tY\t_\tk\tq\tw\t\133\t\137\t\143\t\155\t\163\t\169\t\173\t\199\t\217\t\227\t\235\t\239\t\245\t\247\t\253\t\DC3\n\US\n!\n1\n9\n=\nI\nW\na\nc\ng\no\nu\n{\n\DEL\n\129\n\133\n\139\n\147\n\151\n\153\n\159\n\169\n\171\n\181\n\189\n\193\n\207\n\217\n\229\n\231\n\237\n\241\n\243\n\ETX\v\DC1\v\NAK\v\ESC\v#\v)\v-\v?\vG\vQ\vW\v]\ve\vo\v{\v\137\v\141\v\147\v\153\v\155\v\183\v\185\v\195\v\203\v\207\v\221\v\225\v\233\v\245\v\251\v\a\f\v\f\DC1\f%\f/\f1\fA\f[\f_\fa\fm\fs\fw\f\131\f\137\f\145\f\149\f\157\f\179\f\181\f\185\f\187\f\199\f\227\f\229\f\235\f\241\f\247\f\251\f\SOH\r\ETX\r\SI\r\DC3\r\US\r!\r+\r-\r=\r?\rO\rU\ri\ry\r\129\r\133\r\135\r\139\r\141\r\163\r\171\r\183\r\189\r\199\r\201\r\205\r\211\r\213\r\219\r\229\r\231\r\243\r\253\r\255\r\t\SO\ETB\SO\GS\SO!\SO'\SO/\SO5\SO;\SOK\SOW\SOY\SO]\SOk\SOq\SOu\SO}\SO\135\SO\143\SO\149\SO\155\SO\177\SO\183\SO\185\SO\195\SO\209\SO\213\SO\219\SO\237\SO\239\SO\249\SO\a\SI\v\SI\r\SI\ETB\SI%\SI)\SI1\SIC\SIG\SIM\SIO\SIS\SIY\SI[\SIg\SIk\SI\DEL\SI\149\SI\161\SI\163\SI\167\SI\173\SI\179\SI\181\SI\187\SI\209\SI\211\SI\217\SI\233\SI\239\SI\251\SI\253\SI\ETX\DLE\SI\DLE\US\DLE!\DLE%\DLE+\DLE9\DLE=\DLE?\DLEQ\DLEi\DLEs\DLEy\DLE{\DLE\133\DLE\135\DLE\145\DLE\147\DLE\157\DLE\163\DLE\165\DLE\175\DLE\177\DLE\187\DLE\193\DLE\201\DLE\231\DLE\241\DLE\243\DLE\253\DLE\ENQ\DC1\v\DC1\NAK\DC1'\DC1-\DC19\DC1E\DC1G\DC1Y\DC1_\DC1c\DC1i\DC1o\DC1\129\DC1\131\DC1\141\DC1\155\DC1\161\DC1\165\DC1\167\DC1\171\DC1\195\DC1\197\DC1\209\DC1\215\DC1\231\DC1\239\DC1\245\DC1\251\DC1\r\DC2\GS\DC2\US\DC2#\DC2)\DC2+\DC21\DC27\DC2A\DC2G\DC2S\DC2_\DC2q\DC2s\DC2y\DC2}\DC2\143\DC2\151\DC2\175\DC2\179\DC2\181\DC2\185\DC2\191\DC2\193\DC2\205\DC2\209\DC2\223\DC2\253\DC2\a\DC3\r\DC3\EM\DC3'\DC3-\DC37\DC3C\DC3E\DC3I\DC3O\DC3W\DC3]\DC3g\DC3i\DC3m\DC3{\DC3\129\DC3\135\DC3\139\DC3\145\DC3\147\DC3\157\DC3\159\DC3\175\DC3\187\DC3\195\DC3\213\DC3\217\DC3\223\DC3\235\DC3\237\DC3\243\DC3\249\DC3\255\DC3\ESC\DC4!\DC4/\DC43\DC4;\DC4E\DC4M\DC4Y\DC4k\DC4o\DC4q\DC4u\DC4\141\DC4\153\DC4\159\DC4\161\DC4\177\DC4\183\DC4\189\DC4\203\DC4\213\DC4\227\DC4\231\DC4\ENQ\NAK\v\NAK\DC1\NAK\ETB\NAK\US\NAK%\NAK)\NAK+\NAK7\NAK=\NAKA\NAKC\NAKI\NAK_\NAKe\NAKg\NAKk\NAK}\NAK\DEL\NAK\131\NAK\143\NAK\145\NAK\151\NAK\155\NAK\181\NAK\187\NAK\193\NAK\197\NAK\205\NAK\215\NAK\247\NAK\a\SYN\t\SYN\SI\SYN\DC3\SYN\NAK\SYN\EM\SYN\ESC\SYN%\SYN3\SYN9\SYN=\SYNE\SYNO\SYNU\SYNi\SYNm\SYNo\SYNu\SYN\147\SYN\151\SYN\159\SYN\169\SYN\175\SYN\181\SYN\189\SYN\195\SYN\207\SYN\211\SYN\217\SYN\219\SYN\225\SYN\229\SYN\235\SYN\237\SYN\247\SYN\249\SYN\t\ETB\SI\ETB#\ETB'\ETB3\ETBA\ETB]\ETBc\ETBw\ETB{\ETB\141\ETB\149\ETB\155\ETB\159\ETB\165\ETB\179\ETB\185\ETB\191\ETB\201\ETB\203\ETB\213\ETB\225\ETB\233\ETB\243\ETB\245\ETB\255\ETB\a\CAN\DC3\CAN\GS\CAN5\CAN7\CAN;\CANC\CANI\CANM\CANU\CANg\CANq\CANw\CAN}\CAN\DEL\CAN\133\CAN\143\CAN\155\CAN\157\CAN\167\CAN\173\CAN\179\CAN\185\CAN\193\CAN\199\CAN\209\CAN\215\CAN\217\CAN\223\CAN\229\CAN\235\CAN\245\CAN\253\CAN\NAK\EM\ESC\EM1\EM3\EME\EMI\EMQ\EM[\EMy\EM\129\EM\147\EM\151\EM\153\EM\163\EM\169\EM\171\EM\177\EM\181\EM\199\EM\207\EM\219\EM\237\EM\253\EM\ETX\SUB\ENQ\SUB\DC1\SUB\ETB\SUB!\SUB#\SUB-\SUB/\SUB5\SUB?\SUBM\SUBQ\SUBi\SUBk\SUB{\SUB}\SUB\135\SUB\137\SUB\147\SUB\167\SUB\171\SUB\173\SUB\177\SUB\185\SUB\201\SUB\207\SUB\213\SUB\215\SUB\227\SUB\243\SUB\251\SUB\255\SUB\ENQ\ESC#\ESC%\ESC/\ESC1\ESC7\ESC;\ESCA\ESCG\ESCO\ESCU\ESCY\ESCe\ESCk\ESCs\ESC\DEL\ESC\131\ESC\145\ESC\157\ESC\167\ESC\191\ESC\197\ESC\209\ESC\215\ESC\217\ESC\239\ESC\247\ESC\t\FS\DC3\FS\EM\FS'\FS+\FS-\FS3\FS=\FSE\FSK\FSO\FSU\FSs\FS\129\FS\139\FS\141\FS\153\FS\163\FS\165\FS\181\FS\183\FS\201\FS\225\FS\243\FS\249\FS\t\GS\ESC\GS!\GS#\GS5\GS9\GS?\GSA\GSK\GSS\GS]\GSc\GSi\GSq\GSu\GS{\GS}\GS\135\GS\137\GS\149\GS\153\GS\159\GS\165\GS\167\GS\179\GS\183\GS\197\GS\215\GS\219\GS\225\GS\245\GS\249\GS\SOH\RS\a\RS\v\RS\DC3\RS\ETB\RS%\RS+\RS/\RS=\RSI\RSM\RSO\RSm\RSq\RS\137\RS\143\RS\149\RS\161\RS\173\RS\187\RS\193\RS\197\RS\199\RS\203\RS\221\RS\227\RS\239\RS\247\RS\253\RS\SOH\US\r\US\SI\US\ESC\US9\USI\USK\USQ\USg\USu\US{\US\133\US\145\US\151\US\153\US\157\US\165\US\175\US\181\US\187\US\211\US\225\US\231\US\235\US\243\US\255\US\DC1 \ESC \GS ' ) - 3 G M Q _ c e i w } \137 \161 \171 \177 \185 \195 \197 \227 \231 \237 \239 \251 \255 \r!\DC3!5!A!I!O!Y\ENQ)\DC1)!)#)?)G)])e)i)o)u)\131)\135)\143)\155)\161)\167)\171)\191)\195)\213)\215)\227)\233)\237)\243)\SOH*\DC3*\GS*%*/*O*U*_*e*k*m*s*\131*\137*\139*\151*\157*\185*\187*\197*\205*\221*\227*\235*\241*\251*\DC3+'+1+3+=+?+K+O+U+i+m+o+{+\141+\151+\153+\163+\165+\169+\189+\205+\231+\235+\243+\249+\253+\t,\SI,\ETB,#,/,5,9,A,W,Y,i,w,\129,\135,\147,\159,\173,\179,\183,\203,\207,\219,\225,\227,\233,\239,\255,\a-\GS-\US-;-C-I-M-a-e-q-\137-\157-\161-\169-\179-\181-\197-\199-\211-\223-\SOH.\ETX.\a.\r.\EM.\US.%.-.3.7.9.?.W.[.o.y.\DEL.\133.\147.\151.\157.\163.\165.\177.\183.\193.\195.\205.\211.\231.\235.\ENQ/\t/\v/\DC1/'/)/A/E/K/M/Q/W/o/u/}/\129/\131/\165/\171/\179/\195/\207/\209/\219/\221/\231/\237/\245/\249/\SOH0\r0#0)070;0U0Y0[0g0q0y0}0\133\&0\145\&0\149\&0\163\&0\169\&0\185\&0\191\&0\199\&0\203\&0\209\&0\215\&0\223\&0\229\&0\239\&0\251\&0\253\&0\ETX1\t1\EM1!1'1-191C1E1K1]1a1g1m1s1\DEL1\145\&1\153\&1\159\&1\169\&1\177\&1\195\&1\199\&1\213\&1\219\&1\237\&1\247\&1\255\&1\t2\NAK2\ETB2\GS2)252Y2]2c2k2o2u2w2{2\141\&2\153\&2\159\&2\167\&2\173\&2\179\&2\183\&2\201\&2\203\&2\207\&2\209\&2\233\&2\237\&2\243\&2\249\&2\a3%3+3/353A3G3[3_3g3k3s3y3\DEL3\131\&3\161\&3\163\&3\173\&3\185\&3\193\&3\203\&3\211\&3\235\&3\241\&3\253\&3\SOH4\SI4\DC34\EM4\ESC474E4U4W4c4i4m4\129\&4\139\&4\145\&4\151\&4\157\&4\165\&4\175\&4\187\&4\201\&4\211\&4\225\&4\241\&4\255\&4\t5\ETB5\GS5-535;5A5Q5e5o5q5w5{5}5\129\&5\141\&5\143\&5\153\&5\155\&5\161\&5\183\&5\189\&5\191\&5\195\&5\213\&5\221\&5\231\&5\239\&5\ENQ6\a6\DC16#6165676;6M6O6S6Y6a6k6m6\139\&6\143\&6\173\&6\175\&6\185\&6\187\&6\205\&6\209\&6\227\&6\233\&6\247\&6\SOH7\ETX7\a7\ESC7?7E7I7O7]7a7u7\DEL7\141\&7\163\&7\169\&7\171\&7\201\&7\213\&7\223\&7\241\&7\243\&7\247\&7\ENQ8\v8!83858A8G8K8S8W8_8e8o8q8}8\143\&8\153\&8\167\&8\183\&8\197\&8\201\&8\207\&8\213\&8\215\&8\221\&8\225\&8\227\&8\255\&8\SOH9\GS9#9%9)9/9=9A9M9[9k9y9}9\131\&9\139\&9\145\&9\149\&9\155\&9\161\&9\167\&9\175\&9\179\&9\187\&9\191\&9\205\&9\221\&9\229\&9\235\&9\239\&9\251\&9\ETX:\DC3:\NAK:\US:':+:1:K:Q:[:c:g:m:y:\135:\165:\169:\183:\205:\213:\225:\229:\235:\243:\253:\ETX;\DC1;\ESC;!;#;-;9;E;S;Y;_;q;{;\129;\137;\155;\159;\165;\167;\173;\183;\185;\195;\203;\209;\215;\225;\227;\245;\255;\SOH<\r<\DC1<\ETB<\US<)<5<C<O<S<[<e<k<q<\133<\137<\151<\167<\181<\191<\199<\209<\221<\223<\241<\247<\ETX=\r=\EM=\ESC=\US=!=-=3=7=?=C=o=s=u=y={=\133=\145=\151=\157=\171=\175=\181=\187=\193=\201=\207=\243=\ENQ>\t>\SI>\DC1>\GS>#>)>/>3>A>W>c>e>w>\129>\135>\161>\185>\189>\191>\195>\197>\201>\215>\219>\225>\231>\239>\255>\v?\r?7?;?=?A?Y?_?e?g?y?}?\139?\145?\173?\191?\205?\211?\221?\233?\235?\241?\253?\ESC@!@%@+@1@?@C@E@]@a@g@m@\135@\145@\163@\169@\177@\183@\189@\219@\223@\235@\247@\249@\tA\vA\DC1A\NAKA!A3A5A;A?AYAeAkAwA{A\147A\171A\183A\189A\191A\203A\231A\239A\243A\249A\ENQB\aB\EMB\USB#B)B/BCBSBUB[BaBsB}B\131B\133B\137B\145B\151B\157B\181B\197B\203B\211B\221B\227B\241B\aC\SIC\USC%C'C3C7C9COCWCiC\139C\141C\147C\165C\169C\175C\181C\189C\199C\207C\225C\231C\235C\237C\241C\249C\tD\vD\ETBD#D)D;D?DEDKDQDSDYDeDoD\131D\143D\161D\165D\171D\173D\189D\191D\201D\215D\219D\249D\251D\ENQE\DC1E\DC3E+E1EAEIESEUEaEwE}E\DELE\143E\163E\173E\175E\187E\199E\217E\227E\239E\245E\247E\SOHF\ETXF\tF\DC3F%F'F3F9F=FCFEF]FyF{F\DELF\129F\139F\141F\157F\169F\177F\199F\201F\207F\211F\213F\223F\229F\249F\ENQG\SIG\ETBG#G)G/G5G9GKGMGQG]GoGqG}G\131G\135G\137G\153G\165G\177G\191G\195G\203G\221G\225G\237G\251G\SOHH\aH\vH\DC3H\EMH\GSH1H=HGHUHYH[HkHmHyH\151H\155H\161H\185H\205H\229H\239H\247H\ETXI\rI\EMI\USI+I7I=IEIUIcIiImIsI\151I\171I\181I\211I\223I\225I\229I\231I\ETXJ\SIJ\GSJ#J9JAJEJWJ]JkJ}J\129J\135J\137J\143J\177J\195J\197J\213J\219J\237J\239J\aK\vK\rK\DC3K\USK%K1K;KCKIKYKeKmKwK\133K\173K\179K\181K\187K\191K\203K\217K\221K\223K\227K\229K\233K\241K\247K\SOHL\aL\rL\SIL\NAKL\ESCL!L-L3LKLULWLaLgLsLyL\DELL\141L\147L\153L\205L\225L\231L\241L\243L\253L\ENQM\SIM\ESCM'M)M/M3MAMQMYMeMkM\129M\131M\141M\149M\155M\177M\179M\201M\207M\215M\225M\237M\249M\251M\ENQN\vN\ETBN\EMN\GSN+N5N7N=NONSN_NgNyN\133N\139N\145N\149N\155N\161N\175N\179N\181N\193N\205N\209N\215N\233N\251N\aO\tO\EMO%O-O?OIOcOgOmOuO{O\129O\133O\135O\145O\165O\169O\175O\183O\187O\207O\217O\219O\253O\255O\ETXP\ESCP\GSP)P5P?PEPGPSPqPwP\131P\147P\159P\161P\183P\201P\213P\227P\237P\239P\251P\aQ\vQ\rQ\DC1Q\ETBQ#Q%Q5QGQIQqQyQ\137Q\143Q\151Q\161Q\163Q\167Q\185Q\193Q\203Q\211Q\223Q\227Q\245Q\247Q\tR\DC3R\NAKR\EMR\ESCR\USR'RCRERKRaRmRsR\129R\147R\151R\157R\165R\171R\177R\187R\195R\199R\201R\219R\229R\235R\255R\NAKS\GSS#SASESGSKS]ScS\129S\131S\135S\143S\149S\153S\159S\171S\185S\219S\233S\239S\243S\245S\251S\255S\rT\DC1T\DC3T\EMT5T7T;TATITSTUT_TaTkTmTqT\143T\145T\157T\169T\179T\197T\209T\223T\233T\235T\247T\253T\aU\rU\ESCU'U+U9U=UOUQU[UcUgUoUyU\133U\151U\169U\177U\183U\201U\217U\231U\237U\243U\253U\vV\SIV\NAKV\ETBV#V/V3V9V?VKVMV]V_VkVqVuV\131V\137V\141V\143V\155V\173V\177V\213V\231V\243V\255V\SOHW\ENQW\aW\vW\DC3W\USW#WGWMW_WaWmWwW}W\137W\161W\169W\175W\181W\197W\209W\211W\229W\239W\ETXX\rX\SIX\NAKX'X+X-XUX[X]XmXoXsX{X\141X\151X\163X\169X\171X\181X\189X\193X\199X\211X\213X\223X\241X\249X\255X\ETXY\ETBY\ESCY!YEYKYMYWY]YuY{Y\137Y\153Y\159Y\177Y\179Y\189Y\209Y\219Y\227Y\233Y\237Y\243Y\245Y\255Y\SOHZ\rZ\DC1Z\DC3Z\ETBZ\USZ)Z/Z;ZMZ[ZgZwZ\DELZ\133Z\149Z\157Z\161Z\163Z\169Z\187Z\211Z\229Z\239Z\251Z\253Z\SOH[\SI[\EM[\US[%[+[=[I[K[g[y[\135[\151[\163[\177[\201[\213[\235[\241[\243[\253[\ENQ\\\t\\\v\\\SI\\\GS\\)\\/\\3\\9\\G\\K\\M\\Q\\o\\u\\w\\}\\\135\\\137\\\167\\\189\\\191\\\195\\\201\\\209\\\215\\\221\\\237\\\249\\\ENQ]\v]\DC3]\ETB]\EM]1]=]A]G]O]U][]e]g]m]y]\149]\163]\169]\173]\185]\193]\199]\211]\215]\221]\235]\241]\253]\a^\r^\DC3^\ESC^!^'^+^-^1^9^E^I^W^i^s^u^\133^\139^\159^\165^\175^\183^\187^\217^\253^\t_\DC1_'_3_5_;_G_W_]_c_e_w_{_\149_\153_\161_\179_\189_\197_\207_\213_\227_\231_\251_\DC1`#`/`7`S`_`e`k`s`y`\133`\157`\173`\187`\191`\205`\217`\223`\233`\245`\ta\SIa\DC3a\ESCa-a9aKaUaWa[aoaya\135a\139a\145a\147a\157a\181a\199a\201a\205a\225a\241a\255a\tb\ETBb\GSb!b'b;bAbKbQbSb_beb\131b\141b\149b\155b\159b\165b\173b\213b\215b\219b\221b\233b\251b\255b\ENQc\rc\ETBc\GSc/cAcCcOc_cgcmcqcwc}c\DELc\179c\193c\197c\217c\233c\235c\239c\245c\SOHd\ETXd\td\NAKd!d'd+d9dCdIdOd]dgdud\133d\141d\147d\159d\163d\171d\193d\199d\201d\219d\241d\247d\249d\ve\DC1e!e/e9e?eKeMeSeWe_eqe}e\141e\143e\147e\161e\165e\173e\185e\197e\227e\243e\251e\255e\SOHf\af\GSf)f1f;fAfGfMf[fafsf}f\137f\139f\149f\151f\155f\181f\185f\197f\205f\209f\227f\235f\245f\ETXg\DC3g\EMg\USg'g1g7g?gEgQg[gogyg\129g\133g\145g\171g\189g\193g\205g\223g\229g\ETXh\th\DC1h\ETBh-h9h;h?hEhKhMhWhYh]hchihkhqh\135h\153h\159h\177h\189h\197h\209h\215h\225h\237h\239h\255h\SOHi\vi\ri\ETBi)i/iCiGiIiOieikiqi\131i\137i\151i\163i\179i\181i\187i\193i\197i\211i\223i\227i\229i\247i\aj+j7j=jKjgjijuj{j\135j\141j\145j\147j\163j\193j\201j\225j\231j\ENQk\SIk\DC1k#k'k-k9kAkWkYk_kuk\135k\137k\147k\149k\159k\189k\191k\219k\225k\239k\255k\ENQl\EMl)l+l1l5lUlYl[l_lelglslwl}l\131l\143l\145l\151l\155l\161l\169l\175l\179l\199l\203l\235l\245l\253l\rm\SIm%m'm+m1m9m?mOm]mamsm{m\DELm\147m\153m\165m\177m\183m\193m\195m\205m\207m\219m\247m\ETXn\NAKn\ETBn)n3n;nEnunwn{n\129n\137n\147n\149n\159n\189n\191n\227n\233n\243n\249n\251n\ro\DC1o\ETBo\USo/o=oMoSoaoeoyo}o\131o\133o\143o\155o\157o\163o\175o\181o\187o\191o\203o\205o\211o\215o\227o\233o\241o\245o\247o\253o\SIp\EMp\USp'p3p9pOpQpWpcpupyp\135p\141p\145p\165p\171p\187p\195p\199p\207p\229p\237p\249p\255p\ENQq\NAKq!q3qQqYq]q_qcqiq\131q\135q\149q\173q\195q\201q\203q\209q\219q\225q\239q\245q\251q\ar\DC1r\ETBr\EMr%r/r;rCrUrgrqrwr\DELr\143r\149r\155r\163r\179r\199r\203r\205r\215r\217r\227r\239r\245r\253r\ETXs\rs!s+s=sWs[sas\DELs\129s\133s\141s\147s\159s\171s\189s\193s\201s\223s\229s\231s\243s\NAKt\ESCt-t9t?tAt]tkt{t\137t\141t\155t\167t\171t\177t\183t\185t\221t\225t\231t\251t\au\USu%u;u=uMu_ukuwu\137u\139u\145u\151u\157u\161u\167u\181u\185u\187u\209u\217u\229u\235u\245u\251u\ETXv\SIv!v-v3v=v?vUvcvivovsv\133v\139v\159v\181v\183v\195v\219v\223v\241v\ETXw\ENQw\ESCw\GSw!w-w5wAwKwYw]w_wqw\129w\167w\173w\179w\185w\197w\207w\213w\225w\233w\239w\243w\249w\ax%x+x5x=xSxYxaxmxwxyx\131x\133x\139x\149x\151x\161x\173x\191x\211x\217x\221x\229x\251x\SOHy\ay%y+y9y?yKyWy]ygyiysy\145y\147y\163y\171y\175y\177y\183y\201y\205y\207y\213y\217y\243y\247y\255y\ENQz\SIz\DC1z\NAKz\ESCz#z'z-zKzWzYz_zeziz}z\147z\155z\159z\161z\165z\237z\245z\249z\SOH{\ETB{\EM{\GS{+{5{7{;{O{U{_{q{w{\139{\155{\161{\169{\175{\179{\199{\211{\233{\235{\239{\241{\253{\a|\EM|\ESC|1|7|I|g|i|s|\129|\139|\147|\163|\213|\219|\229|\237|\247|\ETX}\t}\ESC}\GS}3}9};}?}E}M}S}Y}c}u}w}\141}\143}\159}\173}\183}\189}\191}\203}\213}\233}\237}\251}\SOH~\ENQ~)~+~/~5~A~C~G~U~a~g~k~q~s~y~}~\145~\155~\157~\167~\173~\185~\187~\211~\223~\235~\241~\247~\251~\DC3\DEL\NAK\DEL\EM\DEL1\DEL3\DEL9\DEL=\DELC\DELK\DEL[\DELa\DELc\DELm\DELy\DEL\135\DEL\141\DEL\175\DEL\181\DEL\195\DEL\201\DEL\205\DEL\207\DEL\237\DEL\ETX\128\v\128\SI\128\NAK\128\GS\128!\128#\128?\128A\128G\128K\128e\128w\128\141\128\143\128\149\128\165\128\171\128\173\128\189\128\201\128\203\128\215\128\219\128\225\128\231\128\245\128\255\128\ENQ\129\r\129\EM\129\GS\129/\129\&1\129;\129C\129S\129Y\129_\129}\129\DEL\129\137\129\155\129\157\129\167\129\175\129\179\129\187\129\199\129\223\129\a\130\t\130\NAK\130\US\130%\130\&1\130\&3\130?\130C\130E\130I\130O\130a\130o\130{\130\129\130\133\130\147\130\177\130\181\130\189\130\199\130\207\130\213\130\223\130\241\130\249\130\253\130\v\131\ESC\131!\131)\131-\131\&3\131\&5\131?\131A\131M\131Q\131S\131W\131]\131e\131i\131o\131\143\131\167\131\177\131\185\131\203\131\213\131\215\131\221\131\231\131\233\131\237\131\255\131\ENQ\132\DC1\132\DC3\132#\132%\132;\132A\132G\132O\132a\132e\132w\132\131\132\139\132\145\132\149\132\169\132\175\132\205\132\227\132\239\132\241\132\247\132\t\133\r\133K\133O\133Q\133]\133c\133m\133o\133{\133\135\133\163\133\165\133\169\133\183\133\205\133\211\133\213\133\219\133\225\133\235\133\249\133\253\133\255\133\t\134\SI\134\ETB\134!\134/\134\&9\134?\134A\134M\134c\134u\134}\134\135\134\153\134\165\134\167\134\179\134\183\134\195\134\197\134\207\134\209\134\215\134\233\134\239\134\245\134\ETB\135\GS\135\US\135+\135/\135\&5\135G\135Y\135[\135k\135q\135w\135\DEL\135\133\135\143\135\161\135\169\135\179\135\187\135\197\135\199\135\203\135\221\135\247\135\ETX\136\EM\136\ESC\136\US\136!\136\&7\136=\136C\136Q\136a\136g\136{\136\133\136\145\136\147\136\165\136\207\136\211\136\235\136\237\136\243\136\253\136\t\137\v\137\DC1\137\ESC\137#\137'\137-\137\&9\137E\137M\137Q\137W\137c\137\129\137\149\137\155\137\179\137\185\137\195\137\207\137\209\137\219\137\239\137\245\137\251\137\255\137\v\138\EM\138#\138\&5\138A\138I\138O\138[\138_\138m\138w\138y\138\133\138\163\138\179\138\181\138\193\138\199\138\203\138\205\138\209\138\215\138\241\138\245\138\a\139\t\139\r\139\DC3\139!\139W\139]\139\145\139\147\139\163\139\169\139\175\139\187\139\213\139\217\139\219\139\225\139\247\139\253\139\255\139\v\140\ETB\140\GS\140'\140\&9\140;\140G\140S\140]\140o\140{\140\129\140\137\140\143\140\153\140\159\140\167\140\171\140\173\140\177\140\197\140\221\140\227\140\233\140\243\140\SOH\141\v\141\r\141#\141)\141\&7\141A\141[\141_\141q\141y\141\133\141\145\141\155\141\167\141\173\141\181\141\197\141\203\141\211\141\217\141\223\141\245\141\247\141\SOH\142\NAK\142\US\142%\142Q\142c\142i\142s\142u\142y\142\DEL\142\141\142\145\142\171\142\175\142\177\142\189\142\199\142\207\142\211\142\219\142\231\142\235\142\247\142\255\142\NAK\143\GS\143#\143-\143?\143E\143K\143S\143Y\143e\143i\143q\143\131\143\141\143\153\143\159\143\171\143\173\143\179\143\183\143\185\143\201\143\213\143\225\143\239\143\249\143\a\144\r\144\ETB\144#\144%\144\&1\144\&7\144;\144A\144C\144O\144S\144m\144s\144\133\144\139\144\149\144\155\144\157\144\175\144\185\144\193\144\197\144\223\144\233\144\253\144\ETX\145\DC3\145'\145\&3\145=\145E\145O\145Q\145a\145g\145{\145\133\145\153\145\157\145\187\145\189\145\193\145\201\145\217\145\219\145\237\145\241\145\243\145\249\145\ETX\146\NAK\146!\146/\146A\146G\146W\146k\146q\146u\146}\146\131\146\135\146\141\146\153\146\161\146\171\146\173\146\185\146\191\146\195\146\197\146\203\146\213\146\215\146\231\146\243\146\SOH\147\v\147\DC1\147\EM\147\US\147;\147=\147C\147U\147s\147\149\147\151\147\167\147\179\147\181\147\199\147\215\147\221\147\229\147\239\147\247\147\SOH\148\t\148\DC3\148?\148E\148K\148O\148c\148g\148i\148m\148{\148\151\148\159\148\165\148\181\148\195\148\225\148\231\148\ENQ\149\t\149\ETB\149!\149'\149-\149\&5\149\&9\149K\149W\149]\149_\149u\149\129\149\137\149\143\149\155\149\159\149\173\149\177\149\183\149\185\149\189\149\207\149\227\149\233\149\249\149\US\150/\150\&1\150\&5\150;\150=\150e\150\143\150\157\150\161\150\167\150\169\150\193\150\203\150\209\150\211\150\229\150\239\150\251\150\253\150\r\151\SI\151\NAK\151%\151+\151\&3\151\&7\151\&9\151C\151I\151Q\151[\151]\151o\151\DEL\151\135\151\147\151\165\151\177\151\183\151\195\151\205\151\211\151\217\151\235\151\247\151\ENQ\152\t\152\v\152\NAK\152)\152/\152;\152A\152Q\152k\152o\152\129\152\131\152\135\152\167\152\177\152\185\152\191\152\195\152\201\152\207\152\221\152\227\152\245\152\249\152\251\152\r\153\ETB\153\US\153)\153\&1\153;\153=\153A\153G\153I\153S\153}\153\133\153\145\153\149\153\155\153\173\153\175\153\191\153\199\153\203\153\205\153\215\153\229\153\241\153\251\153\SI\154\DC3\154\ESC\154%\154K\154O\154U\154W\154a\154u\154\DEL\154\139\154\145\154\157\154\183\154\195\154\199\154\207\154\235\154\243\154\247\154\255\154\ETB\155\GS\155'\155/\155\&5\155E\155Q\155Y\155c\155o\155w\155\141\155\147\155\149\155\159\155\161\155\167\155\177\155\183\155\189\155\197\155\203\155\207\155\221\155\249\155\SOH\156\DC1\156#\156+\156/\156\&5\156I\156M\156_\156e\156g\156\DEL\156\151\156\157\156\163\156\175\156\187\156\191\156\193\156\215\156\217\156\227\156\233\156\241\156\253\156\SOH\157\NAK\157'\157-\157\&1\157=\157U\157[\157a\157\151\157\159\157\165\157\169\157\195\157\231\157\235\157\237\157\241\157\v\158\ETB\158#\158'\158-\158\&3\158;\158G\158Q\158S\158_\158o\158\129\158\135\158\143\158\149\158\161\158\179\158\189\158\191\158\245\158\249\158\251\158\ENQ\159#\159/\159\&7\159;\159C\159S\159a\159m\159s\159w\159}\159\137\159\143\159\145\159\149\159\163\159\175\159\179\159\193\159\199\159\223\159\229\159\235\159\245\159\SOH\160\r\160!\160\&3\160\&9\160?\160O\160W\160[\160a\160u\160y\160\153\160\157\160\171\160\181\160\183\160\189\160\201\160\217\160\219\160\223\160\229\160\241\160\243\160\253\160\ENQ\161\v\161\SI\161\DC1\161\ESC\161)\161/\161\&5\161A\161S\161u\161}\161\135\161\141\161\165\161\171\161\173\161\183\161\195\161\197\161\227\161\237\161\251\161\a\162\DC3\162#\162)\162/\162\&1\162C\162G\162M\162k\162y\162}\162\131\162\137\162\139\162\145\162\149\162\155\162\169\162\175\162\179\162\187\162\197\162\209\162\215\162\247\162\SOH\163\t\163\US\163!\163+\163\&1\163I\163Q\163U\163s\163y\163{\163\135\163\151\163\159\163\165\163\169\163\175\163\183\163\199\163\213\163\219\163\225\163\229\163\231\163\241\163\253\163\255\163\SI\164\GS\164!\164#\164'\164;\164M\164W\164Y\164c\164i\164u\164\147\164\155\164\173\164\185\164\195\164\197\164\203\164\209\164\213\164\225\164\237\164\239\164\243\164\255\164\DC1\165)\165+\165\&5\165;\165C\165S\165[\165a\165m\165w\165\133\165\139\165\151\165\157\165\163\165\167\165\169\165\193\165\197\165\203\165\211\165\217\165\221\165\223\165\227\165\233\165\247\165\251\165\ETX\166\r\166%\166=\166I\166K\166Q\166]\166s\166\145\166\147\166\153\166\171\166\181\166\187\166\193\166\201\166\205\166\207\166\213\166\223\166\231\166\241\166\247\166\255\166\SI\167\NAK\167#\167)\167-\167E\167M\167W\167Y\167e\167k\167o\167\147\167\149\167\171\167\177\167\185\167\191\167\201\167\209\167\215\167\227\167\237\167\251\167\ENQ\168\v\168\GS\168)\168+\168\&7\168;\168U\168_\168m\168}\168\143\168\151\168\169\168\181\168\193\168\199\168\215\168\229\168\253\168\a\169\DC3\169\ESC\169\&1\169\&7\169\&9\169C\169\DEL\169\133\169\135\169\139\169\147\169\163\169\177\169\187\169\193\169\217\169\223\169\235\169\253\169\NAK\170\ETB\170\&5\170\&9\170;\170G\170M\170W\170Y\170]\170k\170q\170\129\170\131\170\141\170\149\170\171\170\191\170\197\170\201\170\233\170\239\170\SOH\171\ENQ\171\a\171\v\171\r\171\DC1\171\EM\171M\171[\171q\171s\171\137\171\157\171\167\171\175\171\185\171\187\171\193\171\197\171\211\171\215\171\221\171\241\171\245\171\251\171\253\171\t\172\NAK\172\ESC\172'\172\&7\172\&9\172E\172O\172W\172[\172a\172c\172\DEL\172\139\172\147\172\157\172\169\172\171\172\175\172\189\172\217\172\225\172\231\172\235\172\237\172\241\172\247\172\249\172\ENQ\173?\173E\173S\173]\173_\173e\173\129\173\161\173\165\173\195\173\203\173\209\173\213\173\219\173\231\173\243\173\245\173\249\173\255\173\ENQ\174\DC3\174#\174+\174I\174M\174O\174Y\174a\174g\174k\174q\174\139\174\143\174\155\174\157\174\167\174\185\174\197\174\209\174\227\174\229\174\233\174\245\174\253\174\t\175\DC3\175'\175+\175\&3\175C\175O\175W\175]\175m\175u\175\DEL\175\139\175\153\175\159\175\163\175\171\175\183\175\187\175\207\175\213\175\253\175\ENQ\176\NAK\176\ESC\176?\176A\176G\176K\176Q\176S\176i\176{\176}\176\135\176\141\176\177\176\191\176\203\176\207\176\225\176\233\176\237\176\251\176\ENQ\177\a\177\DC1\177\EM\177\GS\177\US\177\&1\177A\177M\177[\177e\177s\177y\177\DEL\177\169\177\179\177\185\177\191\177\211\177\221\177\229\177\241\177\245\177\SOH\178\DC3\178\NAK\178\US\178-\178?\178I\178[\178c\178i\178m\178{\178\129\178\139\178\169\178\183\178\189\178\195\178\199\178\211\178\249\178\253\178\255\178\ETX\179\t\179\DC1\179\GS\179'\179-\179?\179E\179w\179}\179\129\179\135\179\147\179\155\179\165\179\197\179\203\179\225\179\227\179\237\179\249\179\v\180\r\180\DC3\180\ETB\180\&5\180=\180C\180I\180[\180e\180g\180k\180w\180\139\180\149\180\157\180\181\180\191\180\193\180\199\180\221\180\227\180\229\180\247\180\SOH\181\r\181\SI\181-\181?\181K\181g\181i\181o\181s\181y\181\135\181\141\181\153\181\163\181\171\181\175\181\187\181\213\181\223\181\231\181\237\181\253\181\255\181\t\182\ESC\182)\182/\182\&3\182\&9\182G\182W\182Y\182_\182c\182o\182\131\182\135\182\155\182\159\182\165\182\177\182\179\182\215\182\219\182\225\182\227\182\237\182\239\182\ENQ\183\r\183\DC3\183\GS\183)\183\&5\183G\183U\183m\183\145\183\149\183\169\183\193\183\203\183\209\183\211\183\239\183\245\183\a\184\SI\184\DC3\184\EM\184!\184'\184+\184-\184\&9\184U\184g\184u\184\133\184\147\184\165\184\175\184\183\184\189\184\193\184\199\184\205\184\213\184\235\184\247\184\249\184\ETX\185\NAK\185\ESC\185\GS\185/\185\&9\185;\185G\185Q\185c\185\131\185\137\185\141\185\147\185\153\185\161\185\167\185\173\185\183\185\203\185\209\185\221\185\231\185\239\185\249\185\a\186\r\186\ETB\186%\186)\186+\186A\186S\186U\186_\186a\186e\186y\186}\186\DEL\186\161\186\163\186\175\186\181\186\191\186\193\186\203\186\221\186\227\186\241\186\253\186\t\187\US\187'\187-\187=\187C\187K\187O\187[\187a\187i\187m\187\145\187\151\187\157\187\177\187\201\187\207\187\219\187\237\187\247\187\249\187\ETX\188\GS\188#\188\&3\188;\188A\188E\188]\188o\188w\188\131\188\143\188\153\188\171\188\183\188\185\188\209\188\213\188\225\188\243\188\255\188\r\189\ETB\189\EM\189\GS\189\&5\189A\189O\189Y\189_\189a\189g\189k\189q\189\139\189\143\189\149\189\155\189\157\189\179\189\187\189\205\189\209\189\227\189\235\189\239\189\a\190\t\190\NAK\190!\190%\190'\190[\190]\190o\190u\190y\190\DEL\190\139\190\141\190\147\190\159\190\169\190\177\190\181\190\183\190\207\190\217\190\219\190\229\190\231\190\243\190\249\190\v\191\&3\191\&9\191M\191]\191_\191k\191q\191{\191\135\191\137\191\141\191\147\191\161\191\173\191\185\191\207\191\213\191\221\191\225\191\227\191\243\191\ENQ\192\DC1\192\DC3\192\EM\192)\192/\192\&1\192\&7\192;\192G\192e\192m\192}\192\DEL\192\145\192\155\192\179\192\181\192\187\192\211\192\215\192\217\192\239\192\241\192\SOH\193\ETX\193\t\193\NAK\193\EM\193+\193\&3\193\&7\193E\193I\193[\193s\193y\193{\193\129\193\139\193\141\193\151\193\189\193\195\193\205\193\219\193\225\193\231\193\255\193\ETX\194\ENQ\194\DC1\194!\194/\194?\194K\194M\194S\194]\194w\194{\194}\194\137\194\143\194\147\194\159\194\167\194\179\194\189\194\207\194\213\194\227\194\255\194\SOH\195\a\195\DC1\195\DC3\195\ETB\195%\195G\195I\195O\195e\195g\195q\195\DEL\195\131\195\133\195\149\195\157\195\167\195\173\195\181\195\191\195\199\195\203\195\209\195\211\195\227\195\233\195\239\195\SOH\196\US\196-\196\&3\196\&7\196U\196W\196a\196o\196s\196\135\196\145\196\153\196\157\196\165\196\183\196\187\196\201\196\207\196\211\196\235\196\241\196\247\196\t\197\ESC\197\GS\197A\197G\197Q\197_\197k\197o\197u\197w\197\149\197\155\197\159\197\161\197\167\197\195\197\215\197\219\197\239\197\251\197\DC3\198#\198\&5\198A\198O\198U\198Y\198e\198\133\198\145\198\151\198\161\198\169\198\179\198\185\198\203\198\205\198\221\198\235\198\241\198\a\199\r\199\EM\199\ESC\199-\199\&1\199\&9\199W\199c\199g\199s\199u\199\DEL\199\165\199\187\199\189\199\193\199\207\199\213\199\225\199\249\199\253\199\255\199\ETX\200\DC1\200\GS\200'\200)\200\&9\200?\200S\200W\200k\200\129\200\141\200\143\200\147\200\149\200\161\200\183\200\207\200\213\200\219\200\221\200\227\200\231\200\237\200\239\200\249\200\ENQ\201\DC1\201\ETB\201\EM\201\US\201/\201\&7\201=\201A\201S\201_\201k\201y\201}\201\137\201\143\201\151\201\157\201\175\201\181\201\191\201\203\201\217\201\223\201\227\201\235\201\SOH\202\a\202\t\202%\202\&7\202\&9\202K\202U\202[\202i\202s\202u\202\DEL\202\141\202\147\202\157\202\159\202\181\202\187\202\195\202\201\202\217\202\229\202\237\202\ETX\203\ENQ\203\t\203\ETB\203)\203\&5\203;\203S\203Y\203c\203e\203q\203\135\203\153\203\159\203\179\203\185\203\195\203\209\203\213\203\215\203\221\203\233\203\255\203\r\204\EM\204\GS\204#\204+\204A\204C\204M\204Y\204a\204\137\204\139\204\145\204\155\204\163\204\167\204\209\204\229\204\233\204\t\205\NAK\205\US\205%\205\&1\205=\205?\205I\205Q\205W\205[\205c\205g\205\129\205\147\205\151\205\159\205\187\205\193\205\211\205\217\205\229\205\231\205\241\205\247\205\253\205\v\206\NAK\206!\206/\206G\206M\206Q\206e\206{\206}\206\143\206\147\206\153\206\165\206\167\206\183\206\201\206\215\206\221\206\227\206\231\206\237\206\245\206\a\207\v\207\EM\207\&7\207;\207M\207U\207_\207a\207e\207m\207y\207}\207\137\207\155\207\157\207\169\207\179\207\181\207\197\207\205\207\209\207\239\207\241\207\247\207\DC3\208\NAK\208\US\208!\208\&3\208=\208K\208O\208i\208o\208\129\208\133\208\153\208\159\208\163\208\171\208\189\208\193\208\205\208\231\208\255\208\ETX\209\ETB\209-\209/\209A\209W\209Y\209]\209i\209k\209q\209w\209}\209\129\209\135\209\149\209\153\209\177\209\189\209\195\209\213\209\215\209\227\209\255\209\r\210\DC1\210\ETB\210\US\210\&5\210;\210G\210Y\210a\210e\210y\210\DEL\210\131\210\137\210\139\210\157\210\163\210\167\210\179\210\191\210\199\210\227\210\233\210\241\210\251\210\253\210\NAK\211!\211+\211C\211K\211U\211i\211u\211{\211\135\211\147\211\151\211\165\211\177\211\201\211\235\211\253\211\ENQ\212\SI\212\NAK\212'\212/\212\&3\212;\212K\212Y\212_\212c\212i\212\129\212\131\212\137\212\141\212\147\212\149\212\165\212\171\212\177\212\197\212\221\212\225\212\227\212\231\212\245\212\249\212\v\213\r\213\DC3\213\US\213#\213\&1\213\&5\213\&7\213I\213Y\213_\213e\213g\213w\213\139\213\145\213\151\213\181\213\185\213\193\213\199\213\223\213\239\213\245\213\251\213\ETX\214\SI\214-\214\&1\214C\214U\214]\214a\214{\214\133\214\135\214\157\214\165\214\175\214\189\214\195\214\199\214\217\214\225\214\237\214\t\215\v\215\DC1\215\NAK\215!\215'\215?\215E\215M\215W\215k\215{\215\131\215\161\215\167\215\173\215\177\215\179\215\189\215\203\215\209\215\219\215\251\215\DC1\216#\216%\216)\216+\216/\216\&7\216M\216U\216g\216s\216\143\216\145\216\161\216\173\216\191\216\205\216\215\216\233\216\245\216\251\216\ESC\217%\217\&3\217\&9\217C\217E\217O\217Q\217W\217m\217o\217s\217y\217\129\217\139\217\145\217\159\217\165\217\169\217\181\217\211\217\235\217\241\217\247\217\255\217\ENQ\218\t\218\v\218\SI\218\NAK\218\GS\218#\218)\218?\218Q\218Y\218]\218_\218q\218w\218{\218}\218\141\218\159\218\179\218\189\218\195\218\201\218\231\218\233\218\245\218\DC1\219\ETB\219\GS\219#\219%\219\&1\219;\219C\219U\219g\219k\219s\219\133\219\143\219\145\219\173\219\175\219\185\219\199\219\203\219\205\219\235\219\247\219\r\220'\220\&1\220\&9\220?\220I\220Q\220a\220o\220u\220{\220\133\220\147\220\153\220\157\220\159\220\169\220\181\220\183\220\189\220\199\220\207\220\211\220\213\220\223\220\249\220\SI\221\NAK\221\ETB\221#\221\&5\221\&9\221S\221W\221_\221i\221o\221}\221\135\221\137\221\155\221\161\221\171\221\191\221\197\221\203\221\207\221\231\221\233\221\237\221\245\221\251\221\v\222\EM\222)\222;\222=\222A\222M\222O\222Y\222[\222a\222m\222w\222}\222\131\222\151\222\157\222\161\222\167\222\205\222\209\222\215\222\227\222\241\222\245\222\SOH\223\t\223\DC3\223\US\223+\223\&3\223\&7\223=\223K\223U\223[\223g\223i\223s\223\133\223\135\223\153\223\163\223\171\223\181\223\183\223\195\223\199\223\213\223\241\223\243\223\ETX\224\ENQ\224\ETB\224\GS\224'\224-\224\&5\224E\224S\224q\224{\224\143\224\149\224\159\224\183\224\185\224\213\224\215\224\227\224\243\224\249\224\SOH\225%\225)\225\&1\225\&5\225C\225O\225Y\225a\225m\225q\225w\225\DEL\225\131\225\137\225\151\225\173\225\181\225\187\225\191\225\193\225\203\225\209\225\229\225\239\225\247\225\253\225\ETX\226\EM\226+\226-\226=\226C\226W\226[\226u\226y\226\135\226\157\226\171\226\175\226\187\226\193\226\201\226\205\226\211\226\217\226\243\226\253\226\255\226\DC1\227#\227'\227)\227\&9\227;\227M\227Q\227W\227_\227c\227i\227u\227w\227}\227\131\227\159\227\197\227\201\227\209\227\225\227\251\227\255\227\SOH\228\v\228\ETB\228\EM\228#\228+\228\&1\228;\228G\228I\228S\228U\228m\228q\228\143\228\169\228\175\228\181\228\199\228\205\228\211\228\233\228\235\228\245\228\a\229!\229%\229\&7\229?\229E\229K\229W\229g\229m\229u\229\133\229\139\229\147\229\163\229\165\229\207\229\t\230\DC1\230\NAK\230\ESC\230\GS\230!\230)\230\&9\230?\230S\230W\230c\230o\230u\230\129\230\131\230\141\230\143\230\149\230\171\230\173\230\183\230\189\230\197\230\203\230\213\230\227\230\233\230\239\230\243\230\ENQ\231\r\231\ETB\231\US\231/\231=\231G\231I\231S\231U\231a\231g\231k\231\DEL\231\137\231\145\231\197\231\205\231\215\231\221\231\223\231\233\231\241\231\251\231\SOH\232\a\232\SI\232\EM\232\ESC\232\&1\232\&3\232\&7\232=\232K\232O\232Q\232i\232u\232y\232\147\232\165\232\169\232\175\232\189\232\219\232\225\232\229\232\235\232\237\232\ETX\233\v\233\SI\233\NAK\233\ETB\233-\233\&3\233;\233K\233Q\233_\233c\233i\233{\233\131\233\143\233\149\233\161\233\185\233\215\233\231\233\239\233\DC1\234\EM\234/\234\&5\234C\234M\234_\234m\234q\234}\234\133\234\137\234\173\234\179\234\185\234\187\234\197\234\199\234\203\234\223\234\229\234\235\234\245\234\SOH\235\a\235\t\235\&1\235\&9\235?\235[\235a\235c\235o\235\129\235\133\235\157\235\171\235\177\235\183\235\193\235\213\235\223\235\237\235\253\235\v\236\ESC\236!\236)\236M\236Q\236]\236i\236o\236{\236\173\236\185\236\191\236\195\236\201\236\207\236\215\236\221\236\231\236\233\236\243\236\245\236\a\237\DC1\237\US\237/\237\&7\237=\237A\237U\237Y\237[\237e\237k\237y\237\139\237\149\237\187\237\197\237\215\237\217\237\227\237\229\237\241\237\245\237\247\237\251\237\t\238\SI\238\EM\238!\238I\238O\238c\238g\238s\238{\238\129\238\163\238\171\238\193\238\201\238\213\238\223\238\225\238\241\238\ESC\239'\239/\239E\239M\239c\239k\239q\239\147\239\149\239\155\239\159\239\173\239\179\239\195\239\197\239\219\239\225\239\233\239\SOH\240\ETB\240\GS\240\US\240+\240/\240\&5\240C\240G\240O\240g\240k\240q\240w\240y\240\143\240\163\240\169\240\173\240\187\240\191\240\197\240\203\240\211\240\217\240\227\240\233\240\241\240\247\240\a\241\NAK\241\ESC\241!\241\&7\241=\241U\241u\241{\241\141\241\147\241\165\241\175\241\183\241\213\241\231\241\237\241\253\241\t\242\SI\242\ESC\242\GS\242#\242'\242\&3\242;\242A\242W\242_\242e\242i\242w\242\129\242\147\242\167\242\177\242\179\242\185\242\189\242\191\242\219\242\237\242\239\242\249\242\255\242\ENQ\243\v\243\EM\243A\243Y\243[\243_\243g\243s\243w\243\139\243\143\243\175\243\193\243\209\243\215\243\251\243\ETX\244\t\244\r\244\DC3\244!\244%\244+\244E\244K\244U\244c\244u\244\DEL\244\133\244\139\244\153\244\163\244\169\244\175\244\189\244\195\244\219\244\223\244\237\244\ETX\245\v\245\ETB\245!\245)\245\&5\245G\245Q\245c\245k\245\131\245\141\245\149\245\153\245\177\245\183\245\201\245\207\245\209\245\219\245\249\245\251\245\ENQ\246\a\246\v\246\r\246\&5\246\&7\246S\246[\246a\246g\246y\246\DEL\246\137\246\151\246\155\246\173\246\203\246\221\246\223\246\235\246\t\247\SI\247-\247\&1\247C\247O\247Q\247U\247c\247i\247s\247y\247\129\247\135\247\145\247\157\247\159\247\165\247\177\247\187\247\189\247\207\247\211\247\231\247\235\247\241\247\255\247\ENQ\248\v\248!\248'\248-\248\&5\248G\248Y\248c\248e\248o\248q\248w\248{\248\129\248\141\248\159\248\161\248\171\248\179\248\183\248\201\248\203\248\209\248\215\248\221\248\231\248\239\248\249\248\255\248\DC1\249\GS\249%\249\&1\249\&7\249;\249A\249O\249_\249a\249m\249q\249w\249\157\249\163\249\169\249\185\249\205\249\233\249\253\249\a\250\r\250\DC3\250!\250%\250?\250C\250Q\250[\250m\250{\250\151\250\153\250\157\250\171\250\187\250\189\250\217\250\223\250\231\250\237\250\SI\251\ETB\251\ESC\251-\251/\251?\251G\251M\251u\251}\251\143\251\147\251\177\251\183\251\195\251\197\251\227\251\233\251\243\251\SOH\252)\252\&7\252A\252C\252O\252Y\252a\252e\252m\252s\252y\252\149\252\151\252\155\252\167\252\181\252\197\252\205\252\235\252\251\252\r\253\SI\253\EM\253+\253\&1\253Q\253U\253g\253m\253o\253{\253\133\253\151\253\153\253\159\253\169\253\183\253\201\253\229\253\235\253\243\253\ETX\254\ENQ\254\t\254\GS\254'\254/\254A\254K\254M\254W\254_\254c\254i\254u\254{\254\143\254\147\254\149\254\155\254\159\254\179\254\189\254\215\254\233\254\243\254\245\254\a\255\r\255\GS\255+\255/\255I\255M\255[\255e\255q\255\DEL\255\133\255\139\255\143\255\157\255\167\255\169\255\199\255\217\255\239\255\241\255"#++-- smallPrimes :: [Word16]+-- smallPrimes =+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997,1009,1013,1019,1021,1031,1033,1039,1049,1051,1061,1063,1069,1087,1091,1093,1097,1103,1109,1117,1123,1129,1151,1153,1163,1171,1181,1187,1193,1201,1213,1217,1223,1229,1231,1237,1249,1259,1277,1279,1283,1289,1291,1297,1301,1303,1307,1319,1321,1327,1361,1367,1373,1381,1399,1409,1423,1427,1429,1433,1439,1447,1451,1453,1459,1471,1481,1483,1487,1489,1493,1499,1511,1523,1531,1543,1549,1553,1559,1567,1571,1579,1583,1597,1601,1607,1609,1613,1619,1621,1627,1637,1657,1663,1667,1669,1693,1697,1699,1709,1721,1723,1733,1741,1747,1753,1759,1777,1783,1787,1789,1801,1811,1823,1831,1847,1861,1867,1871,1873,1877,1879,1889,1901,1907,1913,1931,1933,1949,1951,1973,1979,1987,1993,1997,1999,2003,2011,2017,2027,2029,2039,2053,2063,2069,2081,2083,2087,2089,2099,2111,2113,2129,2131,2137,2141,2143,2153,2161,2179,2203,2207,2213,2221,2237,2239,2243,2251,2267,2269,2273,2281,2287,2293,2297,2309,2311,2333,2339,2341,2347,2351,2357,2371,2377,2381,2383,2389,2393,2399,2411,2417,2423,2437,2441,2447,2459,2467,2473,2477,2503,2521,2531,2539,2543,2549,2551,2557,2579,2591,2593,2609,2617,2621,2633,2647,2657,2659,2663,2671,2677,2683,2687,2689,2693,2699,2707,2711,2713,2719,2729,2731,2741,2749,2753,2767,2777,2789,2791,2797,2801,2803,2819,2833,2837,2843,2851,2857,2861,2879,2887,2897,2903,2909,2917,2927,2939,2953,2957,2963,2969,2971,2999,3001,3011,3019,3023,3037,3041,3049,3061,3067,3079,3083,3089,3109,3119,3121,3137,3163,3167,3169,3181,3187,3191,3203,3209,3217,3221,3229,3251,3253,3257,3259,3271,3299,3301,3307,3313,3319,3323,3329,3331,3343,3347,3359,3361,3371,3373,3389,3391,3407,3413,3433,3449,3457,3461,3463,3467,3469,3491,3499,3511,3517,3527,3529,3533,3539,3541,3547,3557,3559,3571,3581,3583,3593,3607,3613,3617,3623,3631,3637,3643,3659,3671,3673,3677,3691,3697,3701,3709,3719,3727,3733,3739,3761,3767,3769,3779,3793,3797,3803,3821,3823,3833,3847,3851,3853,3863,3877,3881,3889,3907,3911,3917,3919,3923,3929,3931,3943,3947,3967,3989,4001,4003,4007,4013,4019,4021,4027,4049,4051,4057,4073,4079,4091,4093,4099,4111,4127,4129,4133,4139,4153,4157,4159,4177,4201,4211,4217,4219,4229,4231,4241,4243,4253,4259,4261,4271,4273,4283,4289,4297,4327,4337,4339,4349,4357,4363,4373,4391,4397,4409,4421,4423,4441,4447,4451,4457,4463,4481,4483,4493,4507,4513,4517,4519,4523,4547,4549,4561,4567,4583,4591,4597,4603,4621,4637,4639,4643,4649,4651,4657,4663,4673,4679,4691,4703,4721,4723,4729,4733,4751,4759,4783,4787,4789,4793,4799,4801,4813,4817,4831,4861,4871,4877,4889,4903,4909,4919,4931,4933,4937,4943,4951,4957,4967,4969,4973,4987,4993,4999,5003,5009,5011,5021,5023,5039,5051,5059,5077,5081,5087,5099,5101,5107,5113,5119,5147,5153,5167,5171,5179,5189,5197,5209,5227,5231,5233,5237,5261,5273,5279,5281,5297,5303,5309,5323,5333,5347,5351,5381,5387,5393,5399,5407,5413,5417,5419,5431,5437,5441,5443,5449,5471,5477,5479,5483,5501,5503,5507,5519,5521,5527,5531,5557,5563,5569,5573,5581,5591,5623,5639,5641,5647,5651,5653,5657,5659,5669,5683,5689,5693,5701,5711,5717,5737,5741,5743,5749,5779,5783,5791,5801,5807,5813,5821,5827,5839,5843,5849,5851,5857,5861,5867,5869,5879,5881,5897,5903,5923,5927,5939,5953,5981,5987,6007,6011,6029,6037,6043,6047,6053,6067,6073,6079,6089,6091,6101,6113,6121,6131,6133,6143,6151,6163,6173,6197,6199,6203,6211,6217,6221,6229,6247,6257,6263,6269,6271,6277,6287,6299,6301,6311,6317,6323,6329,6337,6343,6353,6359,6361,6367,6373,6379,6389,6397,6421,6427,6449,6451,6469,6473,6481,6491,6521,6529,6547,6551,6553,6563,6569,6571,6577,6581,6599,6607,6619,6637,6653,6659,6661,6673,6679,6689,6691,6701,6703,6709,6719,6733,6737,6761,6763,6779,6781,6791,6793,6803,6823,6827,6829,6833,6841,6857,6863,6869,6871,6883,6899,6907,6911,6917,6947,6949,6959,6961,6967,6971,6977,6983,6991,6997,7001,7013,7019,7027,7039,7043,7057,7069,7079,7103,7109,7121,7127,7129,7151,7159,7177,7187,7193,7207,7211,7213,7219,7229,7237,7243,7247,7253,7283,7297,7307,7309,7321,7331,7333,7349,7351,7369,7393,7411,7417,7433,7451,7457,7459,7477,7481,7487,7489,7499,7507,7517,7523,7529,7537,7541,7547,7549,7559,7561,7573,7577,7583,7589,7591,7603,7607,7621,7639,7643,7649,7669,7673,7681,7687,7691,7699,7703,7717,7723,7727,7741,7753,7757,7759,7789,7793,7817,7823,7829,7841,7853,7867,7873,7877,7879,7883,7901,7907,7919,7927,7933,7937,7949,7951,7963,7993,8009,8011,8017,8039,8053,8059,8069,8081,8087,8089,8093,8101,8111,8117,8123,8147,8161,8167,8171,8179,8191,8209,8219,8221,8231,8233,8237,8243,8263,8269,8273,8287,8291,8293,8297,8311,8317,8329,8353,8363,8369,8377,8387,8389,8419,8423,8429,8431,8443,8447,8461,8467,8501,8513,8521,8527,8537,8539,8543,8563,8573,8581,8597,8599,8609,8623,8627,8629,8641,8647,8663,8669,8677,8681,8689,8693,8699,8707,8713,8719,8731,8737,8741,8747,8753,8761,8779,8783,8803,8807,8819,8821,8831,8837,8839,8849,8861,8863,8867,8887,8893,8923,8929,8933,8941,8951,8963,8969,8971,8999,9001,9007,9011,9013,9029,9041,9043,9049,9059,9067,9091,9103,9109,9127,9133,9137,9151,9157,9161,9173,9181,9187,9199,9203,9209,9221,9227,9239,9241,9257,9277,9281,9283,9293,9311,9319,9323,9337,9341,9343,9349,9371,9377,9391,9397,9403,9413,9419,9421,9431,9433,9437,9439,9461,9463,9467,9473,9479,9491,9497,9511,9521,9533,9539,9547,9551,9587,9601,9613,9619,9623,9629,9631,9643,9649,9661,9677,9679,9689,9697,9719,9721,9733,9739,9743,9749,9767,9769,9781,9787,9791,9803,9811,9817,9829,9833,9839,9851,9857,9859,9871,9883,9887,9901,9907,9923,9929,9931,9941,9949,9967,9973,10007,10009,10037,10039,10061,10067,10069,10079,10091,10093,10099,10103,10111,10133,10139,10141,10151,10159,10163,10169,10177,10181,10193,10211,10223,10243,10247,10253,10259,10267,10271,10273,10289,10301,10303,10313,10321,10331,10333,10337,10343,10357,10369,10391,10399,10427,10429,10433,10453,10457,10459,10463,10477,10487,10499,10501,10513,10529,10531,10559,10567,10589,10597,10601,10607,10613,10627,10631,10639,10651,10657,10663,10667,10687,10691,10709,10711,10723,10729,10733,10739,10753,10771,10781,10789,10799,10831,10837,10847,10853,10859,10861,10867,10883,10889,10891,10903,10909,10937,10939,10949,10957,10973,10979,10987,10993,11003,11027,11047,11057,11059,11069,11071,11083,11087,11093,11113,11117,11119,11131,11149,11159,11161,11171,11173,11177,11197,11213,11239,11243,11251,11257,11261,11273,11279,11287,11299,11311,11317,11321,11329,11351,11353,11369,11383,11393,11399,11411,11423,11437,11443,11447,11467,11471,11483,11489,11491,11497,11503,11519,11527,11549,11551,11579,11587,11593,11597,11617,11621,11633,11657,11677,11681,11689,11699,11701,11717,11719,11731,11743,11777,11779,11783,11789,11801,11807,11813,11821,11827,11831,11833,11839,11863,11867,11887,11897,11903,11909,11923,11927,11933,11939,11941,11953,11959,11969,11971,11981,11987,12007,12011,12037,12041,12043,12049,12071,12073,12097,12101,12107,12109,12113,12119,12143,12149,12157,12161,12163,12197,12203,12211,12227,12239,12241,12251,12253,12263,12269,12277,12281,12289,12301,12323,12329,12343,12347,12373,12377,12379,12391,12401,12409,12413,12421,12433,12437,12451,12457,12473,12479,12487,12491,12497,12503,12511,12517,12527,12539,12541,12547,12553,12569,12577,12583,12589,12601,12611,12613,12619,12637,12641,12647,12653,12659,12671,12689,12697,12703,12713,12721,12739,12743,12757,12763,12781,12791,12799,12809,12821,12823,12829,12841,12853,12889,12893,12899,12907,12911,12917,12919,12923,12941,12953,12959,12967,12973,12979,12983,13001,13003,13007,13009,13033,13037,13043,13049,13063,13093,13099,13103,13109,13121,13127,13147,13151,13159,13163,13171,13177,13183,13187,13217,13219,13229,13241,13249,13259,13267,13291,13297,13309,13313,13327,13331,13337,13339,13367,13381,13397,13399,13411,13417,13421,13441,13451,13457,13463,13469,13477,13487,13499,13513,13523,13537,13553,13567,13577,13591,13597,13613,13619,13627,13633,13649,13669,13679,13681,13687,13691,13693,13697,13709,13711,13721,13723,13729,13751,13757,13759,13763,13781,13789,13799,13807,13829,13831,13841,13859,13873,13877,13879,13883,13901,13903,13907,13913,13921,13931,13933,13963,13967,13997,13999,14009,14011,14029,14033,14051,14057,14071,14081,14083,14087,14107,14143,14149,14153,14159,14173,14177,14197,14207,14221,14243,14249,14251,14281,14293,14303,14321,14323,14327,14341,14347,14369,14387,14389,14401,14407,14411,14419,14423,14431,14437,14447,14449,14461,14479,14489,14503,14519,14533,14537,14543,14549,14551,14557,14561,14563,14591,14593,14621,14627,14629,14633,14639,14653,14657,14669,14683,14699,14713,14717,14723,14731,14737,14741,14747,14753,14759,14767,14771,14779,14783,14797,14813,14821,14827,14831,14843,14851,14867,14869,14879,14887,14891,14897,14923,14929,14939,14947,14951,14957,14969,14983,15013,15017,15031,15053,15061,15073,15077,15083,15091,15101,15107,15121,15131,15137,15139,15149,15161,15173,15187,15193,15199,15217,15227,15233,15241,15259,15263,15269,15271,15277,15287,15289,15299,15307,15313,15319,15329,15331,15349,15359,15361,15373,15377,15383,15391,15401,15413,15427,15439,15443,15451,15461,15467,15473,15493,15497,15511,15527,15541,15551,15559,15569,15581,15583,15601,15607,15619,15629,15641,15643,15647,15649,15661,15667,15671,15679,15683,15727,15731,15733,15737,15739,15749,15761,15767,15773,15787,15791,15797,15803,15809,15817,15823,15859,15877,15881,15887,15889,15901,15907,15913,15919,15923,15937,15959,15971,15973,15991,16001,16007,16033,16057,16061,16063,16067,16069,16073,16087,16091,16097,16103,16111,16127,16139,16141,16183,16187,16189,16193,16217,16223,16229,16231,16249,16253,16267,16273,16301,16319,16333,16339,16349,16361,16363,16369,16381,16411,16417,16421,16427,16433,16447,16451,16453,16477,16481,16487,16493,16519,16529,16547,16553,16561,16567,16573,16603,16607,16619,16631,16633,16649,16651,16657,16661,16673,16691,16693,16699,16703,16729,16741,16747,16759,16763,16787,16811,16823,16829,16831,16843,16871,16879,16883,16889,16901,16903,16921,16927,16931,16937,16943,16963,16979,16981,16987,16993,17011,17021,17027,17029,17033,17041,17047,17053,17077,17093,17099,17107,17117,17123,17137,17159,17167,17183,17189,17191,17203,17207,17209,17231,17239,17257,17291,17293,17299,17317,17321,17327,17333,17341,17351,17359,17377,17383,17387,17389,17393,17401,17417,17419,17431,17443,17449,17467,17471,17477,17483,17489,17491,17497,17509,17519,17539,17551,17569,17573,17579,17581,17597,17599,17609,17623,17627,17657,17659,17669,17681,17683,17707,17713,17729,17737,17747,17749,17761,17783,17789,17791,17807,17827,17837,17839,17851,17863,17881,17891,17903,17909,17911,17921,17923,17929,17939,17957,17959,17971,17977,17981,17987,17989,18013,18041,18043,18047,18049,18059,18061,18077,18089,18097,18119,18121,18127,18131,18133,18143,18149,18169,18181,18191,18199,18211,18217,18223,18229,18233,18251,18253,18257,18269,18287,18289,18301,18307,18311,18313,18329,18341,18353,18367,18371,18379,18397,18401,18413,18427,18433,18439,18443,18451,18457,18461,18481,18493,18503,18517,18521,18523,18539,18541,18553,18583,18587,18593,18617,18637,18661,18671,18679,18691,18701,18713,18719,18731,18743,18749,18757,18773,18787,18793,18797,18803,18839,18859,18869,18899,18911,18913,18917,18919,18947,18959,18973,18979,19001,19009,19013,19031,19037,19051,19069,19073,19079,19081,19087,19121,19139,19141,19157,19163,19181,19183,19207,19211,19213,19219,19231,19237,19249,19259,19267,19273,19289,19301,19309,19319,19333,19373,19379,19381,19387,19391,19403,19417,19421,19423,19427,19429,19433,19441,19447,19457,19463,19469,19471,19477,19483,19489,19501,19507,19531,19541,19543,19553,19559,19571,19577,19583,19597,19603,19609,19661,19681,19687,19697,19699,19709,19717,19727,19739,19751,19753,19759,19763,19777,19793,19801,19813,19819,19841,19843,19853,19861,19867,19889,19891,19913,19919,19927,19937,19949,19961,19963,19973,19979,19991,19993,19997,20011,20021,20023,20029,20047,20051,20063,20071,20089,20101,20107,20113,20117,20123,20129,20143,20147,20149,20161,20173,20177,20183,20201,20219,20231,20233,20249,20261,20269,20287,20297,20323,20327,20333,20341,20347,20353,20357,20359,20369,20389,20393,20399,20407,20411,20431,20441,20443,20477,20479,20483,20507,20509,20521,20533,20543,20549,20551,20563,20593,20599,20611,20627,20639,20641,20663,20681,20693,20707,20717,20719,20731,20743,20747,20749,20753,20759,20771,20773,20789,20807,20809,20849,20857,20873,20879,20887,20897,20899,20903,20921,20929,20939,20947,20959,20963,20981,20983,21001,21011,21013,21017,21019,21023,21031,21059,21061,21067,21089,21101,21107,21121,21139,21143,21149,21157,21163,21169,21179,21187,21191,21193,21211,21221,21227,21247,21269,21277,21283,21313,21317,21319,21323,21341,21347,21377,21379,21383,21391,21397,21401,21407,21419,21433,21467,21481,21487,21491,21493,21499,21503,21517,21521,21523,21529,21557,21559,21563,21569,21577,21587,21589,21599,21601,21611,21613,21617,21647,21649,21661,21673,21683,21701,21713,21727,21737,21739,21751,21757,21767,21773,21787,21799,21803,21817,21821,21839,21841,21851,21859,21863,21871,21881,21893,21911,21929,21937,21943,21961,21977,21991,21997,22003,22013,22027,22031,22037,22039,22051,22063,22067,22073,22079,22091,22093,22109,22111,22123,22129,22133,22147,22153,22157,22159,22171,22189,22193,22229,22247,22259,22271,22273,22277,22279,22283,22291,22303,22307,22343,22349,22367,22369,22381,22391,22397,22409,22433,22441,22447,22453,22469,22481,22483,22501,22511,22531,22541,22543,22549,22567,22571,22573,22613,22619,22621,22637,22639,22643,22651,22669,22679,22691,22697,22699,22709,22717,22721,22727,22739,22741,22751,22769,22777,22783,22787,22807,22811,22817,22853,22859,22861,22871,22877,22901,22907,22921,22937,22943,22961,22963,22973,22993,23003,23011,23017,23021,23027,23029,23039,23041,23053,23057,23059,23063,23071,23081,23087,23099,23117,23131,23143,23159,23167,23173,23189,23197,23201,23203,23209,23227,23251,23269,23279,23291,23293,23297,23311,23321,23327,23333,23339,23357,23369,23371,23399,23417,23431,23447,23459,23473,23497,23509,23531,23537,23539,23549,23557,23561,23563,23567,23581,23593,23599,23603,23609,23623,23627,23629,23633,23663,23669,23671,23677,23687,23689,23719,23741,23743,23747,23753,23761,23767,23773,23789,23801,23813,23819,23827,23831,23833,23857,23869,23873,23879,23887,23893,23899,23909,23911,23917,23929,23957,23971,23977,23981,23993,24001,24007,24019,24023,24029,24043,24049,24061,24071,24077,24083,24091,24097,24103,24107,24109,24113,24121,24133,24137,24151,24169,24179,24181,24197,24203,24223,24229,24239,24247,24251,24281,24317,24329,24337,24359,24371,24373,24379,24391,24407,24413,24419,24421,24439,24443,24469,24473,24481,24499,24509,24517,24527,24533,24547,24551,24571,24593,24611,24623,24631,24659,24671,24677,24683,24691,24697,24709,24733,24749,24763,24767,24781,24793,24799,24809,24821,24841,24847,24851,24859,24877,24889,24907,24917,24919,24923,24943,24953,24967,24971,24977,24979,24989,25013,25031,25033,25037,25057,25073,25087,25097,25111,25117,25121,25127,25147,25153,25163,25169,25171,25183,25189,25219,25229,25237,25243,25247,25253,25261,25301,25303,25307,25309,25321,25339,25343,25349,25357,25367,25373,25391,25409,25411,25423,25439,25447,25453,25457,25463,25469,25471,25523,25537,25541,25561,25577,25579,25583,25589,25601,25603,25609,25621,25633,25639,25643,25657,25667,25673,25679,25693,25703,25717,25733,25741,25747,25759,25763,25771,25793,25799,25801,25819,25841,25847,25849,25867,25873,25889,25903,25913,25919,25931,25933,25939,25943,25951,25969,25981,25997,25999,26003,26017,26021,26029,26041,26053,26083,26099,26107,26111,26113,26119,26141,26153,26161,26171,26177,26183,26189,26203,26209,26227,26237,26249,26251,26261,26263,26267,26293,26297,26309,26317,26321,26339,26347,26357,26371,26387,26393,26399,26407,26417,26423,26431,26437,26449,26459,26479,26489,26497,26501,26513,26539,26557,26561,26573,26591,26597,26627,26633,26641,26647,26669,26681,26683,26687,26693,26699,26701,26711,26713,26717,26723,26729,26731,26737,26759,26777,26783,26801,26813,26821,26833,26839,26849,26861,26863,26879,26881,26891,26893,26903,26921,26927,26947,26951,26953,26959,26981,26987,26993,27011,27017,27031,27043,27059,27061,27067,27073,27077,27091,27103,27107,27109,27127,27143,27179,27191,27197,27211,27239,27241,27253,27259,27271,27277,27281,27283,27299,27329,27337,27361,27367,27397,27407,27409,27427,27431,27437,27449,27457,27479,27481,27487,27509,27527,27529,27539,27541,27551,27581,27583,27611,27617,27631,27647,27653,27673,27689,27691,27697,27701,27733,27737,27739,27743,27749,27751,27763,27767,27773,27779,27791,27793,27799,27803,27809,27817,27823,27827,27847,27851,27883,27893,27901,27917,27919,27941,27943,27947,27953,27961,27967,27983,27997,28001,28019,28027,28031,28051,28057,28069,28081,28087,28097,28099,28109,28111,28123,28151,28163,28181,28183,28201,28211,28219,28229,28277,28279,28283,28289,28297,28307,28309,28319,28349,28351,28387,28393,28403,28409,28411,28429,28433,28439,28447,28463,28477,28493,28499,28513,28517,28537,28541,28547,28549,28559,28571,28573,28579,28591,28597,28603,28607,28619,28621,28627,28631,28643,28649,28657,28661,28663,28669,28687,28697,28703,28711,28723,28729,28751,28753,28759,28771,28789,28793,28807,28813,28817,28837,28843,28859,28867,28871,28879,28901,28909,28921,28927,28933,28949,28961,28979,29009,29017,29021,29023,29027,29033,29059,29063,29077,29101,29123,29129,29131,29137,29147,29153,29167,29173,29179,29191,29201,29207,29209,29221,29231,29243,29251,29269,29287,29297,29303,29311,29327,29333,29339,29347,29363,29383,29387,29389,29399,29401,29411,29423,29429,29437,29443,29453,29473,29483,29501,29527,29531,29537,29567,29569,29573,29581,29587,29599,29611,29629,29633,29641,29663,29669,29671,29683,29717,29723,29741,29753,29759,29761,29789,29803,29819,29833,29837,29851,29863,29867,29873,29879,29881,29917,29921,29927,29947,29959,29983,29989,30011,30013,30029,30047,30059,30071,30089,30091,30097,30103,30109,30113,30119,30133,30137,30139,30161,30169,30181,30187,30197,30203,30211,30223,30241,30253,30259,30269,30271,30293,30307,30313,30319,30323,30341,30347,30367,30389,30391,30403,30427,30431,30449,30467,30469,30491,30493,30497,30509,30517,30529,30539,30553,30557,30559,30577,30593,30631,30637,30643,30649,30661,30671,30677,30689,30697,30703,30707,30713,30727,30757,30763,30773,30781,30803,30809,30817,30829,30839,30841,30851,30853,30859,30869,30871,30881,30893,30911,30931,30937,30941,30949,30971,30977,30983,31013,31019,31033,31039,31051,31063,31069,31079,31081,31091,31121,31123,31139,31147,31151,31153,31159,31177,31181,31183,31189,31193,31219,31223,31231,31237,31247,31249,31253,31259,31267,31271,31277,31307,31319,31321,31327,31333,31337,31357,31379,31387,31391,31393,31397,31469,31477,31481,31489,31511,31513,31517,31531,31541,31543,31547,31567,31573,31583,31601,31607,31627,31643,31649,31657,31663,31667,31687,31699,31721,31723,31727,31729,31741,31751,31769,31771,31793,31799,31817,31847,31849,31859,31873,31883,31891,31907,31957,31963,31973,31981,31991,32003,32009,32027,32029,32051,32057,32059,32063,32069,32077,32083,32089,32099,32117,32119,32141,32143,32159,32173,32183,32189,32191,32203,32213,32233,32237,32251,32257,32261,32297,32299,32303,32309,32321,32323,32327,32341,32353,32359,32363,32369,32371,32377,32381,32401,32411,32413,32423,32429,32441,32443,32467,32479,32491,32497,32503,32507,32531,32533,32537,32561,32563,32569,32573,32579,32587,32603,32609,32611,32621,32633,32647,32653,32687,32693,32707,32713,32717,32719,32749,32771,32779,32783,32789,32797,32801,32803,32831,32833,32839,32843,32869,32887,32909,32911,32917,32933,32939,32941,32957,32969,32971,32983,32987,32993,32999,33013,33023,33029,33037,33049,33053,33071,33073,33083,33091,33107,33113,33119,33149,33151,33161,33179,33181,33191,33199,33203,33211,33223,33247,33287,33289,33301,33311,33317,33329,33331,33343,33347,33349,33353,33359,33377,33391,33403,33409,33413,33427,33457,33461,33469,33479,33487,33493,33503,33521,33529,33533,33547,33563,33569,33577,33581,33587,33589,33599,33601,33613,33617,33619,33623,33629,33637,33641,33647,33679,33703,33713,33721,33739,33749,33751,33757,33767,33769,33773,33791,33797,33809,33811,33827,33829,33851,33857,33863,33871,33889,33893,33911,33923,33931,33937,33941,33961,33967,33997,34019,34031,34033,34039,34057,34061,34123,34127,34129,34141,34147,34157,34159,34171,34183,34211,34213,34217,34231,34253,34259,34261,34267,34273,34283,34297,34301,34303,34313,34319,34327,34337,34351,34361,34367,34369,34381,34403,34421,34429,34439,34457,34469,34471,34483,34487,34499,34501,34511,34513,34519,34537,34543,34549,34583,34589,34591,34603,34607,34613,34631,34649,34651,34667,34673,34679,34687,34693,34703,34721,34729,34739,34747,34757,34759,34763,34781,34807,34819,34841,34843,34847,34849,34871,34877,34883,34897,34913,34919,34939,34949,34961,34963,34981,35023,35027,35051,35053,35059,35069,35081,35083,35089,35099,35107,35111,35117,35129,35141,35149,35153,35159,35171,35201,35221,35227,35251,35257,35267,35279,35281,35291,35311,35317,35323,35327,35339,35353,35363,35381,35393,35401,35407,35419,35423,35437,35447,35449,35461,35491,35507,35509,35521,35527,35531,35533,35537,35543,35569,35573,35591,35593,35597,35603,35617,35671,35677,35729,35731,35747,35753,35759,35771,35797,35801,35803,35809,35831,35837,35839,35851,35863,35869,35879,35897,35899,35911,35923,35933,35951,35963,35969,35977,35983,35993,35999,36007,36011,36013,36017,36037,36061,36067,36073,36083,36097,36107,36109,36131,36137,36151,36161,36187,36191,36209,36217,36229,36241,36251,36263,36269,36277,36293,36299,36307,36313,36319,36341,36343,36353,36373,36383,36389,36433,36451,36457,36467,36469,36473,36479,36493,36497,36523,36527,36529,36541,36551,36559,36563,36571,36583,36587,36599,36607,36629,36637,36643,36653,36671,36677,36683,36691,36697,36709,36713,36721,36739,36749,36761,36767,36779,36781,36787,36791,36793,36809,36821,36833,36847,36857,36871,36877,36887,36899,36901,36913,36919,36923,36929,36931,36943,36947,36973,36979,36997,37003,37013,37019,37021,37039,37049,37057,37061,37087,37097,37117,37123,37139,37159,37171,37181,37189,37199,37201,37217,37223,37243,37253,37273,37277,37307,37309,37313,37321,37337,37339,37357,37361,37363,37369,37379,37397,37409,37423,37441,37447,37463,37483,37489,37493,37501,37507,37511,37517,37529,37537,37547,37549,37561,37567,37571,37573,37579,37589,37591,37607,37619,37633,37643,37649,37657,37663,37691,37693,37699,37717,37747,37781,37783,37799,37811,37813,37831,37847,37853,37861,37871,37879,37889,37897,37907,37951,37957,37963,37967,37987,37991,37993,37997,38011,38039,38047,38053,38069,38083,38113,38119,38149,38153,38167,38177,38183,38189,38197,38201,38219,38231,38237,38239,38261,38273,38281,38287,38299,38303,38317,38321,38327,38329,38333,38351,38371,38377,38393,38431,38447,38449,38453,38459,38461,38501,38543,38557,38561,38567,38569,38593,38603,38609,38611,38629,38639,38651,38653,38669,38671,38677,38693,38699,38707,38711,38713,38723,38729,38737,38747,38749,38767,38783,38791,38803,38821,38833,38839,38851,38861,38867,38873,38891,38903,38917,38921,38923,38933,38953,38959,38971,38977,38993,39019,39023,39041,39043,39047,39079,39089,39097,39103,39107,39113,39119,39133,39139,39157,39161,39163,39181,39191,39199,39209,39217,39227,39229,39233,39239,39241,39251,39293,39301,39313,39317,39323,39341,39343,39359,39367,39371,39373,39383,39397,39409,39419,39439,39443,39451,39461,39499,39503,39509,39511,39521,39541,39551,39563,39569,39581,39607,39619,39623,39631,39659,39667,39671,39679,39703,39709,39719,39727,39733,39749,39761,39769,39779,39791,39799,39821,39827,39829,39839,39841,39847,39857,39863,39869,39877,39883,39887,39901,39929,39937,39953,39971,39979,39983,39989,40009,40013,40031,40037,40039,40063,40087,40093,40099,40111,40123,40127,40129,40151,40153,40163,40169,40177,40189,40193,40213,40231,40237,40241,40253,40277,40283,40289,40343,40351,40357,40361,40387,40423,40427,40429,40433,40459,40471,40483,40487,40493,40499,40507,40519,40529,40531,40543,40559,40577,40583,40591,40597,40609,40627,40637,40639,40693,40697,40699,40709,40739,40751,40759,40763,40771,40787,40801,40813,40819,40823,40829,40841,40847,40849,40853,40867,40879,40883,40897,40903,40927,40933,40939,40949,40961,40973,40993,41011,41017,41023,41039,41047,41051,41057,41077,41081,41113,41117,41131,41141,41143,41149,41161,41177,41179,41183,41189,41201,41203,41213,41221,41227,41231,41233,41243,41257,41263,41269,41281,41299,41333,41341,41351,41357,41381,41387,41389,41399,41411,41413,41443,41453,41467,41479,41491,41507,41513,41519,41521,41539,41543,41549,41579,41593,41597,41603,41609,41611,41617,41621,41627,41641,41647,41651,41659,41669,41681,41687,41719,41729,41737,41759,41761,41771,41777,41801,41809,41813,41843,41849,41851,41863,41879,41887,41893,41897,41903,41911,41927,41941,41947,41953,41957,41959,41969,41981,41983,41999,42013,42017,42019,42023,42043,42061,42071,42073,42083,42089,42101,42131,42139,42157,42169,42179,42181,42187,42193,42197,42209,42221,42223,42227,42239,42257,42281,42283,42293,42299,42307,42323,42331,42337,42349,42359,42373,42379,42391,42397,42403,42407,42409,42433,42437,42443,42451,42457,42461,42463,42467,42473,42487,42491,42499,42509,42533,42557,42569,42571,42577,42589,42611,42641,42643,42649,42667,42677,42683,42689,42697,42701,42703,42709,42719,42727,42737,42743,42751,42767,42773,42787,42793,42797,42821,42829,42839,42841,42853,42859,42863,42899,42901,42923,42929,42937,42943,42953,42961,42967,42979,42989,43003,43013,43019,43037,43049,43051,43063,43067,43093,43103,43117,43133,43151,43159,43177,43189,43201,43207,43223,43237,43261,43271,43283,43291,43313,43319,43321,43331,43391,43397,43399,43403,43411,43427,43441,43451,43457,43481,43487,43499,43517,43541,43543,43573,43577,43579,43591,43597,43607,43609,43613,43627,43633,43649,43651,43661,43669,43691,43711,43717,43721,43753,43759,43777,43781,43783,43787,43789,43793,43801,43853,43867,43889,43891,43913,43933,43943,43951,43961,43963,43969,43973,43987,43991,43997,44017,44021,44027,44029,44041,44053,44059,44071,44087,44089,44101,44111,44119,44123,44129,44131,44159,44171,44179,44189,44201,44203,44207,44221,44249,44257,44263,44267,44269,44273,44279,44281,44293,44351,44357,44371,44381,44383,44389,44417,44449,44453,44483,44491,44497,44501,44507,44519,44531,44533,44537,44543,44549,44563,44579,44587,44617,44621,44623,44633,44641,44647,44651,44657,44683,44687,44699,44701,44711,44729,44741,44753,44771,44773,44777,44789,44797,44809,44819,44839,44843,44851,44867,44879,44887,44893,44909,44917,44927,44939,44953,44959,44963,44971,44983,44987,45007,45013,45053,45061,45077,45083,45119,45121,45127,45131,45137,45139,45161,45179,45181,45191,45197,45233,45247,45259,45263,45281,45289,45293,45307,45317,45319,45329,45337,45341,45343,45361,45377,45389,45403,45413,45427,45433,45439,45481,45491,45497,45503,45523,45533,45541,45553,45557,45569,45587,45589,45599,45613,45631,45641,45659,45667,45673,45677,45691,45697,45707,45737,45751,45757,45763,45767,45779,45817,45821,45823,45827,45833,45841,45853,45863,45869,45887,45893,45943,45949,45953,45959,45971,45979,45989,46021,46027,46049,46051,46061,46073,46091,46093,46099,46103,46133,46141,46147,46153,46171,46181,46183,46187,46199,46219,46229,46237,46261,46271,46273,46279,46301,46307,46309,46327,46337,46349,46351,46381,46399,46411,46439,46441,46447,46451,46457,46471,46477,46489,46499,46507,46511,46523,46549,46559,46567,46573,46589,46591,46601,46619,46633,46639,46643,46649,46663,46679,46681,46687,46691,46703,46723,46727,46747,46751,46757,46769,46771,46807,46811,46817,46819,46829,46831,46853,46861,46867,46877,46889,46901,46919,46933,46957,46993,46997,47017,47041,47051,47057,47059,47087,47093,47111,47119,47123,47129,47137,47143,47147,47149,47161,47189,47207,47221,47237,47251,47269,47279,47287,47293,47297,47303,47309,47317,47339,47351,47353,47363,47381,47387,47389,47407,47417,47419,47431,47441,47459,47491,47497,47501,47507,47513,47521,47527,47533,47543,47563,47569,47581,47591,47599,47609,47623,47629,47639,47653,47657,47659,47681,47699,47701,47711,47713,47717,47737,47741,47743,47777,47779,47791,47797,47807,47809,47819,47837,47843,47857,47869,47881,47903,47911,47917,47933,47939,47947,47951,47963,47969,47977,47981,48017,48023,48029,48049,48073,48079,48091,48109,48119,48121,48131,48157,48163,48179,48187,48193,48197,48221,48239,48247,48259,48271,48281,48299,48311,48313,48337,48341,48353,48371,48383,48397,48407,48409,48413,48437,48449,48463,48473,48479,48481,48487,48491,48497,48523,48527,48533,48539,48541,48563,48571,48589,48593,48611,48619,48623,48647,48649,48661,48673,48677,48679,48731,48733,48751,48757,48761,48767,48779,48781,48787,48799,48809,48817,48821,48823,48847,48857,48859,48869,48871,48883,48889,48907,48947,48953,48973,48989,48991,49003,49009,49019,49031,49033,49037,49043,49057,49069,49081,49103,49109,49117,49121,49123,49139,49157,49169,49171,49177,49193,49199,49201,49207,49211,49223,49253,49261,49277,49279,49297,49307,49331,49333,49339,49363,49367,49369,49391,49393,49409,49411,49417,49429,49433,49451,49459,49463,49477,49481,49499,49523,49529,49531,49537,49547,49549,49559,49597,49603,49613,49627,49633,49639,49663,49667,49669,49681,49697,49711,49727,49739,49741,49747,49757,49783,49787,49789,49801,49807,49811,49823,49831,49843,49853,49871,49877,49891,49919,49921,49927,49937,49939,49943,49957,49991,49993,49999,50021,50023,50033,50047,50051,50053,50069,50077,50087,50093,50101,50111,50119,50123,50129,50131,50147,50153,50159,50177,50207,50221,50227,50231,50261,50263,50273,50287,50291,50311,50321,50329,50333,50341,50359,50363,50377,50383,50387,50411,50417,50423,50441,50459,50461,50497,50503,50513,50527,50539,50543,50549,50551,50581,50587,50591,50593,50599,50627,50647,50651,50671,50683,50707,50723,50741,50753,50767,50773,50777,50789,50821,50833,50839,50849,50857,50867,50873,50891,50893,50909,50923,50929,50951,50957,50969,50971,50989,50993,51001,51031,51043,51047,51059,51061,51071,51109,51131,51133,51137,51151,51157,51169,51193,51197,51199,51203,51217,51229,51239,51241,51257,51263,51283,51287,51307,51329,51341,51343,51347,51349,51361,51383,51407,51413,51419,51421,51427,51431,51437,51439,51449,51461,51473,51479,51481,51487,51503,51511,51517,51521,51539,51551,51563,51577,51581,51593,51599,51607,51613,51631,51637,51647,51659,51673,51679,51683,51691,51713,51719,51721,51749,51767,51769,51787,51797,51803,51817,51827,51829,51839,51853,51859,51869,51871,51893,51899,51907,51913,51929,51941,51949,51971,51973,51977,51991,52009,52021,52027,52051,52057,52067,52069,52081,52103,52121,52127,52147,52153,52163,52177,52181,52183,52189,52201,52223,52237,52249,52253,52259,52267,52289,52291,52301,52313,52321,52361,52363,52369,52379,52387,52391,52433,52453,52457,52489,52501,52511,52517,52529,52541,52543,52553,52561,52567,52571,52579,52583,52609,52627,52631,52639,52667,52673,52691,52697,52709,52711,52721,52727,52733,52747,52757,52769,52783,52807,52813,52817,52837,52859,52861,52879,52883,52889,52901,52903,52919,52937,52951,52957,52963,52967,52973,52981,52999,53003,53017,53047,53051,53069,53077,53087,53089,53093,53101,53113,53117,53129,53147,53149,53161,53171,53173,53189,53197,53201,53231,53233,53239,53267,53269,53279,53281,53299,53309,53323,53327,53353,53359,53377,53381,53401,53407,53411,53419,53437,53441,53453,53479,53503,53507,53527,53549,53551,53569,53591,53593,53597,53609,53611,53617,53623,53629,53633,53639,53653,53657,53681,53693,53699,53717,53719,53731,53759,53773,53777,53783,53791,53813,53819,53831,53849,53857,53861,53881,53887,53891,53897,53899,53917,53923,53927,53939,53951,53959,53987,53993,54001,54011,54013,54037,54049,54059,54083,54091,54101,54121,54133,54139,54151,54163,54167,54181,54193,54217,54251,54269,54277,54287,54293,54311,54319,54323,54331,54347,54361,54367,54371,54377,54401,54403,54409,54413,54419,54421,54437,54443,54449,54469,54493,54497,54499,54503,54517,54521,54539,54541,54547,54559,54563,54577,54581,54583,54601,54617,54623,54629,54631,54647,54667,54673,54679,54709,54713,54721,54727,54751,54767,54773,54779,54787,54799,54829,54833,54851,54869,54877,54881,54907,54917,54919,54941,54949,54959,54973,54979,54983,55001,55009,55021,55049,55051,55057,55061,55073,55079,55103,55109,55117,55127,55147,55163,55171,55201,55207,55213,55217,55219,55229,55243,55249,55259,55291,55313,55331,55333,55337,55339,55343,55351,55373,55381,55399,55411,55439,55441,55457,55469,55487,55501,55511,55529,55541,55547,55579,55589,55603,55609,55619,55621,55631,55633,55639,55661,55663,55667,55673,55681,55691,55697,55711,55717,55721,55733,55763,55787,55793,55799,55807,55813,55817,55819,55823,55829,55837,55843,55849,55871,55889,55897,55901,55903,55921,55927,55931,55933,55949,55967,55987,55997,56003,56009,56039,56041,56053,56081,56087,56093,56099,56101,56113,56123,56131,56149,56167,56171,56179,56197,56207,56209,56237,56239,56249,56263,56267,56269,56299,56311,56333,56359,56369,56377,56383,56393,56401,56417,56431,56437,56443,56453,56467,56473,56477,56479,56489,56501,56503,56509,56519,56527,56531,56533,56543,56569,56591,56597,56599,56611,56629,56633,56659,56663,56671,56681,56687,56701,56711,56713,56731,56737,56747,56767,56773,56779,56783,56807,56809,56813,56821,56827,56843,56857,56873,56891,56893,56897,56909,56911,56921,56923,56929,56941,56951,56957,56963,56983,56989,56993,56999,57037,57041,57047,57059,57073,57077,57089,57097,57107,57119,57131,57139,57143,57149,57163,57173,57179,57191,57193,57203,57221,57223,57241,57251,57259,57269,57271,57283,57287,57301,57329,57331,57347,57349,57367,57373,57383,57389,57397,57413,57427,57457,57467,57487,57493,57503,57527,57529,57557,57559,57571,57587,57593,57601,57637,57641,57649,57653,57667,57679,57689,57697,57709,57713,57719,57727,57731,57737,57751,57773,57781,57787,57791,57793,57803,57809,57829,57839,57847,57853,57859,57881,57899,57901,57917,57923,57943,57947,57973,57977,57991,58013,58027,58031,58043,58049,58057,58061,58067,58073,58099,58109,58111,58129,58147,58151,58153,58169,58171,58189,58193,58199,58207,58211,58217,58229,58231,58237,58243,58271,58309,58313,58321,58337,58363,58367,58369,58379,58391,58393,58403,58411,58417,58427,58439,58441,58451,58453,58477,58481,58511,58537,58543,58549,58567,58573,58579,58601,58603,58613,58631,58657,58661,58679,58687,58693,58699,58711,58727,58733,58741,58757,58763,58771,58787,58789,58831,58889,58897,58901,58907,58909,58913,58921,58937,58943,58963,58967,58979,58991,58997,59009,59011,59021,59023,59029,59051,59053,59063,59069,59077,59083,59093,59107,59113,59119,59123,59141,59149,59159,59167,59183,59197,59207,59209,59219,59221,59233,59239,59243,59263,59273,59281,59333,59341,59351,59357,59359,59369,59377,59387,59393,59399,59407,59417,59419,59441,59443,59447,59453,59467,59471,59473,59497,59509,59513,59539,59557,59561,59567,59581,59611,59617,59621,59627,59629,59651,59659,59663,59669,59671,59693,59699,59707,59723,59729,59743,59747,59753,59771,59779,59791,59797,59809,59833,59863,59879,59887,59921,59929,59951,59957,59971,59981,59999,60013,60017,60029,60037,60041,60077,60083,60089,60091,60101,60103,60107,60127,60133,60139,60149,60161,60167,60169,60209,60217,60223,60251,60257,60259,60271,60289,60293,60317,60331,60337,60343,60353,60373,60383,60397,60413,60427,60443,60449,60457,60493,60497,60509,60521,60527,60539,60589,60601,60607,60611,60617,60623,60631,60637,60647,60649,60659,60661,60679,60689,60703,60719,60727,60733,60737,60757,60761,60763,60773,60779,60793,60811,60821,60859,60869,60887,60889,60899,60901,60913,60917,60919,60923,60937,60943,60953,60961,61001,61007,61027,61031,61043,61051,61057,61091,61099,61121,61129,61141,61151,61153,61169,61211,61223,61231,61253,61261,61283,61291,61297,61331,61333,61339,61343,61357,61363,61379,61381,61403,61409,61417,61441,61463,61469,61471,61483,61487,61493,61507,61511,61519,61543,61547,61553,61559,61561,61583,61603,61609,61613,61627,61631,61637,61643,61651,61657,61667,61673,61681,61687,61703,61717,61723,61729,61751,61757,61781,61813,61819,61837,61843,61861,61871,61879,61909,61927,61933,61949,61961,61967,61979,61981,61987,61991,62003,62011,62017,62039,62047,62053,62057,62071,62081,62099,62119,62129,62131,62137,62141,62143,62171,62189,62191,62201,62207,62213,62219,62233,62273,62297,62299,62303,62311,62323,62327,62347,62351,62383,62401,62417,62423,62459,62467,62473,62477,62483,62497,62501,62507,62533,62539,62549,62563,62581,62591,62597,62603,62617,62627,62633,62639,62653,62659,62683,62687,62701,62723,62731,62743,62753,62761,62773,62791,62801,62819,62827,62851,62861,62869,62873,62897,62903,62921,62927,62929,62939,62969,62971,62981,62983,62987,62989,63029,63031,63059,63067,63073,63079,63097,63103,63113,63127,63131,63149,63179,63197,63199,63211,63241,63247,63277,63281,63299,63311,63313,63317,63331,63337,63347,63353,63361,63367,63377,63389,63391,63397,63409,63419,63421,63439,63443,63463,63467,63473,63487,63493,63499,63521,63527,63533,63541,63559,63577,63587,63589,63599,63601,63607,63611,63617,63629,63647,63649,63659,63667,63671,63689,63691,63697,63703,63709,63719,63727,63737,63743,63761,63773,63781,63793,63799,63803,63809,63823,63839,63841,63853,63857,63863,63901,63907,63913,63929,63949,63977,63997,64007,64013,64019,64033,64037,64063,64067,64081,64091,64109,64123,64151,64153,64157,64171,64187,64189,64217,64223,64231,64237,64271,64279,64283,64301,64303,64319,64327,64333,64373,64381,64399,64403,64433,64439,64451,64453,64483,64489,64499,64513,64553,64567,64577,64579,64591,64601,64609,64613,64621,64627,64633,64661,64663,64667,64679,64693,64709,64717,64747,64763,64781,64783,64793,64811,64817,64849,64853,64871,64877,64879,64891,64901,64919,64921,64927,64937,64951,64969,64997,65003,65011,65027,65029,65033,65053,65063,65071,65089,65099,65101,65111,65119,65123,65129,65141,65147,65167,65171,65173,65179,65183,65203,65213,65239,65257,65267,65269,65287,65293,65309,65323,65327,65353,65357,65371,65381,65393,65407,65413,65419,65423,65437,65447,65449,65479,65497,65519,65521]
Math/NumberTheory/Primes/Testing.hs view
@@ -6,8 +6,6 @@ -- -- Primality tests. -{-# OPTIONS_GHC -fno-warn-deprecations #-}- module Math.NumberTheory.Primes.Testing ( -- * Standard tests isPrime
− Math/NumberTheory/Primes/Testing/Certificates.hs
@@ -1,34 +0,0 @@--- |--- Module: Math.NumberTheory.Primes.Testing.Certificates--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Certificates for primality or compositeness.-module Math.NumberTheory.Primes.Testing.Certificates- ( -- * Certificates- Certificate(..)- , argueCertificate- , CompositenessProof- , composite- , PrimalityProof- , cprime- -- * Arguments- , CompositenessArgument(..)- , PrimalityArgument(..)- -- ** Weaken proofs to arguments- , arguePrimality- , argueCompositeness- -- ** Prove valid arguments- , verifyPrimalityArgument- , verifyCompositenessArgument- -- * Determine and prove whether a number is prime or composite- , certify- -- ** Checks for the paranoid- , checkCertificate- , checkCompositenessProof- , checkPrimalityProof- ) where--import Math.NumberTheory.Primes.Testing.Certificates.Internal-
− Math/NumberTheory/Primes/Testing/Certificates/Internal.hs
@@ -1,358 +0,0 @@--- |--- Module: Math.NumberTheory.Primes.Testing.Certificates.Internal--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Certificates for primality or compositeness.-{-# LANGUAGE CPP #-}-{-# OPTIONS_HADDOCK hide #-}-module Math.NumberTheory.Primes.Testing.Certificates.Internal- ( Certificate(..)- , CompositenessProof(..)- , PrimalityProof(..)- , CompositenessArgument(..)- , PrimalityArgument(..)- , checkCertificate- , checkCompositenessProof- , checkPrimalityProof- , certify- , trivial- , smallCert- , certifyBPSW- , argueCertificate- , arguePrimality- , argueCompositeness- , verifyPrimalityArgument- , verifyCompositenessArgument- ) where--import Data.List-import Data.Bits-import Data.Maybe-import GHC.Integer.GMP.Internals--import Math.NumberTheory.Moduli.Class-import Math.NumberTheory.Utils-import Math.NumberTheory.Primes.Factorisation.TrialDivision-import Math.NumberTheory.Primes.Factorisation.Montgomery-import Math.NumberTheory.Primes.Testing.Probabilistic-import Math.NumberTheory.Primes.Sieve.Eratosthenes-import Math.NumberTheory.Primes.Types (unPrime)-import Math.NumberTheory.Powers.Squares---- | A certificate of either compositeness or primality of an--- 'Integer'. Only numbers @> 1@ can be certified, trying to--- create a certificate for other numbers raises an error.-data Certificate- = Composite !CompositenessProof- | Prime !PrimalityProof- deriving Show---- | A proof of compositeness of a positive number. The type is--- abstract to ensure the validity of proofs.-data CompositenessProof- = Factors { composite :: !Integer -- ^ The number whose compositeness is proved.- , firstFactor- , secondFactor :: !Integer }- | StrongFermat { composite :: !Integer -- ^ The number whose compositeness is proved.- , witness :: !Integer }- | LucasSelfridge { composite :: !Integer -- ^ The number whose compositeness is proved.- }- deriving Show---- | An argument for compositeness of a number (which must be @> 1@).--- 'CompositenessProof's translate directly to 'CompositenessArgument's,--- correct arguments can be transformed into proofs. This type allows the--- manipulation of proofs while maintaining their correctness.--- The only way to access components of a 'CompositenessProof' except--- the composite is through this type.-data CompositenessArgument- = Divisors { compo, firstDivisor, secondDivisor :: Integer }- -- ^ @compo == firstDiv*secondDiv@, where all are @> 1@- | Fermat { compo, fermatBase :: Integer } -- ^ @compo@ fails the strong Fermat test for @fermatBase@- | Lucas { compo :: Integer } -- ^ @compo@ fails the Lucas-Selfridge test- | Belief { compo :: Integer } -- ^ No particular reason given- deriving (Show, Read, Eq, Ord)---- | A proof of primality of a positive number. The type is--- abstract to ensure the validity of proofs.-data PrimalityProof- = Pocklington { cprime :: !Integer -- ^ The number whose primality is proved.- , factorisedPart, cofactor :: !Integer- , knownFactors :: ![(Integer, Word, Integer, PrimalityProof)]- }- | TrialDivision { cprime :: !Integer -- ^ The number whose primality is proved.- , tdLimit :: !Integer }- | Trivial { cprime :: !Integer -- ^ The number whose primality is proved.- }- deriving Show---- | An argument for primality of a number (which must be @> 1@).--- 'PrimalityProof's translate directly to 'PrimalityArgument's,--- correct arguments can be transformed into proofs. This type allows the--- manipulation of proofs while maintaining their correctness.--- The only way to access components of a 'PrimalityProof' except--- the prime is through this type.-data PrimalityArgument- = Pock { aprime :: Integer- , largeFactor, smallFactor :: Integer- , factorList :: [(Integer, Word, Integer, PrimalityArgument)]- } -- ^ A suggested Pocklington certificate- | Division { aprime, alimit :: Integer } -- ^ Primality should be provable by trial division to @alimit@- | Obvious { aprime :: Integer } -- ^ @aprime@ is said to be obviously prime, that holds for primes @< 30@- | Assumption { aprime :: Integer } -- ^ Primality assumed- deriving (Show, Read, Eq, Ord)---- | Eliminate 'Certificate'.-argueCertificate :: Certificate -> Either CompositenessArgument PrimalityArgument-argueCertificate (Composite proof) = Left (argueCompositeness proof)-argueCertificate (Prime proof) = Right (arguePrimality proof)---- | @'arguePrimality'@ transforms a proof of primality into an argument for primality.-arguePrimality :: PrimalityProof -> PrimalityArgument-arguePrimality (TrialDivision p l) = Division p l-arguePrimality (Trivial p) = Obvious p-arguePrimality (Pocklington p a b fcts) = Pock p a b (map argue fcts)- where- argue (x,y,z,prf) = (x,y,z,arguePrimality prf)---- | @'verifyPrimalityArgument'@ checks the given argument and constructs a proof from--- it, if it is valid. For the explicit arguments, this is simple and resonably fast,--- for an 'Assumption', the verification uses 'certify' and hence may take a long time.-verifyPrimalityArgument :: PrimalityArgument -> Maybe PrimalityProof-verifyPrimalityArgument (Assumption p)- = case certify p of- Composite _ -> Nothing- Prime proof -> Just proof-verifyPrimalityArgument arg- | checkPrimalityProof prf = Just prf- | otherwise = Nothing- where- prf = primProof arg---- | not exported, this is the one place where invalid proofs can be constructed-primProof :: PrimalityArgument -> PrimalityProof-primProof (Division p l) = TrialDivision p l-primProof (Obvious p) = Trivial p-primProof (Assumption p) = case certify p of- Composite _ -> Trivial p -- we're faking to not raise an error- Prime proof -> proof-primProof (Pock p a b fcts) = Pocklington p a b (map prove fcts)- where- prove (x,y,z,arg) = (x,y,z,primProof arg)---- | @'argueCompositeness'@ transforms a proof of compositeness into an argument--- for compositeness.-argueCompositeness :: CompositenessProof -> CompositenessArgument-argueCompositeness (Factors c f s) = Divisors c f s-argueCompositeness (StrongFermat c b) = Fermat c b-argueCompositeness (LucasSelfridge c) = Lucas c---- | @'verifyCompositenessArgument'@ checks the given argument and constructs a proof from--- it, if it is valid. For the explicit arguments, this is simple and resonably fast,--- for a 'Belief', the verification uses 'certify' and hence may take a long time.-verifyCompositenessArgument :: CompositenessArgument -> Maybe CompositenessProof-verifyCompositenessArgument (Belief c)- = case certify c of- Composite proof -> Just proof- Prime _ -> Nothing-verifyCompositenessArgument arg- | checkCompositenessProof prf = Just prf- | otherwise = Nothing- where- prf = compProof arg---- | not exported, here is where invalid proofs can be constructed,--- they must not leak-compProof :: CompositenessArgument -> CompositenessProof-compProof (Divisors c f s) = Factors c f s-compProof (Fermat c b) = StrongFermat c b-compProof (Lucas c) = LucasSelfridge c-compProof (Belief _) = error "Trying to prove by belief"---- | Check the validity of a 'Certificate'. Since it should be impossible--- to construct invalid certificates by the public interface, this should--- never return 'False'.-checkCertificate :: Certificate -> Bool-checkCertificate (Composite cp) = checkCompositenessProof cp-checkCertificate (Prime pp) = checkPrimalityProof pp---- | Check the validity of a 'CompositenessProof'. Since it should be--- impossible to create invalid proofs by the public interface, this--- should never return 'False'.-checkCompositenessProof :: CompositenessProof -> Bool-checkCompositenessProof (Factors c a b) = a > 1 && b > 1 && a*b == c-checkCompositenessProof (StrongFermat c w) = w > 1 && c > w && not (isStrongFermatPP c w)-checkCompositenessProof (LucasSelfridge c) = c > 3 && fromIntegral c .&. (1 :: Int) == 1 && lucasTest c---- | Check the validity of a 'PrimalityProof'. Since it should be--- impossible to create invalid proofs by the public interface, this--- should never return 'False'.-checkPrimalityProof :: PrimalityProof -> Bool-checkPrimalityProof (Trivial n) = isTrivialPrime n-checkPrimalityProof (TrialDivision p b) = p <= b*b && trialDivisionPrimeTo b p-checkPrimalityProof (Pocklington p a b fcts) = b > 0 && a > b && a*b == pm1 && a == ppProd fcts && all verify fcts- where- pm1 = p-1- ppProd pps = product [pf^e | (pf,e,_,_) <- pps]- verify (pf,_,base,proof) = pf == cprime proof && crit pf base && checkPrimalityProof proof- crit pf base = gcd p (x-1) == 1 && y == 1- where- x = powModInteger base (pm1 `quot` pf) p- y = powModInteger x pf p---- | @'trivial'@ records a trivially known prime.--- If the argument is not one of them, an error is raised.-trivial :: Integer -> PrimalityProof-trivial n = fromMaybe oops $ maybeTrivial n- where- oops = error ("trivial: " ++ show n ++ " isn't a trivially known prime.")---- | @'maybeTrivial'@ finds out if its argument is a trivially known--- prime or not and returns the appropriate.-maybeTrivial :: Integer -> Maybe PrimalityProof-maybeTrivial n- | isTrivialPrime n = Just (Trivial n)- | otherwise = Nothing---- | @'isTrivialPrime'@ checks whether its argument is a trivially--- known prime.-isTrivialPrime :: Integer -> Bool-isTrivialPrime n = n `elem` trivialPrimes---- | List of trivially known primes.-trivialPrimes :: [Integer]-trivialPrimes = [2,3,5,7,11,13,17,19,23,29]---- | Certify a small number. This is not exposed and should only--- be used where correct. It is always checked after use, though,--- so it shouldn't be able to lie.-smallCert :: Integer -> PrimalityProof-smallCert n- | n < 30 = Trivial n- | otherwise = TrialDivision n (integerSquareRoot' n + 1)---- | @'certify' n@ constructs, for @n > 1@, a proof of either--- primality or compositeness of @n@. This may take a very long--- time if the number has no small(ish) prime divisors-certify :: Integer -> Certificate-certify n- | n < 2 = error "Only numbers larger than 1 can be certified"- | n < 31 = case trialDivisionWith trivialPrimes n of- ((p,_):_) | p < n -> Composite (Factors n p (n `quot` p))- | otherwise -> Prime (Trivial n)- _ -> error "Impossible"- | n < billi = let r2 = integerSquareRoot' n + 2 in- case trialDivisionTo r2 n of- ((p,_):_) | p < n -> Composite (Factors n p (n `quot` p))- | otherwise -> Prime (TrialDivision n r2)- _ -> error "Impossible"- | otherwise = case smallFactors 100000 n of- ([], Just _) | not (isStrongFermatPP n 2) -> Composite (StrongFermat n 2)- | not (lucasTest n) -> Composite (LucasSelfridge n)- | otherwise -> Prime (certifyBPSW n) -- if it isn't we error and ask for a report.- ((p,_):_, _) | p == n -> Prime (TrialDivision n (min 100000 n))- | otherwise -> Composite (Factors n p (n `quot` p))- _ -> error ("***Error factorising " ++ show n ++ "! Please report this to maintainer of arithmoi.")- where- billi = 1000000000000---- | Certify a number known to be not too small, having no small prime divisors and having--- passed the Baillie PSW test. So we assume it's prime, erroring if not.--- Since it's presumably a large number, we don't bother with trial division and--- construct a Pocklington certificate.-certifyBPSW :: Integer -> PrimalityProof-certifyBPSW n = Pocklington n a b kfcts- where- nm1 = n-1- h = nm1 `quot` 2- m3 = fromInteger n .&. (3 :: Int) == 3- (a,pp,b) = findDecomposition nm1- kfcts0 = map check pp- kfcts = foldl' force [] kfcts0- force xs t@(_,_,_,prf) = prf `seq` (t:xs)- check (p,e,byTD) = go 2- where- go bs- | bs > h = error (bpswMessage n)- | x == 1 = if m3 && (p == 2) then (p,e,n-bs,Trivial 2) else go (bs+1)- | g /= 1 = error (bpswMessage n ++ found g)- | y /= 1 = error (bpswMessage n ++ fermat bs)- | byTD = (p,e,bs, smallCert p)- | otherwise = case certify p of- Composite cpr -> error ("***Error in factorisation code: " ++ show p- ++ " was supposed to be prime but isn't.\n"- ++ "Please report this to the maintainer.\n\n"- ++ show cpr)- Prime ppr ->(p,e,bs,ppr)- where- q = nm1 `quot` p- x = powModInteger bs q n- y = powModInteger x p n- g = gcd n (x-1)---- | Find a decomposition of p-1 for the pocklington certificate.--- Usually bloody slow if p-1 has two (or more) /large/ prime divisors.-findDecomposition :: Integer -> (Integer, [(Integer, Word, Bool)], Integer)-findDecomposition n = go 1 n [] prms- where- sr = integerSquareRoot' n- pbd = min 1000000 (sr+20)- prms = map unPrime $ primeList (primeSieve $ pbd)- go a b afs (p:ps)- | a > b = (a,afs,b)- | otherwise = case splitOff p b of- (0,_) -> go a b afs ps- (e,q) -> go (a*p^e) q ((p,e,True):afs) ps- go a b afs []- | a > b = (a,afs,b)- | bailliePSW b = (b,[(b,1,False)],a) -- Until a Baillie PSW pseudoprime is found, I'm going with this- | e == 0 = error ("Error in factorisation, " ++ show p ++ " was found as a factor of " ++ show b ++ " but isn't.")- | otherwise = go (a*p^e) q ((p,e,False):afs) []- where- p = findFactor b 8 6- (e,q) = splitOff p b---- | Find a factor of a known composite with approximately digits digits,--- starting with curve s. Actually, this may loop infinitely, but the--- loop should not be entered before the heat death of the universe.-findFactor :: Integer -> Int -> Integer -> Integer-findFactor n digits s = case findLoop n lo hi count s of- Left t -> findFactor n (digits+5) t- Right f -> f- where- (lo,hi,count) = findParms digits---- | Find a factor or say with which curve to continue.-findLoop :: Integer -> Word -> Word -> Word -> Integer -> Either Integer Integer-findLoop _ _ _ 0 s = Left s-findLoop n lo hi ct s- | n <= s+2 = Left 6- | otherwise = case s `modulo` fromInteger n of- InfMod{} -> error "impossible case"- SomeMod sn -> case montgomeryFactorisation lo hi sn of- Nothing -> findLoop n lo hi (ct-1) (s+1)- Just fct- | bailliePSW fct -> Right fct- | otherwise -> Right (findFactor fct 8 (s+1))---- | Message in the unlikely case a Baillie PSW pseudoprime is found.-bpswMessage :: Integer -> String-bpswMessage n = unlines- [ "\n***Congratulations! You found a Baillie PSW pseudoprime!"- , "Please report this finding to the package maintainer,"- , "<daniel.is.fischer@googlemail.com>"- , "The number in question is:\n"- , show n- , "\nOther parties like wikipedia might also be interested."- , "\nSorry for aborting your programme, but this is a major discovery."- ]---- | Found a factor-found :: Integer -> String-found g = "\nA nontrivial divisor is:\n" ++ show g---- | Fermat failure-fermat :: Integer -> String-fermat b = "\nThe Fermat test fails for base\n" ++ show b
Math/NumberTheory/Primes/Testing/Certified.hs view
@@ -5,11 +5,33 @@ -- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com> -- -- Deterministic primality testing.-module Math.NumberTheory.Primes.Testing.Certified (isCertifiedPrime) where -import Math.NumberTheory.Primes.Testing.Probabilistic-import Math.NumberTheory.Primes.Testing.Certificates.Internal+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +module Math.NumberTheory.Primes.Testing.Certified+ ( isCertifiedPrime+ ) where++import Prelude hiding (Foldable(..))+import Data.Bits ((.&.))+import Data.Foldable+import Data.Mod+import Data.Proxy+import GHC.Num.Integer+import GHC.TypeNats (SomeNat(..), someNatVal)++import Math.NumberTheory.Roots (integerSquareRoot)+import Math.NumberTheory.Primes (unPrime)+import Math.NumberTheory.Primes.Factorisation.TrialDivision (trialDivisionPrimeTo, trialDivisionTo, trialDivisionWith)+import Math.NumberTheory.Primes.Factorisation.Montgomery (montgomeryFactorisation, smallFactors, findParms)+import Math.NumberTheory.Primes.Testing.Probabilistic (bailliePSW, isPrime, isStrongFermatPP, lucasTest)+import Math.NumberTheory.Primes.Sieve.Eratosthenes (primeList, primeSieve)+import Math.NumberTheory.Utils (splitOff)+ -- | @'isCertifiedPrime' n@ tests primality of @n@, first trial division -- by small primes is performed, then a Baillie PSW test and finally a -- prime certificate is constructed and verified, provided no step before@@ -24,3 +46,173 @@ -- Although it is known that there are no Baillie PSW pseudoprimes below 2^64, -- use the verified bound 10^17, I don't know whether Gilchrist's result has been -- verified yet.++-- | A proof of primality of a positive number. The type is+-- abstract to ensure the validity of proofs.+data PrimalityProof+ = Pocklington { cprime :: !Integer -- ^ The number whose primality is proved.+ , _factorisedPart, _cofactor :: !Integer+ , _knownFactors :: ![(Integer, Word, Integer, PrimalityProof)]+ }+ | TrialDivision { cprime :: !Integer -- ^ The number whose primality is proved.+ , _tdLimit :: !Integer }+ | Trivial { cprime :: !Integer -- ^ The number whose primality is proved.+ }+ deriving Show++-- | Check the validity of a 'PrimalityProof'. Since it should be+-- impossible to create invalid proofs by the public interface, this+-- should never return 'False'.+checkPrimalityProof :: PrimalityProof -> Bool+checkPrimalityProof (Trivial n) = isTrivialPrime n+checkPrimalityProof (TrialDivision p b) = p <= b*b && trialDivisionPrimeTo b p+checkPrimalityProof (Pocklington p a b fcts) = b > 0 && a > b && a*b == pm1 && a == ppProd fcts && all verify fcts+ where+ pm1 = p-1+ ppProd pps = product [pf^e | (pf,e,_,_) <- pps]+ verify (pf,_,base,proof) = pf == cprime proof && crit pf base && checkPrimalityProof proof+ crit pf base = gcd p (toInteger x-1) == 1 && y == 1+ where+ (# x | #) = integerPowMod# base (pm1 `quot` pf) (fromInteger p)+ (# y | #) = integerPowMod# (toInteger x) pf (fromInteger p)++-- | @'isTrivialPrime'@ checks whether its argument is a trivially+-- known prime.+isTrivialPrime :: Integer -> Bool+isTrivialPrime n = n `elem` trivialPrimes++-- | List of trivially known primes.+trivialPrimes :: [Integer]+trivialPrimes = [2,3,5,7,11,13,17,19,23,29]++-- | Certify a small number. This is not exposed and should only+-- be used where correct. It is always checked after use, though,+-- so it shouldn't be able to lie.+smallCert :: Integer -> PrimalityProof+smallCert n+ | n < 30 = Trivial n+ | otherwise = TrialDivision n (integerSquareRoot n + 1)++-- | @'certify' n@ constructs, for @n > 1@, a proof of either+-- primality or compositeness of @n@. This may take a very long+-- time if the number has no small(ish) prime divisors+certify :: Integer -> Maybe PrimalityProof+certify n+ | n < 2 = error "Only numbers larger than 1 can be certified"+ | n < 31 = case trialDivisionWith trivialPrimes n of+ ((p,_):_) | p < n -> Nothing+ | otherwise -> Just (Trivial n)+ _ -> error "Impossible"+ | n < billi = let r2 = integerSquareRoot n + 2 in+ case trialDivisionTo r2 n of+ ((p,_):_) | p < n -> Nothing+ | otherwise -> Just (TrialDivision n r2)+ _ -> error "Impossible"+ | otherwise = case smallFactors (fromInteger (abs n)) of+ ([], Just _) | not (isStrongFermatPP n 2) -> Nothing+ | not (lucasTest n) -> Nothing+ | otherwise -> Just (certifyBPSW n) -- if it isn't we error and ask for a report.+ ((toInteger -> p,_):_, _)+ | p == n -> Just (TrialDivision n (min 100000 n))+ | otherwise -> Nothing+ _ -> error ("***Error factorising " ++ show n ++ "! Please report this to maintainer of arithmoi.")+ where+ billi = 1000000000000++-- | Certify a number known to be not too small, having no small prime divisors and having+-- passed the Baillie PSW test. So we assume it's prime, erroring if not.+-- Since it's presumably a large number, we don't bother with trial division and+-- construct a Pocklington certificate.+certifyBPSW :: Integer -> PrimalityProof+certifyBPSW n = Pocklington n a b kfcts+ where+ nm1 = n-1+ h = nm1 `quot` 2+ m3 = fromInteger n .&. (3 :: Int) == 3+ (a,pp,b) = findDecomposition nm1+ kfcts0 = map check pp+ kfcts = foldl' force [] kfcts0+ force xs t@(_,_,_,prf) = prf `seq` (t:xs)+ check (p,e,byTD) = go 2+ where+ go bs+ | bs > h = error (bpswMessage n)+ | x == 1 = if m3 && (p == 2) then (p,e,n-bs,Trivial 2) else go (bs+1)+ | g /= 1 = error (bpswMessage n ++ found g)+ | y /= 1 = error (bpswMessage n ++ fermat bs)+ | byTD = (p,e,bs, smallCert p)+ | otherwise = case certify p of+ Nothing -> error ("***Error in factorisation code: " ++ show p+ ++ " was supposed to be prime but isn't.\n"+ ++ "Please report this to the maintainer.\n\n")+ Just ppr ->(p,e,bs,ppr)+ where+ q = nm1 `quot` p+ (# x | #) = integerPowMod# bs q (fromInteger n)+ (# y | #) = integerPowMod# (toInteger x) p (fromInteger n)+ g = gcd n (toInteger x-1)++-- | Find a decomposition of p-1 for the pocklington certificate.+-- Usually bloody slow if p-1 has two (or more) /large/ prime divisors.+findDecomposition :: Integer -> (Integer, [(Integer, Word, Bool)], Integer)+findDecomposition n = go 1 n [] prms+ where+ sr = integerSquareRoot n+ pbd = min 1000000 (sr+20)+ prms = map unPrime $ primeList (primeSieve pbd)+ go a b afs (p:ps)+ | a > b = (a,afs,b)+ | otherwise = case splitOff p b of+ (0,_) -> go a b afs ps+ (e,q) -> go (a*p^e) q ((p,e,True):afs) ps+ go a b afs []+ | a > b = (a,afs,b)+ | bailliePSW b = (b,[(b,1,False)],a) -- Until a Baillie PSW pseudoprime is found, I'm going with this+ | e == 0 = error ("Error in factorisation, " ++ show p ++ " was found as a factor of " ++ show b ++ " but isn't.")+ | otherwise = go (a*p^e) q ((p,e,False):afs) []+ where+ p = findFactor b 8 6+ (e,q) = splitOff p b++-- | Find a factor of a known composite with approximately digits digits,+-- starting with curve s. Actually, this may loop infinitely, but the+-- loop should not be entered before the heat death of the universe.+findFactor :: Integer -> Int -> Integer -> Integer+findFactor n digits s = case findLoop n lo hi count s of+ Left t -> findFactor n (digits+5) t+ Right f -> f+ where+ (lo,hi,count) = findParms digits++-- | Find a factor or say with which curve to continue.+findLoop :: Integer -> Word -> Word -> Word -> Integer -> Either Integer Integer+findLoop _ _ _ 0 s = Left s+findLoop n lo hi ct s+ | n <= s+2 = Left 6+ | otherwise = case someNatVal (fromInteger n) of+ SomeNat (_ :: Proxy t) -> case montgomeryFactorisation lo hi (fromInteger s :: Mod t) of+ Nothing -> findLoop n lo hi (ct-1) (s+1)+ Just fct+ | bailliePSW fct -> Right fct+ | otherwise -> Right (findFactor fct 8 (s+1))++-- | Message in the unlikely case a Baillie PSW pseudoprime is found.+bpswMessage :: Integer -> String+bpswMessage n = unlines+ [ "\n***Congratulations! You found a Baillie PSW pseudoprime!"+ , "Please report this finding to the maintainers:"+ , "<daniel.is.fischer@googlemail.com>,"+ , "<andrew.lelechenko@gmail.com>"+ , "The number in question is:\n"+ , show n+ , "\nOther parties like wikipedia might also be interested."+ , "\nSorry for aborting your program, but this is a major discovery."+ ]++-- | Found a factor+found :: Integer -> String+found g = "\nA nontrivial divisor is:\n" ++ show g++-- | Fermat failure+fermat :: Integer -> String+fermat b = "\nThe Fermat test fails for base\n" ++ show b
Math/NumberTheory/Primes/Testing/Probabilistic.hs view
@@ -5,8 +5,11 @@ -- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com> -- -- Probabilistic primality tests, Miller-Rabin and Baillie-PSW.-{-# LANGUAGE CPP, MagicHash, BangPatterns #-}-{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Math.NumberTheory.Primes.Testing.Probabilistic ( isPrime , millerRabinV@@ -16,17 +19,18 @@ , lucasTest ) where -#include "MachDeps.h"- import Data.Bits-import GHC.Base-import GHC.Integer.GMP.Internals-import GHC.TypeNats.Compat+import Data.Mod+import Data.Proxy+import GHC.Num.BigNat+import GHC.Num.Integer+import GHC.Exts (Word(..), Int(..), (-#), (<#), isTrue#)+import GHC.TypeNats (KnownNat, SomeNat(..), someNatVal) -import Math.NumberTheory.Moduli.Class-import Math.NumberTheory.Moduli.Jacobi+import Math.NumberTheory.Moduli.JacobiSymbol+import Math.NumberTheory.Primes.Small+import Math.NumberTheory.Roots import Math.NumberTheory.Utils-import Math.NumberTheory.Powers.Squares -- | @isPrime n@ tests whether @n@ is a prime (negative or positive). -- It is a combination of trial division and Baillie-PSW test.@@ -55,9 +59,17 @@ -- If @millerRabinV k n@ returns @False@ then @n@ is definitely composite. -- Otherwise @n@ may appear composite with probability @1/4^k@. millerRabinV :: Int -> Integer -> Bool-millerRabinV (I# k) n = case testPrimeInteger n k of- 0# -> False- _ -> True+millerRabinV k n+ | n < 0 = millerRabinV k (-n)+ | n < 2 = False+ | n < 4 = True+ | otherwise = go smallPrimes+ where+ go (p:ps)+ | p*p > n = True+ | otherwise = (n `rem` p /= 0) && go ps+ go [] = all (isStrongFermatPP n) (take k smallPrimes)+ smallPrimes = map toInteger $ smallPrimesFromTo minBound maxBound -- | @'isStrongFermatPP' n b@ tests whether non-negative @n@ is -- a strong Fermat probable prime for base @b@.@@ -83,15 +95,14 @@ | n < 0 = error "isStrongFermatPP: negative argument" | n <= 1 = False | n == 2 = True- | otherwise = case b `modulo` fromInteger n of- SomeMod b' -> isStrongFermatPPMod b'- InfMod{} -> True+ | otherwise = case someNatVal (fromInteger n) of+ SomeNat (_ :: Proxy t) -> isStrongFermatPPMod (fromInteger b :: Mod t) isStrongFermatPPMod :: KnownNat n => Mod n -> Bool isStrongFermatPPMod b = b == 0 || a == 1 || go t a where m = -1- (t, u) = shiftToOddCount $ getVal m+ (t, u) = shiftToOddCount $ unMod m a = b ^% u go 0 _ = False@@ -114,9 +125,8 @@ -- of prime bases is reasonable to find out whether it's worth the -- effort to undertake the prime factorisation). isFermatPP :: Integer -> Integer -> Bool-isFermatPP n b = case b `modulo` fromInteger n of- SomeMod b' -> b' ^% (n-1) == 1- InfMod{} -> True+isFermatPP n b = case someNatVal (fromInteger n) of+ SomeNat (_ :: Proxy t) -> (fromInteger b :: Mod t) ^% (n-1) == 1 -- | Primality test after Baillie, Pomerance, Selfridge and Wagstaff. -- The Baillie-PSW test consists of a strong Fermat probable primality@@ -147,12 +157,10 @@ -- the Fermat test. For package-internal use only. lucasTest :: Integer -> Bool lucasTest n- | square || d == 0 = False- | d == 1 = True- | otherwise = uo == 0 || go t vo qo+ | isSquare n || d == 0 = False+ | d == 1 = True+ | otherwise = uo == 0 || go t vo qo where- square = isPossibleSquare2 n && r*r == n- r = integerSquareRoot n d = find True 5 find !pos cd = case jacobi (n `rem` cd) cd of MinusOne -> if pos then cd else (-cd)@@ -167,7 +175,7 @@ -- n odd positive, n > abs q, index odd testLucas :: Integer -> Integer -> Integer -> (Integer, Integer, Integer)-testLucas n q (S# i#) = look (WORD_SIZE_IN_BITS - 2)+testLucas n q (IS i#) = look (finiteBitSize (0 :: Word) - 2) where j = I# i# look k@@ -185,19 +193,19 @@ v2n1 = ((un1 - (2*q)*un)*vn-qn) `rem` n q2n = (qn*qn) `rem` n q2n1 = (qn*qn*q) `rem` n-testLucas n q (Jp# bn#) = test (s# -# 1#)+testLucas n q (IP bn#) = test (s# -# 1#) where- s# = sizeofBigNat# bn#- test j# = case indexBigNat# bn# j# of+ s# = bigNatSize# bn#+ test j# = case bigNatIndex# bn# j# of 0## -> test (j# -# 1#)- w# -> look (j# -# 1#) (W# w#) (WORD_SIZE_IN_BITS - 1)+ w# -> look (j# -# 1#) (W# w#) (finiteBitSize (0 :: Word) - 1) look j# w i | testBit w i = go j# w (i - 1) 1 1 1 q | otherwise = look j# w (i-1) go k# w i un un1 vn qn | i < 0 = if isTrue# (k# <# 0#) then (un,vn,qn)- else go (k# -# 1#) (W# (indexBigNat# bn# k#)) (WORD_SIZE_IN_BITS - 1) un un1 vn qn+ else go (k# -# 1#) (W# (bigNatIndex# bn# k#)) (finiteBitSize (0 :: Word) - 1) un un1 vn qn | testBit w i = go k# w (i-1) u2n1 u2n2 v2n1 q2n1 | otherwise = go k# w (i-1) u2n u2n1 v2n q2n where
Math/NumberTheory/Primes/Types.hs view
@@ -8,17 +8,28 @@ -- Should not be exposed to users. -- -{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-} module Math.NumberTheory.Primes.Types ( Prime(..)+ , toPrimeIntegral ) where +import Data.Bits import GHC.Generics import Control.DeepSeq+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as M+import qualified Data.Vector.Unboxed as U +import Math.NumberTheory.Utils.FromIntegral++-- $setup+-- >>> import Math.NumberTheory.Primes (nextPrime, precPrime)+ -- | Wrapper for prime elements of @a@. It is supposed to be constructed -- by 'Math.NumberTheory.Primes.nextPrime' / 'Math.NumberTheory.Primes.precPrime'. -- and eliminated by 'unPrime'.@@ -28,13 +39,14 @@ -- -- * Generate primes from the given interval: --+-- >>> :set -XFlexibleContexts -- >>> [nextPrime 101 .. precPrime 130] -- [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127] -- -- * Generate an infinite list of primes: ----- >>> [nextPrime 101 ..]--- [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127...+-- > [nextPrime 101 ..]+-- > [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127... -- -- * Generate primes from the given interval of form p = 6k+5: --@@ -48,7 +60,7 @@ -- -- * Get previous prime: ----- >>> prec (nextPrime 101)+-- >>> pred (nextPrime 101) -- Prime 97 -- -- * Count primes less than a given number (cf. 'Math.NumberTheory.Primes.Counting.approxPrimeCount'):@@ -72,3 +84,86 @@ showsPrec d (Prime p) r = (if d > 10 then "(" ++ s ++ ")" else s) ++ r where s = "Prime " ++ show p++newtype instance U.MVector s (Prime a) = MV_Prime (U.MVector s a)+newtype instance U.Vector (Prime a) = V_Prime (U.Vector a)++instance U.Unbox a => U.Unbox (Prime a)++instance M.MVector U.MVector a => M.MVector U.MVector (Prime a) where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicInitialize #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MV_Prime v) = M.basicLength v+ basicUnsafeSlice i n (MV_Prime v) = MV_Prime $ M.basicUnsafeSlice i n v+ basicOverlaps (MV_Prime v1) (MV_Prime v2) = M.basicOverlaps v1 v2+ basicUnsafeNew n = MV_Prime <$> M.basicUnsafeNew n+ basicInitialize (MV_Prime v) = M.basicInitialize v+ basicUnsafeReplicate n x = MV_Prime <$> M.basicUnsafeReplicate n (unPrime x)+ basicUnsafeRead (MV_Prime v) i = Prime <$> M.basicUnsafeRead v i+ basicUnsafeWrite (MV_Prime v) i x = M.basicUnsafeWrite v i (unPrime x)+ basicClear (MV_Prime v) = M.basicClear v+ basicSet (MV_Prime v) x = M.basicSet v (unPrime x)+ basicUnsafeCopy (MV_Prime v1) (MV_Prime v2) = M.basicUnsafeCopy v1 v2+ basicUnsafeMove (MV_Prime v1) (MV_Prime v2) = M.basicUnsafeMove v1 v2+ basicUnsafeGrow (MV_Prime v) n = MV_Prime <$> M.basicUnsafeGrow v n++instance G.Vector U.Vector a => G.Vector U.Vector (Prime a) where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MV_Prime v) = V_Prime <$> G.basicUnsafeFreeze v+ basicUnsafeThaw (V_Prime v) = MV_Prime <$> G.basicUnsafeThaw v+ basicLength (V_Prime v) = G.basicLength v+ basicUnsafeSlice i n (V_Prime v) = V_Prime $ G.basicUnsafeSlice i n v+ basicUnsafeIndexM (V_Prime v) i = Prime <$> G.basicUnsafeIndexM v i+ basicUnsafeCopy (MV_Prime mv) (V_Prime v) = G.basicUnsafeCopy mv v+ elemseq _ = seq++-- | Convert between primes of different types, similar in spirit to 'toIntegralSized'.+--+-- A simpler version of this function is:+--+-- > toPrimeIntegral :: (Integral a, Integral b) => a -> Maybe b+-- > toPrimeIntegral (Prime a)+-- > | toInteger a == b = Just (Prime (fromInteger b))+-- > | otherwise = Nothing+-- > where+-- > b = toInteger a+--+-- The point of 'toPrimeIntegral' is to avoid redundant conversions and conditions,+-- when it is safe to do so, determining type sizes statically with 'bitSizeMaybe'.+-- For example, 'toPrimeIntegral' from 'Prime' 'Int' to 'Prime' 'Word' boils down to+-- 'Just' . 'fromIntegral'.+--+toPrimeIntegral :: (Integral a, Integral b, Bits a, Bits b) => Prime a -> Maybe (Prime b)+toPrimeIntegral (Prime a) = case unsignedWidth b of+ Nothing -> res+ Just bW -> case unsignedWidth a of+ Just aW+ | aW <= bW -> res+ _+ | a <= bit bW - 1 -> res+ | otherwise -> Nothing+ where+ b = fromIntegral' a+ res = Just (Prime b)+{-# INLINE toPrimeIntegral #-}++unsignedWidth :: Bits a => a -> Maybe Int+unsignedWidth t+ | isSigned t = subtract 1 <$> bitSizeMaybe t+ | otherwise = bitSizeMaybe t+{-# INLINE unsignedWidth #-}
Math/NumberTheory/Quadratic/EisensteinIntegers.hs view
@@ -10,6 +10,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PostfixOperators #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} @@ -26,26 +27,29 @@ , primes ) where +import Prelude hiding (quot, quotRem, gcd) import Control.DeepSeq import Data.Coerce-import Data.List (mapAccumL, partition)-import Data.Maybe (fromMaybe)+import Data.Euclidean+import Data.List (mapAccumL)+import Data.List.Infinite (Infinite(..), (...))+import qualified Data.List.Infinite as Inf+import Data.List.NonEmpty (NonEmpty(..))+import Data.Maybe import Data.Ord (comparing)+import qualified Data.Semiring as S import GHC.Generics (Generic) -import qualified Math.NumberTheory.Euclidean as ED import Math.NumberTheory.Moduli.Sqrt-import qualified Math.NumberTheory.Primes.Sieve as Sieve-import qualified Math.NumberTheory.Primes.Testing as Testing import Math.NumberTheory.Primes.Types-import qualified Math.NumberTheory.Primes as U+import qualified Math.NumberTheory.Primes as U import Math.NumberTheory.Utils (mergeBy) import Math.NumberTheory.Utils.FromIntegral infix 6 :+ -- | An Eisenstein integer is @a + bω@, where @a@ and @b@ are both integers.-data EisensteinInteger = (:+) { real :: !Integer, imag :: !Integer }+data EisensteinInteger = !Integer :+ !Integer deriving (Eq, Ord, Generic) instance NFData EisensteinInteger@@ -75,17 +79,33 @@ fromInteger n = n :+ 0 signum = snd . absSignum +instance S.Semiring EisensteinInteger where+ plus = (+)+ times = (*)+ zero = 0 :+ 0+ one = 1 :+ 0+ fromNatural n = naturalToInteger n :+ 0++instance S.Ring EisensteinInteger where+ negate = negate+ -- | Returns an @EisensteinInteger@'s sign, and its associate in the first -- sextant. absSignum :: EisensteinInteger -> (EisensteinInteger, EisensteinInteger)+absSignum 0 = (0, 0) absSignum z@(a :+ b)- | a == 0 && b == 0 = (z, 0) -- origin- | a > b && b >= 0 = (z, 1) -- first sextant: 0 ≤ Arg(η) < π/3- | b >= a && a > 0 = ((-ω) * z, 1 + ω) -- second sextant: π/3 ≤ Arg(η) < 2π/3- | b > 0 && 0 >= a = ((-1 - ω) * z, ω) -- third sextant: 2π/3 ≤ Arg(η) < π- | a < b && b <= 0 = (- z, -1) -- fourth sextant: -π < Arg(η) < -2π/3 or Arg(η) = π- | b <= a && a < 0 = (ω * z, -1 - ω) -- fifth sextant: -2π/3 ≤ Arg(η) < -π/3- | otherwise = ((1 + ω) * z, -ω) -- sixth sextant: -π/3 ≤ Arg(η) < 0+ -- first sextant: 0 ≤ Arg(z) < π/3+ | a > b && b >= 0 = (z, 1)+ -- second sextant: π/3 ≤ Arg(z) < 2π/3+ | b >= a && a > 0 = (b :+ (b - a), 1 :+ 1)+ -- third sextant: 2π/3 ≤ Arg(z) < π+ | b > 0 && 0 >= a = ((b - a) :+ (-a), 0 :+ 1)+ -- fourth sextant: -π ≤ Arg(z) < -2π/3+ | a < b && b <= 0 = (-z, -1)+ -- fifth sextant: -2π/3 ≤ Arg(η) < -π/3+ | b <= a && a < 0 = ((-b) :+ (a - b), (-1) :+ (-1))+ -- sixth sextant: -π/3 ≤ Arg(η) < 0+ | otherwise = ((a - b) :+ a, 0 :+ (-1)) -- | List of all Eisenstein units, counterclockwise across all sextants, -- starting with @1@.@@ -96,26 +116,26 @@ associates :: EisensteinInteger -> [EisensteinInteger] associates e = map (e *) ids -instance ED.Euclidean EisensteinInteger where- quotRem = divHelper quot- divMod = divHelper div+instance GcdDomain EisensteinInteger --- | Function that does most of the underlying work for @divMod@ and--- @quotRem@, apart from choosing the specific integer division algorithm.--- This is instead done by the calling function (either @divMod@ which uses--- @div@, or @quotRem@, which uses @quot@.)-divHelper- :: (Integer -> Integer -> Integer)- -> EisensteinInteger- -> EisensteinInteger- -> (EisensteinInteger, EisensteinInteger)-divHelper divide g h =- let nr :+ ni = g * conjugate h- denom = norm h- q = divide nr denom :+ divide ni denom- p = h * q- in (q, g - p)+instance Euclidean EisensteinInteger where+ degree = fromInteger . norm+ quotRem x (d :+ 0) = quotRemInt x d+ quotRem x y = (q, x - q * y)+ where+ (q, _) = quotRemInt (x * conjugate y) (norm y) +quotRemInt :: EisensteinInteger -> Integer -> (EisensteinInteger, EisensteinInteger)+quotRemInt z 1 = ( z, 0)+quotRemInt z (-1) = (-z, 0)+quotRemInt (a :+ b) c = (qa :+ qb, (ra - bumpA) :+ (rb - bumpB))+ where+ halfC = abs c `quot` 2+ bumpA = signum a * halfC+ bumpB = signum b * halfC+ (qa, ra) = (a + bumpA) `quotRem` c+ (qb, rb) = (b + bumpB) `quotRem` c+ -- | Conjugate a Eisenstein integer. conjugate :: EisensteinInteger -> EisensteinInteger conjugate (a :+ b) = (a - b) :+ (-b)@@ -133,8 +153,8 @@ -- Special case, @1 - ω@ is the only Eisenstein prime with norm @3@, -- and @abs (1 - ω) = 2 + ω@. | a' == 2 && b' == 1 = True- | b' == 0 && a' `mod` 3 == 2 = Testing.isPrime a'- | nE `mod` 3 == 1 = Testing.isPrime nE+ | b' == 0 && a' `mod` 3 == 2 = isJust $ U.isPrime a'+ | nE `mod` 3 == 1 = isJust $ U.isPrime nE | otherwise = False where nE = norm e a' :+ b' = abs e@@ -154,35 +174,17 @@ (q2, r2) = divMod (a + b) 3 -- | Find an Eisenstein integer whose norm is the given prime number--- in the form @3k + 1@ using a modification of the--- <http://www.ams.org/journals/mcom/1972-26-120/S0025-5718-1972-0314745-6/S0025-5718-1972-0314745-6.pdf Hermite-Serret algorithm>.------ The maintainer <https://github.com/cartazio/arithmoi/pull/121#issuecomment-415010647 Andrew Lelechenko>--- derived the following:------ * Each prime of the form @3n + 1@ is actually of the form @6k + 1@.--- * One has @(z + 3k)^2 ≡ z^2 + 6kz + 9k^2 ≡ z^2 + (6k + 1)z - z + 9k^2 ≡ z^2 - z + 9k^2 (mod 6k + 1)@.------ The goal is to solve @z^2 - z + 1 ≡ 0 (mod 6k + 1)@. One has:------ 1. @z^2 - z + 1 ≡ 0 (mod 6k + 1)@--- 2. @z^2 - z ≡ -1 (mod 6k + 1)@--- 3. @z^2 - z + 9k^2 ≡ 9k^2 - 1 (mod 6k + 1)@--- 4. @(z + 3k)^2 ≡ 9k^2 - 1 (mod 6k + 1)@--- 5. @z + 3k = sqrtsModPrime(9k^2 - 1) (mod 6k + 1)@--- 6. @z = (sqrtsModPrime(9k^2 - 1) (mod 6k + 1)) - 3k@------ For example, let @p = 7@, then @k = 1@.--- Square root of @9*1^2-1 ≡ 1 (mod 7)@, and @z = 1 - 3*1 = -2 ≡ 5 (mod 7)@.+-- in the form @3k + 1@. ----- Truly, @norm (5 :+ 1) = 25 - 5 + 1 = 21 ≡ 0 (mod 7)@.+-- >>> import Math.NumberTheory.Primes (nextPrime)+-- >>> findPrime (nextPrime 7)+-- Prime 3+2*ω findPrime :: Prime Integer -> U.Prime EisensteinInteger-findPrime p = case sqrtsModPrime (9*k*k - 1) p of- [] -> error "findPrime: argument must be prime p = 6k + 1"- z : _ -> Prime $ ED.gcd (unPrime p :+ 0) ((z - 3 * k) :+ 1)- where- k :: Integer- k = unPrime p `div` 6+findPrime p = case (r, sqrtsModPrime (9 * q * q - 1) p) of+ (1, z : _) -> Prime $ abs $ gcd (unPrime p :+ 0) ((z - 3 * q) :+ 1)+ _ -> error "findPrime: argument must be prime p = 6k + 1"+ where+ (q, r) = unPrime p `quotRem` 6 -- | An infinite list of Eisenstein primes. Uses primes in @Z@ to exhaustively -- generate all Eisenstein primes in order of ascending norm.@@ -190,15 +192,26 @@ -- * Every prime is in the first sextant, so the list contains no associates. -- * Eisenstein primes from the whole complex plane can be generated by -- applying 'associates' to each prime in this list.-primes :: [Prime EisensteinInteger]-primes = coerce $ (2 :+ 1) : mergeBy (comparing norm) l r+--+-- >>> take 10 primes+-- [Prime 2+ω,Prime 2,Prime 3+2*ω,Prime 3+ω,Prime 4+3*ω,Prime 4+ω,Prime 5+3*ω,Prime 5+2*ω,Prime 5,Prime 6+5*ω]+primes :: Infinite (Prime EisensteinInteger)+primes = coerce $ (2 :+ 1) :< mergeBy (comparing norm) l r where- leftPrimes, rightPrimes :: [Prime Integer]- (leftPrimes, rightPrimes) = partition (\p -> unPrime p `mod` 3 == 2) Sieve.primes- rightPrimes' = filter (\prime -> unPrime prime `mod` 3 == 1) $ tail rightPrimes- l = [unPrime p :+ 0 | p <- leftPrimes]- r = [g | p <- rightPrimes', let x :+ y = unPrime (findPrime p), g <- [x :+ y, x :+ (x - y)]]+ leftPrimes, rightPrimes :: Infinite (Prime Integer)+ (leftPrimes, rightPrimes) = Inf.partition (\p -> unPrime p `mod` 3 == 2) (U.nextPrime 2...) + rightPrimes' :: Infinite (Prime Integer)+ rightPrimes' = Inf.filter (\prime -> unPrime prime `mod` 3 == 1) $ Inf.tail rightPrimes++ l :: Infinite EisensteinInteger+ l = fmap (\p -> unPrime p :+ 0) leftPrimes++ r :: Infinite EisensteinInteger+ r = Inf.concatMap+ (\p -> let x :+ y = unPrime (findPrime p) in (x :+ y) :| [x :+ (x - y)])+ rightPrimes'+ -- | [Implementation notes for factorise function] -- -- Compute the prime factorisation of a Eisenstein integer.@@ -215,7 +228,7 @@ -- where @a, b, c, a_i@ are nonnegative integers, @N > 1@ is an integer and -- @π_i@ are Eisenstein primes. ----- Aplying @norm@ to both sides of the equation from Theorem 8.4:+-- Applying @norm@ to both sides of the equation from Theorem 8.4: -- -- 1. @norm μ = norm ( (-1)^a * ω^b * (1 - ω)^c * product [ π_i^a_i | i <- [1..N]] ) ==@ -- 2. @norm μ = norm ((-1)^a) * norm (ω^b) * norm ((1 - ω)^c) * norm (product [ π_i^a_i | i <- [1..N]]) ==@@@ -255,7 +268,7 @@ | unPrime p `mod` 3 == 2 = let e' = e `quot` 2 in (z `quotI` (unPrime p ^ e'), [(Prime (unPrime p :+ 0), e')]) - -- The @`mod` 3 == 0@ case need not be verified because the+ -- The @`rem` 3 == 0@ case need not be verified because the -- only Eisenstein primes whose norm are a multiple of 3 -- are @1 - ω@ and its associates, which have already been -- removed by the above @go z (3, e)@ pattern match.@@ -268,7 +281,7 @@ gp' = Prime (x :+ (x - y)) (k, k', z') = divideByPrime gp gp' (unPrime p) e z - quotI (a :+ b) n = (a `quot` n :+ b `quot` n)+ quotI (a :+ b) n = a `quot` n :+ b `quot` n -- | Remove @p@ and @conjugate p@ factors from the argument, where -- @p@ is an Eisenstein prime.@@ -292,8 +305,7 @@ where (d1, z') = go1 c 0 z d2 = c - d1- z'' = head $ drop (wordToInt d2)- $ iterate (\g -> fromMaybe err $ (g * unPrime p) `quotEvenI` np) z'+ z'' = iterate (\g -> fromMaybe err $ (g * unPrime p) `quotEvenI` np) z' !! max 0 (wordToInt d2) go1 :: Word -> Word -> EisensteinInteger -> (Word, EisensteinInteger) go1 0 d z = (d, z)
Math/NumberTheory/Quadratic/GaussianIntegers.hs view
@@ -8,8 +8,8 @@ -- computing their prime factorisations. -- -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PostfixOperators #-} {-# LANGUAGE TypeFamilies #-} module Math.NumberTheory.Quadratic.GaussianIntegers (@@ -17,25 +17,29 @@ ι, conjugate, norm,+ ids,+ associates, primes, findPrime, ) where +import Prelude hiding (quot, quotRem) import Control.DeepSeq (NFData) import Data.Coerce-import Data.List (mapAccumL, partition)-import Data.Maybe (fromMaybe)+import Data.Euclidean+import Data.List (mapAccumL)+import Data.List.Infinite (Infinite(..), (...))+import qualified Data.List.Infinite as Inf+import Data.List.NonEmpty (NonEmpty(..))+import Data.Maybe import Data.Ord (comparing)+import qualified Data.Semiring as S import GHC.Generics --import qualified Math.NumberTheory.Euclidean as ED import Math.NumberTheory.Moduli.Sqrt-import Math.NumberTheory.Powers (integerSquareRoot)+import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.Primes.Types-import qualified Math.NumberTheory.Primes.Sieve as Sieve-import qualified Math.NumberTheory.Primes.Testing as Testing-import qualified Math.NumberTheory.Primes as U+import qualified Math.NumberTheory.Primes as U import Math.NumberTheory.Utils (mergeBy) import Math.NumberTheory.Utils.FromIntegral @@ -70,30 +74,61 @@ fromInteger n = n :+ 0 signum = snd . absSignum +instance S.Semiring GaussianInteger where+ plus = (+)+ times = (*)+ zero = 0 :+ 0+ one = 1 :+ 0+ fromNatural n = naturalToInteger n :+ 0++instance S.Ring GaussianInteger where+ negate = negate+ absSignum :: GaussianInteger -> (GaussianInteger, GaussianInteger)+absSignum 0 = (0, 0) absSignum z@(a :+ b)- | a == 0 && b == 0 = (z, 0) -- origin- | a > 0 && b >= 0 = (z, 1) -- first quadrant: (0, inf) x [0, inf)i- | a <= 0 && b > 0 = (b :+ (-a), ι) -- second quadrant: (-inf, 0] x (0, inf)i- | a < 0 && b <= 0 = ((-a) :+ (-b), -1) -- third quadrant: (-inf, 0) x (-inf, 0]i- | otherwise = ((-b) :+ a, -ι) -- fourth quadrant: [0, inf) x (-inf, 0)i+ -- first quadrant: (0, inf) x [0, inf)i+ | a > 0 && b >= 0 = (z, 1)+ -- second quadrant: (-inf, 0] x (0, inf)i+ | a <= 0 && b > 0 = (b :+ (-a), ι)+ -- third quadrant: (-inf, 0) x (-inf, 0]i+ | a < 0 && b <= 0 = (-z, -1)+ -- fourth quadrant: [0, inf) x (-inf, 0)i+ | otherwise = ((-b) :+ a, -ι) -instance ED.Euclidean GaussianInteger where- quotRem = divHelper quot- divMod = divHelper div+-- | List of all Gaussian units, counterclockwise across all quadrants,+-- starting with @1@.+--+-- @since 0.13.4.0+ids :: [GaussianInteger]+ids = [1, ι, -1, -ι] -divHelper- :: (Integer -> Integer -> Integer)- -> GaussianInteger- -> GaussianInteger- -> (GaussianInteger, GaussianInteger)-divHelper divide g h =- let nr :+ ni = g * conjugate h- denom = norm h- q = divide nr denom :+ divide ni denom- p = h * q- in (q, g - p)+-- | Produce a list of a @GaussianInteger@'s associates.+--+-- @since 0.13.4.0+associates :: GaussianInteger -> [GaussianInteger]+associates (a :+ b) = [a :+ b, (-b) :+ a, (-a) :+ (-b), b :+ (-a)] +instance GcdDomain GaussianInteger++instance Euclidean GaussianInteger where+ degree = fromInteger . norm+ quotRem x (d :+ 0) = quotRemInt x d+ quotRem x y = (q, x - q * y)+ where+ (q, _) = quotRemInt (x * conjugate y) (norm y)++quotRemInt :: GaussianInteger -> Integer -> (GaussianInteger, GaussianInteger)+quotRemInt z 1 = ( z, 0)+quotRemInt z (-1) = (-z, 0)+quotRemInt (a :+ b) c = (qa :+ qb, (ra - bumpA) :+ (rb - bumpB))+ where+ halfC = abs c `quot` 2+ bumpA = signum a * halfC+ bumpB = signum b * halfC+ (qa, ra) = (a + bumpA) `quotRem` c+ (qb, rb) = (b + bumpB) `quotRem` c+ -- |Conjugate a Gaussian integer. conjugate :: GaussianInteger -> GaussianInteger conjugate (r :+ i) = r :+ (-i)@@ -105,25 +140,37 @@ -- |Compute whether a given Gaussian integer is prime. isPrime :: GaussianInteger -> Bool isPrime g@(x :+ y)- | x == 0 && y /= 0 = abs y `mod` 4 == 3 && Testing.isPrime y- | y == 0 && x /= 0 = abs x `mod` 4 == 3 && Testing.isPrime x- | otherwise = Testing.isPrime $ norm g+ | x == 0 && y /= 0 = abs y `mod` 4 == 3 && isJust (U.isPrime y)+ | y == 0 && x /= 0 = abs x `mod` 4 == 3 && isJust (U.isPrime x)+ | otherwise = isJust $ U.isPrime $ norm g -- |An infinite list of the Gaussian primes. Uses primes in Z to exhaustively -- generate all Gaussian primes (up to associates), in order of ascending -- magnitude.-primes :: [U.Prime GaussianInteger]-primes = coerce $ (1 :+ 1) : mergeBy (comparing norm) l r+--+-- >>> take 10 primes+-- [Prime 1+ι,Prime 2+ι,Prime 1+2*ι,Prime 3,Prime 3+2*ι,Prime 2+3*ι,Prime 4+ι,Prime 1+4*ι,Prime 5+2*ι,Prime 2+5*ι]+primes :: Infinite (U.Prime GaussianInteger)+primes = coerce $ (1 :+ 1) :< mergeBy (comparing norm) l r where- leftPrimes, rightPrimes :: [Prime Integer]- (leftPrimes, rightPrimes) = partition (\p -> unPrime p `mod` 4 == 3) (tail Sieve.primes)- l = [unPrime p :+ 0 | p <- leftPrimes]- r = [g | p <- rightPrimes, let Prime (x :+ y) = findPrime p, g <- [x :+ y, y :+ x]]+ leftPrimes, rightPrimes :: Infinite (Prime Integer)+ (leftPrimes, rightPrimes) = Inf.partition (\p -> unPrime p `mod` 4 == 3) (U.nextPrime 3 ...) + l :: Infinite (GaussianInteger)+ l = fmap (\p -> unPrime p :+ 0) leftPrimes + r :: Infinite (GaussianInteger)+ r = Inf.concatMap+ (\p -> let x :+ y = unPrime (findPrime p) in (x :+ y) :| [y :+ x])+ rightPrimes+ -- |Find a Gaussian integer whose norm is the given prime number -- of form 4k + 1 using -- <http://www.ams.org/journals/mcom/1972-26-120/S0025-5718-1972-0314745-6/S0025-5718-1972-0314745-6.pdf Hermite-Serret algorithm>.+--+-- >>> import Math.NumberTheory.Primes (nextPrime)+-- >>> findPrime (nextPrime 5)+-- Prime 2+ι findPrime :: Prime Integer -> U.Prime GaussianInteger findPrime p = case sqrtsModPrime (-1) p of [] -> error "findPrime: an argument must be prime p = 4k + 1"@@ -189,8 +236,7 @@ where (d1, z') = go1 c 0 z d2 = c - d1- z'' = head $ drop (wordToInt d2)- $ iterate (\g -> fromMaybe err $ (g * unPrime p) `quotEvenI` np) z'+ z'' = iterate (\g -> fromMaybe err $ (g * unPrime p) `quotEvenI` np) z' !! wordToInt d2 go1 :: Word -> Word -> GaussianInteger -> (Word, GaussianInteger) go1 0 d z = (d, z)@@ -203,7 +249,7 @@ err = error $ "divideByPrime: malformed arguments" ++ show (p, np, k) quotI :: GaussianInteger -> Integer -> GaussianInteger-quotI (x :+ y) n = (x `quot` n :+ y `quot` n)+quotI (x :+ y) n = x `quot` n :+ y `quot` n quotEvenI :: GaussianInteger -> Integer -> Maybe GaussianInteger quotEvenI (x :+ y) n
Math/NumberTheory/Recurrences/Bilinear.hs view
@@ -12,29 +12,32 @@ -- Top-level definitions in this module are polymorphic, so the results of computations are not retained in memory. -- Make them monomorphic to take advantages of memoization. Compare ----- >>> :set +s--- >>> binomial !! 1000 !! 1000 :: Integer+-- >>> binomial !! 1000 !! 1000 :: Integer -- (0.01 secs, 1,385,512 bytes) -- 1--- (0.01 secs, 1,385,512 bytes)--- >>> binomial !! 1000 !! 1000 :: Integer+-- >>> binomial !! 1000 !! 1000 :: Integer -- (0.01 secs, 1,381,616 bytes) -- 1--- (0.01 secs, 1,381,616 bytes) -- -- against -- -- >>> let binomial' = binomial :: [[Integer]]--- >>> binomial' !! 1000 !! 1000 :: Integer+-- >>> binomial' !! 1000 !! 1000 :: Integer -- (0.01 secs, 1,381,696 bytes) -- 1--- (0.01 secs, 1,381,696 bytes)--- >>> binomial' !! 1000 !! 1000 :: Integer+-- >>> binomial' !! 1000 !! 1000 :: Integer -- (0.01 secs, 391,152 bytes) -- 1--- (0.01 secs, 391,152 bytes) -{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PostfixOperators #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Recurrences.Bilinear- ( binomial+ ( -- * Pascal triangle+ binomial+ , binomialRotated+ , binomialLine+ , binomialDiagonal+ , binomialFactors+ -- * Other recurrences , stirling1 , stirling2 , lah@@ -46,31 +49,105 @@ , faulhaberPoly ) where -import Data.List+import Data.Euclidean (GcdDomain(..))+import Data.List (scanl', zipWith4)+import Data.List.Infinite (Infinite(..), (...))+import qualified Data.List.Infinite as Inf+import Data.List.NonEmpty (NonEmpty(..))+import Data.Maybe import Data.Ratio+import Data.Semiring (Semiring(..)) import Numeric.Natural import Math.NumberTheory.Recurrences.Linear (factorial)+import Math.NumberTheory.Primes --- | Infinite zero-based table of binomial coefficients (also known as Pascal triangle):--- @binomial !! n !! k == n! \/ k! \/ (n - k)!@.+-- | Infinite zero-based table of binomial coefficients (also known as Pascal triangle). ----- >>> take 5 (map (take 5) binomial)--- [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1]]+-- > binomial !! n !! k == n! / k! / (n - k)! ----- Complexity: @binomial !! n !! k@ is O(n) bits long, its computation--- takes O(k n) time and forces thunks @binomial !! n !! i@ for @0 <= i <= k@.--- Use the symmetry of Pascal triangle @binomial !! n !! k == binomial !! n !! (n - k)@ to speed up computations.+-- Note that 'binomial' !! n !! k is asymptotically slower+-- than 'binomialLine' n !! k,+-- but imposes only 'Semiring' constraint. ----- One could also consider 'Math.Combinat.Numbers.binomial' to compute stand-alone values.-binomial :: Integral a => [[a]]-binomial = map f [0..]+-- >>> take 6 binomial :: [[Int]]+-- [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1]]+binomial :: Semiring a => Infinite [a]+binomial = Inf.iterate (\l -> zipWith plus (l ++ [zero]) (zero : l)) [one]+{-# SPECIALIZE binomial :: Infinite [Int] #-}+{-# SPECIALIZE binomial :: Infinite [Word] #-}+{-# SPECIALIZE binomial :: Infinite [Integer] #-}+{-# SPECIALIZE binomial :: Infinite [Natural] #-}++-- | Pascal triangle, rotated by 45 degrees.+--+-- > binomialRotated !! n !! k == (n + k)! / n! / k! == binomial !! (n + k) !! k+--+-- Note that 'binomialRotated' !! n !! k is asymptotically slower+-- than 'binomialDiagonal' n !! k,+-- but imposes only 'Semiring' constraint.+--+-- >>> take 6 (map (take 6) binomialRotated) :: [[Int]]+-- [[1,1,1,1,1,1],[1,2,3,4,5,6],[1,3,6,10,15,21],[1,4,10,20,35,56],[1,5,15,35,70,126],[1,6,21,56,126,252]]+binomialRotated :: Semiring a => Infinite (Infinite a)+binomialRotated = Inf.iterate (Inf.tail . Inf.scanl' plus zero) (Inf.repeat one)+{-# SPECIALIZE binomialRotated :: Infinite (Infinite Int) #-}+{-# SPECIALIZE binomialRotated :: Infinite (Infinite Word) #-}+{-# SPECIALIZE binomialRotated :: Infinite (Infinite Integer) #-}+{-# SPECIALIZE binomialRotated :: Infinite (Infinite Natural) #-}++-- | The n-th (zero-based) line of 'binomial'+-- (and the n-th diagonal of 'binomialRotated').+--+-- >>> binomialLine 5+-- [1,5,10,10,5,1]+binomialLine :: (Enum a, GcdDomain a) => a -> [a]+binomialLine n = scanl'+ (\x (k, nk1) -> fromJust $ (x `times` nk1) `divide` k)+ one+ (zip [one..n] [n, pred n..one])+{-# SPECIALIZE binomialLine :: Int -> [Int] #-}+{-# SPECIALIZE binomialLine :: Word -> [Word] #-}+{-# SPECIALIZE binomialLine :: Integer -> [Integer] #-}+{-# SPECIALIZE binomialLine :: Natural -> [Natural] #-}++-- | The n-th (zero-based) diagonal of 'binomial'+-- (and the n-th line of 'binomialRotated').+--+-- >>> take 6 (binomialDiagonal 5)+-- [1,6,21,56,126,252]+binomialDiagonal :: (Enum a, GcdDomain a) => a -> Infinite a+binomialDiagonal n = Inf.scanl'+ (\x k -> fromJust (x `times` (n `plus` k) `divide` k))+ one+ (one...)+{-# SPECIALIZE binomialDiagonal :: Int -> Infinite Int #-}+{-# SPECIALIZE binomialDiagonal :: Word -> Infinite Word #-}+{-# SPECIALIZE binomialDiagonal :: Integer -> Infinite Integer #-}+{-# SPECIALIZE binomialDiagonal :: Natural -> Infinite Natural #-}++-- | Prime factors of a binomial coefficient.+--+-- > binomialFactors n k == factorise (binomial !! n !! k)+--+-- >>> binomialFactors 10 4+-- [(Prime 2,1),(Prime 3,1),(Prime 5,1),(Prime 7,1)]+binomialFactors :: Word -> Word -> [(Prime Word, Word)]+binomialFactors n k+ | n < 2+ = []+ | otherwise+ = filter ((/= 0) . snd)+ $ map (\p -> (p, mult (unPrime p) n - mult (unPrime p) (n - k) - mult (unPrime p) k))+ [minBound .. precPrime n] where- f n = scanl (\x k -> x * (n - k + 1) `div` k) 1 [1..n]-{-# SPECIALIZE binomial :: [[Int]] #-}-{-# SPECIALIZE binomial :: [[Word]] #-}-{-# SPECIALIZE binomial :: [[Integer]] #-}-{-# SPECIALIZE binomial :: [[Natural]] #-}+ mult :: Word -> Word -> Word+ mult p m = go mp mp+ where+ mp = m `quot` p+ go !acc !x+ | x >= p = let xp = x `quot` p in go (acc + xp) xp+ | otherwise = acc -- | Infinite zero-based table of <https://en.wikipedia.org/wiki/Stirling_numbers_of_the_first_kind Stirling numbers of the first kind>. --@@ -80,15 +157,15 @@ -- Complexity: @stirling1 !! n !! k@ is O(n ln n) bits long, its computation -- takes O(k n^2 ln n) time and forces thunks @stirling1 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@. ----- One could also consider 'Math.Combinat.Numbers.unsignedStirling1st' to compute stand-alone values.-stirling1 :: (Num a, Enum a) => [[a]]-stirling1 = scanl f [1] [0..]+-- One could also consider 'Math.Combinat.Numbers.unsignedStirling1st' from <http://hackage.haskell.org/package/combinat combinat> package to compute stand-alone values.+stirling1 :: (Num a, Enum a) => Infinite [a]+stirling1 = Inf.scanl f [1] (0...) where f xs n = 0 : zipIndexedListWithTail (\_ x y -> x + n * y) 1 xs 0-{-# SPECIALIZE stirling1 :: [[Int]] #-}-{-# SPECIALIZE stirling1 :: [[Word]] #-}-{-# SPECIALIZE stirling1 :: [[Integer]] #-}-{-# SPECIALIZE stirling1 :: [[Natural]] #-}+{-# SPECIALIZE stirling1 :: Infinite [Int] #-}+{-# SPECIALIZE stirling1 :: Infinite [Word] #-}+{-# SPECIALIZE stirling1 :: Infinite [Integer] #-}+{-# SPECIALIZE stirling1 :: Infinite [Natural] #-} -- | Infinite zero-based table of <https://en.wikipedia.org/wiki/Stirling_numbers_of_the_second_kind Stirling numbers of the second kind>. --@@ -98,15 +175,15 @@ -- Complexity: @stirling2 !! n !! k@ is O(n ln n) bits long, its computation -- takes O(k n^2 ln n) time and forces thunks @stirling2 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@. ----- One could also consider 'Math.Combinat.Numbers.stirling2nd' to compute stand-alone values.-stirling2 :: (Num a, Enum a) => [[a]]-stirling2 = iterate f [1]+-- One could also consider 'Math.Combinat.Numbers.stirling2nd' from <http://hackage.haskell.org/package/combinat combinat> package to compute stand-alone values.+stirling2 :: (Num a, Enum a) => Infinite [a]+stirling2 = Inf.iterate f [1] where f xs = 0 : zipIndexedListWithTail (\k x y -> x + k * y) 1 xs 0-{-# SPECIALIZE stirling2 :: [[Int]] #-}-{-# SPECIALIZE stirling2 :: [[Word]] #-}-{-# SPECIALIZE stirling2 :: [[Integer]] #-}-{-# SPECIALIZE stirling2 :: [[Natural]] #-}+{-# SPECIALIZE stirling2 :: Infinite [Int] #-}+{-# SPECIALIZE stirling2 :: Infinite [Word] #-}+{-# SPECIALIZE stirling2 :: Infinite [Integer] #-}+{-# SPECIALIZE stirling2 :: Infinite [Natural] #-} -- | Infinite one-based table of <https://en.wikipedia.org/wiki/Lah_number Lah numbers>. -- @lah !! n !! k@ equals to lah(n + 1, k + 1).@@ -116,15 +193,15 @@ -- -- Complexity: @lah !! n !! k@ is O(n ln n) bits long, its computation -- takes O(k n ln n) time and forces thunks @lah !! n !! i@ for @0 <= i <= k@.-lah :: Integral a => [[a]]+lah :: Integral a => Infinite [a] -- Implementation was derived from code by https://github.com/grandpascorpion-lah = zipWith f (tail factorial) [1..]+lah = Inf.zipWith f (Inf.tail factorial) (1...) where f nf n = scanl (\x k -> x * (n - k) `div` (k * (k + 1))) nf [1..n-1]-{-# SPECIALIZE lah :: [[Int]] #-}-{-# SPECIALIZE lah :: [[Word]] #-}-{-# SPECIALIZE lah :: [[Integer]] #-}-{-# SPECIALIZE lah :: [[Natural]] #-}+{-# SPECIALIZE lah :: Infinite [Int] #-}+{-# SPECIALIZE lah :: Infinite [Word] #-}+{-# SPECIALIZE lah :: Infinite [Integer] #-}+{-# SPECIALIZE lah :: Infinite [Natural] #-} -- | Infinite zero-based table of <https://en.wikipedia.org/wiki/Eulerian_number Eulerian numbers of the first kind>. --@@ -134,14 +211,14 @@ -- Complexity: @eulerian1 !! n !! k@ is O(n ln n) bits long, its computation -- takes O(k n^2 ln n) time and forces thunks @eulerian1 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@. ---eulerian1 :: (Num a, Enum a) => [[a]]-eulerian1 = scanl f [] [1..]+eulerian1 :: (Num a, Enum a) => Infinite [a]+eulerian1 = Inf.scanl f [] (1...) where f xs n = 1 : zipIndexedListWithTail (\k x y -> (n - k) * x + (k + 1) * y) 1 xs 0-{-# SPECIALIZE eulerian1 :: [[Int]] #-}-{-# SPECIALIZE eulerian1 :: [[Word]] #-}-{-# SPECIALIZE eulerian1 :: [[Integer]] #-}-{-# SPECIALIZE eulerian1 :: [[Natural]] #-}+{-# SPECIALIZE eulerian1 :: Infinite [Int] #-}+{-# SPECIALIZE eulerian1 :: Infinite [Word] #-}+{-# SPECIALIZE eulerian1 :: Infinite [Integer] #-}+{-# SPECIALIZE eulerian1 :: Infinite [Natural] #-} -- | Infinite zero-based table of <https://en.wikipedia.org/wiki/Eulerian_number#Eulerian_numbers_of_the_second_kind Eulerian numbers of the second kind>. --@@ -151,14 +228,14 @@ -- Complexity: @eulerian2 !! n !! k@ is O(n ln n) bits long, its computation -- takes O(k n^2 ln n) time and forces thunks @eulerian2 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@. ---eulerian2 :: (Num a, Enum a) => [[a]]-eulerian2 = scanl f [] [1..]+eulerian2 :: (Num a, Enum a) => Infinite [a]+eulerian2 = Inf.scanl f [] (1...) where f xs n = 1 : zipIndexedListWithTail (\k x y -> (2 * n - k - 1) * x + (k + 1) * y) 1 xs 0-{-# SPECIALIZE eulerian2 :: [[Int]] #-}-{-# SPECIALIZE eulerian2 :: [[Word]] #-}-{-# SPECIALIZE eulerian2 :: [[Integer]] #-}-{-# SPECIALIZE eulerian2 :: [[Natural]] #-}+{-# SPECIALIZE eulerian2 :: Infinite [Int] #-}+{-# SPECIALIZE eulerian2 :: Infinite [Word] #-}+{-# SPECIALIZE eulerian2 :: Infinite [Integer] #-}+{-# SPECIALIZE eulerian2 :: Infinite [Natural] #-} -- | Infinite zero-based sequence of <https://en.wikipedia.org/wiki/Bernoulli_number Bernoulli numbers>, -- computed via <https://en.wikipedia.org/wiki/Bernoulli_number#Connection_with_Stirling_numbers_of_the_second_kind connection>@@ -170,11 +247,11 @@ -- Complexity: @bernoulli !! n@ is O(n ln n) bits long, its computation -- takes O(n^3 ln n) time and forces thunks @stirling2 !! i !! j@ for @0 <= i <= n@ and @0 <= j <= i@. ----- One could also consider 'Math.Combinat.Numbers.bernoulli' to compute stand-alone values.-bernoulli :: Integral a => [Ratio a]-bernoulli = helperForB_E_EP id (map recip [1..])-{-# SPECIALIZE bernoulli :: [Ratio Int] #-}-{-# SPECIALIZE bernoulli :: [Rational] #-}+-- One could also consider 'Math.Combinat.Numbers.bernoulli' from <http://hackage.haskell.org/package/combinat combinat> package to compute stand-alone values.+bernoulli :: Integral a => Infinite (Ratio a)+bernoulli = helperForBEEP id (Inf.map recip (1...))+{-# SPECIALIZE bernoulli :: Infinite (Ratio Int) #-}+{-# SPECIALIZE bernoulli :: Infinite (Rational) #-} -- | <https://en.wikipedia.org/wiki/Faulhaber%27s_formula Faulhaber's formula>. --@@ -182,15 +259,15 @@ -- 959924142434241924250 -- >>> sum $ zipWith (*) (faulhaberPoly 10) (iterate (* 100) 1) -- 959924142434241924250 % 1-faulhaberPoly :: Integral a => Int -> [Ratio a]+faulhaberPoly :: (GcdDomain a, Integral a) => Int -> [Ratio a] -- Implementation by https://github.com/CarlEdman faulhaberPoly p = zipWith (*) ((0:) $ reverse- $ take (p+1) $ bernoulli)+ $ Inf.take (p + 1) bernoulli) $ map (% (fromIntegral p+1)) $ zipWith (*) (iterate negate (if odd p then 1 else -1))- $ binomial !! (fromIntegral p+1)+ $ binomial Inf.!! (fromIntegral (p+1)) -- | Infinite zero-based list of <https://en.wikipedia.org/wiki/Euler_number Euler numbers>. -- The algorithm used was derived from <http://www.emis.ams.org/journals/JIS/VOL4/CHEN/AlgBE2.pdf Algorithms for Bernoulli numbers and Euler numbers>@@ -199,28 +276,28 @@ -- -- >>> take 10 euler' :: [Rational] -- [1 % 1,0 % 1,(-1) % 1,0 % 1,5 % 1,0 % 1,(-61) % 1,0 % 1,1385 % 1,0 % 1]-euler' :: forall a . Integral a => [Ratio a]-euler' = tail $ helperForB_E_EP tail as+euler' :: forall a . Integral a => Infinite (Ratio a)+euler' = Inf.tail $ helperForBEEP (drop 1) as where- as :: [Ratio a]- as = zipWith3+ as :: Infinite (Ratio a)+ as = Inf.zipWith3 (\sgn frac ones -> (sgn * ones) % frac)- (cycle [1, 1, 1, 1, -1, -1, -1, -1])- (dups (iterate (2 *) 1))- (cycle [1, 1, 1, 0])+ (Inf.cycle (1 :| [1, 1, 1, -1, -1, -1, -1]))+ (dups (Inf.iterate (2 *) 1))+ (Inf.cycle (1 :| [1, 1, 0])) - dups :: forall x . [x] -> [x]- dups = foldr (\n list -> n : n : list) []-{-# SPECIALIZE euler' :: [Ratio Int] #-}-{-# SPECIALIZE euler' :: [Rational] #-}+ dups :: forall x . Infinite x -> Infinite x+ dups = Inf.foldr (\n list -> n :< n :< list)+{-# SPECIALIZE euler' :: Infinite (Ratio Int) #-}+{-# SPECIALIZE euler' :: Infinite (Rational) #-} -- | The same sequence as @euler'@, but with type @[a]@ instead of @[Ratio a]@ -- as the denominators in @euler'@ are always @1@. -- -- >>> take 10 euler :: [Integer] -- [1,0,-1,0,5,0,-61,0,1385,0]-euler :: forall a . Integral a => [a]-euler = map numerator euler'+euler :: forall a . Integral a => Infinite a+euler = Inf.map numerator euler' -- | Infinite zero-based list of the @n@-th order Euler polynomials evaluated at @1@. -- The algorithm used was derived from <http://www.emis.ams.org/journals/JIS/VOL4/CHEN/AlgBE2.pdf Algorithms for Bernoulli numbers and Euler numbers>@@ -230,10 +307,10 @@ -- -- >>> take 10 eulerPolyAt1 :: [Rational] -- [1 % 1,1 % 2,0 % 1,(-1) % 4,0 % 1,1 % 2,0 % 1,(-17) % 8,0 % 1,31 % 2]-eulerPolyAt1 :: forall a . Integral a => [Ratio a]-eulerPolyAt1 = tail $ helperForB_E_EP tail (map recip (iterate (2 *) 1))-{-# SPECIALIZE eulerPolyAt1 :: [Ratio Int] #-}-{-# SPECIALIZE eulerPolyAt1 :: [Rational] #-}+eulerPolyAt1 :: forall a . Integral a => Infinite (Ratio a)+eulerPolyAt1 = Inf.tail $ helperForBEEP (drop 1) (Inf.map recip (Inf.iterate (2 *) 1))+{-# SPECIALIZE eulerPolyAt1 :: Infinite (Ratio Int) #-}+{-# SPECIALIZE eulerPolyAt1 :: Infinite (Rational) #-} ------------------------------------------------------------------------------- -- Utils@@ -255,16 +332,15 @@ -- zipping four lists together with multiplication, with one of those lists -- being the sublists in @stirling2@, and two of them being the factorial -- sequence and @cycle [1, -1]@. The remaining list is passed to--- @helperForB_E_EP@ as an argument.+-- @helperForBEEP@ as an argument. -- -- Note: This function has a @([Ratio a] -> [Ratio a])@ argument because -- @bernoulli !! n@ will use, for all nonnegative @n@, every element in -- @stirling2 !! n@, while @euler, eulerPolyAt1@ only use -- @tail $ stirling2 !! n@. As such, this argument serves to pass @id@ -- in the former case, and @tail@ in the latter.-helperForB_E_EP :: Integral a => ([Ratio a] -> [Ratio a]) -> [Ratio a] -> [Ratio a]-helperForB_E_EP g xs = map (f . g) stirling2+helperForBEEP :: Integral a => (forall b. [b] -> [b]) -> Infinite (Ratio a) -> Infinite (Ratio a)+helperForBEEP g xs = Inf.map (f . g) stirling2 where- f = sum . zipWith4 (\sgn fact x stir -> sgn * fact * x * stir) (cycle [1, -1]) factorial xs-{-# SPECIALIZE helperForB_E_EP :: ([Ratio Int] -> [Ratio Int]) -> [Ratio Int] -> [Ratio Int] #-}-{-# SPECIALIZE helperForB_E_EP :: ([Rational] -> [Rational]) -> [Rational] -> [Rational] #-}+ f = sum . zipWith4 (\sgn fact x stir -> sgn * fact * x * stir) (cycle [1, -1]) (Inf.toList factorial) (Inf.toList xs)+{-# INLINABLE helperForBEEP #-}
Math/NumberTheory/Recurrences/Linear.hs view
@@ -6,9 +6,12 @@ -- -- Efficient calculation of linear recurrent sequences, including Fibonacci and Lucas sequences. -{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PostfixOperators #-}+ module Math.NumberTheory.Recurrences.Linear ( factorial+ , factorialFactors , fibonacci , fibonacciPair , lucas@@ -16,10 +19,11 @@ , generalLucas ) where -#include "MachDeps.h"- import Data.Bits+import Data.List.Infinite (Infinite(..), (...))+import qualified Data.List.Infinite as Inf import Numeric.Natural+import Math.NumberTheory.Primes -- | Infinite zero-based table of factorials. --@@ -28,13 +32,34 @@ -- -- The time-and-space behaviour of 'factorial' is similar to described in -- "Math.NumberTheory.Recurrences.Bilinear#memory".-factorial :: (Num a, Enum a) => [a]-factorial = scanl (*) 1 [1..]-{-# SPECIALIZE factorial :: [Int] #-}-{-# SPECIALIZE factorial :: [Word] #-}-{-# SPECIALIZE factorial :: [Integer] #-}-{-# SPECIALIZE factorial :: [Natural] #-}+factorial :: (Num a, Enum a) => Infinite a+factorial = Inf.scanl (*) 1 (1...)+{-# SPECIALIZE factorial :: Infinite Int #-}+{-# SPECIALIZE factorial :: Infinite Word #-}+{-# SPECIALIZE factorial :: Infinite Integer #-}+{-# SPECIALIZE factorial :: Infinite Natural #-} +-- | Prime factors of a factorial.+--+-- > factorialFactors n == factorise (factorial !! n)+--+-- >>> factorialFactors 10+-- [(Prime 2,8),(Prime 3,4),(Prime 5,2),(Prime 7,1)]+factorialFactors :: Word -> [(Prime Word, Word)]+factorialFactors n+ | n < 2+ = []+ | otherwise+ = map (\p -> (p, mult (unPrime p))) [minBound .. precPrime n]+ where+ mult :: Word -> Word+ mult p = go np np+ where+ np = n `quot` p+ go !acc !x+ | x >= p = let xp = x `quot` p in go (acc + xp) xp+ | otherwise = acc+ -- | @'fibonacci' k@ calculates the @k@-th Fibonacci number in -- /O/(@log (abs k)@) steps. The index may be negative. This -- is efficient for calculating single Fibonacci numbers (with@@ -58,7 +83,7 @@ fibonacciPair n | n < 0 = let (f,g) = fibonacciPair (-(n+1)) in if testBit n 0 then (g, -f) else (-g, f) | n == 0 = (0, 1)- | otherwise = look (WORD_SIZE_IN_BITS - 2)+ | otherwise = look (finiteBitSize (0 :: Word) - 2) where look k | testBit n k = go (k-1) 0 1@@ -87,7 +112,7 @@ lucasPair n | n < 0 = let (f,g) = lucasPair (-(n+1)) in if testBit n 0 then (-g, f) else (g, -f) | n == 0 = (2, 1)- | otherwise = look (WORD_SIZE_IN_BITS - 2)+ | otherwise = look (finiteBitSize (0 :: Word) - 2) where look k | testBit n k = go (k-1) 0 1@@ -118,7 +143,7 @@ generalLucas p q k | k < 0 = error "generalLucas: negative index" | k == 0 = (0,1,2,p)- | otherwise = look (WORD_SIZE_IN_BITS - 2)+ | otherwise = look (finiteBitSize (0 :: Word) - 2) where look i | testBit k i = go (i-1) 1 p p q
Math/NumberTheory/Recurrences/Pentagonal.hs view
@@ -7,66 +7,40 @@ -- Values of <https://en.wikipedia.org/wiki/Partition_(number_theory)#Partition_function partition function>. -- -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE PostfixOperators #-}+{-# LANGUAGE TypeApplications #-} module Math.NumberTheory.Recurrences.Pentagonal ( partition- , pentagonalSigns- , pents ) where -import qualified Data.IntMap as IM-import Numeric.Natural (Natural)+import qualified Data.Chimera as Ch+import Data.List.Infinite (Infinite(..), (...))+import qualified Data.List.Infinite as Inf+import Data.Vector (Vector)+import Numeric.Natural (Natural) -- | Infinite list of generalized pentagonal numbers. -- Example: -- -- >>> take 10 pents -- [0,1,2,5,7,12,15,22,26,35]-pents :: (Enum a, Num a) => [a]-pents = interleave (scanl (\acc n -> acc + 3 * n - 1) 0 [1..])- (scanl (\acc n -> acc + 3 * n - 2) 1 [2..])- where- interleave :: [a] -> [a] -> [a]- interleave (n : ns) (m : ms) = n : m : interleave ns ms- interleave _ _ = []---- | When calculating the @n@-th partition number @p(n)@ using the sum--- @p(n) = p(n-1) + p(n-2) - p(n-5) - p(n-7) + p(n-11) + ...@, the signs of each--- term alternate every two terms, starting with a positive sign.--- @pentagonalSigns@ takes a list of numbers and produces such an alternated--- sequence.--- Examples:------ >>> pentagonalSigns [1..5]--- [1,2,-3,-4,5]------ >>> pentagonalSigns [1..6]--- [1,2,-3,-4,5,6]-pentagonalSigns :: Num a => [a] -> [a]-pentagonalSigns = zipWith (*) (cycle [1, 1, -1, -1])+pents :: (Enum a, Num a) => Infinite a+pents = Inf.interleave+ (Inf.scanl (\acc n -> acc + 3 * n - 1) 0 (1...))+ (Inf.scanl (\acc n -> acc + 3 * n - 2) 1 (2...)) --- [Implementation notes for partition function]------ @p(n) = p(n-1) + p(n-2) - p(n-5) - p(n-7) + p(n-11) + ...@, where @p(0) = 1@--- and @p(k) = 0@ for a negative integer @k@. Uses a @Map@ from the--- @containers@ package to memoize previous results.------ Example: calculating @partition !! 10@, assuming the memoization map is--- filled and called @dict :: Integral a => Map a a@.------ * @tail [0, 1, 2, 5, 7, 12 ,15, 22, 26, 35, ..] == [1, 2, 5, 7, 12 ,15, 22, 26, 35, 40, ..]@.--- * @takeWhile (\m -> 10 - m >= 0) [1, 2, 5, 7, 12 ,15, 22, 26, 35, 40, ..] == [1, 2, 5, 7]@.--- * @map (\m -> dict ! fromIntegral (10 - m)) [1, 2, 5, 7] == [dict ! 9, dict ! 8, dict ! 5, dict ! 3] == [30, 22, 7, 3]@--- * @pentagonalSigns [30, 22, 7, 3] == [30, 22, 7, 3] == [30, 22, -7, -3]@--- * @sum [30, 22, -7, -3] == 42@------ Notes:--- 1. @tail@ is applied to @pents@ because otherwise the calculation of--- @p(n)@ would involve a duplicated @p(n-1)@ term (see the above example).--- 2. Calculating @partition !! k@, where @k@ is any index equal or higher--- than @maxBound :: Int@ results in undefined behavior.+-- | @p(n) = p(n-1) + p(n-2) - p(n-5) - p(n-7) + p(n-11) + ...@, where @p(0) = 1@+-- and @p(k) = 0@ for a negative integer @k@. Uses a @Chimera@ from the+-- @chimera@ package to memoize previous results.+partitionF :: Num a => (Word -> a) -> Word -> a+partitionF _ 0 = 1+partitionF f n+ = sum+ $ zipWith (*) (cycle [1, 1, -1, -1])+ $ map (f . (n -))+ $ Inf.takeWhile (<= n)+ $ Inf.tail pents -- | Infinite zero-based table of <https://oeis.org/A000041 partition numbers>. --@@ -74,22 +48,14 @@ -- [1,1,2,3,5,7,11,15,22,30] -- -- >>> :set -XDataKinds--- >>> import Math.NumberTheory.Moduli.Class+-- >>> import Data.Mod -- >>> partition !! 1000 :: Mod 1000 -- (991 `modulo` 1000)-partition :: Num a => [a]-partition = 1 : go (IM.singleton 0 1) 1+partition :: Num a => Infinite a+partition = Inf.tabulate (Ch.index ch) where- go :: Num a => IM.IntMap a -> Int -> [a]- go dict !n =- let n' = (sum .- pentagonalSigns .- map (\m -> dict IM.! (n - m)) .- takeWhile (\m -> n >= m) .- tail) (pents :: [Int])- dict' = IM.insert n n' dict- in n' : go dict' (n + 1)-{-# SPECIALIZE partition :: [Int] #-}-{-# SPECIALIZE partition :: [Word] #-}-{-# SPECIALIZE partition :: [Integer] #-}-{-# SPECIALIZE partition :: [Natural] #-}+ ch = Ch.tabulateFix @Vector partitionF+{-# SPECIALIZE partition :: Infinite Int #-}+{-# SPECIALIZE partition :: Infinite Word #-}+{-# SPECIALIZE partition :: Infinite Integer #-}+{-# SPECIALIZE partition :: Infinite Natural #-}
− Math/NumberTheory/Recurrencies.hs
@@ -1,17 +0,0 @@--- |--- Module: Math.NumberTheory.Recurrencies--- Description: Deprecated--- Copyright: (c) 2018 Alexandre Rodrigues Baldé--- Licence: MIT--- Maintainer: Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>-----module Math.NumberTheory.Recurrencies {-# DEPRECATED "Use `Math.NumberTheory.Recurrences` instead." #-}- ( module Math.NumberTheory.Recurrences.Linear- , module Math.NumberTheory.Recurrences.Bilinear- , module Math.NumberTheory.Recurrences.Pentagonal- ) where--import Math.NumberTheory.Recurrences.Bilinear-import Math.NumberTheory.Recurrences.Linear-import Math.NumberTheory.Recurrences.Pentagonal (partition)
− Math/NumberTheory/Recurrencies/Bilinear.hs
@@ -1,38 +0,0 @@--- |--- Module: Math.NumberTheory.Recurrencies.Bilinear--- Description: Deprecated--- Copyright: (c) 2016 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Bilinear recurrent sequences and Bernoulli numbers,--- roughly covering Ch. 5-6 of /Concrete Mathematics/--- by R. L. Graham, D. E. Knuth and O. Patashnik.------ #memory# __Note on memory leaks and memoization.__--- Top-level definitions in this module are polymorphic, so the results of computations are not retained in memory.--- Make them monomorphic to take advantages of memoization. Compare------ >>> :set +s--- >>> binomial !! 1000 !! 1000 :: Integer--- 1--- (0.01 secs, 1,385,512 bytes)--- >>> binomial !! 1000 !! 1000 :: Integer--- 1--- (0.01 secs, 1,381,616 bytes)------ against------ >>> let binomial' = binomial :: [[Integer]]--- >>> binomial' !! 1000 !! 1000 :: Integer--- 1--- (0.01 secs, 1,381,696 bytes)--- >>> binomial' !! 1000 !! 1000 :: Integer--- 1--- (0.01 secs, 391,152 bytes)--module Math.NumberTheory.Recurrencies.Bilinear {-# DEPRECATED "Use `Math.NumberTheory.Recurrences.Bilinear` instead." #-}- ( module Math.NumberTheory.Recurrences.Bilinear- ) where--import Math.NumberTheory.Recurrences.Bilinear
− Math/NumberTheory/Recurrencies/Linear.hs
@@ -1,14 +0,0 @@--- |--- Module: Math.NumberTheory.Recurrencies.Linear--- Description: Deprecated--- Copyright: (c) 2011 Daniel Fischer--- Licence: MIT--- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>------ Efficient calculation of linear recurrent sequences, including Fibonacci and Lucas sequences.--module Math.NumberTheory.Recurrencies.Linear {-# DEPRECATED "Use `Math.NumberTheory.Recurrences.Linear` instead." #-}- ( module Math.NumberTheory.Recurrences.Linear- ) where--import Math.NumberTheory.Recurrences.Linear
+ Math/NumberTheory/RootsOfUnity.hs view
@@ -0,0 +1,68 @@+-- |+-- Module: Math.NumberTheory.RootsOfUnity+-- Copyright: (c) 2018 Bhavik Mehta+-- Licence: MIT+-- Maintainer: Bhavik Mehta <bhavikmehta8@gmail.com>+--+-- Implementation of roots of unity+--+++module Math.NumberTheory.RootsOfUnity+( +-- * Roots of unity+ RootOfUnity (..)+-- ** Conversions+ , toRootOfUnity+ , toComplex )++where++import Data.Complex (Complex(..), cis)+import Data.Semigroup (Semigroup(..))+import Data.Ratio ((%), numerator, denominator)++-- | A representation of <https://en.wikipedia.org/wiki/Root_of_unity roots of unity>: complex+-- numbers \(z\) for which there is \(n\) such that \(z^n=1\).+newtype RootOfUnity =+ RootOfUnity { -- | Every root of unity can be expressed as \(e^{2 \pi i q}\) for some+ -- rational \(q\) satisfying \(0 \leq q < 1\), this function extracts it.+ fromRootOfUnity :: Rational }+ deriving (Eq)++instance Show RootOfUnity where+ show (RootOfUnity q)+ | n == 0 = "1"+ | d == 1 = "-1"+ | n == 1 = "e^(πi/" ++ show d ++ ")"+ | otherwise = "e^(" ++ show n ++ "πi/" ++ show d ++ ")"+ where n = numerator (2*q)+ d = denominator (2*q)++-- | Given a rational \(q\), produce the root of unity \(e^{2 \pi i q}\).+toRootOfUnity :: Rational -> RootOfUnity+toRootOfUnity q = RootOfUnity ((n `rem` d) % d)+ where n = numerator q+ d = denominator q+ -- effectively q `mod` 1+ -- This smart constructor ensures that the rational is always in the range 0 <= q < 1.++-- | This Semigroup is in fact a group, so @'stimes'@ can be called with a negative first argument.+instance Semigroup RootOfUnity where+ RootOfUnity q1 <> RootOfUnity q2 = toRootOfUnity (q1 + q2)+ stimes k (RootOfUnity q) = toRootOfUnity (q * (toInteger k % 1))++instance Monoid RootOfUnity where+ mempty = RootOfUnity 0++-- | Convert a root of unity into an inexact complex number. Due to floating point inaccuracies,+-- it is recommended to avoid use of this until the end of a calculation. Alternatively, with+-- the [cyclotomic](http://hackage.haskell.org/package/cyclotomic-0.5.1) package, one can use+-- @[polarRat](https://hackage.haskell.org/package/cyclotomic-0.5.1/docs/Data-Complex-Cyclotomic.html#v:polarRat)+-- 1 . @'fromRootOfUnity' to convert to a cyclotomic number.+toComplex :: Floating a => RootOfUnity -> Complex a+toComplex (RootOfUnity t)+ | t == 1/2 = (-1) :+ 0+ | t == 1/4 = 0 :+ 1+ | t == 3/4 = 0 :+ (-1)+ | otherwise = cis . (2*pi*) . fromRational $ t
Math/NumberTheory/SmoothNumbers.hs view
@@ -1,181 +1,110 @@ -- | -- Module: Math.NumberTheory.SmoothNumbers--- Copyright: (c) 2018 Frederick Schneider+-- Copyright: (c) 2018 Frederick Schneider, 2018-2019 Andrew Lelechenko -- Licence: MIT -- Maintainer: Frederick Schneider <frederick.schneider2011@gmail.com> -- -- A <https://en.wikipedia.org/wiki/Smooth_number smooth number>--- is an integer, which can be represented as a product of powers of elements+-- is an number, which can be represented as a product of powers of elements -- from a given set (smooth basis). E. g., 48 = 3 * 4 * 4 is smooth -- over a set {3, 4}, and 24 is not. -- +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.SmoothNumbers- ( -- * Create a smooth basis- SmoothBasis- , fromSet+ ( SmoothBasis+ , unSmoothBasis , fromList- , fromSmoothUpperBound- -- * Generate smooth numbers+ , isSmooth , smoothOver , smoothOver'- , smoothOverInRange- , smoothOverInRangeBF-- -- * Verify if a number is smooth- , isSmooth ) where -import Prelude hiding (div, mod, gcd)-import Data.Coerce+import Prelude hiding (div, mod, gcd, (+))+import Data.Euclidean import Data.List (nub)-import qualified Data.Set as S-import qualified Math.NumberTheory.Euclidean as E-import Math.NumberTheory.Primes (unPrime)-import Math.NumberTheory.Primes.Sieve (primes)+import Data.Maybe+import Data.Semiring -- | An abstract representation of a smooth basis.--- It consists of a set of numbers ≥2.-newtype SmoothBasis a = SmoothBasis { unSmoothBasis :: [a] } deriving (Eq, Show)---- | Build a 'SmoothBasis' from a set of numbers ≥2.------ >>> import qualified Data.Set as Set--- >>> fromSet (Set.fromList [2, 3])--- Just (SmoothBasis {unSmoothBasis = [2,3]})--- >>> fromSet (Set.fromList [2, 4])--- Just (SmoothBasis {unSmoothBasis = [2,4]})--- >>> fromSet (Set.fromList [1, 3]) -- should be >= 2--- Nothing-fromSet :: E.Euclidean a => S.Set a -> Maybe (SmoothBasis a)-fromSet s = if isValid l then Just (SmoothBasis l) else Nothing where l = S.elems s+newtype SmoothBasis a = SmoothBasis+ { unSmoothBasis :: [a]+ -- ^ Unwrap elements of a smooth basis.+ }+ deriving (Show) --- | Build a 'SmoothBasis' from a list of numbers ≥2.+-- | Build a 'SmoothBasis' from a list of numbers,+-- sanitizing it from duplicates, zeros and units. -- -- >>> fromList [2, 3]--- Just (SmoothBasis {unSmoothBasis = [2,3]})+-- SmoothBasis {unSmoothBasis = [2,3]} -- >>> fromList [2, 2]--- Just (SmoothBasis {unSmoothBasis = [2]})--- >>> fromList [2, 4]--- Just (SmoothBasis {unSmoothBasis = [2,4]})--- >>> fromList [1, 3] -- should be >= 2--- Nothing-fromList :: E.Euclidean a => [a] -> Maybe (SmoothBasis a)-fromList l = if isValid l' then Just (SmoothBasis l') else Nothing- where- l' = nub l+-- SmoothBasis {unSmoothBasis = [2]}+-- >>> fromList [1, 3]+-- SmoothBasis {unSmoothBasis = [3]}+fromList :: (Eq a, GcdDomain a) => [a] -> SmoothBasis a+fromList+ = SmoothBasis+ . filter (\x -> not (isZero x) && isNothing (one `divide` x))+ . nub --- | Build a 'SmoothBasis' from a list of primes below given bound.+-- | A generalization of 'smoothOver',+-- suitable for non-'Integral' domains.+-- The first argument must be an appropriate+-- <https://en.wikipedia.org/wiki/Ideal_norm Ideal norm> function,+-- like 'Math.NumberTheory.Quadratic.GaussianIntegers.norm'+-- or 'Math.NumberTheory.Quadratic.EisensteinIntegers.norm'. ----- >>> fromSmoothUpperBound 10--- Just (SmoothBasis {unSmoothBasis = [2,3,5,7]})--- >>> fromSmoothUpperBound 1--- Nothing-fromSmoothUpperBound :: Integral a => a -> Maybe (SmoothBasis a)-fromSmoothUpperBound n = if (n < 2)- then Nothing- else Just $ SmoothBasis $ takeWhile (<= n) $ map unPrime primes---- | Helper used by @smoothOver@ (@Integral@ constraint) and @smoothOver'@--- (@Euclidean@ constraint) Since the typeclass constraint is just--- @Num@, it receives a @norm@ comparison function for the generated smooth--- numbers.--- This function relies on the fact that for any element of a smooth basis @p@--- and any @a@ it is true that @norm (a * p) > norm a@.--- This condition is not checked.-smoothOver' :: forall a b . (Eq a, Num a, Ord b) => (a -> b) -> SmoothBasis a -> [a]-smoothOver' norm pl =- foldr- (\p l -> mergeListLists $ iterate (map $ abs . (p*)) l)- [1]- (nub $ unSmoothBasis pl)+-- This routine is more efficient than filtering with 'isSmooth'.+--+-- >>> import Math.NumberTheory.Quadratic.GaussianIntegers+-- >>> take 10 (smoothOver' norm (fromList [1+ι,3]))+-- [1,1+ι,2,2+2*ι,3,4,3+3*ι,4+4*ι,6,8]+smoothOver'+ :: (Eq a, Num a, Ord b)+ => (a -> b) -- ^ <https://en.wikipedia.org/wiki/Ideal_norm Ideal norm>+ -> SmoothBasis a+ -> [a]+smoothOver' norm (SmoothBasis pl) =+ foldr+ (\p l -> foldr skipHead [] $ iterate (map (abs . (Prelude.* p))) l)+ [1]+ pl where- {-# INLINE mergeListLists #-}- mergeListLists :: [[a]] -> [a]- mergeListLists = foldr go1 []- where- go1 :: [a] -> [a] -> [a]- go1 [] b = b- go1 (h:t) b = h:(go2 t b)+ skipHead [] b = b+ skipHead (h : t) b = h : merge t b - go2 :: [a] -> [a] -> [a]- go2 a [] = a- go2 [] b = b- go2 a@(ah:at) b@(bh:bt)- | norm bh < norm ah = bh : (go2 a bt)- | ah == bh = ah : (go2 at bt)- | otherwise = ah : (go2 at b)+ merge a [] = a+ merge [] b = b+ merge a@(ah : at) b@(bh : bt)+ | norm bh < norm ah = bh : merge a bt+ | ah == bh = ah : merge at bt+ | otherwise = ah : merge at b -- | Generate an infinite ascending list of -- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers> -- over a given smooth basis. ----- >>> import Data.Maybe--- >>> take 10 (smoothOver (fromJust (fromList [2, 5])))+-- This routine is more efficient than filtering with 'isSmooth'.+--+-- >>> take 10 (smoothOver (fromList [2, 5])) -- [1,2,4,5,8,10,16,20,25,32] smoothOver :: Integral a => SmoothBasis a -> [a] smoothOver = smoothOver' abs --- | Generate an ascending list of--- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers>--- over a given smooth basis in a given range.------ It may appear inefficient--- for short, but distant ranges;--- consider using 'smoothOverInRangeBF' in such cases.------ >>> import Data.Maybe--- >>> smoothOverInRange (fromJust (fromList [2, 5])) 100 200--- [100,125,128,160,200]-smoothOverInRange :: forall a. Integral a => SmoothBasis a -> a -> a -> [a]-smoothOverInRange s lo hi- = takeWhile (<= hi)- $ dropWhile (< lo)- $ coerce- $ smoothOver (coerce s :: SmoothBasis (E.WrappedIntegral a))---- | Generate an ascending list of--- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers>--- over a given smooth basis in a given range.------ It is inefficient--- for large or starting near 0 ranges;--- consider using 'smoothOverInRange' in such cases.------ Suffix BF stands for the brute force algorithm, involving a lot of divisions.+-- | Check that a given number is smooth under a given 'SmoothBasis'. ----- >>> import Data.Maybe--- >>> smoothOverInRangeBF (fromJust (fromList [2, 5])) 100 200--- [100,125,128,160,200]-smoothOverInRangeBF- :: forall a. (Enum a, E.Euclidean a)- => SmoothBasis a- -> a- -> a- -> [a]-smoothOverInRangeBF prs lo hi- = coerce- $ filter (isSmooth prs)- $ coerce [lo..hi]---- | isValid assumes that the list is sorted and unique and then checks if the list is suitable to be a SmoothBasis.-isValid :: (Eq a, Num a) => [a] -> Bool-isValid pl = length pl /= 0 && v' pl- where- v' :: (Eq a, Num a) => [a] -> Bool- v' [] = True- v' (x:xs) = x /= 0 && abs x /= 1 && abs x == x && v' xs---- | @isSmooth@ checks if a given number is smooth under a certain @SmoothBasis@.--- Does not check if the @SmoothBasis@ is valid.-isSmooth :: forall a . E.Euclidean a => SmoothBasis a -> a -> Bool-isSmooth prs x = mf (unSmoothBasis prs) x+-- >>> isSmooth (fromList [2,3]) 12+-- True+-- >>> isSmooth (fromList [2,3]) 15+-- False+isSmooth :: (Eq a, GcdDomain a) => SmoothBasis a -> a -> Bool+isSmooth prs x = not (isZero x) && go (unSmoothBasis prs) x where- mf :: [a] -> a -> Bool- mf _ 0 = False- mf [] n = abs n == 1 -- mf means manually factor- mf pl@(p:ps) n = if E.mod n p == 0- then mf pl (E.div n p)- else mf ps n+ go :: (Eq a, GcdDomain a) => [a] -> a -> Bool+ go [] n = isJust (one `divide` n)+ go pps@(p:ps) n = case n `divide` p of+ Nothing -> go ps n+ Just q -> go pps q || go ps n
− Math/NumberTheory/UniqueFactorisation.hs
@@ -1,13 +0,0 @@--- |--- Module: Math.NumberTheory.Recurrencies--- Description: Deprecated--- Copyright: (c) 2019 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>-----module Math.NumberTheory.UniqueFactorisation {-# DEPRECATED "Use `Math.NumberTheory.Primes` instead." #-}- ( module Math.NumberTheory.Primes- ) where--import Math.NumberTheory.Primes
− Math/NumberTheory/Unsafe.hs
@@ -1,69 +0,0 @@--- |--- Module: Math.NumberTheory.Unsafe--- Copyright: (c) 2016 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Layer to switch between safe and unsafe arrays.-----{-# LANGUAGE CPP #-}--module Math.NumberTheory.Unsafe- ( UArray- , bounds- , castSTUArray- , unsafeAt- , unsafeFreeze- , unsafeNewArray_- , unsafeRead- , unsafeThaw- , unsafeWrite- ) where--#ifdef CheckBounds--import Data.Array.Base- ( UArray- , castSTUArray- )-import Data.Array.IArray- ( IArray- , bounds- , (!)- )-import Data.Array.MArray--unsafeAt :: (IArray a e, Ix i) => a i e -> i -> e-unsafeAt = (!)--unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)-unsafeFreeze = freeze--unsafeNewArray_ :: (Ix i, MArray a e m) => (i, i) -> m (a i e)-unsafeNewArray_ = newArray_--unsafeRead :: (MArray a e m, Ix i) => a i e -> i -> m e-unsafeRead = readArray--unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)-unsafeThaw = thaw--unsafeWrite :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()-unsafeWrite = writeArray--#else--import Data.Array.Base- ( UArray- , bounds- , castSTUArray- , unsafeAt- , unsafeFreeze- , unsafeNewArray_- , unsafeRead- , unsafeThaw- , unsafeWrite- )--#endif
Math/NumberTheory/Utils.hs view
@@ -6,17 +6,22 @@ -- -- Some utilities, mostly for bit twiddling. ---{-# LANGUAGE CPP, MagicHash, UnboxedTuples, BangPatterns #-}-{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+ module Math.NumberTheory.Utils- ( shiftToOddCount+ ( SomeKnown(..)+ , shiftToOddCount , shiftToOdd , shiftToOdd# , shiftToOddCount#- , bitCountWord- , bitCountInt- , bitCountWord#- , uncheckedShiftR+ , shiftToOddCountBigNat , splitOff , splitOff# @@ -26,23 +31,25 @@ , toWheel30 , fromWheel30+ , withSomeKnown+ , intVal ) where -#include "MachDeps.h"- import Prelude hiding (mod, quotRem) import qualified Prelude as P +import Data.Bits+import Data.Euclidean+import Data.List.Infinite (Infinite(..))+import Data.Semiring (Semiring(..), isZero) import GHC.Base--import GHC.Integer.GMP.Internals+import GHC.Num.BigNat+import GHC.Num.Integer+import GHC.Num.Natural+import qualified Math.NumberTheory.Utils.FromIntegral as UT import GHC.Natural--import Data.Bits-import Math.NumberTheory.Euclidean--uncheckedShiftR :: Word -> Int -> Word-uncheckedShiftR (W# w#) (I# i#) = W# (uncheckedShiftRL# w# i#)+import GHC.TypeNats+import Math.NumberTheory.Utils.FromIntegral (intToWord) -- | Remove factors of @2@ and count them. If -- @n = 2^k*m@ with @m@ odd, the result is @(k, m)@.@@ -55,7 +62,7 @@ #-} {-# INLINE [1] shiftToOddCount #-} shiftToOddCount :: Integral a => a -> (Word, a)-shiftToOddCount n = case shiftOCInteger (fromIntegral n) of+shiftToOddCount n = case shiftOCInteger (toInteger n) of (z, o) -> (z, fromInteger o) -- | Specialised version for @'Word'@.@@ -73,16 +80,16 @@ -- | Specialised version for @'Integer'@. -- Precondition: argument nonzero (not checked). shiftOCInteger :: Integer -> (Word, Integer)-shiftOCInteger n@(S# i#) =+shiftOCInteger n@(IS i#) = case shiftToOddCount# (int2Word# i#) of (# 0##, _ #) -> (0, n)- (# z#, w# #) -> (W# z#, wordToInteger w#)-shiftOCInteger n@(Jp# bn#) = case bigNatZeroCount bn# of+ (# z#, w# #) -> (W# z#, integerFromWord# w#)+shiftOCInteger n@(IP bn#) = case bigNatZeroCount bn# of 0## -> (0, n)- z# -> (W# z#, bigNatToInteger (bn# `shiftRBigNat` (word2Int# z#)))-shiftOCInteger n@(Jn# bn#) = case bigNatZeroCount bn# of+ z# -> (W# z#, integerFromBigNat# (bn# `bigNatShiftR#` z#))+shiftOCInteger n@(IN bn#) = case bigNatZeroCount bn# of 0## -> (0, n)- z# -> (W# z#, bigNatToNegInteger (bn# `shiftRBigNat` (word2Int# z#)))+ z# -> (W# z#, integerFromBigNatNeg# (bn# `bigNatShiftR#` z#)) -- | Specialised version for @'Natural'@. -- Precondition: argument nonzero (not checked).@@ -91,18 +98,24 @@ case shiftToOddCount# i# of (# 0##, _ #) -> (0, n) (# z#, w# #) -> (W# z#, NatS# w#)-shiftOCNatural n@(NatJ# bn#) = case bigNatZeroCount bn# of+shiftOCNatural n@(NatJ# (BN# bn#)) = case bigNatZeroCount bn# of 0## -> (0, n)- z# -> (W# z#, bigNatToNatural (bn# `shiftRBigNat` (word2Int# z#)))+ z# -> (W# z#, naturalFromBigNat# (bn# `bigNatShiftR#` z#)) +shiftToOddCountBigNat :: BigNat# -> (# Word, BigNat# #)+shiftToOddCountBigNat bn# = case bigNatZeroCount bn# of+ 0## -> (# 0, bn# #)+ z# -> (# W# z#, bn# `bigNatShiftR#` z# #)+ -- | Count trailing zeros in a @'BigNat'@. -- Precondition: argument nonzero (not checked, Integer invariant).-bigNatZeroCount :: BigNat -> Word#+bigNatZeroCount :: BigNat# -> Word# bigNatZeroCount bn# = count 0## 0# where+ !(W# bitSize#) = intToWord (finiteBitSize (0 :: Word)) count a# i# =- case indexBigNat# bn# i# of- 0## -> count (a# `plusWord#` WORD_SIZE_IN_BITS##) (i# +# 1#)+ case bigNatIndex# bn# i# of+ 0## -> count (a# `plusWord#` bitSize#) (i# +# 1#) w# -> a# `plusWord#` ctz# w# -- | Remove factors of @2@. If @n = 2^k*m@ with @m@ odd, the result is @m@.@@ -114,7 +127,7 @@ #-} {-# INLINE [1] shiftToOdd #-} shiftToOdd :: Integral a => a -> a-shiftToOdd n = fromInteger (shiftOInteger (fromIntegral n))+shiftToOdd n = fromInteger (shiftOInteger (toInteger n)) -- | Specialised version for @'Int'@. -- Precondition: argument nonzero (not checked).@@ -129,13 +142,13 @@ -- | Specialised version for @'Int'@. -- Precondition: argument nonzero (not checked). shiftOInteger :: Integer -> Integer-shiftOInteger (S# i#) = wordToInteger (shiftToOdd# (int2Word# i#))-shiftOInteger n@(Jp# bn#) = case bigNatZeroCount bn# of+shiftOInteger (IS i#) = integerFromWord# (shiftToOdd# (int2Word# i#))+shiftOInteger n@(IP bn#) = case bigNatZeroCount bn# of 0## -> n- z# -> bigNatToInteger (bn# `shiftRBigNat` (word2Int# z#))-shiftOInteger n@(Jn# bn#) = case bigNatZeroCount bn# of+ z# -> integerFromBigNat# (bn# `bigNatShiftR#` z#)+shiftOInteger n@(IN bn#) = case bigNatZeroCount bn# of 0## -> n- z# -> bigNatToNegInteger (bn# `shiftRBigNat` (word2Int# z#))+ z# -> integerFromBigNatNeg# (bn# `bigNatShiftR#` z#) -- | Shift argument right until the result is odd. -- Precondition: argument not @0@, not checked.@@ -147,25 +160,13 @@ shiftToOddCount# w# = case ctz# w# of k# -> (# k#, uncheckedShiftRL# w# (word2Int# k#) #) --- | Number of 1-bits in a @'Word#'@.-bitCountWord# :: Word# -> Int#-bitCountWord# w# = case bitCountWord (W# w#) of- I# i# -> i#---- | Number of 1-bits in a @'Word'@.-bitCountWord :: Word -> Int-bitCountWord = popCount---- | Number of 1-bits in an @'Int'@.-bitCountInt :: Int -> Int-bitCountInt = popCount--splitOff :: Euclidean a => a -> a -> (Word, a)-splitOff _ 0 = (0, 0) -- prevent infinite loop-splitOff p n = go 0 n+splitOff :: (Eq a, GcdDomain a) => a -> a -> (Word, a)+splitOff p n+ | isZero n = (0, zero) -- prevent infinite loop+ | otherwise = go 0 n where- go !k m = case m `quotRem` p of- (q, 0) -> go (k + 1) q+ go !k m = case m `divide` p of+ Just q -> go (k + 1) q _ -> (k, m) {-# INLINABLE splitOff #-} @@ -182,26 +183,19 @@ -- | Merges two ordered lists into an ordered list. Checks for neither its -- precondition or postcondition.-mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]+mergeBy :: (a -> a -> Ordering) -> Infinite a -> Infinite a -> Infinite a mergeBy cmp = loop where- loop [] ys = ys- loop xs [] = xs- loop (x:xs) (y:ys)+ loop ( x:< xs) (y :< ys) = case cmp x y of- GT -> y : loop (x:xs) ys- _ -> x : loop xs (y:ys)+ GT -> y :< loop (x :< xs) ys+ _ -> x :< loop xs (y :< ys) -- | Work around https://ghc.haskell.org/trac/ghc/ticket/14085 recipMod :: Integer -> Integer -> Maybe Integer-recipMod x m = case recipModInteger (x `mod` m) m of- 0 -> Nothing- y -> Just y--bigNatToNatural :: BigNat -> Natural-bigNatToNatural bn- | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)- | otherwise = NatJ# bn+recipMod x m = case integerRecipMod# (x `P.mod` m) (fromInteger m) of+ (# | _ #) -> Nothing+ (# y | #) -> Just (toInteger y) ------------------------------------------------------------------------------- -- Helpers for mapping to rough numbers and back.@@ -215,3 +209,15 @@ fromWheel30 :: (Num a, Bits a) => a -> a fromWheel30 i = ((i `shiftL` 2 - i `shiftR` 2) .|. 1) + ((i `shiftL` 1 - i `shiftR` 1) .&. 2)++-------------------------------------------------------------------------------+-- Helpers for dealing with data types parametrised by natural numbers.++data SomeKnown (f :: Nat -> Type) where+ SomeKnown :: KnownNat k => f k -> SomeKnown f++withSomeKnown :: (forall k. KnownNat k => f k -> a) -> SomeKnown f -> a+withSomeKnown f (SomeKnown x) = f x++intVal :: KnownNat k => a k -> Int+intVal = UT.naturalToInt . natVal
Math/NumberTheory/Utils/DirichletSeries.hs view
@@ -9,7 +9,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ViewPatterns #-} module Math.NumberTheory.Utils.DirichletSeries ( DirichletSeries@@ -23,14 +22,22 @@ , timesAndCrop ) where -import Prelude hiding (filter, last, rem, quot, snd, lookup)-import Data.Coerce+import Prelude (Integer, Num, (*))+import Data.Bool (Bool)+import Data.Coerce (coerce)+import Data.Euclidean (Euclidean, quot, divide)+import Data.Function (($), (.))+import Data.Int (Int)+import Data.List (takeWhile) import Data.Map (Map) import qualified Data.Map.Strict as M+import Data.Maybe (isJust)+import Data.Ord (Ord, (<=)) import Data.Semiring (Semiring(..))-import Numeric.Natural--import Math.NumberTheory.Euclidean+import Data.Tuple (fst)+import Data.Word (Word)+import Numeric.Natural (Natural)+import Text.Show (Show) -- Sparse Dirichlet series are represented by an ascending list of pairs. -- For instance, [(a, b), (c, d)] stands for 1 + b/a^s + d/c^s.@@ -65,7 +72,7 @@ -- and all a_i and b_i are divisors of n. Return Dirichlet series cs, -- which contains all terms as * bs = sum_i m_i/c_i^s such that c_i divides n. timesAndCrop- :: (Euclidean a, Ord a, Semiring b)+ :: (Num a, Euclidean a, Ord a, Semiring b) => a -> DirichletSeries a b -> DirichletSeries a b@@ -78,7 +85,7 @@ | (b, fb) <- M.assocs bs , let nb = n `quot` b , (a, fa) <- takeWhile ((<= nb) . fst) (M.assocs as)- , nb `rem` a == 0+ , isJust (nb `divide` a) ] {-# SPECIALISE timesAndCrop :: Semiring b => Int -> DirichletSeries Int b -> DirichletSeries Int b -> DirichletSeries Int b #-} {-# SPECIALISE timesAndCrop :: Semiring b => Word -> DirichletSeries Word b -> DirichletSeries Word b -> DirichletSeries Word b #-}
Math/NumberTheory/Utils/FromIntegral.hs view
@@ -7,19 +7,39 @@ -- Monomorphic `fromIntegral`. -- -{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} module Math.NumberTheory.Utils.FromIntegral ( wordToInt , wordToInteger , intToWord+ , intToInt8+ , intToInt64+ , int8ToInt64+ , intToWord8+ , intToWord64+ , int8ToInt+ , int64ToInt+ , word8ToInt+ , word64ToInt , intToInteger+ , int16ToInteger+ , int64ToInteger+ , word64ToInteger , naturalToInteger , integerToNatural , integerToWord+ , integerToWord64 , integerToInt+ , integerToInt64+ , intToNatural+ , naturalToInt+ , intToDouble+ , fromIntegral' ) where +import Data.Int+import Data.Word import Numeric.Natural wordToInt :: Word -> Int@@ -34,22 +54,99 @@ intToWord = fromIntegral {-# INLINE intToWord #-} +intToInt8 :: Int -> Int8+intToInt8 = fromIntegral+{-# INLINE intToInt8 #-}++intToInt64 :: Int -> Int64+intToInt64 = fromIntegral+{-# INLINE intToInt64 #-}++int8ToInt64 :: Int8 -> Int64+int8ToInt64 = fromIntegral+{-# INLINE int8ToInt64 #-}++intToWord8 :: Int -> Word8+intToWord8 = fromIntegral+{-# INLINE intToWord8 #-}++intToWord64 :: Int -> Word64+intToWord64 = fromIntegral+{-# INLINE intToWord64 #-}++int8ToInt :: Int8 -> Int+int8ToInt = fromIntegral+{-# INLINE int8ToInt #-}++int64ToInt :: Int64 -> Int+int64ToInt = fromIntegral+{-# INLINE int64ToInt #-}++word8ToInt :: Word8 -> Int+word8ToInt = fromIntegral+{-# INLINE word8ToInt #-}++word64ToInt :: Word64 -> Int+word64ToInt = fromIntegral+{-# INLINE word64ToInt #-}+ intToInteger :: Int -> Integer intToInteger = fromIntegral {-# INLINE intToInteger #-} +int16ToInteger :: Int16 -> Integer+int16ToInteger = fromIntegral+{-# INLINE int16ToInteger #-}++int64ToInteger :: Int64 -> Integer+int64ToInteger = fromIntegral+{-# INLINE int64ToInteger #-}++word64ToInteger :: Word64 -> Integer+word64ToInteger = fromIntegral+{-# INLINE word64ToInteger #-}+ naturalToInteger :: Natural -> Integer naturalToInteger = fromIntegral {-# INLINE naturalToInteger #-} integerToNatural :: Integer -> Natural-integerToNatural = fromIntegral+integerToNatural = fromIntegral' {-# INLINE integerToNatural #-} integerToWord :: Integer -> Word integerToWord = fromIntegral {-# INLINE integerToWord #-} +integerToWord64 :: Integer -> Word64+integerToWord64 = fromIntegral+{-# INLINE integerToWord64 #-}+ integerToInt :: Integer -> Int integerToInt = fromIntegral {-# INLINE integerToInt #-}++integerToInt64 :: Integer -> Int64+integerToInt64 = fromIntegral+{-# INLINE integerToInt64 #-}++intToNatural :: Int -> Natural+intToNatural = fromIntegral+{-# INLINE intToNatural #-}++naturalToInt :: Natural -> Int+naturalToInt = fromIntegral+{-# INLINE naturalToInt #-}++intToDouble :: Int -> Double+intToDouble = fromIntegral+{-# INLINE intToDouble #-}++fromIntegral' :: (Integral a, Num b) => a -> b+#if __GLASGOW_HASKELL__ == 900 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1+-- Cannot use fromIntegral because of https://gitlab.haskell.org/ghc/ghc/-/issues/19411+fromIntegral' = fromInteger . toInteger+#else+fromIntegral' = fromIntegral+#endif+{-# INLINE fromIntegral' #-}
Math/NumberTheory/Utils/Hyperbola.hs view
@@ -7,16 +7,13 @@ -- Highest points under hyperbola. -- -{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}- module Math.NumberTheory.Utils.Hyperbola ( pointsUnderHyperbola ) where import Data.Bits -import Math.NumberTheory.Powers.Cubes+import Math.NumberTheory.Roots -- | Straightforward computation of -- [ n `quot` x | x <- [hi, hi - 1 .. lo] ].@@ -50,19 +47,15 @@ -- | bresenham(x+1) -> bresenham(x) for x >= (2n)^1/3 stepBack :: Bresenham -> Bresenham-stepBack (Bresenham x' beta' gamma' delta1' epsilon') =- if eps >= x- then (if eps >= x `shiftL` 1- then {- delta2 = 2 -}- let delta1 = delta1' + 2 in (Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 - x `shiftL` 1) delta1 (eps - x `shiftL` 1))- else {- delta1 = 1 -}- let delta1 = delta1' + 1 in (Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 - x) delta1 (eps - x))- )- else (if eps >= 0- then {- delta2 = 0 -}- (Bresenham x (beta' + delta1') (gamma' + delta1' `shiftL` 1) delta1' eps)- else {- delta2 = -1 -}- let delta1 = delta1' - 1 in (Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 + x) delta1 (eps + x)))+stepBack (Bresenham x' beta' gamma' delta1' epsilon')+ | eps >= x `shiftL` 1 {- delta2 = 2 -}+ = let delta1 = delta1' + 2 in Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 - x `shiftL` 1) delta1 (eps - x `shiftL` 1)+ | eps >= x {- delta1 = 1 -}+ = let delta1 = delta1' + 1 in Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 - x) delta1 (eps - x)+ | eps >= 0 {- delta2 = 0 -}+ = Bresenham x (beta' + delta1') (gamma' + delta1' `shiftL` 1) delta1' eps+ | otherwise {- delta2 = -1 -}+ = let delta1 = delta1' - 1 in Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 + x) delta1 (eps + x) where x = x' - 1 eps = epsilon' + gamma'
Math/NumberTheory/Zeta.hs view
@@ -1,21 +1,24 @@ -- | -- Module: Math.NumberTheory.Zeta--- Copyright: (c) 2018 Andrew Lelechenko+-- Copyright: (c) 2018 Alexandre Rodrigues Baldé, Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> ----- Interface to work with Riemann zeta-function and Dirichlet beta-function.+-- Numeric evaluation of various zeta-functions. {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Zeta- ( module Math.NumberTheory.Zeta.Dirichlet- , module Math.NumberTheory.Zeta.Hurwitz- , module Math.NumberTheory.Zeta.Riemann- , module Math.NumberTheory.Zeta.Utils+ ( -- * Riemann zeta-function+ zetas+ , zetasEven+ -- * Dirichlet beta-function+ , betas+ , betasOdd+ -- * Hurwitz zeta-functions+ , zetaHurwitz ) where import Math.NumberTheory.Zeta.Dirichlet import Math.NumberTheory.Zeta.Hurwitz import Math.NumberTheory.Zeta.Riemann-import Math.NumberTheory.Zeta.Utils
Math/NumberTheory/Zeta/Dirichlet.hs view
@@ -6,6 +6,7 @@ -- -- Dirichlet beta-function. +{-# LANGUAGE PostfixOperators #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Zeta.Dirichlet@@ -15,56 +16,54 @@ ) where import Data.ExactPi-import Data.List (zipWith4)+import Data.List.Infinite (Infinite(..), (....))+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.Infinite as Inf import Data.Ratio ((%)) import Math.NumberTheory.Recurrences (euler, factorial) import Math.NumberTheory.Zeta.Hurwitz (zetaHurwitz)-import Math.NumberTheory.Zeta.Utils (intertwine, skipOdds)+import Math.NumberTheory.Zeta.Utils (skipOdds) -- | Infinite sequence of exact values of Dirichlet beta-function at odd arguments, starting with @β(1)@. --+-- >>> import Data.ExactPi -- >>> approximateValue (betasOdd !! 25) :: Double -- 0.9999999999999987 -- >>> import Data.Number.Fixed -- >>> approximateValue (betasOdd !! 25) :: Fixed Prec50 -- 0.99999999999999999999999960726927497384196726751694-betasOdd :: [ExactPi]-betasOdd = zipWith Exact [1, 3 ..] $ zipWith4+betasOdd :: Infinite ExactPi+betasOdd = Inf.zipWith Exact ((1, 3)....) $ Inf.zipWith4 (\sgn denom eul twos -> sgn * (eul % (twos * denom)))- (cycle [1, -1])+ (Inf.cycle (1 :| [-1])) (skipOdds factorial) (skipOdds euler)- (iterate (4 *) 4)+ (Inf.iterate (4 *) 4) -- | Infinite sequence of approximate values of the Dirichlet @β@ function at -- positive even integer arguments, starting with @β(0)@.-betasEven :: forall a. (Floating a, Ord a) => a -> [a]-betasEven eps = (1 / 2) : hurwitz+betasEven :: forall a. (Floating a, Ord a) => a -> Infinite a+betasEven eps = (1 / 2) :< hurwitz where- hurwitz :: [a]+ hurwitz :: Infinite a hurwitz =- zipWith3 (\quarter threeQuarters four ->+ Inf.zipWith3 (\quarter threeQuarters four -> (quarter - threeQuarters) / four)- (tail . skipOdds $ zetaHurwitz eps 0.25)- (tail . skipOdds $ zetaHurwitz eps 0.75)- (iterate (16 *) 16)+ (Inf.tail . skipOdds $ zetaHurwitz eps 0.25)+ (Inf.tail . skipOdds $ zetaHurwitz eps 0.75)+ (Inf.iterate (16 *) 16) -- | Infinite sequence of approximate (up to given precision) -- values of Dirichlet beta-function at integer arguments, starting with @β(0)@. ----- The algorithm previously used to compute @β@ for even arguments was derived--- from <https://arxiv.org/pdf/0910.5004.pdf An Euler-type formula for β(2n) and closed-form expressions for a class of zeta series>--- by F. M. S. Lima, formula (12), but is now based on the--- 'Math.NumberTheory.Zeta.Hurwitz.zetaHurwitz' recurrence.--- -- >>> take 5 (betas 1e-14) :: [Double] -- [0.5,0.7853981633974483,0.9159655941772189,0.9689461462593694,0.9889445517411051]-betas :: (Floating a, Ord a) => a -> [a]-betas eps = e : o : scanl1 f (intertwine es os)+betas :: (Floating a, Ord a) => a -> Infinite a+betas eps = e :< o :< Inf.scanl1 f (Inf.interleave es os) where- e : es = betasEven eps- o : os = map (getRationalLimit (\a b -> abs (a - b) < eps) . rationalApproximations) betasOdd+ e :< es = betasEven eps+ o :< os = Inf.map (getRationalLimit (\a b -> abs (a - b) < eps) . rationalApproximations) betasOdd -- Cap-and-floor to improve numerical stability: -- 1 > beta(n + 1) - 1 > (beta(n) - 1) / 2
Math/NumberTheory/Zeta/Hurwitz.hs view
@@ -6,22 +6,24 @@ -- -- Hurwitz zeta function. +{-# LANGUAGE PostfixOperators #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Zeta.Hurwitz ( zetaHurwitz ) where +import Data.List.Infinite (Infinite(..), (....))+import qualified Data.List.Infinite as Inf+ import Math.NumberTheory.Recurrences (bernoulli, factorial) import Math.NumberTheory.Zeta.Utils (skipEvens, skipOdds) --- | Values of Hurwitz zeta function evaluated at @ζ(s, a)@ with--- @forall t1 . (Floating t1, Ord t1) => a ∈ t1@, and @s ∈ [0, 1 ..]@.+-- | Values of Hurwitz zeta function evaluated at @ζ(s, a)@ for @s ∈ [0, 1 ..]@. -- -- The algorithm used was based on the Euler-Maclaurin formula and was derived -- from <http://fredrikj.net/thesis/thesis.pdf Fast and Rigorous Computation of Special Functions to High Precision> -- by F. Johansson, chapter 4.8, formula 4.8.5.--- -- The error for each value in this recurrence is given in formula 4.8.9 as an -- indefinite integral, and in formula 4.8.12 as a closed form formula. --@@ -29,14 +31,14 @@ -- the type chosen. -- -- For instance, when using @Double@s, it does not make sense--- to provide a number @ε >= 1e-53@ as the desired precision. For @Float@s,--- providing an @ε >= 1e-24@ also does not make sense.+-- to provide a number @ε < 1e-53@ as the desired precision. For @Float@s,+-- providing an @ε < 1e-24@ also does not make sense. -- Example of how to call the function: -- -- >>> zetaHurwitz 1e-15 0.25 !! 5 -- 1024.3489745265808-zetaHurwitz :: forall a . (Floating a, Ord a) => a -> a -> [a]-zetaHurwitz eps a = zipWith3 (\s i t -> s + i + t) ss is ts+zetaHurwitz :: forall a . (Floating a, Ord a) => a -> a -> Infinite a+zetaHurwitz eps a = Inf.zipWith3 (\s i t -> s + i + t) ss is ts where -- When given @1e-14@ as the @eps@ argument, this'll be -- @div (33 * (length . takeWhile (>= 1) . iterate (/ 10) . recip) 1e-14) 10 == div (33 * 14) 10@@@ -52,74 +54,73 @@ -- @a + n@ aPlusN :: a- aPlusN = a + fromIntegral digitsOfPrecision+ aPlusN = a + fromInteger digitsOfPrecision -- @[(a + n)^s | s <- [0, 1, 2 ..]]@- powsOfAPlusN :: [a]- powsOfAPlusN = iterate (aPlusN *) 1+ powsOfAPlusN :: Infinite a+ powsOfAPlusN = Inf.iterate (aPlusN *) 1 -- [ [ 1 ] | ] -- | \sum_{k=0}^\(n-1) | ----------- | | s <- [0, 1, 2 ..] | -- [ [ (a + k) ^ s ] | ] -- @S@ value in 4.8.5 formula.- ss :: [a]+ ss :: Infinite a ss = let numbers = map ((a +) . fromInteger) [0..digitsOfPrecision-1]- denoms = replicate (fromInteger digitsOfPrecision) 1 :- iterate (zipWith (*) numbers) numbers- in map (sum . map recip) denoms+ denoms = replicate (fromInteger digitsOfPrecision) 1 :<+ Inf.iterate (zipWith (*) numbers) numbers+ in Inf.map (sum . map recip) denoms -- [ (a + n) ^ (1 - s) a + n | ] -- | ----------------- = ---------------------- | s <- [0, 1, 2 ..] | -- [ s - 1 (a + n) ^ s * (s - 1) | ] -- @I@ value in 4.8.5 formula.- is :: [a]- is = let denoms = zipWith+ is :: Infinite a+ is = let denoms = Inf.zipWith (\powOfA int -> powOfA * fromInteger int) powsOfAPlusN- [-1, 0..]- in zipWith (/) (repeat aPlusN) denoms+ ((-1, 0)....)+ in Inf.map (aPlusN /) denoms -- [ 1 | ] -- [ ----------- | s <- [0 ..] ] -- [ (a + n) ^ s | ]- constants2 :: [a]- constants2 = map recip powsOfAPlusN+ constants2 :: Infinite a+ constants2 = Inf.map recip powsOfAPlusN -- [ [(s)_(2*k - 1) | k <- [1 ..]], s <- [0 ..]], i.e. odd indices of -- infinite rising factorial sequences, each sequence starting at a -- positive integer.- pochhammers :: [[Integer]]+ pochhammers :: Infinite (Infinite Integer) pochhammers = let -- [ [(s)_k | k <- [1 ..]], s <- [1 ..]]- pochhs :: [[Integer]]- pochhs = iterate (\(x : xs) -> map (`div` x) xs) (tail factorial)+ pochhs :: Infinite (Infinite Integer)+ pochhs = Inf.iterate (\(x :< xs) -> Inf.map (`div` x) xs) (Inf.tail factorial) in -- When @s@ is @0@, the infinite sequence of rising -- factorials starting at @s@ is @[0,0,0,0..]@.- repeat 0 : map skipOdds pochhs+ Inf.repeat 0 :< Inf.map skipOdds pochhs -- [ B_2k | ] -- | ------------------------- | k <- [1 ..] | -- [ (2k)! (a + n) ^ (2*k - 1) | ] second :: [a] second =- take (fromInteger digitsOfPrecision) $- zipWith3+ Inf.take (fromInteger digitsOfPrecision) $+ Inf.zipWith3 (\bern evenFac denom -> fromRational bern / (denom * fromInteger evenFac))- (tail $ skipOdds bernoulli)- (tail $ skipOdds factorial)+ (Inf.tail $ skipOdds bernoulli)+ (Inf.tail $ skipOdds factorial) -- Recall that @powsOfAPlusN = [(a + n) ^ s | s <- [0 ..]]@, so this -- is @[(a + n) ^ (2 * s - 1) | s <- [1 ..]]@ (skipEvens powsOfAPlusN) - fracs :: [a]- fracs = zipWith- (\sec pochh -> sum $ zipWith (\s p -> s * fromInteger p) sec pochh)- (repeat second)+ fracs :: Infinite a+ fracs = Inf.map+ (sum . zipWith (\s p -> s * fromInteger p) second . Inf.toList) pochhammers -- Infinite list of @T@ values in 4.8.5 formula, for every @s@ in -- @[0, 1, 2 ..]@.- ts :: [a]- ts = zipWith+ ts :: Infinite a+ ts = Inf.zipWith (\constant2 frac -> constant2 * (0.5 + frac)) constants2 fracs
Math/NumberTheory/Zeta/Riemann.hs view
@@ -6,6 +6,7 @@ -- -- Riemann zeta-function. +{-# LANGUAGE PostfixOperators #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Zeta.Riemann@@ -15,11 +16,13 @@ ) where import Data.ExactPi+import Data.List.Infinite (Infinite(..), (...), (....))+import qualified Data.List.Infinite as Inf import Data.Ratio ((%)) import Math.NumberTheory.Recurrences (bernoulli) import Math.NumberTheory.Zeta.Hurwitz (zetaHurwitz)-import Math.NumberTheory.Zeta.Utils (intertwine, skipEvens, skipOdds)+import Math.NumberTheory.Zeta.Utils (skipEvens, skipOdds) -- | Infinite sequence of exact values of Riemann zeta-function at even arguments, starting with @ζ(0)@. -- Note that due to numerical errors conversion to 'Double' may return values below 1:@@ -33,35 +36,31 @@ -- >>> approximateValue (zetasEven !! 25) :: Fixed Prec50 -- 1.00000000000000088817842111574532859293035196051773 ---zetasEven :: [ExactPi]-zetasEven = zipWith Exact [0, 2 ..] $ zipWith (*) (skipOdds bernoulli) cs+zetasEven :: Infinite ExactPi+zetasEven = Inf.zipWith Exact ((0, 2)....) $ Inf.zipWith (*) (skipOdds bernoulli) cs where- cs = (- 1 % 2) : zipWith (\i f -> i * (-4) / fromInteger (2 * f * (2 * f - 1))) cs [1..]+ cs :: Infinite Rational+ cs = (- 1 % 2) :< Inf.zipWith (\i f -> i * (-4) / fromInteger (2 * f * (2 * f - 1))) cs (1...) -- | Infinite sequence of approximate values of Riemann zeta-function -- at odd arguments, starting with @ζ(1)@.-zetasOdd :: forall a. (Floating a, Ord a) => a -> [a]-zetasOdd eps = (1 / 0) : tail (skipEvens $ zetaHurwitz eps 1)+zetasOdd :: forall a. (Floating a, Ord a) => a -> Infinite a+zetasOdd eps = (1 / 0) :< Inf.tail (skipEvens $ zetaHurwitz eps 1) -- | Infinite sequence of approximate (up to given precision) -- values of Riemann zeta-function at integer arguments, starting with @ζ(0)@. ----- Computations for odd arguments were formerly performed in accordance to--- <https://cr.yp.to/bib/2000/borwein.pdf Computational strategies for the Riemann zeta function>--- by J. M. Borwein, D. M. Bradley, R. E. Crandall, formula (57), but now use--- the 'Math.NumberTheory.Zeta.Hurwitz.zetaHurwitz' recurrence.--- -- >>> take 5 (zetas 1e-14) :: [Double] -- [-0.5,Infinity,1.6449340668482264,1.2020569031595942,1.0823232337111381] -- -- Beware to force evaluation of @zetas !! 1@ if the type @a@ does not support infinite values -- (for instance, 'Data.Number.Fixed.Fixed'). ---zetas :: (Floating a, Ord a) => a -> [a]-zetas eps = e : o : scanl1 f (intertwine es os)+zetas :: (Floating a, Ord a) => a -> Infinite a+zetas eps = e :< o :< Inf.scanl1 f (Inf.interleave es os) where- e : es = map (getRationalLimit (\a b -> abs (a - b) < eps) . rationalApproximations) zetasEven- o : os = zetasOdd eps+ e :< es = Inf.map (getRationalLimit (\a b -> abs (a - b) < eps) . rationalApproximations) zetasEven+ o :< os = zetasOdd eps -- Cap-and-floor to improve numerical stability: -- 0 < zeta(n + 1) - 1 < (zeta(n) - 1) / 2
Math/NumberTheory/Zeta/Utils.hs view
@@ -7,33 +7,25 @@ -- Shared utilities used by functions from @Math.NumberTheory.Zeta@. module Math.NumberTheory.Zeta.Utils- ( intertwine- , skipEvens+ ( skipEvens , skipOdds ) where --- | Joins two lists element-by-element together into one, starting with the--- first one provided as argument.------ >>> take 10 $ intertwine [0, 2 ..] [1, 3 ..]--- [0,1,2,3,4,5,6,7,8,9]-intertwine :: [a] -> [a] -> [a]-intertwine [] ys = ys-intertwine (x : xs) ys = x : intertwine ys xs+import Data.List.Infinite (Infinite(..))+import qualified Data.List.Infinite as Inf -- | Skips every odd-indexed element from an infinite list. -- Do NOT use with finite lists. -- -- >>> take 10 (skipOdds [0, 1 ..]) -- [0,2,4,6,8,10,12,14,16,18]-skipOdds :: [a] -> [a]-skipOdds (x : _ : xs) = x : skipOdds xs-skipOdds xs = xs+skipOdds :: Infinite a -> Infinite a+skipOdds (x :< _ :< xs) = x :< skipOdds xs -- | Skips every even-indexed element from an infinite list. -- Do NOT use with finite lists. -- -- >>> take 10 (skipEvens [0, 1 ..]) -- [1,3,5,7,9,11,13,15,17,19]-skipEvens :: [a] -> [a]-skipEvens = skipOdds . tail+skipEvens :: Infinite a -> Infinite a+skipEvens = skipOdds . Inf.tail
− Setup.hs
@@ -1,5 +0,0 @@-module Main where--import Distribution.Simple--main = defaultMain
arithmoi.cabal view
@@ -1,15 +1,13 @@ name: arithmoi-version: 0.9.0.0-cabal-version: >=1.10+version: 0.13.4.0+cabal-version: 2.0 build-type: Simple license: MIT license-file: LICENSE-copyright: (c) 2011 Daniel Fischer, 2016-2018 Andrew Lelechenko, Carter Schonwald-maintainer: Carter Schonwald carter at wellposed dot com,- Andrew Lelechenko andrew dot lelechenko at gmail dot com-stability: Provisional-homepage: https://github.com/cartazio/arithmoi-bug-reports: https://github.com/cartazio/arithmoi/issues+copyright: (c) 2016-2021 Andrew Lelechenko, 2016-2019 Carter Schonwald, 2011 Daniel Fischer+maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+homepage: https://github.com/Bodigrim/arithmoi+bug-reports: https://github.com/Bodigrim/arithmoi/issues synopsis: Efficient basic number-theoretic functions. description: A library of basic functionality needed for@@ -18,37 +16,36 @@ Primes and related things (totients, factorisation), powers (integer roots and tests, modular exponentiation). category: Math, Algorithms, Number Theory-author: Daniel Fischer-tested-with: GHC ==8.0.2 GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.1-extra-source-files:- Changes+author: Andrew Lelechenko, Daniel Fischer+tested-with: GHC ==9.0.2 GHC ==9.2.8 GHC ==9.4.8 GHC ==9.6.7 GHC ==9.8.4 GHC ==9.10.2 GHC ==9.12.2 GHC ==9.14.1+extra-doc-files:+ changelog.md+ Math/NumberTheory/Primes/Counting/HowPrimeCountingWorks.md source-repository head type: git- location: https://github.com/cartazio/arithmoi--flag check-bounds- description:- Replace unsafe array operations with safe ones- default: False- manual: True+ location: https://github.com/Bodigrim/arithmoi library build-depends:- base >=4.9 && <5,- array >=0.5 && <0.6,- containers >=0.5 && <0.7,- deepseq,- exact-pi >=0.5,- ghc-prim <0.6,- integer-gmp <1.1,- integer-logarithms >=1.0,- random >=1.0 && <1.2,- transformers >=0.4 && <0.6,- semirings >= 0.2,- vector >= 0.12+ base >=4.15 && <5,+ array >=0.5.4.0 && <0.6,+ bitvec >=1.1 && <1.2,+ containers >=0.5.11 && <0.9,+ chimera >=0.3 && <0.5,+ constraints <0.15,+ deepseq <1.6,+ exact-pi >=0.5 && <0.6,+ ghc-bignum <1.5,+ infinite-list <0.2,+ integer-logarithms >=1.0 && <1.1,+ integer-roots >= 1.0.4.0 && <1.1,+ mod >=0.2.1 && <0.3,+ random >=1.0 && <1.4,+ transformers >=0.4 && <0.7,+ semirings >=0.5.2 && <0.8,+ vector >=0.12 && <0.14 exposed-modules:- GHC.TypeNats.Compat Math.NumberTheory.ArithmeticFunctions Math.NumberTheory.ArithmeticFunctions.Inverse Math.NumberTheory.ArithmeticFunctions.Mertens@@ -56,89 +53,77 @@ Math.NumberTheory.ArithmeticFunctions.Moebius Math.NumberTheory.ArithmeticFunctions.SieveBlock Math.NumberTheory.Curves.Montgomery- Math.NumberTheory.Euclidean+ Math.NumberTheory.Diophantine+ Math.NumberTheory.DirichletCharacters Math.NumberTheory.Euclidean.Coprimes Math.NumberTheory.Moduli Math.NumberTheory.Moduli.Chinese Math.NumberTheory.Moduli.Class- Math.NumberTheory.Moduli.DiscreteLogarithm+ Math.NumberTheory.Moduli.Cbrt Math.NumberTheory.Moduli.Equations- Math.NumberTheory.Moduli.Jacobi- Math.NumberTheory.Moduli.PrimitiveRoot+ Math.NumberTheory.Moduli.Multiplicative+ Math.NumberTheory.Moduli.Singleton Math.NumberTheory.Moduli.Sqrt Math.NumberTheory.MoebiusInversion- Math.NumberTheory.MoebiusInversion.Int- Math.NumberTheory.Powers- Math.NumberTheory.Powers.Cubes- Math.NumberTheory.Powers.Fourth- Math.NumberTheory.Powers.General- Math.NumberTheory.Powers.Modular- Math.NumberTheory.Powers.Squares- Math.NumberTheory.Powers.Squares.Internal Math.NumberTheory.Prefactored Math.NumberTheory.Primes Math.NumberTheory.Primes.Counting- Math.NumberTheory.Primes.Factorisation- Math.NumberTheory.Primes.Factorisation.Certified- Math.NumberTheory.Primes.Sieve+ Math.NumberTheory.Primes.IntSet Math.NumberTheory.Primes.Testing- Math.NumberTheory.Primes.Testing.Certificates Math.NumberTheory.Quadratic.GaussianIntegers Math.NumberTheory.Quadratic.EisensteinIntegers Math.NumberTheory.Recurrences- Math.NumberTheory.Recurrencies Math.NumberTheory.Recurrences.Bilinear- Math.NumberTheory.Recurrencies.Bilinear Math.NumberTheory.Recurrences.Linear- Math.NumberTheory.Recurrencies.Linear Math.NumberTheory.SmoothNumbers- Math.NumberTheory.UniqueFactorisation Math.NumberTheory.Zeta- Math.NumberTheory.Zeta.Dirichlet- Math.NumberTheory.Zeta.Hurwitz- Math.NumberTheory.Zeta.Riemann other-modules: Math.NumberTheory.ArithmeticFunctions.Class- Math.NumberTheory.ArithmeticFunctions.SieveBlock.Unboxed Math.NumberTheory.ArithmeticFunctions.Standard- Math.NumberTheory.Moduli.SqrtOld+ Math.NumberTheory.Moduli.Internal+ Math.NumberTheory.Moduli.JacobiSymbol+ Math.NumberTheory.Moduli.SomeMod Math.NumberTheory.Primes.Counting.Approximate Math.NumberTheory.Primes.Counting.Impl Math.NumberTheory.Primes.Factorisation.Montgomery Math.NumberTheory.Primes.Factorisation.TrialDivision Math.NumberTheory.Primes.Sieve.Eratosthenes Math.NumberTheory.Primes.Sieve.Indexing- Math.NumberTheory.Primes.Testing.Certificates.Internal+ Math.NumberTheory.Primes.Small Math.NumberTheory.Primes.Testing.Certified Math.NumberTheory.Primes.Testing.Probabilistic Math.NumberTheory.Primes.Types Math.NumberTheory.Recurrences.Pentagonal- Math.NumberTheory.Unsafe+ Math.NumberTheory.RootsOfUnity Math.NumberTheory.Utils Math.NumberTheory.Utils.DirichletSeries Math.NumberTheory.Utils.FromIntegral Math.NumberTheory.Utils.Hyperbola+ Math.NumberTheory.Zeta.Dirichlet+ Math.NumberTheory.Zeta.Hurwitz+ Math.NumberTheory.Zeta.Riemann Math.NumberTheory.Zeta.Utils default-language: Haskell2010- ghc-options: -O2 -Wall- if flag(check-bounds)- cpp-options: -DCheckBounds+ ghc-options: -Wall -Widentities -Wcompat -Wno-deprecations -test-suite spec+test-suite arithmoi-tests build-depends:- base >=4.9 && <5,+ base >=4.10 && <5, arithmoi, containers, exact-pi >=0.4.1.1,- integer-gmp <1.1,- QuickCheck >=2.10,- semirings >= 0.2,- smallcheck >=1.1.3 && <1.2,- tasty >=0.10,+ infinite-list,+ integer-roots >=1.0,+ mod,+ QuickCheck >=2.10 && <2.19,+ quickcheck-classes >=0.6.3 && <0.7,+ semirings >=0.2,+ smallcheck >=1.2 && <1.3,+ tasty >=0.10 && <1.6, tasty-hunit >=0.9 && <0.11,- tasty-quickcheck >=0.9 && <0.11,+ tasty-quickcheck >=0.9 && <0.12,+ tasty-rerun >=1.1.17 && <1.2, tasty-smallcheck >=0.8 && <0.9,- transformers >=0.5, vector other-modules: Math.NumberTheory.ArithmeticFunctionsTests@@ -146,26 +131,26 @@ Math.NumberTheory.ArithmeticFunctions.MertensTests Math.NumberTheory.ArithmeticFunctions.SieveBlockTests Math.NumberTheory.CurvesTests+ Math.NumberTheory.DiophantineTests+ Math.NumberTheory.DirichletCharactersTests Math.NumberTheory.EisensteinIntegersTests Math.NumberTheory.GaussianIntegersTests Math.NumberTheory.EuclideanTests Math.NumberTheory.Moduli.ChineseTests Math.NumberTheory.Moduli.DiscreteLogarithmTests Math.NumberTheory.Moduli.ClassTests+ Math.NumberTheory.Moduli.CbrtTests Math.NumberTheory.Moduli.EquationsTests Math.NumberTheory.Moduli.JacobiTests Math.NumberTheory.Moduli.PrimitiveRootTests+ Math.NumberTheory.Moduli.SingletonTests Math.NumberTheory.Moduli.SqrtTests- Math.NumberTheory.MoebiusInversion.IntTests Math.NumberTheory.MoebiusInversionTests- Math.NumberTheory.Powers.CubesTests- Math.NumberTheory.Powers.FourthTests- Math.NumberTheory.Powers.GeneralTests- Math.NumberTheory.Powers.ModularTests- Math.NumberTheory.Powers.SquaresTests Math.NumberTheory.PrefactoredTests Math.NumberTheory.Primes.CountingTests Math.NumberTheory.Primes.FactorisationTests+ -- Math.NumberTheory.Primes.LinearAlgebraTests+ -- Math.NumberTheory.Primes.QuadraticSieveTests Math.NumberTheory.Primes.SequenceTests Math.NumberTheory.Primes.SieveTests Math.NumberTheory.Primes.TestingTests@@ -173,6 +158,7 @@ Math.NumberTheory.Recurrences.PentagonalTests Math.NumberTheory.Recurrences.BilinearTests Math.NumberTheory.Recurrences.LinearTests+ Math.NumberTheory.RootsOfUnityTests Math.NumberTheory.SmoothNumbersTests Math.NumberTheory.TestUtils Math.NumberTheory.TestUtils.MyCompose@@ -184,29 +170,29 @@ main-is: Test.hs default-language: Haskell2010 hs-source-dirs: test-suite- ghc-options: -Wall+ ghc-options: -Wall -Widentities -Wcompat -threaded -benchmark criterion+benchmark arithmoi-bench build-depends: base, arithmoi,- array,+ constraints, containers,- deepseq,- gauge,+ infinite-list, integer-logarithms,+ mod, random,+ semirings,+ tasty-bench >= 0.4 && < 0.6, vector other-modules: Math.NumberTheory.ArithmeticFunctionsBench Math.NumberTheory.DiscreteLogarithmBench Math.NumberTheory.EisensteinIntegersBench- Math.NumberTheory.EuclideanBench Math.NumberTheory.GaussianIntegersBench Math.NumberTheory.InverseBench Math.NumberTheory.JacobiBench Math.NumberTheory.MertensBench- Math.NumberTheory.PowersBench Math.NumberTheory.PrimesBench Math.NumberTheory.PrimitiveRootsBench Math.NumberTheory.RecurrencesBench@@ -218,14 +204,17 @@ main-is: Bench.hs default-language: Haskell2010 hs-source-dirs: benchmark+ ghc-options: -Wall -Widentities -Wcompat -executable sequence-model+benchmark arithmoi-sequence-model build-depends: base, arithmoi, containers, hmatrix-gsl buildable: False+ type: exitcode-stdio-1.0 main-is: SequenceModel.hs- hs-source-dirs: app default-language: Haskell2010+ hs-source-dirs: app+ ghc-options: -Wall -Widentities -Wcompat
benchmark/Bench.hs view
@@ -1,16 +1,14 @@ module Main where -import Gauge.Main+import Test.Tasty.Bench import Math.NumberTheory.ArithmeticFunctionsBench as ArithmeticFunctions import Math.NumberTheory.DiscreteLogarithmBench as DiscreteLogarithm import Math.NumberTheory.EisensteinIntegersBench as Eisenstein-import Math.NumberTheory.EuclideanBench as Euclidean import Math.NumberTheory.GaussianIntegersBench as Gaussian import Math.NumberTheory.InverseBench as Inverse import Math.NumberTheory.JacobiBench as Jacobi import Math.NumberTheory.MertensBench as Mertens-import Math.NumberTheory.PowersBench as Powers import Math.NumberTheory.PrimesBench as Primes import Math.NumberTheory.PrimitiveRootsBench as PrimitiveRoots import Math.NumberTheory.RecurrencesBench as Recurrences@@ -24,12 +22,10 @@ [ ArithmeticFunctions.benchSuite , DiscreteLogarithm.benchSuite , Eisenstein.benchSuite- , Euclidean.benchSuite , Gaussian.benchSuite , Inverse.benchSuite , Jacobi.benchSuite , Mertens.benchSuite- , Powers.benchSuite , Primes.benchSuite , PrimitiveRoots.benchSuite , Recurrences.benchSuite
benchmark/Math/NumberTheory/ArithmeticFunctionsBench.hs view
@@ -4,7 +4,7 @@ ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench import Data.Set (Set) import Math.NumberTheory.ArithmeticFunctions as A
benchmark/Math/NumberTheory/DiscreteLogarithmBench.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} @@ -10,28 +11,29 @@ , discreteLogarithm' ) where -import Gauge.Main+import Test.Tasty.Bench+import Control.Monad import Data.Maybe-import GHC.TypeNats.Compat+import Data.Mod+import GHC.TypeNats (KnownNat, SomeNat(..), someNatVal) import Data.Proxy import Numeric.Natural -import Math.NumberTheory.Moduli.Class (isMultElement, KnownNat, MultMod, multElement, getVal,Mod)-import Math.NumberTheory.Moduli.DiscreteLogarithm (discreteLogarithm)-import Math.NumberTheory.Moduli.PrimitiveRoot (PrimitiveRoot, isPrimitiveRoot, unPrimitiveRoot, cyclicGroupFromModulo)+import Math.NumberTheory.Moduli.Multiplicative+import Math.NumberTheory.Moduli.Singleton data Case = forall m. KnownNat m => Case (PrimitiveRoot m) (MultMod m) String instance Show Case where- show (Case a b s) = concat [show (getVal a'), "ⁿ == ", show b', " mod ", s]+ show (Case a b s) = concat [show (unMod a'), "ⁿ == ", show b', " mod ", s] where a' = multElement $ unPrimitiveRoot a- b' = getVal $ multElement b+ b' = unMod $ multElement b makeCase :: (Integer, Integer, Natural, String) -> Maybe Case makeCase (a,b,n,s) = case someNatVal n of SomeNat (_ :: Proxy m) ->- Case <$> isPrimitiveRoot a' <*> isMultElement b' <*> pure s+ Case <$> join (isPrimitiveRoot @Integer <$> cyclicGroup <*> pure a') <*> isMultElement b' <*> pure s where a' = fromInteger a :: Mod m b' = fromInteger b @@ -45,15 +47,16 @@ rangeCases :: Natural -> Int -> [Case] rangeCases start num = take num $ do n <- [start..]- _cg <- maybeToList $ cyclicGroupFromModulo n case someNatVal n of- SomeNat (_ :: Proxy m) -> do- a <- take 1 $ mapMaybe isPrimitiveRoot [2 :: Mod m .. maxBound]- b <- take 1 $ filter (/= unPrimitiveRoot a) $ mapMaybe isMultElement [2 .. maxBound]- return $ Case a b (show n)+ SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of+ Nothing -> []+ Just cg -> do+ a <- take 1 $ mapMaybe (isPrimitiveRoot cg) [2 :: Mod m .. maxBound]+ b <- take 1 $ filter (/= unPrimitiveRoot a) $ mapMaybe isMultElement [2 .. maxBound]+ return $ Case a b (show n) discreteLogarithm' :: Case -> Natural-discreteLogarithm' (Case a b _) = discreteLogarithm a b+discreteLogarithm' (Case a b _) = discreteLogarithm (fromJust cyclicGroup) a b benchSuite :: Benchmark benchSuite = bgroup "Discrete logarithm"
benchmark/Math/NumberTheory/EisensteinIntegersBench.hs view
@@ -6,7 +6,7 @@ ) where import Data.Maybe-import Gauge.Main+import Test.Tasty.Bench import Math.NumberTheory.ArithmeticFunctions (tau) import Math.NumberTheory.Primes (isPrime)
− benchmark/Math/NumberTheory/EuclideanBench.hs
@@ -1,19 +0,0 @@-{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Math.NumberTheory.EuclideanBench- ( benchSuite- ) where--import Gauge.Main--import Math.NumberTheory.Euclidean--doBench :: Integral a => (a -> a -> (a, a, a)) -> a -> a-doBench func lim = sum [ let (a, b, c) = func x y in a + b + c | y <- [3, 5 .. lim], x <- [0..y] ]--benchSuite :: Benchmark-benchSuite = bgroup "Euclidean"- [ bench "extendedGCD/Int" $ nf (doBench extendedGCD :: Int -> Int) 1000- , bench "extendedGCD/Word" $ nf (doBench extendedGCD :: Word -> Word) 1000- , bench "extendedGCD/Integer" $ nf (doBench extendedGCD :: Integer -> Integer) 1000- ]
benchmark/Math/NumberTheory/GaussianIntegersBench.hs view
@@ -5,7 +5,7 @@ ) where import Data.Maybe-import Gauge.Main+import Test.Tasty.Bench import Math.NumberTheory.ArithmeticFunctions (tau) import Math.NumberTheory.Primes (isPrime)
benchmark/Math/NumberTheory/InverseBench.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}@@ -6,11 +7,12 @@ ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench+import Data.Bits (Bits)+import Data.Euclidean import Numeric.Natural import Math.NumberTheory.ArithmeticFunctions.Inverse-import Math.NumberTheory.Euclidean import Math.NumberTheory.Primes fact :: (Enum a, Num a) => a@@ -19,10 +21,10 @@ tens :: Num a => a tens = 10 ^ 18 -countInverseTotient :: (Ord a, Euclidean a, UniqueFactorisation a) => a -> Word+countInverseTotient :: (Ord a, Integral a, Euclidean a, UniqueFactorisation a) => a -> Word countInverseTotient = inverseTotient (const 1) -countInverseSigma :: (Integral a, Euclidean a, UniqueFactorisation a) => a -> Word+countInverseSigma :: (Integral a, Euclidean a, UniqueFactorisation a, Enum (Prime a), Bits a) => a -> Word countInverseSigma = inverseSigma (const 1) benchSuite :: Benchmark
benchmark/Math/NumberTheory/JacobiBench.hs view
@@ -4,10 +4,10 @@ ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench import Numeric.Natural -import Math.NumberTheory.Moduli.Jacobi+import Math.NumberTheory.Moduli.Sqrt doBench :: Integral a => (a -> a -> JacobiSymbol) -> a -> a doBench func lim = sum [ x + y | y <- [3, 5 .. lim], x <- [0..y], func x y == One ]
benchmark/Math/NumberTheory/MertensBench.hs view
@@ -1,13 +1,10 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.MertensBench ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench import Math.NumberTheory.ArithmeticFunctions.Mertens
− benchmark/Math/NumberTheory/PowersBench.hs
@@ -1,31 +0,0 @@-{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Math.NumberTheory.PowersBench- ( benchSuite- ) where--import Gauge.Main-import System.Random--import Math.NumberTheory.Logarithms (integerLog2)-import Math.NumberTheory.Powers.Squares.Internal--genInteger :: Int -> Int -> Integer-genInteger salt bits- = head- . dropWhile ((< bits) . integerLog2)- . scanl (\a r -> a * 2^31 + abs r) 1- . randoms- . mkStdGen- $ salt + bits--compareRoots :: Int -> Benchmark-compareRoots bits = bgroup ("sqrt" ++ show bits)- [ bench "new" $ nf (fst . karatsubaSqrt) n- , bench "old" $ nf isqrtA n- ]- where- n = genInteger 0 bits--benchSuite :: Benchmark-benchSuite = bgroup "Powers" $ map compareRoots [2300, 2400 .. 2600]
benchmark/Math/NumberTheory/PrimesBench.hs view
@@ -1,14 +1,16 @@-{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+{-# OPTIONS_GHC -Wno-x-partial #-}+{-# OPTIONS_GHC -Wno-unrecognised-warning-flags #-} module Math.NumberTheory.PrimesBench ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench import System.Random import Math.NumberTheory.Logarithms (integerLog2)-import Math.NumberTheory.Primes.Factorisation+import Math.NumberTheory.Primes (factorise) import Math.NumberTheory.Primes.Testing genInteger :: Int -> Int -> Integer
benchmark/Math/NumberTheory/PrimitiveRootsBench.hs view
@@ -1,24 +1,35 @@+{-# LANGUAGE RankNTypes #-}+ {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.PrimitiveRootsBench ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench+import Data.Constraint import Data.Maybe -import Math.NumberTheory.Moduli.PrimitiveRoot+import Math.NumberTheory.Moduli.Multiplicative+import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes primRootWrap :: Integer -> Word -> Integer -> Bool-primRootWrap p k g = isPrimitiveRoot' (CGOddPrimePower p' k) g- where p' = fromJust $ isPrime p+primRootWrap p k g = case fromJust $ cyclicGroupFromFactors [(p', k)] of+ Some cg -> case proofFromCyclicGroup cg of+ Sub Dict -> isJust $ isPrimitiveRoot cg (fromInteger g)+ where+ p' = fromJust $ isPrime p primRootWrap2 :: Integer -> Word -> Integer -> Bool-primRootWrap2 p k g = isPrimitiveRoot' (CGDoubleOddPrimePower p' k) g- where p' = fromJust $ isPrime p+primRootWrap2 p k g = case fromJust $ cyclicGroupFromFactors [(two, 1), (p', k)] of+ Some cg -> case proofFromCyclicGroup cg of+ Sub Dict -> isJust $ isPrimitiveRoot cg (fromInteger g)+ where+ two = fromJust $ isPrime 2+ p' = fromJust $ isPrime p -cyclicWrap :: Integer -> Maybe (CyclicGroup Integer)+cyclicWrap :: Integer -> Maybe (Some (CyclicGroup Integer)) cyclicWrap = cyclicGroupFromModulo benchSuite :: Benchmark@@ -28,7 +39,7 @@ , bench "10000000000000061" $ nf cyclicWrap (10^16 + 61) -- large prime , bench "2*3^20000" $ nf cyclicWrap (2*3^20000) -- twice prime to large power , bench "10000000000000046" $ nf cyclicWrap (10^16 + 46) -- twice large prime- , bench "224403121196654400" $ nf cyclicWrap (224403121196654400) -- highly composite+ , bench "224403121196654400" $ nf cyclicWrap 224403121196654400 -- highly composite ] , bgroup "check prim roots" [ bench "3^20000" $ nf (primRootWrap 3 20000) 2 -- prime to large power
benchmark/Math/NumberTheory/RecurrencesBench.hs view
@@ -4,45 +4,46 @@ ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench -import Math.NumberTheory.Recurrences (binomial, eulerian1, eulerian2,- stirling1, stirling2, partition)+import Data.Euclidean (GcdDomain)+import Data.List.Infinite (Infinite(..))+import qualified Data.List.Infinite as Inf+import Math.NumberTheory.Recurrences -benchTriangle :: String -> (forall a. (Integral a) => [[a]]) -> Int -> Benchmark+benchTriangle :: String -> (forall a. (GcdDomain a, Integral a) => Infinite [a]) -> Word -> Benchmark benchTriangle name triangle n = bgroup name- [ benchAt (10 * n) (1 * n)- , benchAt (10 * n) (2 * n)- , benchAt (10 * n) (5 * n)- , benchAt (10 * n) (9 * n)+ [ benchAt (10 * n) (1 * fromIntegral n)+ , benchAt (10 * n) (2 * fromIntegral n)+ , benchAt (10 * n) (5 * fromIntegral n)+ , benchAt (10 * n) (9 * fromIntegral n) ] where benchAt i j = bench ("!! " ++ show i ++ " !! " ++ show j)- $ nf (\(x, y) -> triangle !! x !! y :: Integer) (i, j)+ $ nf (\(x, y) -> triangle Inf.!! x !! y :: Integer) (i, j) -benchPartition :: Int -> Benchmark+benchPartition :: Word -> Benchmark benchPartition n = bgroup "partition" [ benchAt n , benchAt (n * 10) , benchAt (n * 100) ] where- benchAt m = bench ("!!" ++ show m) $ nf (\k -> partition !! k :: Integer) m+ benchAt m = bench ("!!" ++ show m) $ nf (\k -> partition Inf.!! k :: Integer) m benchSuite :: Benchmark benchSuite = bgroup "Recurrences"- [- bgroup "Bilinear"- [ benchTriangle "binomial" binomial 1000- , benchTriangle "stirling1" stirling1 100- , benchTriangle "stirling2" stirling2 100- , benchTriangle "eulerian1" eulerian1 100- , benchTriangle "eulerian2" eulerian2 100+ [ bgroup "Bilinear"+ [ benchTriangle "binomial" binomial 80+ , benchTriangle "stirling1" stirling1 75+ , benchTriangle "stirling2" stirling2 75+ , benchTriangle "eulerian1" eulerian1 50+ , benchTriangle "eulerian2" eulerian2 50 ]- ,- bgroup "Pentagonal"- [ bgroup "Partition function"- [ benchPartition 1000- ]+ , benchPartition 1000+ , bgroup "factorialFactors"+ [ bench "10000" $ nf factorialFactors 10000+ , bench "20000" $ nf factorialFactors 20000+ , bench "40000" $ nf factorialFactors 40000 ] ]
benchmark/Math/NumberTheory/SequenceBench.hs view
@@ -4,36 +4,30 @@ ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench -import Data.Array.IArray ((!))-import Data.Array.Unboxed import Data.Bits+import qualified Data.Vector.Unboxed as U -import Math.NumberTheory.Primes (Prime(..))-import Math.NumberTheory.Primes.Sieve as P-import Math.NumberTheory.Primes.Testing as P+import Math.NumberTheory.Primes (Prime(..), nextPrime, precPrime)+import Math.NumberTheory.Primes.Testing filterIsPrime :: (Integer, Integer) -> Integer filterIsPrime (p, q) = sum $ takeWhile (<= q) $ dropWhile (< p) $ filter isPrime (map toPrim [toIdx p .. toIdx q]) eratosthenes :: (Integer, Integer) -> Integer-eratosthenes (p, q) = sum $ takeWhile (<= q) $ dropWhile (< p) $ map unPrime $ if q < toInteger sieveRange- then primeList $ primeSieve q- else concatMap primeList $ psieveFrom p+eratosthenes (p, q) = sum (map unPrime [nextPrime p .. precPrime q]) filterIsPrimeBench :: Benchmark filterIsPrimeBench = bgroup "filterIsPrime" $- map (\(x, y) -> bench (show (x, y)) $ nf filterIsPrime (x, x + y))- [ (10 ^ x, 10 ^ y)+ [ bench (show (10^x, 10^y)) $ nf filterIsPrime (10^x, 10^x + 10^y) | x <- [5..8] , y <- [3..x-1] ] eratosthenesBench :: Benchmark eratosthenesBench = bgroup "eratosthenes" $- map (\(x, y) -> bench (show (x, y)) $ nf eratosthenes (x, x + y))- [ (10 ^ x, 10 ^ y)+ [ bench (show (10^x, 10^y)) $ nf eratosthenes (10^x, 10^x + 10^y) | x <- [10..17] , y <- [6..x-1] , x == 10 || y == 7@@ -48,14 +42,11 @@ ------------------------------------------------------------------------------- -- Utils copypasted from internal modules -sieveRange :: Int-sieveRange = 30*128*1024- rho :: Int -> Int-rho i = residues ! i+rho i = residues U.! i -residues :: UArray Int Int-residues = listArray (0,7) [7,11,13,17,19,23,29,31]+residues :: U.Vector Int+residues = U.fromList [7,11,13,17,19,23,29,31] toIdx :: Integral a => a -> Int toIdx n = 8*fromIntegral q+r2
benchmark/Math/NumberTheory/SieveBlockBench.hs view
@@ -1,17 +1,12 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.SieveBlockBench ( benchSuite ) where -import Gauge.Main-#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif+import Test.Tasty.Bench import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U @@ -46,7 +41,7 @@ carmichaelBlockConfig = SieveBlockConfig { sbcEmpty = 1 -- There is a specialized 'gcd' for Word, but not 'lcm'.- , sbcAppend = (\x y -> (x `quot` (gcd x y)) * y)+ , sbcAppend = \x y -> (x `quot` gcd x y) * y , sbcFunctionOnPrimePower = carmichaelHelper . unPrime }
benchmark/Math/NumberTheory/SmoothNumbersBench.hs view
@@ -4,19 +4,17 @@ ( benchSuite ) where -import Data.List (genericTake)-import Data.Maybe-import Gauge.Main+import Test.Tasty.Bench -import Math.NumberTheory.Euclidean (Euclidean)+import Math.NumberTheory.Primes import Math.NumberTheory.SmoothNumbers -doBench :: (Euclidean a, Integral a) => a -> a-doBench lim = sum $ genericTake lim $ smoothOver $ fromJust $ fromSmoothUpperBound lim+doBench :: Int -> Int+doBench lim = sum $ take lim $ smoothOver $ fromList $ map unPrime [nextPrime 2 .. precPrime lim] benchSuite :: Benchmark benchSuite = bgroup "SmoothNumbers"- [ bench "100" $ nf doBench (100 :: Int)- , bench "1000" $ nf doBench (1000 :: Int)- , bench "10000" $ nf doBench (10000 :: Int)+ [ bench "100" $ nf doBench 100+ , bench "1000" $ nf doBench 1000+ , bench "10000" $ nf doBench 10000 ]
benchmark/Math/NumberTheory/ZetaBench.hs view
@@ -4,12 +4,13 @@ ( benchSuite ) where -import Gauge.Main+import Test.Tasty.Bench +import qualified Data.List.Infinite as Inf import Math.NumberTheory.Zeta benchSuite :: Benchmark benchSuite = bgroup "Zeta"- [ bench "riemann zeta" $ nf (\eps -> sum $ take 20 $ zetas eps) (1e-15 :: Double)- , bench "dirichlet beta" $ nf (\eps -> sum $ take 20 $ betas eps) (1e-15 :: Double)+ [ bench "riemann zeta" $ nf (sum . Inf.take 20 . zetas) (1e-15 :: Double)+ , bench "dirichlet beta" $ nf (sum . Inf.take 20 . betas) (1e-15 :: Double) ]
+ changelog.md view
@@ -0,0 +1,635 @@+# Changelog++## 0.13.4.0++### Fixed++* Fix `sieveBlockUnboxed` segfaulting when a block starts from 0.+* Fix typos.++### Added++* Add `ids` and `associates` to `Math.NumberTheory.Quadratic.GaussianIntegers`.++### Changed++* Define `liftA2` for `ArithmeticFunction` explicitly.++## 0.13.3.0++### Changed++* Changed primeCount implementation to something a little faster and better documented.+* Added a documentation file: "HowPrimeCountingWorks.md".+* Tweaked some benchmark settings to make them complete faster.++## 0.13.2.0++### Changed++* Migrate implementation of prime sieves from `Array Bool` to `Vector Bit`.++## 0.13.1.0++### Fixed++* Fix a grave bug in prime counting, lurking since `arithmoi-0.11.0.0`.++## 0.13.0.1++### Fixed++* Compatibility patches for `containers-0.8`.++## 0.13.0.0++### Changed++* Migrate functions under `Math.NumberTheory.Recurrences` and `Math.NumberTheory.Zeta`, which operate on infinite lists, to use `Infinite` from `infinite-list` package.+* Migrate functions under `Math.NumberTheory.Quadratic` to return an `Infinite` list of quadratic primes.++### Removed++* Remove deprecated `Math.NumberTheory.Powers.Modular`.++## 0.12.1.0++### Fixed++* Fix a grave bug in prime factorisation, lurking since `arithmoi-0.7.0.0`.++## 0.12.0.2++### Fixed++* Compatibility patches for GHC 9.4.++## 0.12.0.1++### Fixed++* Compatibility patches for GHC 9.2.++## 0.12.0.0++### Added++* Define cubic symbol ([#194](https://github.com/Bodigrim/arithmoi/pull/194)).+* Add `instance Unbox (Prime a)` and `toPrimeIntegral` helper ([#201](https://github.com/Bodigrim/arithmoi/pull/201)).+* Implement Cornacchia's algorithm for Diophantine equations ([#195](https://github.com/Bodigrim/arithmoi/pull/195)).+* Define a wrapper `PrimeIntSet` for sets of primes ([#205](https://github.com/Bodigrim/arithmoi/pull/205)).++### Deprecated++* Deprecate `Math.NumberTheory.Powers.Modular`, use `Data.Mod` or `Data.Mod.Word` instead.++### Removed++* Remove modules and functions, deprecated in the previous release.++## 0.11.0.1++### Changed++* Switch to `smallcheck-1.2.0`.++## 0.11.0.0++### Added++* Brand new machinery to deal with Dirichlet characters ([#180](https://github.com/Bodigrim/arithmoi/pull/180)).++* Generate preimages of the Jordan and the sum-of-powers-of-divisors+ functions ([#148](https://github.com/Bodigrim/arithmoi/pull/148)).++* More flexible interface for Pascal triangle: in addition to `binomial`+ we now provide also `binomialRotated`, `binomialLine` and `binomialDiagonal`+ ([#151](https://github.com/Bodigrim/arithmoi/pull/151)). There are also `factoriseFactorial` and `factoriseBinomial` ([#152](https://github.com/Bodigrim/arithmoi/pull/152)).++* Add `Semiring` instance of `SomeMod` ([#174](https://github.com/Bodigrim/arithmoi/pull/174)).++* Generate divisors in range ([#183](https://github.com/Bodigrim/arithmoi/pull/183)).++### Changed++* Speed up `partition`, using better container for memoization ([#176](https://github.com/Bodigrim/arithmoi/pull/176)).++* Speed up `integerRoot`, using better starting approximation ([#177](https://github.com/Bodigrim/arithmoi/pull/177)).++### Deprecated++* Deprecate `Math.NumberTheory.Euclidean`, use `Data.Euclidean` instead.++* Deprecate `chineseRemainder`, `chineseRemainder2`, `chineseCoprime`,+ use `chinese` instead. Deprecate `chineseCoprimeSomeMod`, use `chineseSomeMod`.++* Deprecate `Math.NumberTheory.Powers` except `Math.NumberTheory.Powers.Modular`.+ Use `Math.NumberTheory.Roots` instead.++* Deprecate `Math.NumberTheory.Moduli.Jacobi`, use `Math.NumberTheory.Moduli.Sqrt`+ instead.++* Deprecate `Math.NumberTheory.Moduli.{DiscreteLogarithm,PrimitiveRoot}`,+ use `Math.NumberTheory.Moduli.Multiplicative` instead.++### Removed++* Remove modules and functions, deprecated in the previous release.++### Fixed++* Fix subtraction of `SomeMod` ([#174](https://github.com/Bodigrim/arithmoi/pull/174)).++## 0.10.0.0++### Added++* The machinery of cyclic groups, primitive roots and discrete logarithms+ has been completely overhauled and rewritten using singleton types ([#169](https://github.com/Bodigrim/arithmoi/pull/169)).++ There is also a new singleton type, linking a type-level modulo with+ a term-level factorisation. It allows both to have a nicely-typed API+ of `Mod m` and avoid repeating factorisations ([#169](https://github.com/Bodigrim/arithmoi/pull/169)).++ Refer to a brand new module `Math.NumberTheory.Moduli.Singleton` for details.++* Add a new function `factorBack`.++* Add `Ord SomeMod` instance ([#165](https://github.com/Bodigrim/arithmoi/pull/165)).++* Add `Semiring` and `Ring` instances for Eisenstein and Gaussian integers.++### Changed++* Embrace the new `Semiring -> GcdDomain -> Euclidean` hierarchy+ of classes, refining `Num` and `Integral` constraints.++* Reshuffle exports from `Math.NumberTheory.Zeta`, do not advertise+ its submodules as available to import.++* Add a proxy argument storing vector's flavor to+ `Math.NumberTheory.MoebiusInversion.{generalInversion,totientSum}`.++* `solveQuadratic` and `sqrtsMod` require an additional argument: a singleton+ linking a type-level modulo with a term-level factorisation ([#169](https://github.com/Bodigrim/arithmoi/pull/169)).++* Generalize `sieveBlock` to handle any flavor of `Vector` ([#164](https://github.com/Bodigrim/arithmoi/pull/164)).++### Deprecated++* Deprecate `Math.NumberTheory.Primes.Factorisation`, use+ `Math.NumberTheory.Primes.factorise` instead. Deprecate+ `Math.NumberTheory.Primes.Sieve`, use `Enum` instance instead.++* Deprecate `Math.NumberTheory.Primes.Factorisation.Certified` and+ `Math.NumberTheory.Primes.Testing.Certificates`.++* Deprecate `Math.NumberTheory.MoebiusInversion.Int`.++* Deprecate `Math.NumberTheory.SmoothNumbers.{fromSet,fromSmoothUpperBound}`.+ Use `Math.NumberTheory.SmoothNumbers.fromList` instead.++* Deprecate `Math.NumberTheory.SmoothNumbers.smoothOverInRange` in favor+ of `smoothOver` and `Math.NumberTheory.SmoothNumbers.smoothOverInRange`+ in favor of `isSmooth`.++### Removed++* Move `Euclidean` type class to `semirings` package ([#168](https://github.com/Bodigrim/arithmoi/pull/168)).++* Remove deprecated earlier `Math.NumberTheory.Recurrencies.*`+ and `Math.NumberTheory.UniqueFactorisation` modules.+ Use `Math.NumberTheory.Recurrences.*` and `Math.NumberTheory.Primes`+ instead.++* Remove deprecated earlier an old interface of `Math.NumberTheory.Moduli.Sqrt`.++## 0.9.0.0++### Added++* Introduce `Prime` newtype. This newtype+ is now used extensively in public API:++ ```haskell+ primes :: Integral a => [Prime a]+ primeList :: Integral a => PrimeSieve -> [Prime a]+ sieveFrom :: Integer -> [Prime Integer]+ nthPrime :: Integer -> Prime Integer+ ```++* New functions `nextPrime` and `precPrime`. Implement an instance of `Enum` for primes ([#153](https://github.com/Bodigrim/arithmoi/pull/153)):++ ```haskell+ > [nextPrime 101 .. precPrime 130]+ [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127]+ ```+* Add the Hurwitz zeta function on non-negative integer arguments ([#126](https://github.com/Bodigrim/arithmoi/pull/126)).++* Implement efficient tests of n-freeness: pointwise and in interval. See `isNFree` and `nFreesBlock` ([#145](https://github.com/Bodigrim/arithmoi/pull/145)).++* Generate preimages of the totient and the sum-of-divisors functions ([#142](https://github.com/Bodigrim/arithmoi/pull/142)):++ ```haskell+ > inverseTotient 120 :: [Integer]+ [155,310,183,366,225,450,175,350,231,462,143,286,244,372,396,308,248]+ ```++* Generate coefficients of Faulhaber polynomials `faulhaberPoly` ([#70](https://github.com/Bodigrim/arithmoi/pull/70)).++### Changed++* Support Gaussian and Eisenstein integers in smooth numbers ([#138](https://github.com/Bodigrim/arithmoi/pull/138)).++* Change types of `primes`, `primeList`, `sieveFrom`, `nthPrime`, etc.,+ to use `Prime` newtype.++* `Math.NumberTheory.Primes.{Factorisation,Testing,Counting,Sieve}`+ are no longer re-exported from `Math.NumberTheory.Primes`.+ Merge `Math.NumberTheory.UniqueFactorisation` into+ `Math.NumberTheory.Primes` ([#135](https://github.com/Bodigrim/arithmoi/pull/135), [#153](https://github.com/Bodigrim/arithmoi/pull/153)).++* From now on `Math.NumberTheory.Primes.Factorisation.factorise`+ and similar functions return `[(Integer, Word)]` instead of `[(Integer, Int)]`.++* `sbcFunctionOnPrimePower` now accepts `Prime Word` instead of `Word`.++* Better precision for exact values of Riemann zeta and Dirichlet beta+ functions ([#123](https://github.com/Bodigrim/arithmoi/pull/123)).++* Speed up certain cases of modular multiplication ([#160](https://github.com/Bodigrim/arithmoi/pull/160)).++* Extend Chinese theorem to non-coprime moduli ([#71](https://github.com/Bodigrim/arithmoi/pull/71)).++### Deprecated++* Deprecate `Math.NumberTheory.Recurrencies.*`.+ Use `Math.NumberTheory.Recurrences.*` instead ([#146](https://github.com/Bodigrim/arithmoi/pull/146)).++### Removed++* Remove `Prime` type family.++* Remove deprecated `Math.NumberTheory.GCD` and `Math.NumberTheory.GCD.LowLevel`.++## 0.8.0.0++### Added++* A new interface for `Math.NumberTheory.Moduli.Sqrt`, more robust and type safe ([#87](https://github.com/Bodigrim/arithmoi/pull/87), [#108](https://github.com/Bodigrim/arithmoi/pull/108)).++* Implement Ramanujan tau function ([#112](https://github.com/Bodigrim/arithmoi/pull/112)):++ ```haskell+ > map ramanujan [1..10]+ [1,-24,252,-1472,4830,-6048,-16744,84480,-113643,-115920]+ ```++* Implement partition function ([#115](https://github.com/Bodigrim/arithmoi/pull/115)):++ ```haskell+ > take 10 partition+ [1,1,2,3,5,7,11,15,22,30]+ ```++* Add the Dirichlet beta function on non-negative integer arguments ([#120](https://github.com/Bodigrim/arithmoi/pull/120)).+ E. g.,++ ```haskell+ > take 5 $ Math.NumberTheory.Zeta.Dirichlet.betas 1e-15+ [0.5,0.7853981633974483,0.9159655941772191,0.9689461462593693,0.9889445517411055]+ ```++* Solve linear and quadratic congruences ([#129](https://github.com/Bodigrim/arithmoi/pull/129)).++* Support Eisenstein integers ([#121](https://github.com/Bodigrim/arithmoi/pull/121)).++* Implement discrete logarithm ([#88](https://github.com/Bodigrim/arithmoi/pull/88)).++### Changed++* Stop reporting units (1, -1, i, -i) as a part of factorisation+ for integers and Gaussian integers ([#101](https://github.com/Bodigrim/arithmoi/pull/101)). Now `factorise (-2)`+ is `[(2, 1)]` and not `[(-1, 1), (2, 1)]`.++* Move `splitIntoCoprimes` to `Math.NumberTheory.Euclidean.Coprimes`.++* Change types of `splitIntoCoprimes`, `fromFactors` and `prefFactors`+ using newtype `Coprimes` ([#89](https://github.com/Bodigrim/arithmoi/pull/89)).++* Sort Gaussian primes by norm ([#124](https://github.com/Bodigrim/arithmoi/pull/124)).++* Make return type of `primes` and `primeList` polymorphic instead of+ being limited to `Integer` only ([#109](https://github.com/Bodigrim/arithmoi/pull/109)).++* Speed up factorisation of Gaussian integers ([#116](https://github.com/Bodigrim/arithmoi/pull/116)).++* Speed up computation of primitive roots for prime powers ([#127](https://github.com/Bodigrim/arithmoi/pull/127)).++### Deprecated++* Deprecate an old interface of `Math.NumberTheory.Moduli.Sqrt`.++* Deprecate `Math.NumberTheory.GCD` and `Math.NumberTheory.GCD.LowLevel` ([#80](https://github.com/Bodigrim/arithmoi/pull/80)).+ Use `Math.NumberTheory.Euclidean` instead ([#128](https://github.com/Bodigrim/arithmoi/pull/128)).++* Deprecate `jacobi'` ([#103](https://github.com/Bodigrim/arithmoi/pull/103)).+++* Deprecate `Math.NumberTheory.GaussianIntegers` in favor of+ `Math.NumberTheory.Quadratic.GaussianIntegers`.++## 0.7.0.0++### Added++* A general framework for bulk evaluation of arithmetic functions ([#77](https://github.com/Bodigrim/arithmoi/pull/77)):++ ```haskell+ > runFunctionOverBlock carmichaelA 1 10+ [1,1,2,2,4,2,6,2,6,4]+ ```++* Implement a sublinear algorithm for Mertens function ([#90](https://github.com/Bodigrim/arithmoi/pull/90)):++ ```haskell+ > map (mertens . (10 ^)) [0..9]+ [1,-1,1,2,-23,-48,212,1037,1928,-222]+ ```++* Add basic support for cyclic groups and primitive roots ([#86](https://github.com/Bodigrim/arithmoi/pull/86)).++* Implement an efficient modular exponentiation ([#86](https://github.com/Bodigrim/arithmoi/pull/86)).++* Write routines for lazy generation of smooth numbers ([#91](https://github.com/Bodigrim/arithmoi/pull/91)).++ ```haskell+ > smoothOverInRange (fromJust (fromList [3,5,7])) 1000 2000+ [1029,1125,1215,1225,1323,1575,1701,1715,1875]+ ```++### Changed++* Now `moebius` returns not a number, but a value of `Moebius` type ([#90](https://github.com/Bodigrim/arithmoi/pull/90)).++* Now factorisation of large integers and Gaussian integers produces+ factors as lazy as possible ([#72](https://github.com/Bodigrim/arithmoi/pull/72), [#76](https://github.com/Bodigrim/arithmoi/pull/76)).++### Deprecated++* Deprecate `Math.NumberTheory.Primes.Heap`.+ Use `Math.NumberTheory.Primes.Sieve` instead.++* Deprecate `FactorSieve`, `TotientSieve`, `CarmichaelSieve` and+ accompanying functions. Use new general approach for bulk evaluation+ of arithmetic functions instead ([#77](https://github.com/Bodigrim/arithmoi/pull/77)).++### Removed++* Remove `Math.NumberTheory.Powers.Integer`, deprecated in 0.5.0.0.++## 0.6.0.1++### Changed++* Switch to `smallcheck-1.1.3`.++## 0.6.0.0++### Added++* Brand new `Math.NumberTheory.Moduli.Class` ([#56](https://github.com/Bodigrim/arithmoi/pull/56)), providing+ flexible and type safe modular arithmetic. Due to use of GMP built-ins+ it is also significantly faster.++* New function `divisorsList`, which is lazier than `divisors` and+ does not require `Ord` constraint ([#64](https://github.com/Bodigrim/arithmoi/pull/64)). Thus, it can be used+ for `GaussianInteger`.++### Changed++* `Math.NumberTheory.Moduli` was split into+ `Math.NumberTheory.Moduli.{Chinese,Class,Jacobi,Sqrt}`.++* Functions `jacobi` and `jacobi'` return `JacobiSymbol`+ instead of `Int`.++* Speed up factorisation over elliptic curve up to 15x ([#65](https://github.com/Bodigrim/arithmoi/pull/65)).++* Polymorphic `fibonacci` and `lucas` functions, which previously+ were restricted to `Integer` only ([#63](https://github.com/Bodigrim/arithmoi/pull/63)). This is especially useful+ for modular computations, e. g., `map fibonacci [1..10] :: [Mod 7]`.++* Make `totientSum` more robust and idiomatic ([#58](https://github.com/Bodigrim/arithmoi/pull/58)).++### Removed++* Functions `invertMod`, `powerMod` and `powerModInteger` were removed,+ as well as their unchecked counterparts. Use new interface to+ modular computations, provided by `Math.NumberTheory.Moduli.Class`.++## 0.5.0.1++### Changed++ Switch to `QuickCheck-2.10`.++## 0.5.0.0++### Added++* Add basic combinatorial sequences: binomial coefficients, Stirling+ numbers of both kinds, Eulerian numbers of both kinds, Bernoulli+ numbers ([#39](https://github.com/Bodigrim/arithmoi/pull/39)). E. g.,++ ```haskell+ > take 10 $ Math.NumberTheory.Recurrencies.Bilinear.bernoulli+ [1 % 1,(-1) % 2,1 % 6,0 % 1,(-1) % 30,0 % 1,1 % 42,0 % 1,(-1) % 30,0 % 1]+ ```++* Add the Riemann zeta function on non-negative integer arguments ([#44](https://github.com/Bodigrim/arithmoi/pull/44)).+ E. g.,++ ```haskell+ > take 5 $ Math.NumberTheory.Zeta.zetas 1e-15+ [-0.5,Infinity,1.6449340668482262,1.2020569031595945,1.0823232337111381]+ ```++### Changed++* Rename `Math.NumberTheory.Lucas` to `Math.NumberTheory.Recurrencies.Linear`.++* Speed up `isPrime` twice; rework `millerRabinV` and `isStrongFermatPP` ([#22](https://github.com/Bodigrim/arithmoi/pull/22), [#25](https://github.com/Bodigrim/arithmoi/pull/25)).++### Deprecated++* Deprecate `integerPower` and `integerWordPower` from+ `Math.NumberTheory.Powers.Integer`. Use `(^)` instead ([#51](https://github.com/Bodigrim/arithmoi/pull/51)).++### Removed++* Remove deprecated interface to arithmetic functions (`divisors`, `tau`,+ `sigma`, `totient`, `jordan`, `moebius`, `liouville`, `smallOmega`, `bigOmega`,+ `carmichael`, `expMangoldt`). New interface is exposed via+ `Math.NumberTheory.ArithmeticFunctions` ([#30](https://github.com/Bodigrim/arithmoi/pull/30)).++* `Math.NumberTheory.Logarithms` has been moved to the separate package+ `integer-logarithms` ([#51](https://github.com/Bodigrim/arithmoi/pull/51)).++## 0.4.3.0++### Added++* Add `Math.NumberTheory.ArithmeticFunctions` with brand-new machinery+ for arithmetic functions: `divisors`, `tau`, `sigma`, `totient`, `jordan`,+ `moebius`, `liouville`, `smallOmega`, `bigOmega`, `carmichael`, `expMangoldt` ([#30](https://github.com/Bodigrim/arithmoi/pull/30)).+ Old implementations (exposed via `Math.NumberTheory.Primes.Factorisation`+ and `Math.NumberTheory.Powers.Integer`) are deprecated and will be removed+ in the next major release.++* Add Karatsuba sqrt algorithm, improving performance on large integers ([#6](https://github.com/Bodigrim/arithmoi/pull/6)).++### Fixed++* Fix incorrect indexing of `FactorSieve` ([#35](https://github.com/Bodigrim/arithmoi/pull/35)).++## 0.4.2.0++### Added++* Add new cabal flag `check-bounds`, which replaces all unsafe array functions with safe ones.++* Add basic functions on Gaussian integers.++* Add Möbius mu-function.++### Changed++* Forbid non-positive moduli in `Math.NumberTheory.Moduli`.++### Fixed++* Fix out-of-bounds errors in `Math.NumberTheory.Primes.Heap`, `Math.NumberTheory.Primes.Sieve` and `Math.NumberTheory.MoebiusInversion`.++* Fix 32-bit build.++* Fix `binaryGCD` on negative numbers.++* Fix `highestPower` (various issues).++## 0.4.1.0++### Added++* Add `integerLog10` variants at Bas van Dijk's request and expose+ `Math.NumberTheory.Powers.Integer`, with an added `integerWordPower`.++## 0.4.0.4++### Fixed++* Update for GHC 7.8, the type of some primops changed, they return `Int#` now+ instead of `Bool`.++* Fixed bugs in modular square roots and factorisation.++## 0.4.0.3++### Changed++* Relaxed dependencies on mtl and containers.++### Fixed++* Fixed warnings from GHC 7.5, `Word(..)` moved to `GHC.Types`.++* Removed `SPECIALISE` pragma from inline function (warning from GHC 7.5, probably+ pointless anyway).++## 0.4.0.2++### Changed++* Sped up factor sieves. They need more space now, but the speedup is worth it, IMO.++* Raised spec-constr limit in `MoebiusInversion.Int`.++## 0.4.0.1++### Fixed++* Fixed Haddock bug.++## 0.4.0.0++### Added++* Added generalised Möbius inversion, to be continued.++## 0.3.0.0++### Added++* Added modular square roots and Chinese remainder theorem.++## 0.2.0.6++### Changed++* Performance tweaks for `powerModInteger` (~10%) and `invertMod` (~25%).++## 0.2.0.5++### Fixed++* Fix bug in `psieveFrom`.++## 0.2.0.4++### Fixed++* Fix bug in `nthPrime`.++## 0.2.0.3++### Fixed++* Fix bug in `powerMod`.++## 0.2.0.2++### Changed++* Relax bounds on `array` dependency for GHC 7.4.++## 0.2.0.1++### Fixed++* Fix copy-pasto (only relevant for GHC 7.3).++* Fix imports for GHC 7.3.++## 0.2.0.0++### Added++* Added certificates and certified testing/factorisation++## 0.1.0.2++### Fixed++* Fixed doc bugs++## 0.1.0.1++### Changed++* Elaborate on overflow, work more on native `Ints` in Eratosthenes.++## 0.1.0.0++### Added++* First release.
test-suite/Math/NumberTheory/ArithmeticFunctions/InverseTests.hs view
@@ -9,8 +9,11 @@ -- {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}+ {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.ArithmeticFunctions.InverseTests@@ -19,12 +22,18 @@ import Test.Tasty import Test.Tasty.HUnit+import Test.Tasty.SmallCheck as SC hiding (test)+import Test.Tasty.QuickCheck as QC hiding (Positive) +import Data.Bits (Bits)+import Data.Euclidean+import qualified Data.List.Infinite as Inf+import Data.Semiring (Semiring) import qualified Data.Set as S+import Numeric.Natural (Natural) import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.ArithmeticFunctions.Inverse-import Math.NumberTheory.Euclidean import Math.NumberTheory.Primes import Math.NumberTheory.Recurrences import Math.NumberTheory.TestUtils@@ -35,9 +44,28 @@ totientProperty1 :: forall a. (Euclidean a, Integral a, UniqueFactorisation a) => Positive a -> Bool totientProperty1 (Positive x) = x `S.member` asSetOfPreimages inverseTotient (totient x) +jordanProperty1+ :: (Euclidean a, Integral a, UniqueFactorisation a)+ => Power Word+ -> Positive a+ -> Bool+jordanProperty1 (Power k') (Positive x) =+ -- 'k' shouldn't be large to avoid slow tests.+ let k = 2 + k' `Prelude.mod` 20+ in x `S.member` asSetOfPreimages (inverseJordan k) (jordan k x)+ totientProperty2 :: (Euclidean a, Integral a, UniqueFactorisation a) => Positive a -> Bool totientProperty2 (Positive x) = all (== x) (S.map totient (asSetOfPreimages inverseTotient x)) +jordanProperty2+ :: (Euclidean a, Integral a, UniqueFactorisation a, Ord a)+ => Power Word+ -> Positive a+ -> Bool+jordanProperty2 (Power k') (Positive x) =+ let k = 2 + k' `Prelude.mod` 20+ in all (== x) (S.map (jordan k) (asSetOfPreimages (inverseJordan k) x))+ -- | http://oeis.org/A055506 totientCountFactorial :: [Word] totientCountFactorial =@@ -62,7 +90,7 @@ ] totientSpecialCases1 :: [Assertion]-totientSpecialCases1 = zipWith mkAssert (tail factorial) totientCountFactorial+totientSpecialCases1 = zipWith mkAssert (drop 1 (Inf.toList factorial)) totientCountFactorial where mkAssert n m = assertEqual "should be equal" m (totientCount n) @@ -93,7 +121,7 @@ ] totientSpecialCases2 :: [Assertion]-totientSpecialCases2 = zipWith mkAssert (tail factorial) totientMinFactorial+totientSpecialCases2 = zipWith mkAssert (drop 1 (Inf.toList factorial)) totientMinFactorial where mkAssert n m = assertEqual "should be equal" m (totientMin n) @@ -124,22 +152,81 @@ ] totientSpecialCases3 :: [Assertion]-totientSpecialCases3 = zipWith mkAssert (tail factorial) totientMaxFactorial+totientSpecialCases3 = zipWith mkAssert (drop 1 (Inf.toList factorial)) totientMaxFactorial where mkAssert n m = assertEqual "should be equal" m (totientMax n) totientMax :: Word -> Word totientMax = unMaxWord . inverseTotient MaxWord +jordans5 :: [Word]+jordans5 =+ [ 1+ , 31+ , 242+ , 992+ , 3124+ , 7502+ , 16806+ , 31744+ , 58806+ , 96844+ , 161050+ , 240064+ , 371292+ , 520986+ , 756008+ , 1015808+ , 1419856+ , 1822986+ , 2476098+ , 3099008+ , 4067052+ , 4992550+ , 6436342+ , 7682048+ , 9762500+ , 11510052+ , 14289858+ , 16671552+ , 20511148+ ]++jordanSpecialCase1 :: [Assertion]+jordanSpecialCase1 = zipWith mkAssert ixs jordans5+ where+ mkAssert a b = assertEqual "should be equal" (S.singleton a) (asSetOfPreimages (inverseJordan 5) b)+ ixs = [1 .. 29]+ ------------------------------------------------------------------------------- -- Sigma -sigmaProperty1 :: forall a. (Euclidean a, UniqueFactorisation a, Integral a) => Positive a -> Bool+sigmaProperty1 :: forall a. (Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a) => Positive a -> Bool sigmaProperty1 (Positive x) = x `S.member` asSetOfPreimages inverseSigma (sigma 1 x) -sigmaProperty2 :: (Euclidean a, UniqueFactorisation a, Integral a) => Positive a -> Bool+sigmaKProperty1+ :: forall a+ . (Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a)+ => Power Word+ -> Positive a+ -> Bool+sigmaKProperty1 (Power k') (Positive x) =+ -- 'k' shouldn't be large to avoid slow tests.+ let k = 2 + k' `Prelude.mod` 20+ in x `S.member` asSetOfPreimages (inverseSigmaK k) (sigma k x)++sigmaProperty2 :: (Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a) => Positive a -> Bool sigmaProperty2 (Positive x) = all (== x) (S.map (sigma 1) (asSetOfPreimages inverseSigma x)) +sigmaKProperty2+ :: (Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a)+ => Power Word+ -> Positive a+ -> Bool+sigmaKProperty2 (Power k') (Positive x) =+ let k = 2 + k' `Prelude.mod` 20+ in all (== x) (S.map (sigma k) (asSetOfPreimages (inverseSigmaK k) x))+ -- | http://oeis.org/A055486 sigmaCountFactorial :: [Word] sigmaCountFactorial =@@ -164,7 +251,7 @@ ] sigmaSpecialCases1 :: [Assertion]-sigmaSpecialCases1 = zipWith mkAssert (tail factorial) sigmaCountFactorial+sigmaSpecialCases1 = zipWith mkAssert (drop 1 (Inf.toList factorial)) sigmaCountFactorial where mkAssert n m = assertEqual "should be equal" m (sigmaCount n) @@ -193,7 +280,7 @@ ] sigmaSpecialCases2 :: [Assertion]-sigmaSpecialCases2 = zipWith mkAssert (drop 3 factorial) sigmaMinFactorial+sigmaSpecialCases2 = zipWith mkAssert (drop 3 (Inf.toList factorial)) sigmaMinFactorial where mkAssert n m = assertEqual "should be equal" m (sigmaMin n) @@ -222,7 +309,7 @@ ] sigmaSpecialCases3 :: [Assertion]-sigmaSpecialCases3 = zipWith mkAssert (drop 3 factorial) sigmaMaxFactorial+sigmaSpecialCases3 = zipWith mkAssert (drop 3 (Inf.toList factorial)) sigmaMaxFactorial where mkAssert n m = assertEqual "should be equal" m (sigmaMax n) @@ -233,9 +320,60 @@ sigmaSpecialCase4 = assertBool "200 should be in inverseSigma(sigma(200))" $ sigmaProperty1 $ Positive (200 :: Word) +sigmas5 :: [Word]+sigmas5 =+ [ 1+ , 33+ , 244+ , 1057+ , 3126+ , 8052+ , 16808+ , 33825+ , 59293+ , 103158+ , 161052+ , 257908+ , 371294+ , 554664+ , 762744+ , 1082401+ , 1419858+ , 1956669+ , 2476100+ , 3304182+ , 4101152+ , 5314716+ , 6436344+ , 8253300+ , 9768751+ , 12252702+ , 14408200+ , 17766056+ , 20511150+ ]++sigmaSpecialCase5 :: [Assertion]+sigmaSpecialCase5 = zipWith mkAssert ixs sigmas5+ where+ mkAssert a b = assertEqual "should be equal" (S.singleton a) (asSetOfPreimages (inverseSigmaK 5) b)+ ixs = [1 .. 29]+ ------------------------------------------------------------------------------- -- TestTree +-- Tests for 'Int', 'Word' are omitted because 'inverseSigmaK/inverseJordan'+-- tests would quickly overflow in these types.+testIntegralPropertyNoLargeInverse+ :: forall bool. (SC.Testable IO bool, QC.Testable bool)+ => String -> (forall a. (Euclidean a, Semiring a, Integral a, Bits a, UniqueFactorisation a, Show a, Enum (Prime a)) => Power Word -> Positive a -> bool) -> TestTree+testIntegralPropertyNoLargeInverse name f = testGroup name+ [ SC.testProperty "smallcheck Integer" (f :: Power Word -> Positive Integer -> bool)+ , SC.testProperty "smallcheck Natural" (f :: Power Word -> Positive Natural -> bool)+ , QC.testProperty "quickcheck Integer" (f :: Power Word -> Positive Integer -> bool)+ , QC.testProperty "quickcheck Natural" (f :: Power Word -> Positive Natural -> bool)+ ]+ testSuite :: TestTree testSuite = testGroup "Inverse" [ testGroup "Totient"@@ -258,5 +396,19 @@ (zipWith (\i a -> testCase ("factorial " ++ show i) a) [1..] sigmaSpecialCases2) , testGroup "max" (zipWith (\i a -> testCase ("factorial " ++ show i) a) [1..] sigmaSpecialCases3)+ ]++ , testGroup "Jordan"+ [ testIntegralPropertyNoLargeInverse "forward" jordanProperty1+ , testIntegralPropertyNoLargeInverse "backward" jordanProperty2+ , testGroup "inverseJordan"+ (zipWith (\i test -> testCase ("inverseJordan 5" ++ show i) test) jordans5 jordanSpecialCase1)+ ]++ , testGroup "SigmaK"+ [ testIntegralPropertyNoLargeInverse "forward" sigmaKProperty1+ , testIntegralPropertyNoLargeInverse "backward" sigmaKProperty2+ , testGroup "inverseSigma"+ (zipWith (\i test -> testCase ("inverseSigma 5" ++ show i) test) sigmas5 sigmaSpecialCase5) ] ]
test-suite/Math/NumberTheory/ArithmeticFunctions/MertensTests.hs view
@@ -7,7 +7,6 @@ -- Tests for Math.NumberTheory.ArithmeticFunctions.Mertens -- -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}@@ -18,9 +17,6 @@ import Test.Tasty -#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U
test-suite/Math/NumberTheory/ArithmeticFunctions/SieveBlockTests.hs view
@@ -7,7 +7,6 @@ -- Tests for Math.NumberTheory.ArithmeticFunctions.SieveBlock -- -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}@@ -19,26 +18,18 @@ import Test.Tasty import Test.Tasty.HUnit -#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.ArithmeticFunctions.SieveBlock-import Math.NumberTheory.Primes (unPrime)+import Math.NumberTheory.Primes (Prime(..)) pointwiseTest :: (Eq a, Show a) => ArithmeticFunction Word a -> Word -> Word -> IO () pointwiseTest f lowIndex len = assertEqual "pointwise" (runFunctionOverBlock f lowIndex len) (V.generate (fromIntegral len) (runFunction f . (+ lowIndex) . fromIntegral)) -unboxedTest :: (Eq a, U.Unbox a, Show a) => SieveBlockConfig a -> IO ()-unboxedTest config = assertEqual "unboxed"- (sieveBlock config 1 1000)- (U.convert $ sieveBlockUnboxed config 1 1000)- moebiusTest :: Word -> Word -> Bool moebiusTest m n = m == 0@@ -68,13 +59,6 @@ pairToTest :: Word -> Word -> TestTree pairToTest m n = testCase (show m ++ "," ++ show n) $ assertBool "should be equal" $ moebiusTest m n -multiplicativeConfig :: (Word -> Word -> Word) -> SieveBlockConfig Word-multiplicativeConfig f = SieveBlockConfig- { sbcEmpty = 1- , sbcAppend = (*)- , sbcFunctionOnPrimePower = f . unPrime- }- moebiusConfig :: SieveBlockConfig Moebius moebiusConfig = SieveBlockConfig { sbcEmpty = MoebiusP@@ -85,6 +69,19 @@ _ -> MoebiusZ } +doesNotSegfaultOnZero :: IO ()+doesNotSegfaultOnZero = assertBool "should not segfault" $ xs == xs+ where+ xs = U.sum $ sieveBlockUnboxed sigmaConfig 0 5++sigmaConfig :: SieveBlockConfig Int+sigmaConfig = SieveBlockConfig+ { sbcEmpty = 1+ , sbcAppend = (*)+ , sbcFunctionOnPrimePower =+ \p n -> fromIntegral $ (unPrime p ^ (n+1) - 1) `quot` (unPrime p - 1)+ }+ testSuite :: TestTree testSuite = testGroup "SieveBlock" [ testGroup "pointwise"@@ -96,11 +93,6 @@ , testCase "bigOmega" $ pointwiseTest bigOmegaA 1 1000 , testCase "carmichael" $ pointwiseTest carmichaelA 1 1000 ]- , testGroup "unboxed"- [ testCase "id" $ unboxedTest $ multiplicativeConfig (^)- , testCase "tau" $ unboxedTest $ multiplicativeConfig (\_ a -> succ a )- , testCase "moebius" $ unboxedTest moebiusConfig- , testCase "totient" $ unboxedTest $ multiplicativeConfig (\p a -> (p - 1) * p ^ (a - 1))- ] , testGroup "special moebius" moebiusSpecialCases+ , testCase "does not segfault at 0" doesNotSegfaultOnZero ]
test-suite/Math/NumberTheory/ArithmeticFunctionsTests.hs view
@@ -7,9 +7,6 @@ -- Tests for Math.NumberTheory.ArithmeticFunctions -- -{-# LANGUAGE CPP #-}--{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.ArithmeticFunctionsTests@@ -20,6 +17,7 @@ import Test.Tasty.HUnit import Data.List (sort)+import qualified Data.List.Infinite as Inf import qualified Data.Set as S import qualified Data.IntSet as IS @@ -46,7 +44,7 @@ -- | All divisors of n truly divides n. divisorsProperty3 :: NonZero Natural -> Bool-divisorsProperty3 (NonZero n) = all (\d -> n `mod` d == 0) (runFunction divisorsA n)+divisorsProperty3 (NonZero n) = all (\d -> n `rem` d == 0) (runFunction divisorsA n) -- | 'divisorsA' matches 'divisorsSmallA' divisorsProperty4 :: NonZero Int -> Bool@@ -56,6 +54,13 @@ divisorsProperty5 :: NonZero Int -> Bool divisorsProperty5 (NonZero n) = S.toAscList (runFunction divisorsA n) == sort (runFunction divisorsListA n) +-- | 'divisorsTo' matches 'divisorsA' with a filter+divisorsProperty6 :: Positive Int -> NonNegative Int -> Bool+divisorsProperty6 (Positive a) (NonNegative b) = runFunction (divisorsToA to) n == expected+ where to = a+ n = to + b+ expected = S.filter (<=to) (runFunction divisorsA n)+ -- | tau matches baseline from OEIS. tauOeis :: Assertion tauOeis = oeisAssertion "A000005" tauA@@ -68,7 +73,7 @@ -- | sigma_0 coincides with tau by definition sigmaProperty1 :: NonZero Natural -> Bool-sigmaProperty1 (NonZero n) = runFunction tauA n == runFunction (sigmaA 0) n+sigmaProperty1 (NonZero n) = runFunction tauA n == (runFunction (sigmaA 0) n :: Natural) -- | value of totient is bigger than argument sigmaProperty2 :: NonZero Natural -> Bool@@ -80,7 +85,7 @@ [ 1, 3, 4, 7, 6, 12, 8, 15, 13, 18, 12, 28, 14, 24, 24, 31, 18, 39, 20 , 42, 32, 36, 24, 60, 31, 42, 40, 56, 30, 72, 32, 63, 48, 54, 48, 91, 38 , 60, 56, 90, 42, 96, 44, 84, 78, 72, 48, 124, 57, 93, 72, 98, 54, 120- , 72, 120, 80, 90, 60, 168, 62, 96, 104, 127, 84, 144, 68, 126, 96, 144+ , 72, 120, 80, 90, 60, 168, 62, 96, 104, 127, 84, 144, 68, 126, 96, 144 :: Natural ] -- | sigma_2 matches baseline from OEIS.@@ -89,7 +94,7 @@ [ 1, 5, 10, 21, 26, 50, 50, 85, 91, 130, 122, 210, 170, 250, 260, 341, 290 , 455, 362, 546, 500, 610, 530, 850, 651, 850, 820, 1050, 842, 1300, 962 , 1365, 1220, 1450, 1300, 1911, 1370, 1810, 1700, 2210, 1682, 2500, 1850- , 2562, 2366, 2650, 2210, 3410, 2451, 3255+ , 2562, 2366, 2650, 2210, 3410, 2451, 3255 :: Natural ] -- | value of totient if even, except totient(1) and totient(2)@@ -129,10 +134,10 @@ -- | congruences 1,2,3,4 from https://en.wikipedia.org/wiki/Ramanujan_tau_function ramanujanCongruence1 :: NonZero Natural -> Bool ramanujanCongruence1 (NonZero n)- | k == 1 = (ramanujan n' - sigma 11 n') `mod` (2^11) == 0- | k == 3 = (ramanujan n' - 1217 * sigma 11 n') `mod` (2^13) == 0- | k == 5 = (ramanujan n' - 1537 * sigma 11 n') `mod` (2^12) == 0- | k == 7 = (ramanujan n' - 705 * sigma 11 n') `mod` (2^14) == 0+ | k == 1 = (ramanujan n' - sigma 11 n') `rem` (2^11) == 0+ | k == 3 = (ramanujan n' - 1217 * sigma 11 n') `rem` (2^13) == 0+ | k == 5 = (ramanujan n' - 1537 * sigma 11 n') `rem` (2^12) == 0+ | k == 7 = (ramanujan n' - 705 * sigma 11 n') `rem` (2^14) == 0 | otherwise = True where k = n `mod` 8 n' = fromIntegral n :: Integer@@ -140,8 +145,8 @@ -- | congruences 8,9 from https://en.wikipedia.org/wiki/Ramanujan_tau_function ramanujanCongruence2 :: NonZero Natural -> Bool ramanujanCongruence2 (NonZero n)- | (n `mod` 7) `elem` [0,1,2,4] = m `mod` 7 == 0- | otherwise = m `mod` 49 == 0+ | (n `mod` 7) `elem` [0,1,2,4] = m `rem` 7 == 0+ | otherwise = m `rem` 49 == 0 where m = ramanujan n' - n' * sigma 9 n' n' = fromIntegral n :: Integer @@ -228,7 +233,7 @@ -- | carmichaeil divides totient carmichaelProperty1 :: NonZero Natural -> Bool-carmichaelProperty1 (NonZero n) = runFunction totientA n `mod` runFunction carmichaelA n == 0+carmichaelProperty1 (NonZero n) = runFunction totientA n `rem` runFunction carmichaelA n == 0 -- | carmichael matches baseline from OEIS. carmichaelOeis :: Assertion@@ -283,15 +288,16 @@ in take m (filter (isNFree n') [1 ..]) == take m (nFrees n' :: [Integer]) nFreedomProperty3 :: Power Word -> Positive Int -> Bool-nFreedomProperty3 (Power n) (Positive m) =- let n' | n == maxBound = n- | otherwise = n + 1- zet = 1 / zetas 1e-14 !! (fromIntegral n') :: Double- m' = 100 * m- nfree = fromIntegral m' /- fromIntegral (head (drop (m' - 1) $ nFrees n' :: [Integer]))- in 1 / fromIntegral m >= abs (zet - nfree)+nFreedomProperty3 (Power n) (Positive m) = case drop (m' - 1) $ nFrees n :: [Integer] of+ [] -> True+ x : _ -> 1 / fromIntegral m >= abs (zet - fromIntegral m' / fromIntegral x)+ where+ zet :: Double+ zet = 1 / zetas 1e-14 Inf.!! n + m' :: Int+ m' = 100 * m+ -- | -- * Using a bounded integer type like @Int@ instead of @Integer@ here means -- even a relatively low value of @n@, e.g. 20 may cause out-of-bounds memory@@ -320,6 +326,7 @@ , testSmallAndQuick "matches definition" divisorsProperty3 , testSmallAndQuick "divisors = divisorsSmall" divisorsProperty4 , testSmallAndQuick "divisors = divisorsList" divisorsProperty5+ , testSmallAndQuick "divisors = divisorsTo" divisorsProperty6 ] , testGroup "Tau" [ testCase "OEIS" tauOeis
test-suite/Math/NumberTheory/CurvesTests.hs view
@@ -7,24 +7,21 @@ -- Tests for Math.NumberTheory.Curves -- -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.CurvesTests where import Test.Tasty-import Test.Tasty.QuickCheck as QC hiding (Positive, NonNegative, generate, getNonNegative)+import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..)) -import GHC.TypeNats.Compat+import GHC.TypeNats (KnownNat) import Math.NumberTheory.Curves.Montgomery import Math.NumberTheory.TestUtils (==>?) :: Maybe a -> (a -> Property) -> Property-x ==>? f = case x of- Nothing -> discard- Just y -> f y+x ==>? f = maybe discard f x isValid :: KnownNat n => Point a24 n -> Property isValid p
+ test-suite/Math/NumberTheory/DiophantineTests.hs view
@@ -0,0 +1,38 @@+-- Tests for Math.NumberTheory.Diophantine++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Math.NumberTheory.DiophantineTests+ ( testSuite+ ) where++import Data.List (sort)++import Test.Tasty++import Math.NumberTheory.Diophantine+import Math.NumberTheory.Roots (integerSquareRoot)+import Math.NumberTheory.TestUtils++cornacchiaTest :: Positive Integer -> Positive Integer -> Bool+cornacchiaTest (Positive d) (Positive a) = gcd d m /= 1 || all checkSoln (cornacchia d m)+ where m = d + a+ checkSoln (x, y) = x*x + d*y*y == m++-- Testing against a slower reference implementation on coprime inputs+cornacchiaBruteForce :: Positive Integer -> Positive Integer -> Bool+cornacchiaBruteForce (Positive d) (Positive a) = gcd d m /= 1 || findSolutions [] 1 == sort (cornacchia d m)+ where m = d + a+ -- Simple O(sqrt (m/d)) brute force by considering all possible y values+ findSolutions acc y+ | x2 <= 0 = acc+ | x*x == x2 = findSolutions ((x,y) : acc) (y+1)+ | otherwise = findSolutions acc (y+1)+ where x2 = m - d*y*y+ x = integerSquareRoot x2++testSuite :: TestTree+testSuite = testGroup "Diophantine"+ [ testSmallAndQuick "Cornacchia correct" cornacchiaTest+ , testSmallAndQuick "Cornacchia same solutions as brute force" cornacchiaBruteForce+ ]
+ test-suite/Math/NumberTheory/DirichletCharactersTests.hs view
@@ -0,0 +1,241 @@+-- |+-- Module: Math.NumberTheory.DirichletCharactersTests+-- Copyright: (c) 2018 Bhavik Mehta+-- License: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Tests for Math.NumberTheory.DirichletCharacters+--++{-# LANGUAGE GADTs #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++module Math.NumberTheory.DirichletCharactersTests where++import Test.Tasty++import Data.Complex+import Data.List (genericLength)+import Data.Maybe (isJust, mapMaybe)+import Data.Proxy+import Data.Semigroup+import qualified Data.Vector as V+import Numeric.Natural++import GHC.TypeNats (SomeNat(..), someNatVal, KnownNat, natVal, sameNat)+import Data.Type.Equality++import Math.NumberTheory.ArithmeticFunctions (totient, divisorsList)+import Math.NumberTheory.DirichletCharacters+import qualified Math.NumberTheory.Moduli.Sqrt as J+import Math.NumberTheory.Moduli.Class (SomeMod(..), modulo)+import Math.NumberTheory.TestUtils (testSmallAndQuick, Positive(..))++-- | This tests property 6 from https://en.wikipedia.org/wiki/Dirichlet_character#Axiomatic_definition+dirCharOrder :: forall n. KnownNat n => DirichletCharacter n -> Bool+dirCharOrder chi = isPrincipal (totient n `stimes` chi)+ where n = natVal @n Proxy++-- | Tests wikipedia's property 3 (note 1,2,5 are essentially enforced by the type system).+testMultiplicative :: KnownNat n => DirichletCharacter n -> Natural -> Natural -> Bool+testMultiplicative chi (fromIntegral -> a) (fromIntegral -> b) = chiAB == chiAchiB+ where chi' = evalGeneral chi+ chiAB = chi' (a*b)+ chiAchiB = (<>) <$> chi' a <*> chi' b++-- | Test property 4 from wikipedia+testAtOne :: KnownNat n => DirichletCharacter n -> Bool+testAtOne chi = eval chi mempty == mempty++dirCharProperty :: (forall n. KnownNat n => DirichletCharacter n -> a) -> Positive Natural -> Natural -> a+dirCharProperty test (Positive n) i =+ case someNatVal n of+ SomeNat (Proxy :: Proxy n) -> test chi+ where chi = indexToChar @n (i `mod` totient n)++realCharProperty :: (forall n. KnownNat n => RealCharacter n -> a) -> Positive Natural -> Int -> a+realCharProperty test (Positive n) i =+ case someNatVal n of+ SomeNat (Proxy :: Proxy n) -> test chi+ where chi = chars !! (i `mod` length chars)+ chars = mapMaybe isRealCharacter [principalChar @n .. maxBound]++-- | There should be totient(n) characters+countCharacters :: Positive Natural -> Bool+countCharacters (Positive n) =+ case someNatVal n of+ SomeNat (Proxy :: Proxy n) ->+ genericLength (allChars @n) == totient n++-- | The principal character should be 1 if gcd k n is 1 and 0 otherwise+principalCase :: Positive Natural -> Positive Integer -> Bool+principalCase (Positive n) (Positive k) =+ case k `modulo` n of+ SomeMod a -> evalGeneral chi a == if gcd k (fromIntegral n) > 1+ then Zero+ else mempty+ where chi = principalChar+ InfMod{} -> False++-- | Test the orthogonality relations https://en.wikipedia.org/wiki/Dirichlet_character#Character_orthogonality+orthogonality1 :: forall n. KnownNat n => DirichletCharacter n -> Bool+orthogonality1 chi = magnitude (total - correct) < (1e-13 :: Double)+ where n = natVal @n Proxy+ total = sum [orZeroToNum toComplex (evalGeneral chi a) | a <- [0 .. maxBound]]+ correct = if isPrincipal chi+ then fromIntegral $ totient n+ else 0++orthogonality2 :: Positive Natural -> Integer -> Bool+orthogonality2 (Positive n) a =+ case a `modulo` n of+ SomeMod a' -> magnitude (total - correct) < (1e-13 :: Double)+ where total = sum [orZeroToNum toComplex (evalGeneral chi a') | chi <- allChars]+ correct = if a' == 1+ then fromIntegral $ totient n+ else 0+ InfMod {} -> False++-- | Manually confirm isRealCharacter is correct (in both directions)+realityCheck :: KnownNat n => DirichletCharacter n -> Bool+realityCheck chi = isJust (isRealCharacter chi) == isReal'+ where isReal' = and [real (evalGeneral chi t) | t <- [minBound..maxBound]]+ real Zero = True+ real (NonZero t) = t <> t == mempty++-- | Check real character evaluation matches normal evaluation+realEvalCheck :: KnownNat n => RealCharacter n -> Int -> Bool+realEvalCheck chi i' = fromIntegral (toRealFunction chi i) == (orZeroToNum toComplex (evalGeneral (getRealChar chi) i) :: Complex Double)+ where i = fromIntegral i'++-- | The jacobi character agrees with the jacobi symbol+jacobiCheck :: Positive Natural -> Bool+jacobiCheck (Positive n) =+ case someNatVal (2*n+1) of+ SomeNat (Proxy :: Proxy n) ->+ case jacobiCharacter @n of+ Just chi -> and [toRealFunction chi (fromIntegral j) == J.symbolToNum (J.jacobi j (2*n+1)) | j <- [0..2*n]]+ _ -> False++-- | Bulk evaluation agrees with pointwise evaluation+evalAllCheck :: forall n. KnownNat n => DirichletCharacter n -> Bool+evalAllCheck chi = V.generate (fromIntegral $ natVal @n Proxy) (evalGeneral chi . fromIntegral) == evalAll chi++-- | Induced characters agree with the original character.+-- (Except for when d=1, where chi(0) = 1, which is true for no other d)+inducedCheck :: forall d. KnownNat d => DirichletCharacter d -> Positive Natural -> Bool+inducedCheck chi (Positive k) =+ case someNatVal (d*k) of+ SomeNat (Proxy :: Proxy n) ->+ case induced @n chi of+ Just chi2 -> and (V.izipWith matchedValue (V.concat (replicate (fromIntegral k) (evalAll chi))) (evalAll chi2))+ Nothing -> False+ where d = natVal @d Proxy+ matchedValue i x1 x2 = if gcd (fromIntegral i) (d*k) > 1+ then x2 == Zero+ else x2 == x1++-- | Primitive checker is correct (in both directions)+primitiveCheck :: forall n. KnownNat n => DirichletCharacter n -> Bool+primitiveCheck chi = isJust (isPrimitive chi) == isPrimitive'+ where isPrimitive' = all (\m -> m == n || testModulus m) (divisorsList n)+ n = fromIntegral (natVal @n Proxy) :: Int+ table = evalAll chi+ testModulus d = not $ null [a | a <- [1..n-1], gcd a n == 1, a `mod` d == 1 `mod` d, table V.! a /= mempty]++-- | Ensure that makePrimitive gives primitive characters+makePrimitiveCheck :: DirichletCharacter n -> Bool+makePrimitiveCheck chi = case makePrimitive chi of+ WithNat chi' -> isJust (isPrimitive (getPrimitiveChar chi'))++-- | sameNat also ensures the two new moduli are the same+makePrimitiveIdem :: DirichletCharacter n -> Bool+makePrimitiveIdem chi = case makePrimitive chi of+ WithNat (chi' :: PrimitiveCharacter n') ->+ case makePrimitive (getPrimitiveChar chi') of+ WithNat (chi'' :: PrimitiveCharacter n'') ->+ case sameNat (Proxy :: Proxy n') (Proxy :: Proxy n'') of+ Just Refl -> chi' == chi''+ Nothing -> False++orderCheck :: DirichletCharacter n -> Bool+orderCheck chi = isPrincipal (n `stimes` chi) && and [not (isPrincipal (i `stimes` chi)) | i <- [1..n-1]]+ where n = orderChar chi++fromTableCheck :: forall n. KnownNat n => DirichletCharacter n -> Bool+fromTableCheck chi = isJust (fromTable @n (evalAll chi))++-- A bunch of functions making sure that every function which can produce a character (in+-- particular by fiddling internal representation) produces a valid character+indexToCharValid :: KnownNat n => DirichletCharacter n -> Bool+indexToCharValid = validChar++principalCharValid :: Positive Natural -> Bool+principalCharValid (Positive n) =+ case someNatVal n of+ SomeNat (Proxy :: Proxy n) -> validChar (principalChar @n)++mulCharsValid :: KnownNat n => DirichletCharacter n -> DirichletCharacter n -> Bool+mulCharsValid chi1 chi2 = validChar (chi1 <> chi2)++mulCharsValid' :: Positive Natural -> Natural -> Natural -> Bool+mulCharsValid' (Positive n) i j =+ case someNatVal n of+ SomeNat (Proxy :: Proxy n) ->+ mulCharsValid (indexToChar @n (i `mod` totient n)) (indexToChar @n (j `mod` totient n))++stimesCharValid :: KnownNat n => DirichletCharacter n -> Int -> Bool+stimesCharValid chi n = validChar (n `stimes` chi)++succValid :: KnownNat n => DirichletCharacter n -> Bool+succValid = validChar . succ++inducedValid :: forall d. KnownNat d => DirichletCharacter d -> Positive Natural -> Bool+inducedValid chi (Positive k) = case someNatVal (natVal @d Proxy * k) of+ SomeNat (Proxy :: Proxy n) -> maybe False validChar (induced @n chi)++jacobiValid :: Positive Natural -> Bool+jacobiValid (Positive n) =+ case someNatVal (2*n+1) of+ SomeNat (Proxy :: Proxy n) ->+ case jacobiCharacter @n of+ Just chi -> validChar (getRealChar chi)+ _ -> False++makePrimitiveValid :: DirichletCharacter n -> Bool+makePrimitiveValid chi = case makePrimitive chi of+ WithNat chi' -> validChar (getPrimitiveChar chi')++testSuite :: TestTree+testSuite = testGroup "DirichletCharacters"+ [ testSmallAndQuick "Dirichlet characters divide the right order" (dirCharProperty dirCharOrder)+ , testSmallAndQuick "Dirichlet characters are multiplicative" (dirCharProperty testMultiplicative)+ , testSmallAndQuick "Dirichlet characters are 1 at 1" (dirCharProperty testAtOne)+ , testSmallAndQuick "Right number of Dirichlet characters" countCharacters+ , testSmallAndQuick "Principal character behaves as expected" principalCase+ , testSmallAndQuick "Orthogonality relation 1" (dirCharProperty orthogonality1)+ , testSmallAndQuick "Orthogonality relation 2" orthogonality2+ , testSmallAndQuick "Real character checking is correct" (dirCharProperty realityCheck)+ , testSmallAndQuick "Real character evaluation is accurate" (realCharProperty realEvalCheck)+ , testSmallAndQuick "Jacobi character matches symbol" jacobiCheck+ , testSmallAndQuick "Bulk evaluation matches pointwise" (dirCharProperty evalAllCheck)+ , testSmallAndQuick "Induced character is correct" (dirCharProperty inducedCheck)+ , testSmallAndQuick "Primitive character checking is correct" (dirCharProperty primitiveCheck)+ , testSmallAndQuick "makePrimitive produces primitive character" (dirCharProperty makePrimitiveCheck)+ , testSmallAndQuick "makePrimitive is idempotent" (dirCharProperty makePrimitiveIdem)+ , testSmallAndQuick "Calculates correct order" (dirCharProperty orderCheck)+ , testSmallAndQuick "Can construct from table" (dirCharProperty fromTableCheck)+ , testGroup "Creates valid characters"+ [ testSmallAndQuick "indexToChar" (dirCharProperty indexToCharValid)+ , testSmallAndQuick "principalChar" principalCharValid+ , testSmallAndQuick "mulChars" mulCharsValid'+ , testSmallAndQuick "stimesChar" (dirCharProperty stimesCharValid)+ , testSmallAndQuick "succ" (dirCharProperty succValid)+ , testSmallAndQuick "induced" (dirCharProperty inducedValid)+ , testSmallAndQuick "jacobi" jacobiValid+ , testSmallAndQuick "makePrimitive" (dirCharProperty makePrimitiveValid)+ ]+ ]
test-suite/Math/NumberTheory/EisensteinIntegersTests.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS_GHC -fno-warn-type-defaults #-}- -- | -- Module: Math.NumberTheory.EisensteinIntegersTests -- Copyright: (c) 2018 Alexandre Rodrigues Baldé@@ -9,21 +7,26 @@ -- Tests for Math.NumberTheory.EisensteinIntegers -- +{-# OPTIONS_GHC -fno-warn-type-defaults #-}+ module Math.NumberTheory.EisensteinIntegersTests ( testSuite ) where +import Prelude hiding (gcd, rem, quot, quotRem)+import Data.Euclidean+import qualified Data.List.Infinite as Inf import Data.Maybe (fromJust, isJust)+import Data.Proxy+import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..))+import Test.QuickCheck.Classes import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertEqual, testCase) -import qualified Math.NumberTheory.Euclidean as ED import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E import Math.NumberTheory.Primes-import Math.NumberTheory.Primes.Sieve (primes)-import Math.NumberTheory.TestUtils (Positive (..),- testSmallAndQuick)+import Math.NumberTheory.TestUtils -- | Check that @signum@ and @abs@ satisfy @z == signum z * abs z@, where @z@ is -- an @EisensteinInteger@.@@ -43,55 +46,43 @@ inFirstSextant = x' > y' && y' >= 0 isAssociate = z' `elem` map (\e -> z * (1 E.:+ 1) ^ e) [0 .. 5] --- | Verify that @div@ and @mod@ are what `divMod` produces.-divModProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool-divModProperty1 x y = y == 0 || (q == q' && r == r')- where- (q, r) = ED.divMod x y- q' = ED.div x y- r' = ED.mod x y---- | Verify that @divModE` produces the right quotient and remainder.-divModProperty2 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool-divModProperty2 x y = (y == 0) || (x `ED.div` y) * y + (x `ED.mod` y) == x---- | Verify that @divModE@ produces a remainder smaller than the divisor with+-- | Verify that @rem@ produces a remainder smaller than the divisor with -- regards to the Euclidean domain's function.-modProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool-modProperty1 x y = (y == 0) || (E.norm $ x `ED.mod` y) < (E.norm y)+remProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool+remProperty1 x y = (y == 0) || E.norm (x `rem` y) < E.norm y -- | Verify that @quot@ and @rem@ are what `quotRem` produces. quotRemProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool quotRemProperty1 x y = (y == 0) || q == q' && r == r' where- (q, r) = ED.quotRem x y- q' = ED.quot x y- r' = ED.rem x y+ (q, r) = quotRem x y+ q' = quot x y+ r' = rem x y -- | Verify that @quotRemE@ produces the right quotient and remainder. quotRemProperty2 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool-quotRemProperty2 x y = (y == 0) || (x `ED.quot` y) * y + (x `ED.rem` y) == x+quotRemProperty2 x y = (y == 0) || (x `quot` y) * y + (x `rem` y) == x -- | Verify that @gcd z1 z2@ always divides @z1@ and @z2@. gcdEProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool gcdEProperty1 z1 z2 = z1 == 0 && z2 == 0- || z1 `ED.rem` z == 0 && z2 `ED.rem` z == 0 && z == abs z+ || z1 `rem` z == 0 && z2 `rem` z == 0 where- z = ED.gcd z1 z2+ z = gcd z1 z2 -- | Verify that a common divisor of @z1, z2@ is a always divisor of @gcd z1 z2@. gcdEProperty2 :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool gcdEProperty2 z z1 z2 = z == 0- || (ED.gcd z1' z2') `ED.rem` z == 0+ || gcd z1' z2' `rem` z == 0 where z1' = z * z1 z2' = z * z2 -- | A special case that tests rounding/truncating in GCD. gcdESpecialCase1 :: Assertion-gcdESpecialCase1 = assertEqual "gcd" 1 $ ED.gcd (12 E.:+ 23) (23 E.:+ 34)+gcdESpecialCase1 = assertEqual "gcd" (1 E.:+ 1) $ gcd (12 E.:+ 23) (23 E.:+ 34) findPrimesProperty1 :: Positive Int -> Bool findPrimesProperty1 (Positive index) =@@ -109,21 +100,21 @@ -- | Checks that the numbers produced by @primes@ are actually Eisenstein -- primes. primesProperty1 :: Positive Int -> Bool-primesProperty1 (Positive index) = all (isJust . isPrime . (unPrime :: Prime E.EisensteinInteger -> E.EisensteinInteger)) $ take index $ E.primes+primesProperty1 (Positive index) = all (isJust . isPrime . (unPrime :: Prime E.EisensteinInteger -> E.EisensteinInteger)) $ Inf.take index E.primes -- | Checks that the infinite list of Eisenstein primes @primes@ is ordered -- by the numbers' norm. primesProperty2 :: Positive Int -> Bool primesProperty2 (Positive index) = let isOrdered :: [Prime E.EisensteinInteger] -> Bool- isOrdered xs = all (\(x, y) -> E.norm (unPrime x) <= E.norm (unPrime y)) . zip xs $ tail xs- in isOrdered $ take index E.primes+ isOrdered xs = all (\(x, y) -> E.norm (unPrime x) <= E.norm (unPrime y)) . zip xs $ drop 1 xs+ in isOrdered $ Inf.take index E.primes -- | Checks that the numbers produced by @primes@ are all in the first -- sextant. primesProperty3 :: Positive Int -> Bool primesProperty3 (Positive index) =- all (\e -> abs (unPrime e) == (unPrime e :: E.EisensteinInteger)) $ take index $ E.primes+ all (\e -> abs (unPrime e) == (unPrime e :: E.EisensteinInteger)) $ Inf.take index E.primes -- | An Eisenstein integer is either zero or associated (i.e. equal up to -- multiplication by a unit) to the product of its factors raised to their@@ -150,15 +141,12 @@ (factorise (15 E.:+ 12)) testSuite :: TestTree-testSuite = testGroup "EisensteinIntegers" $+testSuite = testGroup "EisensteinIntegers" [ testSmallAndQuick "forall z . z == signum z * abs z" signumAbsProperty- , testSmallAndQuick "abs z always returns an @EisensteinInteger@ in the\- \ first sextant of the complex plane" absProperty+ , testSmallAndQuick "abs z rotates to the first sextant" absProperty , testGroup "Division"- [ testSmallAndQuick "divE and modE work properly" divModProperty1- , testSmallAndQuick "divModE works properly" divModProperty2- , testSmallAndQuick "The remainder's norm is smaller than the divisor's"- modProperty1+ [ testSmallAndQuick "The remainder's norm is smaller than the divisor's"+ remProperty1 , testSmallAndQuick "quotE and remE work properly" quotRemProperty1 , testSmallAndQuick "quotRemE works properly" quotRemProperty2@@ -167,24 +155,21 @@ , testGroup "g.c.d." [ testSmallAndQuick "The g.c.d. of two Eisenstein integers divides them" gcdEProperty1- , testSmallAndQuick "A common divisor of two Eisenstein integers always\- \ divides the g.c.d. of those two integers"+ -- smallcheck takes too long+ , QC.testProperty "Common divisor divides gcd" gcdEProperty2 , testCase "g.c.d. (12 :+ 23) (23 :+ 34)" gcdESpecialCase1 ] , testSmallAndQuick "The Eisenstein norm function is multiplicative" euclideanDomainProperty1 , testGroup "Primality"- [ testSmallAndQuick "Eisenstein primes found by the norm search used in\- \ findPrime are really prime"+ [ testSmallAndQuick "findPrime returns prime" findPrimesProperty1- , testSmallAndQuick "Eisenstein primes generated by `primes` are actually\- \ primes"+ , testSmallAndQuick "primes are actually prime" primesProperty1- , testSmallAndQuick "The infinite list of Eisenstein primes produced by\- \ `primes` is ordered. "+ , testSmallAndQuick "primes is ordered" primesProperty2- , testSmallAndQuick "All generated primes are in the first sextant"+ , testSmallAndQuick "primes are in the first sextant" primesProperty3 ] @@ -197,4 +182,6 @@ factoriseProperty3 , testCase "factorise 15:+12" factoriseSpecialCase1 ]+ , lawsToTest $ gcdDomainLaws (Proxy :: Proxy E.EisensteinInteger)+ , lawsToTest $ euclideanLaws (Proxy :: Proxy E.EisensteinInteger) ]
test-suite/Math/NumberTheory/EuclideanTests.hs view
@@ -4,15 +4,14 @@ -- Licence: MIT -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> ----- Tests for Math.NumberTheory.Euclidean+-- Tests for Math.NumberTheory.Euclidean.Coprimes -- -{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_GHC -fno-warn-deprecations #-} module Math.NumberTheory.EuclideanTests ( testSuite@@ -21,72 +20,77 @@ import Prelude hiding (gcd) import Test.Tasty import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonZero(..)) import Control.Arrow import Data.Bits+import Data.Euclidean import Data.Maybe import Data.Semigroup import Data.List (tails, sort) import Numeric.Natural -import Math.NumberTheory.Euclidean import Math.NumberTheory.Euclidean.Coprimes+import Math.NumberTheory.Quadratic.GaussianIntegers import Math.NumberTheory.TestUtils --- | Check that 'extendedGCD' is consistent with documentation.-extendedGCDProperty :: forall a. (Bits a, Euclidean a, Ord a) => AnySign a -> AnySign a -> Bool-extendedGCDProperty (AnySign a) (AnySign b)- | isNatural a = True -- extendedGCD does not make sense for Natural- | otherwise =- u * a + v * b == d- && d == gcd a b- -- (-1) >= 0 is true for unsigned types- && (abs u < abs b || abs b <= 1 || (-1 :: a) >= 0)- && (abs v < abs a || abs a <= 1 || (-1 :: a) >= 0)- where- (d, u, v) = extendedGCD a b--isNatural :: Bits a => a -> Bool-isNatural a = isNothing (bitSizeMaybe a) && not (isSigned a)- -- | Check that numbers are coprime iff their gcd equals to 1.-coprimeProperty :: (Euclidean a) => AnySign a -> AnySign a -> Bool+coprimeProperty :: (Eq a, Num a, GcdDomain a, Euclidean a) => AnySign a -> AnySign a -> Bool coprimeProperty (AnySign a) (AnySign b) = coprime a b == (gcd a b == 1) -splitIntoCoprimesProperty1 :: [(Positive Natural, Power Word)] -> Bool+splitIntoCoprimesProperty1+ :: (Eq a, Num a, GcdDomain a)+ => [(a, Power Word)]+ -> Bool splitIntoCoprimesProperty1 fs' = factorback fs == factorback (unCoprimes $ splitIntoCoprimes fs) where- fs = map (getPositive *** getPower) fs'- factorback = product . map (uncurry (^))+ fs = map (second getPower) fs'+ factorback = abs . product . map (uncurry (^)) -splitIntoCoprimesProperty2 :: [(Positive Natural, Power Word)] -> Bool+splitIntoCoprimesProperty2+ :: (Eq a, Num a, GcdDomain a)+ => [(NonZero a, Power Word)]+ -> Bool splitIntoCoprimesProperty2 fs' = multiplicities fs <= multiplicities (unCoprimes $ splitIntoCoprimes fs) where- fs = map (getPositive *** getPower) fs'- multiplicities = sum . map snd . filter ((/= 1) . fst)+ fs = map (getNonZero *** getPower) fs'+ multiplicities = sum . map snd . filter ((/= 1) . abs . fst) -splitIntoCoprimesProperty3 :: [(Positive Natural, Power Word)] -> Bool+splitIntoCoprimesProperty3+ :: (Eq a, Num a, GcdDomain a)+ => [(a, Power Word)]+ -> Bool splitIntoCoprimesProperty3 fs' = and [ coprime x y | (x : xs) <- tails fs, y <- xs ] where- fs = map fst $ unCoprimes $ splitIntoCoprimes $ map (getPositive *** getPower) fs'+ fs = map fst $ unCoprimes $ splitIntoCoprimes $ map (second getPower) fs' -- | Check that evaluation never freezes.-splitIntoCoprimesProperty4 :: [(Integer, Word)] -> Bool+splitIntoCoprimesProperty4+ :: (Eq a, Num a, GcdDomain a)+ => [(a, Word)]+ -> Bool splitIntoCoprimesProperty4 fs' = fs == fs where fs = splitIntoCoprimes fs' +splitIntoCoprimesProperty5+ :: (Eq a, Num a, GcdDomain a)+ => [(a, Word)]+ -> Bool+splitIntoCoprimesProperty5 =+ all ((/= 1) . abs . fst) . unCoprimes . splitIntoCoprimes+ -- | This is an undefined behaviour, but at least it should not -- throw exceptions or loop forever. splitIntoCoprimesSpecialCase1 :: Assertion splitIntoCoprimesSpecialCase1 =- assertBool "should not fail" $ splitIntoCoprimesProperty4 [(0, 0), (0, 0)]+ assertBool "should not fail" $ splitIntoCoprimesProperty4 @Integer [(0, 0), (0, 0)] -- | This is an undefined behaviour, but at least it should not -- throw exceptions or loop forever. splitIntoCoprimesSpecialCase2 :: Assertion splitIntoCoprimesSpecialCase2 =- assertBool "should not fail" $ splitIntoCoprimesProperty4 [(0, 1), (-2, 0)]+ assertBool "should not fail" $ splitIntoCoprimesProperty4 @Integer [(0, 1), (-2, 0)] toListReturnsCorrectValues :: Assertion toListReturnsCorrectValues = assertEqual@@ -117,32 +121,61 @@ expected = [(2,10), (5,2), (7,1)] in assertEqual "should be equal" expected actual -unionProperty1 :: [(Positive Natural, Power Word)] -> [(Positive Natural, Power Word)] -> Bool+unionProperty1+ :: (Ord a, GcdDomain a)+ => [(a, Power Word)]+ -> [(a, Power Word)]+ -> Bool unionProperty1 xs ys = sort (unCoprimes (splitIntoCoprimes (xs' <> ys'))) == sort (unCoprimes (splitIntoCoprimes xs' <> splitIntoCoprimes ys')) where- xs' = map (getPositive *** getPower) xs- ys' = map (getPositive *** getPower) ys+ xs' = map (second getPower) xs+ ys' = map (second getPower) ys testSuite :: TestTree testSuite = testGroup "Euclidean"- [ testSameIntegralProperty "extendedGCD" extendedGCDProperty- , testSameIntegralProperty "coprime" coprimeProperty+ [ testSameIntegralProperty "coprime" coprimeProperty , testGroup "splitIntoCoprimes"- [ testSmallAndQuick "preserves product of factors" splitIntoCoprimesProperty1- , testSmallAndQuick "number of factors is non-decreasing" splitIntoCoprimesProperty2- , testSmallAndQuick "output factors are coprime" splitIntoCoprimesProperty3-- , testCase "does not freeze 1" splitIntoCoprimesSpecialCase1- , testCase "does not freeze 2" splitIntoCoprimesSpecialCase2- , testSmallAndQuick "does not freeze random" splitIntoCoprimesProperty4+ [ testGroup "preserves product of factors"+ [ testSmallAndQuick "Natural" (splitIntoCoprimesProperty1 @Natural)+ , testSmallAndQuick "Integer" (splitIntoCoprimesProperty1 @Integer)+ , testSmallAndQuick "Gaussian" (splitIntoCoprimesProperty1 @GaussianInteger)+ ]+ , testGroup "number of factors is non-decreasing"+ [ testSmallAndQuick "Natural" (splitIntoCoprimesProperty2 @Natural)+ , testSmallAndQuick "Integer" (splitIntoCoprimesProperty2 @Integer)+ , testSmallAndQuick "Gaussian" (splitIntoCoprimesProperty2 @GaussianInteger)+ ]+ , testGroup "output factors are coprime"+ [ testSmallAndQuick "Natural" (splitIntoCoprimesProperty3 @Natural)+ , testSmallAndQuick "Integer" (splitIntoCoprimesProperty3 @Integer)+ , testSmallAndQuick "Gaussian" (splitIntoCoprimesProperty3 @GaussianInteger)+ ]+ , testGroup "does not freeze"+ [ testCase "case 1" splitIntoCoprimesSpecialCase1+ , testCase "case 2" splitIntoCoprimesSpecialCase2+ , testSmallAndQuick "Natural" (splitIntoCoprimesProperty4 @Natural)+ -- smallcheck for Integer and GaussianInteger takes too long+ , QC.testProperty "Integer" (splitIntoCoprimesProperty4 @Integer)+ , QC.testProperty "Gaussian" (splitIntoCoprimesProperty4 @GaussianInteger)+ ]+ , testGroup "output factors are non-unit"+ [ testSmallAndQuick "Natural" (splitIntoCoprimesProperty5 @Natural)+ -- smallcheck for Integer and GaussianInteger takes too long+ , QC.testProperty "Integer" (splitIntoCoprimesProperty5 @Integer)+ , QC.testProperty "Gaussian" (splitIntoCoprimesProperty5 @GaussianInteger)+ ] ] , testGroup "Coprimes" [ testCase "test equality" toListReturnsCorrectValues , testCase "test union" unionReturnsCorrectValues , testCase "test insert with coprime base" insertReturnsCorrectValuesWhenCoprimeBase , testCase "test insert with non-coprime base" insertReturnsCorrectValuesWhenNotCoprimeBase- , testSmallAndQuick "property union" unionProperty1+ , testGroup "property union"+ [ testSmallAndQuick "Natural" (unionProperty1 @Natural)+ -- smallcheck for Integer takes too long+ , QC.testProperty "Integer" (unionProperty1 @Integer)+ ] ] ]
test-suite/Math/NumberTheory/GaussianIntegersTests.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | -- Module: Math.NumberTheory.GaussianIntegersTests@@ -13,16 +14,21 @@ ( testSuite ) where +import Prelude hiding (gcd, rem) import Control.Monad (zipWithM_)+import Data.Euclidean import Data.List (groupBy, sort)+import qualified Data.List.Infinite as Inf import Data.Maybe (fromJust, mapMaybe)+import Data.Proxy+import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..))+import Test.QuickCheck.Classes import Test.Tasty import Test.Tasty.HUnit -import qualified Math.NumberTheory.Euclidean as ED import Math.NumberTheory.Quadratic.GaussianIntegers import Math.NumberTheory.Moduli.Sqrt-import Math.NumberTheory.Powers (integerSquareRoot)+import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.Primes (Prime, unPrime, UniqueFactorisation(..)) import Math.NumberTheory.TestUtils @@ -66,8 +72,8 @@ let c : _ = sqrtsModPrime (-1) p k = integerSquareRoot (unPrime p) bs = [1 .. k]- asbs = map (\b' -> ((b' * c) `mod` (unPrime p), b')) bs- (a, b) = head [ (a', b') | (a', b') <- asbs, a' <= k]+ asbs = map (\b' -> ((b' * c) `mod` unPrime p, b')) bs+ (a, b) : _ = [ (a', b') | (a', b') <- asbs, a' <= k] in a :+ b findPrimeProperty1 :: Prime Integer -> Bool@@ -94,26 +100,26 @@ primesSpecialCase1 :: Assertion primesSpecialCase1 = assertEqual "primes" (f $ mapMaybe isPrime [1+ι,2+ι,1+2*ι,3,3+2*ι,2+3*ι,4+ι,1+4*ι,5+2*ι,2+5*ι,6+ι,1+6*ι,5+4*ι,4+5*ι,7,7+2*ι,2+7*ι,6+5*ι,5+6*ι,8+3*ι,3+8*ι,8+5*ι,5+8*ι,9+4*ι,4+9*ι,10+ι,1+10*ι,10+3*ι,3+10*ι,8+7*ι,7+8*ι,11,11+4*ι,4+11*ι,10+7*ι,7+10*ι,11+6*ι,6+11*ι,13+2*ι,2+13*ι,10+9*ι,9+10*ι,12+7*ι,7+12*ι,14+ι,1+14*ι,15+2*ι,2+15*ι,13+8*ι,8+13*ι,15+4*ι])- (f $ take 51 primes)+ (f $ Inf.take 51 primes) where f :: [Prime GaussianInteger] -> [[Prime GaussianInteger]] f = map sort . groupBy (\g1 g2 -> norm (unPrime g1) == norm (unPrime g2)) -- | The list of primes should include only primes.-primesGeneratesPrimesProperty :: NonNegative Int -> Bool-primesGeneratesPrimesProperty (NonNegative i) = case isPrime (unPrime (primes !! i) :: GaussianInteger) of+primesGeneratesPrimesProperty :: Word -> Bool+primesGeneratesPrimesProperty i = case isPrime (unPrime (primes Inf.!! i) :: GaussianInteger) of Nothing -> False Just{} -> True -- | Check that primes generates the primes in order. orderingPrimes :: Assertion-orderingPrimes = assertBool "primes are ordered" (and $ zipWith (<=) xs (tail xs))- where xs = map (norm . unPrime) $ take 1000 primes+orderingPrimes = assertBool "primes are ordered" (and $ zipWith (<=) xs (drop 1 xs))+ where xs = map (norm . unPrime) $ Inf.take 1000 primes numberOfPrimes :: Assertion numberOfPrimes = assertEqual "counting primes: OEIS A091100"- [16,100,668,4928,38404,313752,2658344]- [4 * (length $ takeWhile ((<= 10^n) . norm . unPrime) primes) | n <- [1..7]]+ [16,100,668,4928,38404,313752]+ [4 * length (Inf.takeWhile ((<= 10^n) . norm . unPrime) primes) | n <- [1..6]] -- | signum and abs should satisfy: z == signum z * abs z signumAbsProperty :: GaussianInteger -> Bool@@ -128,27 +134,35 @@ inFirstQuadrant = x' > 0 && y' >= 0 -- first quadrant includes the positive real axis, but not the origin or the positive imaginary axis isAssociate = z' `elem` map (\e -> z * (0 :+ 1) ^ e) [0 .. 3] +-- | Verify that @rem@ produces a remainder smaller than the divisor with+-- regards to the Euclidean domain's function.+remProperty :: GaussianInteger -> GaussianInteger -> Bool+remProperty x y = (y == 0) || norm (x `rem` y) < norm y+ gcdGProperty1 :: GaussianInteger -> GaussianInteger -> Bool gcdGProperty1 z1 z2 = z1 == 0 && z2 == 0- || z1 `ED.rem` z == 0 && z2 `ED.rem` z == 0 && z == abs z+ || z1 `rem` z == 0 && z2 `rem` z == 0 where- z = ED.gcd z1 z2+ z = gcd z1 z2 gcdGProperty2 :: GaussianInteger -> GaussianInteger -> GaussianInteger -> Bool gcdGProperty2 z z1 z2 = z == 0- || (ED.gcd z1' z2') `ED.rem` z == 0+ || gcd z1' z2' `rem` z == 0 where z1' = z * z1 z2' = z * z2 -- | a special case that tests rounding/truncating in GCD. gcdGSpecialCase1 :: Assertion-gcdGSpecialCase1 = assertEqual "gcdG" 1 $ ED.gcd (12 :+ 23) (23 :+ 34)+gcdGSpecialCase1 = assertEqual "gcdG" (-1) $ gcd (12 :+ 23) (23 :+ 34) +gcdGSpecialCase2 :: Assertion+gcdGSpecialCase2 = assertEqual "gcdG" (0 :+ (-1)) $ gcd (0 :+ 3) (2 :+ 2)+ testSuite :: TestTree-testSuite = testGroup "GaussianIntegers" $+testSuite = testGroup "GaussianIntegers" [ testGroup "factorise" ( [ testSmallAndQuick "factor back" factoriseProperty1 , testSmallAndQuick "powers are > 0" factoriseProperty2@@ -156,8 +170,7 @@ , testCase "factorise 63:+36" factoriseSpecialCase1 ] ++- map (\x -> testCase ("laziness " ++ show (fst x)) (factoriseSpecialCase2 x))- lazyCases)+ map (testCase "laziness" . factoriseSpecialCase2) lazyCases) , testSmallAndQuick "findPrime'" findPrimeProperty1 , testSmallAndQuick "isPrime" isPrimeProperty@@ -167,9 +180,14 @@ , testCase "counting primes" numberOfPrimes , testSmallAndQuick "signumAbsProperty" signumAbsProperty , testSmallAndQuick "absProperty" absProperty+ , testSmallAndQuick "remProperty" remProperty , testGroup "gcd" [ testSmallAndQuick "is divisor" gcdGProperty1- , testSmallAndQuick "is greatest" gcdGProperty2+ -- smallcheck takes too long+ , QC.testProperty "is greatest" gcdGProperty2 , testCase "(12 :+ 23) (23 :+ 34)" gcdGSpecialCase1+ , testCase "(0 :+ 3) (2 :+ 2)" gcdGSpecialCase2 ]+ , lawsToTest $ gcdDomainLaws (Proxy :: Proxy GaussianInteger)+ , lawsToTest $ euclideanLaws (Proxy :: Proxy GaussianInteger) ]
+ test-suite/Math/NumberTheory/Moduli/CbrtTests.hs view
@@ -0,0 +1,89 @@+-- |+-- Module: Math.NumberTheory.Moduli.Cbrt+-- Copyright: (c) 2020 Federico Bongiorno+-- Licence: MIT+-- Maintainer: Federico Bongiorno <federicobongiorno97@gmail.com>+--+-- Test for Math.NumberTheory.Moduli.Cbrt+--++module Math.NumberTheory.Moduli.CbrtTests+ ( testSuite+ ) where++import Math.NumberTheory.Moduli.Cbrt+import Math.NumberTheory.Quadratic.EisensteinIntegers+import Math.NumberTheory.Primes+import qualified Data.Euclidean as A+import Data.List (genericReplicate)+import Test.Tasty+import Math.NumberTheory.TestUtils++-- Checks multiplicative property of numerators. In details,+-- @cubicSymbol1 alpha1 alpha2 beta@ checks that+-- @(cubicSymbol alpha1 beta) <> (cubicSymbol alpha2 beta) == (cubicSymbol alpha1*alpha2 beta)@+cubicSymbol1 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool+cubicSymbol1 alpha1 alpha2 beta = isBadDenominator beta || cubicSymbolNumerator alpha1 alpha2 beta++cubicSymbolNumerator :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool+cubicSymbolNumerator alpha1 alpha2 beta = (symbol1 <> symbol2) == symbolProduct+ where+ symbol1 = cubicSymbol alpha1 beta+ symbol2 = cubicSymbol alpha2 beta+ symbolProduct = cubicSymbol alphaProduct beta+ alphaProduct = alpha1 * alpha2++-- Checks multiplicative property of denominators. In details,+-- @cubicSymbol2 alpha beta1 beta2@ checks that+-- @(cubicSymbol alpha beta1) <> (cubicSymbol alpha beta2) == (cubicSymbol alpha beta1*beta2)@+cubicSymbol2 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool+cubicSymbol2 alpha beta1 beta2 = isBadDenominator beta1 || isBadDenominator beta2 || cubicSymbolDenominator alpha beta1 beta2++cubicSymbolDenominator :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool+cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct+ where+ symbol1 = cubicSymbol alpha beta1+ symbol2 = cubicSymbol alpha beta2+ symbolProduct = cubicSymbol alpha betaProduct+ betaProduct = beta1 * beta2++-- Checks that `cubicSymbol` agrees with the computational definition+-- <https://en.wikipedia.org/wiki/Cubic_reciprocity#Definition here>+-- when the denominator is prime.+cubicSymbol3 :: EisensteinInteger -> Prime EisensteinInteger -> Bool+cubicSymbol3 alpha prime = isBadDenominator beta || cubicSymbol alpha beta == cubicSymbolPrime alpha beta+ where beta = unPrime prime++cubicSymbolPrime :: EisensteinInteger -> EisensteinInteger -> CubicSymbol+cubicSymbolPrime alpha beta = findCubicSymbol residue beta+ where+ residue = foldr f 1 listOfAlphas+ f x y = (x * y) `A.rem` beta+ listOfAlphas = genericReplicate alphaExponent alpha+ -- Exponent is defined to be 1/3*(@betaNorm@ - 1).+ alphaExponent = betaNorm `div` 3+ betaNorm = norm beta++isBadDenominator :: EisensteinInteger -> Bool+isBadDenominator x = modularNorm == 0+ where+ modularNorm = norm x `mod` 3++-- This complication is necessary because it may happen that the residue field+-- of @beta@ has characteristic two. In this case 1=-1 and the Euclidean algorithm+-- can return both. Therefore it is not enough to pattern match for the values+-- which give a well defined @cubicSymbol@.+findCubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol+findCubicSymbol residue beta+ | residue `A.rem` beta == 0 = Zero+ | (residue - ω) `A.rem` beta == 0 = Omega+ | (residue + 1 + ω) `A.rem` beta == 0 = OmegaSquare+ | (residue - 1) `A.rem` beta == 0 = One+ | otherwise = error "Math.NumberTheory.Moduli.Cbrt: invalid EisensteinInteger."++testSuite :: TestTree+testSuite = testGroup "CubicSymbol"+ [ testSmallAndQuick "multiplicative property of numerators" cubicSymbol1+ , testSmallAndQuick "multiplicative property of denominators" cubicSymbol2+ , testSmallAndQuick "cubic residue with prime denominator" cubicSymbol3+ ]
test-suite/Math/NumberTheory/Moduli/ChineseTests.hs view
@@ -7,65 +7,23 @@ -- Tests for Math.NumberTheory.Moduli.Chinese -- -{-# LANGUAGE CPP #-}-{-# LANGUAGE ViewPatterns #-}--{-# OPTIONS_GHC -fno-warn-type-defaults #-}- module Math.NumberTheory.Moduli.ChineseTests ( testSuite ) where import Test.Tasty -import Control.Arrow-import Data.List (tails)--import Math.NumberTheory.Moduli hiding (invertMod)+import Math.NumberTheory.Moduli (chinese) import Math.NumberTheory.TestUtils --- | Check that 'chineseRemainder' is defined iff modulos are coprime.--- Also check that the result is a solution of input modular equations.-chineseRemainderProperty :: [(Integer, Positive Integer)] -> Bool-chineseRemainderProperty rms' = case chineseRemainder rms of- Nothing -> not areCoprime- Just n -> areCoprime && map (n `mod`) ms == zipWith mod rs ms- where- rms = map (second getPositive) rms'- (rs, ms) = unzip rms- areCoprime = all (== 1) [ gcd m1 m2 | (m1 : m2s) <- tails ms, m2 <- m2s ]---- | Check that 'chineseRemainder' matches 'chineseRemainder2'.-chineseRemainder2Property :: Integer -> Positive Integer -> Integer -> Positive Integer -> Bool-chineseRemainder2Property r1 (Positive m1) r2 (Positive m2) = gcd m1 m2 /= 1- || Just (chineseRemainder2 (r1, m1) (r2, m2)) == chineseRemainder [(r1, m1), (r2, m2)]--chineseCoprimeProperty :: Integer -> Positive Integer -> Integer -> Positive Integer -> Bool-chineseCoprimeProperty n1 (Positive m1) n2 (Positive m2) = case gcd m1 m2 of- 1 -> case chineseCoprime (n1, m1) (n2, m2) of- Nothing -> False- Just n -> n `mod` m1 == n1 `mod` m1 && n `mod` m2 == n2 `mod` m2- _ -> case chineseCoprime (n1, m1) (n2, m2) of- Nothing -> True- Just{} -> False- chineseProperty :: Integer -> Positive Integer -> Integer -> Positive Integer -> Bool-chineseProperty n1 (Positive m1) n2 (Positive m2) = if compatible- then case chinese (n1, m1) (n2, m2) of- Nothing -> False- Just n -> n `mod` m1 == n1 `mod` m1 && n `mod` m2 == n2 `mod` m2- else case chineseCoprime (n1, m1) (n2, m2) of- Nothing -> True- Just{} -> False+chineseProperty n1 (Positive m1) n2 (Positive m2) = not compatible ||+ case chinese (n1, m1) (n2, m2) of+ Nothing -> not compatible+ Just (n, m) -> compatible && (n - n1) `rem` m1 == 0 && (n - n2) `rem` m2 == 0 && m == lcm m1 m2 where g = gcd m1 m2- compatible = n1 `mod` g == n2 `mod` g-+ compatible = (n1 - n2) `rem` g == 0 testSuite :: TestTree-testSuite = testGroup "Chinese"- [ testSmallAndQuick "chineseRemainder" chineseRemainderProperty- , testSmallAndQuick "chineseRemainder2" chineseRemainder2Property- , testSmallAndQuick "chineseCoprime" chineseCoprimeProperty- , testSmallAndQuick "chinese" chineseProperty- ]+testSuite = testSmallAndQuick "chinese" chineseProperty
test-suite/Math/NumberTheory/Moduli/ClassTests.hs view
@@ -7,8 +7,7 @@ -- Tests for Math.NumberTheory.Moduli.Class -- -{-# LANGUAGE CPP #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} @@ -34,9 +33,9 @@ -- | Check that 'invertMod' inverts numbers modulo. invertModProperty :: AnySign Integer -> Positive Integer -> Bool invertModProperty (AnySign k) (Positive m) = case invertMod k m of- Nothing -> k `mod` m == 0 || gcd k m > 1+ Nothing -> k `rem` m == 0 || gcd k m > 1 Just InfMod{} -> False- Just (SomeMod inv) -> gcd k m == 1 && k * getVal inv `mod` m == 1+ Just (SomeMod inv) -> gcd k m == 1 && k * getVal inv `mod` m == 1 `mod` m -- | Check that 'powerMod' is multiplicative by first argument. powerModProperty2 :: (Integral a) => NonNegative a -> AnySign Integer -> AnySign Integer -> Positive Integer -> Bool
test-suite/Math/NumberTheory/Moduli/DiscreteLogarithmTests.hs view
@@ -1,50 +1,61 @@ {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}+ module Math.NumberTheory.Moduli.DiscreteLogarithmTests ( testSuite ) where -import Data.Maybe-import Numeric.Natural import Test.Tasty-import Data.Semigroup++import Data.Maybe+import Data.Mod import Data.Proxy-import GHC.TypeNats.Compat+import Data.Semigroup+import GHC.TypeNats (SomeNat(..), KnownNat, someNatVal)+import Numeric.Natural -import Math.NumberTheory.Moduli.Class-import Math.NumberTheory.Moduli.PrimitiveRoot-import Math.NumberTheory.Moduli.DiscreteLogarithm import Math.NumberTheory.ArithmeticFunctions (totient)+import Math.NumberTheory.Moduli.Multiplicative+import Math.NumberTheory.Moduli.Singleton+import Math.NumberTheory.Primes import Math.NumberTheory.TestUtils +nextPrimitiveRoot :: (KnownNat m, UniqueFactorisation a, Integral a) => CyclicGroup a m -> Mod m -> Maybe (PrimitiveRoot m)+nextPrimitiveRoot cg g = listToMaybe $ mapMaybe (isPrimitiveRoot cg) [g..g+100]++nextMultElement :: KnownNat m => Mod m -> Maybe (MultMod m)+nextMultElement g = listToMaybe $ mapMaybe isMultElement [g..g+100]+ -- | Ensure 'discreteLogarithm' returns in the appropriate range. discreteLogRange :: Positive Natural -> Integer -> Integer -> Bool discreteLogRange (Positive m) a b = case someNatVal m of- SomeNat (_ :: Proxy m) -> fromMaybe True $ do- a' <- isPrimitiveRoot (fromInteger a :: Mod m)- b' <- isMultElement (fromInteger b)- return $ discreteLogarithm a' b' < totient m+ SomeNat (_ :: Proxy m) -> (/= Just False) $ do+ cg <- cyclicGroup :: Maybe (CyclicGroup Integer m)+ a' <- nextPrimitiveRoot cg (fromInteger a)+ b' <- nextMultElement (fromInteger b)+ return $ discreteLogarithm cg a' b' < totient m -- | Check that 'discreteLogarithm' inverts exponentiation. discreteLogarithmProperty :: Positive Natural -> Integer -> Integer -> Bool discreteLogarithmProperty (Positive m) a b = case someNatVal m of- SomeNat (_ :: Proxy m) -> fromMaybe True $ do- a' <- isPrimitiveRoot (fromInteger a :: Mod m)- b' <- isMultElement (fromInteger b)- return $ discreteLogarithm a' b' `stimes` unPrimitiveRoot a' == b'+ SomeNat (_ :: Proxy m) -> (/= Just False) $ do+ cg <- cyclicGroup :: Maybe (CyclicGroup Integer m)+ a' <- nextPrimitiveRoot cg (fromInteger a)+ b' <- nextMultElement (fromInteger b)+ return $ discreteLogarithm cg a' b' `stimes` unPrimitiveRoot a' == b' -- | Check that 'discreteLogarithm' inverts exponentiation in the other direction. discreteLogarithmProperty' :: Positive Natural -> Integer -> Natural -> Bool discreteLogarithmProperty' (Positive m) a k = case someNatVal m of- SomeNat (_ :: Proxy m) -> fromMaybe True $ do- a'' <- isPrimitiveRoot (fromInteger a :: Mod m)+ SomeNat (_ :: Proxy m) -> (/= Just False) $ do+ cg <- cyclicGroup :: Maybe (CyclicGroup Integer m)+ a'' <- nextPrimitiveRoot cg (fromInteger a) let a' = unPrimitiveRoot a''- return $ discreteLogarithm a'' (k `stimes` a') == k `mod` totient m+ return $ discreteLogarithm cg a'' (k `stimes` a') == k `mod` totient m testSuite :: TestTree testSuite = testGroup "Discrete logarithm"
test-suite/Math/NumberTheory/Moduli/EquationsTests.hs view
@@ -13,33 +13,42 @@ import Test.Tasty -import Data.List+import Data.List (sort)+import Data.Mod import Data.Proxy-import GHC.TypeNats.Compat+import GHC.TypeNats (KnownNat, SomeNat(..), someNatVal) import Numeric.Natural -import Math.NumberTheory.Moduli.Class+import Math.NumberTheory.Moduli (SomeMod(..)) import Math.NumberTheory.Moduli.Equations+import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.TestUtils -solveLinearProp :: KnownNat m => Mod m -> Mod m -> Bool-solveLinearProp a b = sort (solveLinear a b) ==- filter (\x -> a * x + b == 0) [minBound .. maxBound]+wrapSome :: KnownNat m => ([Mod m], [Mod m]) -> ([SomeMod], [SomeMod])+wrapSome (xs, ys) = (map SomeMod xs, map SomeMod ys) -solveLinearProperty1 :: Positive Natural -> Integer -> Integer -> Bool-solveLinearProperty1 (Positive m) a b = case someNatVal m of- SomeNat (_ :: Proxy t) -> solveLinearProp (fromInteger a :: Mod t) (fromInteger b)+solveLinearProp :: KnownNat m => Mod m -> Mod m -> ([Mod m], [Mod m])+solveLinearProp a b =+ ( sort (solveLinear a b)+ , filter (\x -> a * x + b == 0) [minBound .. maxBound]+ ) -solveQuadraticProp :: KnownNat m => Mod m -> Mod m -> Mod m -> Bool-solveQuadraticProp a b c = sort (solveQuadratic a b c) ==- filter (\x -> a * x * x + b * x + c == 0) [minBound .. maxBound]+solveLinearProperty1 :: (Positive Natural, Integer, Integer) -> ([SomeMod], [SomeMod])+solveLinearProperty1 (Positive m, a, b) = case someNatVal m of+ SomeNat (_ :: Proxy t) -> wrapSome $ solveLinearProp (fromInteger a :: Mod t) (fromInteger b) -solveQuadraticProperty1 :: Positive Natural -> Integer -> Integer -> Integer -> Bool-solveQuadraticProperty1 (Positive m) a b c = case someNatVal m of- SomeNat (_ :: Proxy t) -> solveQuadraticProp (fromInteger a :: Mod t) (fromInteger b) (fromInteger c)+solveQuadraticProp :: KnownNat m => Mod m -> Mod m -> Mod m -> ([Mod m], [Mod m])+solveQuadraticProp a b c =+ ( sort (solveQuadratic sfactors a b c)+ , filter (\x -> a * x * x + b * x + c == 0) [minBound .. maxBound]+ ) +solveQuadraticProperty1 :: (Positive Natural, Integer, Integer, Integer) -> ([SomeMod], [SomeMod])+solveQuadraticProperty1 (Positive m, a, b, c) = case someNatVal m of+ SomeNat (_ :: Proxy t) -> wrapSome $ solveQuadraticProp (fromInteger a :: Mod t) (fromInteger b) (fromInteger c)+ testSuite :: TestTree testSuite = testGroup "Equations"- [ testSmallAndQuick "solveLinear" solveLinearProperty1- , testSmallAndQuick "solveQuadratic" solveQuadraticProperty1+ [ testEqualSmallAndQuick "solveLinear" solveLinearProperty1+ , testEqualSmallAndQuick "solveQuadratic" solveQuadraticProperty1 ]
test-suite/Math/NumberTheory/Moduli/JacobiTests.hs view
@@ -7,9 +7,6 @@ -- Tests for Math.NumberTheory.Moduli.Jacobi -- -{-# LANGUAGE CPP #-}-{-# LANGUAGE ViewPatterns #-}- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Moduli.JacobiTests@@ -19,11 +16,8 @@ import Test.Tasty import Data.Bits-#if __GLASGOW_HASKELL__ < 803-import Data.Semigroup-#endif -import Math.NumberTheory.Moduli hiding (invertMod)+import Math.NumberTheory.Moduli.Sqrt import Math.NumberTheory.TestUtils -- https://en.wikipedia.org/wiki/Jacobi_symbol#Properties, item 2
test-suite/Math/NumberTheory/Moduli/PrimitiveRootTests.hs view
@@ -7,7 +7,6 @@ -- Tests for Math.NumberTheory.Moduli.PrimitiveRoot -- -{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}@@ -18,28 +17,27 @@ import Prelude hiding (gcd) import Test.Tasty+import Test.Tasty.HUnit -import qualified Data.Set as S+import Data.Euclidean import Data.List (genericTake, genericLength) import Data.Maybe (isJust, isNothing, mapMaybe)-import Control.Arrow (first)-import Numeric.Natural+import Data.Mod import Data.Proxy-import GHC.TypeNats.Compat+import qualified Data.Set as S+import GHC.TypeNats (SomeNat(..), someNatVal)+import Numeric.Natural import Math.NumberTheory.ArithmeticFunctions (totient)-import Math.NumberTheory.Euclidean-import Math.NumberTheory.Euclidean.Coprimes-import Math.NumberTheory.Moduli.Class (Mod, SomeMod(..), modulo)-import Math.NumberTheory.Moduli.PrimitiveRoot-import Math.NumberTheory.Prefactored (fromFactors, prefFactors, prefValue, Prefactored)+import Math.NumberTheory.Moduli.Multiplicative+import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes import Math.NumberTheory.TestUtils -cyclicGroupProperty1 :: (Euclidean a, Integral a, UniqueFactorisation a) => AnySign a -> Bool-cyclicGroupProperty1 (AnySign n) = case cyclicGroupFromModulo n of+cyclicGroupProperty1 :: (Euclidean a, Integral a, UniqueFactorisation a) => Positive a -> Bool+cyclicGroupProperty1 (Positive n) = case cyclicGroupFromModulo n of Nothing -> True- Just cg -> prefValue (cyclicGroupToModulo cg) == n+ Just (Some cg) -> factorBack (unSFactors (cyclicGroupToSFactors cg)) == n -- | Multiplicative groups modulo primes are always cyclic. cyclicGroupProperty2 :: (Integral a, UniqueFactorisation a) => Positive a -> Bool@@ -54,75 +52,74 @@ Just _ -> 2 * n < n {- overflow check -} || isJust (cyclicGroupFromModulo n) +cyclicGroupSpecialCase1 :: Assertion+cyclicGroupSpecialCase1 = assertBool "should be non-cyclic" $ isNothing $ cyclicGroupFromModulo (8 :: Integer)+ allUnique :: Ord a => [a] -> Bool allUnique = go S.empty where go _ [] = True- go acc (x : xs) = if x `S.member` acc then False else go (S.insert x acc) xs+ go acc (x : xs) = not (x `S.member` acc) && go (S.insert x acc) xs isPrimitiveRoot'Property1- :: (Euclidean a, Integral a, UniqueFactorisation a)- => AnySign a -> CyclicGroup a -> Bool-isPrimitiveRoot'Property1 (AnySign n) cg- = gcd (toInteger n) (prefValue (castPrefactored (cyclicGroupToModulo cg))) == 1- || not (isPrimitiveRoot' cg n)--castPrefactored :: Integral a => Prefactored a -> Prefactored Integer-castPrefactored = fromFactors . splitIntoCoprimes . map (first toInteger) . unCoprimes . prefFactors+ :: forall a. (Euclidean a, Integral a, UniqueFactorisation a)+ => AnySign a+ -> Positive Natural+ -> Bool+isPrimitiveRoot'Property1 (AnySign n) (Positive m) = case someNatVal m of+ SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup a m) of+ Nothing -> True+ Just cg -> case isPrimitiveRoot cg (fromIntegral n) of+ Nothing -> True+ Just rt -> gcd m (unMod (multElement (unPrimitiveRoot rt))) == 1 isPrimitiveRootProperty1 :: AnySign Integer -> Positive Natural -> Bool-isPrimitiveRootProperty1 (AnySign n) (Positive m)- = case n `modulo` m of- SomeMod n' -> gcd n (toInteger m) == 1- || isNothing (isPrimitiveRoot n')- InfMod{} -> False+isPrimitiveRootProperty1 (AnySign n) (Positive m) = case someNatVal m of+ SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of+ Nothing -> True+ Just cg -> gcd n (toInteger m) == 1+ || isNothing (isPrimitiveRoot cg (fromInteger n)) isPrimitiveRootProperty2 :: Positive Natural -> Bool-isPrimitiveRootProperty2 (Positive m)- = isNothing (cyclicGroupFromModulo m)- || case someNatVal m of- SomeNat (_ :: Proxy t) -> any (isJust . isPrimitiveRoot) [(minBound :: Mod t) .. maxBound]+isPrimitiveRootProperty2 (Positive m) = case someNatVal m of+ SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of+ Nothing -> True+ Just cg -> any (isJust . isPrimitiveRoot cg) [minBound..maxBound] isPrimitiveRootProperty3 :: AnySign Integer -> Positive Natural -> Bool-isPrimitiveRootProperty3 (AnySign n) (Positive m)- = case n `modulo` m of- SomeMod n' -> isNothing (isPrimitiveRoot n')- || allUnique (genericTake (totient m - 1) (iterate (* n') 1))- InfMod{} -> False--isPrimitiveRootProperty4 :: AnySign Integer -> Positive Natural -> Bool-isPrimitiveRootProperty4 (AnySign n) (Positive m)- = isJust (cyclicGroupFromModulo m)- || case n `modulo` m of- SomeMod n' -> isNothing (isPrimitiveRoot n')- InfMod{} -> False+isPrimitiveRootProperty3 (AnySign n) (Positive m) = case someNatVal m of+ SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of+ Nothing -> True+ Just cg -> let n' = fromInteger n+ in isNothing (isPrimitiveRoot cg n')+ || allUnique (genericTake (totient m - 1) (iterate (* n') 1)) isPrimitiveRootProperty5 :: Positive Natural -> Bool-isPrimitiveRootProperty5 (Positive m)- = isNothing (cyclicGroupFromModulo m)- || case someNatVal m of- SomeNat (_ :: Proxy t) -> genericLength (mapMaybe isPrimitiveRoot [(minBound :: Mod t) .. maxBound]) == totient (totient m)+isPrimitiveRootProperty5 (Positive m) = case someNatVal m of+ SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of+ Nothing -> True+ Just cg -> genericLength (mapMaybe (isPrimitiveRoot cg) [minBound..maxBound]) == totient (totient m) testSuite :: TestTree testSuite = testGroup "Primitive root" [ testGroup "CyclicGroup"- [ testIntegralProperty "cyclicGroupToModulo . cyclicGroupFromModulo" cyclicGroupProperty1+ [ testIntegralProperty "cyclicGroupFromModulo" cyclicGroupProperty1 , testIntegralProperty "cyclic group mod p" cyclicGroupProperty2 , testIntegralProperty "cyclic group mod 2p" cyclicGroupProperty3+ , testCase "cyclic group mod 8" cyclicGroupSpecialCase1 ] , testGroup "isPrimitiveRoot'" [ testGroup "primitive root is coprime with modulo"- [ testSmallAndQuick "Integer" (isPrimitiveRoot'Property1 :: AnySign Integer -> CyclicGroup Integer -> Bool)- , testSmallAndQuick "Natural" (isPrimitiveRoot'Property1 :: AnySign Natural -> CyclicGroup Natural -> Bool)- , testSmallAndQuick "Int" (isPrimitiveRoot'Property1 :: AnySign Int -> CyclicGroup Int -> Bool)- , testSmallAndQuick "Word" (isPrimitiveRoot'Property1 :: AnySign Word -> CyclicGroup Word -> Bool)+ [ testSmallAndQuick "Integer" (isPrimitiveRoot'Property1 :: AnySign Integer -> Positive Natural -> Bool)+ , testSmallAndQuick "Natural" (isPrimitiveRoot'Property1 :: AnySign Natural -> Positive Natural -> Bool)+ , testSmallAndQuick "Int" (isPrimitiveRoot'Property1 :: AnySign Int -> Positive Natural -> Bool)+ , testSmallAndQuick "Word" (isPrimitiveRoot'Property1 :: AnySign Word -> Positive Natural -> Bool) ] ] , testGroup "isPrimitiveRoot" [ testSmallAndQuick "primitive root is coprime with modulo" isPrimitiveRootProperty1 , testSmallAndQuick "cyclic group has a primitive root" isPrimitiveRootProperty2 , testSmallAndQuick "primitive root generates cyclic group" isPrimitiveRootProperty3- , testSmallAndQuick "no primitive root in non-cyclic group" isPrimitiveRootProperty4 , testSmallAndQuick "cyclic group has right number of primitive roots" isPrimitiveRootProperty5 ] ]
+ test-suite/Math/NumberTheory/Moduli/SingletonTests.hs view
@@ -0,0 +1,46 @@+-- |+-- Module: Math.NumberTheory.Moduli.SingletonTests+-- Copyright: (c) 2019 Andrew Lelechenko+-- Licence: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Tests for Math.NumberTheory.Moduli.Singleton+--++{-# LANGUAGE TypeApplications #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Math.NumberTheory.Moduli.SingletonTests+ ( testSuite+ ) where++import Test.Tasty++import qualified Data.Map as M++import Math.NumberTheory.Moduli.Singleton+import Math.NumberTheory.Primes+import Math.NumberTheory.TestUtils++someSFactorsProperty1+ :: (Ord a, Num a)+ => [(Prime a, Word)]+ -> Bool+someSFactorsProperty1 xs = case someSFactors xs of+ Some sm -> unSFactors sm == M.assocs (M.fromListWith (+) xs)++cyclicGroupFromModuloProperty1+ :: (Integral a, UniqueFactorisation a)+ => Positive a+ -> Bool+cyclicGroupFromModuloProperty1 (Positive m) = mcg1 == mcg2+ where+ mcg1 = cyclicGroupFromModulo m+ mcg2 = cyclicGroupFromFactors (factorise m)++testSuite :: TestTree+testSuite = testGroup "Singleton"+ [ testSmallAndQuick "unSFactors . someSFactors = id" (someSFactorsProperty1 @Integer)+ , testIntegralPropertyNoLarge "cyclicGroupFromModulo = cyclicGroupFromFactors . factorise" cyclicGroupFromModuloProperty1+ ]
test-suite/Math/NumberTheory/Moduli/SqrtTests.hs view
@@ -7,10 +7,10 @@ -- Tests for Math.NumberTheory.Moduli.Sqrt -- -{-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Math.NumberTheory.Moduli.SqrtTests ( testSuite@@ -20,8 +20,9 @@ import Test.Tasty.HUnit import Control.Arrow-import Data.List (group, sort)-import Data.Maybe (fromJust)+import Data.List (sort)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (fromJust, listToMaybe) import Numeric.Natural import Math.NumberTheory.Moduli hiding (invertMod)@@ -32,17 +33,17 @@ unwrapPP (p, Power e) = (p, e `mod` 5) nubOrd :: Ord a => [a] -> [a]-nubOrd = map head . group . sort+nubOrd = map NE.head . NE.group . sort -- | Check that 'sqrtMod' is defined iff a quadratic residue exists. -- Also check that the result is a solution of input modular equation. sqrtsModPrimeProperty1 :: AnySign Integer -> Prime Integer -> Bool sqrtsModPrimeProperty1 (AnySign n) p'@(unPrime -> p) = case sqrtsModPrime n p' of [] -> jacobi n p == MinusOne- rt : _ -> (p == 2 || jacobi n p /= MinusOne) && rt ^ 2 `mod` p == n `mod` p+ rt : _ -> (p == 2 || jacobi n p /= MinusOne) && (rt ^ 2 - n) `rem` p == 0 sqrtsModPrimeProperty2 :: AnySign Integer -> Prime Integer -> Bool-sqrtsModPrimeProperty2 (AnySign n) p'@(unPrime -> p) = all (\rt -> rt ^ 2 `mod` p == n `mod` p) (sqrtsModPrime n p')+sqrtsModPrimeProperty2 (AnySign n) p'@(unPrime -> p) = all (\rt -> (rt ^ 2 - n) `rem` p == 0) (sqrtsModPrime n p') sqrtsModPrimeProperty3 :: AnySign Integer -> Prime Integer -> Bool sqrtsModPrimeProperty3 (AnySign n) p'@(unPrime -> p) = nubOrd rts == sort rts@@ -58,9 +59,9 @@ rt : _ = sqrtsModPrime n p' tonelliShanksProperty2 :: Prime Integer -> Bool-tonelliShanksProperty2 p'@(unPrime -> p) = p `mod` 4 /= 1 || rt ^ 2 `mod` p == n `mod` p+tonelliShanksProperty2 p'@(unPrime -> p) = p `mod` 4 /= 1 || (rt ^ 2 - n) `rem` p == 0 where- n = head $ filter (\s -> jacobi s p == One) [2..p-1]+ n : _ = filter (\s -> jacobi s p == One) [2..p-1] rt : _ = sqrtsModPrime n p' tonelliShanksProperty3 :: Prime Integer -> Bool@@ -72,15 +73,15 @@ tonelliShanksSpecialCases :: Assertion tonelliShanksSpecialCases =- assertEqual "OEIS A002224" [6, 32, 219, 439, 1526, 2987, 22193, 11740, 13854, 91168, 326277, 232059, 3230839, 4379725, 11754394, 32020334, 151024619, 345641931, 373671108, 1857111865, 8110112775, 4184367042] rts+ assertEqual "OEIS A002224" (map Just [6, 32, 219, 439, 1526, 2987, 22193, 11740, 13854, 91168, 326277, 232059, 3230839, 4379725, 11754394, 32020334, 151024619, 345641931, 373671108, 1857111865, 8110112775, 4184367042]) rts where ps :: [Integer] ps = [17, 73, 241, 1009, 2689, 8089, 33049, 53881, 87481, 483289, 515761, 1083289, 3818929, 9257329, 22000801, 48473881, 175244281, 427733329, 898716289, 8114538721, 9176747449, 23616331489]- rts = map (head . sqrtsModPrime 2 . fromJust . isPrime) ps+ rts = map (listToMaybe . sqrtsModPrime 2 . fromJust . isPrime) ps sqrtsModPrimePowerProperty1 :: AnySign Integer -> (Prime Integer, Power Word) -> Bool sqrtsModPrimePowerProperty1 (AnySign n) (p'@(unPrime -> p), Power e) = gcd n p > 1- || all (\rt -> rt ^ 2 `mod` (p ^ e) == n `mod` (p ^ e)) (sqrtsModPrimePower n p' e)+ || all (\rt -> (rt ^ 2 - n) `rem` (p ^ e) == 0) (sqrtsModPrimePower n p' e) sqrtsModPrimePowerProperty2 :: AnySign Integer -> Power Word -> Bool sqrtsModPrimePowerProperty2 n e = sqrtsModPrimePowerProperty1 n (fromJust $ isPrime (2 :: Integer), e)@@ -152,7 +153,7 @@ sqrtsModFactorisationProperty1 :: AnySign Integer -> [(Prime Integer, Power Word)] -> Bool sqrtsModFactorisationProperty1 (AnySign n) (take 10 . map unwrapPP -> pes'@(map (first unPrime) -> pes)) = nubOrd ps /= sort ps || all- (\rt -> all (\(p, e) -> rt ^ 2 `mod` (p ^ e) == n `mod` (p ^ e)) pes)+ (\rt -> all (\(p, e) -> (rt ^ 2 - n) `rem` (p ^ e) == 0) pes) (take 1000 $ sqrtsModFactorisation n pes') where ps = map fst pes@@ -162,7 +163,7 @@ = nubOrd ps /= sort ps || nubOrd rts == sort rts where ps = map fst pes- m = product $ map (\(p, e) -> p ^ e) pes+ m = product $ map (uncurry (^)) pes rts = map (`mod` m) $ take 1000 $ sqrtsModFactorisation n pes' sqrtsModFactorisationProperty3 :: AnySign Integer -> [(Prime Integer, Power Word)] -> Bool@@ -170,7 +171,7 @@ = nubOrd ps /= sort ps || all (\rt -> rt >= 0 && rt < m) rts where ps = map fst pes- m = product $ map (\(p, e) -> p ^ e) pes+ m = product $ map (uncurry (^)) pes rts = take 1000 $ sqrtsModFactorisation n pes' sqrtsModFactorisationSpecialCase1 :: Assertion@@ -185,7 +186,7 @@ sqrtsModProperty1 :: AnySign Integer -> Positive Natural -> Bool sqrtsModProperty1 (AnySign n) (Positive m) = case n `modulo` m of- SomeMod x -> sort (sqrtsMod x) == filter (\rt -> rt * rt == x) [minBound .. maxBound]+ SomeMod x -> sort (sqrtsMod sfactors x) == filter (\rt -> rt * rt == x) [minBound .. maxBound] InfMod{} -> True testSuite :: TestTree
− test-suite/Math/NumberTheory/MoebiusInversion/IntTests.hs
@@ -1,52 +0,0 @@--- |--- Module: Math.NumberTheory.MoebiusInversion.IntTests--- Copyright: (c) 2016 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Tests for Math.NumberTheory.MoebiusInversion.Int-----{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Math.NumberTheory.MoebiusInversion.IntTests- ( testSuite- ) where--import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck as QC hiding (Positive)--import Math.NumberTheory.MoebiusInversion.Int-import Math.NumberTheory.ArithmeticFunctions-import Math.NumberTheory.TestUtils--totientSumProperty :: Positive Int -> Bool-totientSumProperty (Positive n) = toInteger (totientSum n) == sum (map totient [1 .. toInteger n])--totientSumSpecialCase1 :: Assertion-totientSumSpecialCase1 = assertEqual "totientSum" 4496 (totientSum 121)--totientSumSpecialCase2 :: Assertion-totientSumSpecialCase2 = assertEqual "totientSum" 0 (totientSum (-9001))--totientSumZero :: Assertion-totientSumZero = assertEqual "totientSum" 0 (totientSum 0)--generalInversionProperty :: (Int -> Int) -> Positive Int -> Bool-generalInversionProperty g (Positive n)- = g n == sum [f (n `quot` k) | k <- [1 .. n]]- && f n == sum [runMoebius (moebius k) * g (n `quot` k) | k <- [1 .. n]]- where- f = generalInversion g--testSuite :: TestTree-testSuite = testGroup "Int"- [ testGroup "totientSum"- [ testSmallAndQuick "matches definitions" totientSumProperty- , testCase "special case 1" totientSumSpecialCase1- , testCase "special case 2" totientSumSpecialCase2- , testCase "zero" totientSumZero- ]- , QC.testProperty "generalInversion" generalInversionProperty- ]
test-suite/Math/NumberTheory/MoebiusInversionTests.hs view
@@ -17,35 +17,37 @@ import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC hiding (Positive) +import Data.Proxy+import Data.Vector.Unboxed (Vector)+ import Math.NumberTheory.MoebiusInversion import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.TestUtils -totientSumProperty :: Positive Int -> Bool-totientSumProperty (Positive n) = totientSum n == sum (map totient [1 .. toInteger n])+proxy :: Proxy Vector+proxy = Proxy -totientSumSpecialCase1 :: Assertion-totientSumSpecialCase1 = assertEqual "totientSum" 4496 (totientSum 121)+totientSumProperty :: AnySign Word -> Bool+totientSumProperty (AnySign n) = (totientSum proxy n :: Word) == sum (map totient [1..n]) -totientSumSpecialCase2 :: Assertion-totientSumSpecialCase2 = assertEqual "totientSum" 0 (totientSum (-9001))+totientSumSpecialCase1 :: Assertion+totientSumSpecialCase1 = assertEqual "totientSum" 4496 (totientSum proxy 121 :: Word) totientSumZero :: Assertion-totientSumZero = assertEqual "totientSum" 0 (totientSum 0)+totientSumZero = assertEqual "totientSum" 0 (totientSum proxy 0 :: Word) -generalInversionProperty :: (Int -> Integer) -> Positive Int -> Bool+generalInversionProperty :: (Word -> Word) -> Positive Word -> Bool generalInversionProperty g (Positive n) = g n == sum [f (n `quot` k) | k <- [1 .. n]] && f n == sum [runMoebius (moebius k) * g (n `quot` k) | k <- [1 .. n]] where- f = generalInversion g+ f = generalInversion proxy g testSuite :: TestTree testSuite = testGroup "MoebiusInversion" [ testGroup "totientSum" [ testSmallAndQuick "matches definitions" totientSumProperty , testCase "special case 1" totientSumSpecialCase1- , testCase "special case 2" totientSumSpecialCase2 , testCase "zero" totientSumZero ] , QC.testProperty "generalInversion" generalInversionProperty
− test-suite/Math/NumberTheory/Powers/CubesTests.hs
@@ -1,150 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.CubesTests--- Copyright: (c) 2016 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Tests for Math.NumberTheory.Powers.Cubes-----{-# LANGUAGE CPP #-}--{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Math.NumberTheory.Powers.CubesTests- ( testSuite- ) where--import Test.Tasty-import Test.Tasty.HUnit--import Data.Maybe--import Math.NumberTheory.Powers.Cubes-import Math.NumberTheory.TestUtils--#include "MachDeps.h"---- | Check that 'integerCubeRoot' returns the largest integer @m@ with @m^3 <= n@.------ (m + 1) ^ 3 /= n && cond--- means--- (m + 1) ^ 3 > n--- but without overflow for bounded types-integerCubeRootProperty :: Integral a => AnySign a -> Bool-integerCubeRootProperty (AnySign n) = m ^ 3 <= n && (m + 1) ^ 3 /= n && cond- where- m = integerCubeRoot n- cond- | m < 0 && m == -1 = n == -1- | m < 0 = (m + 1) ^ 2 <= n `div` (m + 1)- | otherwise = (m + 1) ^ 2 >= n `div` (m + 1)---- | Specialized to trigger 'cubeRootInt''.-integerCubeRootProperty_Int :: AnySign Int -> Bool-integerCubeRootProperty_Int = integerCubeRootProperty---- | Specialized to trigger 'cubeRootWord'.-integerCubeRootProperty_Word :: AnySign Word -> Bool-integerCubeRootProperty_Word = integerCubeRootProperty---- | Specialized to trigger 'cubeRootIgr'.-integerCubeRootProperty_Integer :: AnySign Integer -> Bool-integerCubeRootProperty_Integer = integerCubeRootProperty---- | Check that 'integerCubeRoot' returns the largest integer @m@ with @m^3 <= n@, , where @n@ has form @k@^3-1.-integerCubeRootProperty2 :: Integral a => AnySign a -> Bool-integerCubeRootProperty2 (AnySign k) = k == 0 || (m ^ 3 <= n && (m + 1) ^ 3 /= n && cond)- where- n = k ^ 3 - 1- m = integerCubeRoot n- cond- | m < 0 && m == -1 = n == -1- | m < 0 = (m + 1) ^ 2 <= n `div` (m + 1)- | otherwise = (m + 1) ^ 2 >= n `div` (m + 1)---- | Specialized to trigger 'cubeRootInt''.-integerCubeRootProperty2_Int :: AnySign Int -> Bool-integerCubeRootProperty2_Int = integerCubeRootProperty2---- | Specialized to trigger 'cubeRootWord'.-integerCubeRootProperty2_Word :: AnySign Word -> Bool-integerCubeRootProperty2_Word = integerCubeRootProperty2--#if WORD_SIZE_IN_BITS == 64---- | Check that 'integerCubeRoot' of 2^63-1 is 2^21-1, not 2^21.-integerCubeRootSpecialCase1_Int :: Assertion-integerCubeRootSpecialCase1_Int =- assertEqual "integerCubeRoot" (integerCubeRoot (maxBound :: Int)) (2 ^ 21 - 1)---- | Check that 'integerCubeRoot' of 2^63-1 is 2^21-1, not 2^21.-integerCubeRootSpecialCase1_Word :: Assertion-integerCubeRootSpecialCase1_Word =- assertEqual "integerCubeRoot" (integerCubeRoot (maxBound `div` 2 :: Word)) (2 ^ 21 - 1)---- | Check that 'integerCubeRoot' of 2^64-1 is 2642245.-integerCubeRootSpecialCase2 :: Assertion-integerCubeRootSpecialCase2 =- assertEqual "integerCubeRoot" (integerCubeRoot (maxBound :: Word)) 2642245--#endif---- | Check that 'integerCubeRoot'' returns the largest integer @m@ with @m^3 <= n@.-integerCubeRoot'Property :: Integral a => NonNegative a -> Bool-integerCubeRoot'Property (NonNegative n) = m ^ 3 <= n && (m + 1) ^ 3 /= n && (m + 1) ^ 2 >= n `div` (m + 1)- where- m = integerCubeRoot' n---- | Check that the number 'isCube' iff its 'integerCubeRoot' is exact.-isCubeProperty :: Integral a => AnySign a -> Bool-isCubeProperty (AnySign n) = (n /= m ^ 3 && not t) || (n == m ^ 3 && t)- where- t = isCube n- m = integerCubeRoot n---- | Check that the number 'isCube'' iff its 'integerCubeRoot'' is exact.-isCube'Property :: Integral a => NonNegative a -> Bool-isCube'Property (NonNegative n) = (n /= m ^ 3 && not t) || (n == m ^ 3 && t)- where- t = isCube' n- m = integerCubeRoot' n---- | Check that 'exactCubeRoot' returns an exact integer cubic root--- and is consistent with 'isCube'.-exactCubeRootProperty :: Integral a => AnySign a -> Bool-exactCubeRootProperty (AnySign n) = case exactCubeRoot n of- Nothing -> not (isCube n)- Just m -> isCube n && n == m ^ 3---- | Check that 'isPossibleCube' is consistent with 'exactCubeRoot'.-isPossibleCubeProperty :: Integral a => NonNegative a -> Bool-isPossibleCubeProperty (NonNegative n) = t || not t && isNothing m- where- t = isPossibleCube n- m = exactCubeRoot n--testSuite :: TestTree-testSuite = testGroup "Cubes"- [ testGroup "integerCubeRoot"- [ testIntegralProperty "generic" integerCubeRootProperty- , testSmallAndQuick "generic Int" integerCubeRootProperty_Int- , testSmallAndQuick "generic Word" integerCubeRootProperty_Word- , testSmallAndQuick "generic Integer" integerCubeRootProperty_Integer-- , testIntegralProperty "almost cube" integerCubeRootProperty2- , testSmallAndQuick "almost cube Int" integerCubeRootProperty2_Int- , testSmallAndQuick "almost cube Word" integerCubeRootProperty2_Word--#if WORD_SIZE_IN_BITS == 64- , testCase "maxBound :: Int" integerCubeRootSpecialCase1_Int- , testCase "maxBound / 2 :: Word" integerCubeRootSpecialCase1_Word- , testCase "maxBound :: Word" integerCubeRootSpecialCase2-#endif- ]- , testIntegralProperty "integerCubeRoot'" integerCubeRoot'Property- , testIntegralProperty "isCube" isCubeProperty- , testIntegralProperty "isCube'" isCube'Property- , testIntegralProperty "exactCubeRoot" exactCubeRootProperty- , testIntegralProperty "isPossibleCube" isPossibleCubeProperty- ]
− test-suite/Math/NumberTheory/Powers/FourthTests.hs
@@ -1,142 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.FourthTests--- Copyright: (c) 2016 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Tests for Math.NumberTheory.Powers.Fourth-----{-# LANGUAGE CPP #-}--{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Math.NumberTheory.Powers.FourthTests- ( testSuite- ) where--import Test.Tasty-import Test.Tasty.HUnit--import Data.Maybe--import Math.NumberTheory.Powers.Fourth-import Math.NumberTheory.TestUtils--#include "MachDeps.h"---- | Check that 'integerFourthRoot' returns the largest integer @m@ with @m^4 <= n@.------ (m + 1) ^ 4 /= n && (m + 1) ^ 3 >= n `div` (m + 1)--- means--- (m + 1) ^ 4 > n--- but without overflow for bounded types-integerFourthRootProperty :: Integral a => NonNegative a -> Bool-integerFourthRootProperty (NonNegative n) = m >= 0 && m ^ 4 <= n && (m + 1) ^ 4 /= n && (m + 1) ^ 3 >= n `div` (m + 1)- where- m = integerFourthRoot n---- | Specialized to trigger 'biSqrtInt'.-integerFourthRootProperty_Int :: NonNegative Int -> Bool-integerFourthRootProperty_Int = integerFourthRootProperty---- | Specialized to trigger 'biSqrtWord'.-integerFourthRootProperty_Word :: NonNegative Word -> Bool-integerFourthRootProperty_Word = integerFourthRootProperty---- | Specialized to trigger 'biSqrtIgr'.-integerFourthRootProperty_Integer :: NonNegative Integer -> Bool-integerFourthRootProperty_Integer = integerFourthRootProperty---- | Check that 'integerFourthRoot' returns the largest integer @m@ with @m^4 <= n@, , where @n@ has form @k@^4-1.-integerFourthRootProperty2 :: Integral a => Positive a -> Bool-integerFourthRootProperty2 (Positive k) = n < 0 || m >= 0 && m ^ 4 <= n && (m + 1) ^ 4 /= n && (m + 1) ^ 3 >= n `div` (m + 1)- where- n = k ^ 4 - 1- m = integerFourthRoot n---- | Specialized to trigger 'biSqrtInt.-integerFourthRootProperty2_Int :: Positive Int -> Bool-integerFourthRootProperty2_Int = integerFourthRootProperty2---- | Specialized to trigger 'biSqrtWord'.-integerFourthRootProperty2_Word :: Positive Word -> Bool-integerFourthRootProperty2_Word = integerFourthRootProperty2--#if WORD_SIZE_IN_BITS == 64---- | Check that 'integerFourthRoot' of 2^60-1 is 2^15-1, not 2^15.-integerFourthRootSpecialCase1_Int :: Assertion-integerFourthRootSpecialCase1_Int =- assertEqual "integerFourthRoot" (integerFourthRoot (maxBound `div` 8 :: Int)) (2 ^ 15 - 1)---- | Check that 'integerFourthRoot' of 2^60-1 is 2^15-1, not 2^15.-integerFourthRootSpecialCase1_Word :: Assertion-integerFourthRootSpecialCase1_Word =- assertEqual "integerFourthRoot" (integerFourthRoot (maxBound `div` 16 :: Word)) (2 ^ 15 - 1)---- | Check that 'integerFourthRoot' of 2^64-1 is 2^16-1, not 2^16.-integerFourthRootSpecialCase2 :: Assertion-integerFourthRootSpecialCase2 =- assertEqual "integerFourthRoot" (integerFourthRoot (maxBound :: Word)) (2 ^ 16 - 1)--#endif---- | Check that 'integerFourthRoot'' returns the largest integer @m@ with @m^4 <= n@.-integerFourthRoot'Property :: Integral a => NonNegative a -> Bool-integerFourthRoot'Property (NonNegative n) = m >= 0 && m ^ 4 <= n && (m + 1) ^ 4 /= n && (m + 1) ^ 3 >= n `div` (m + 1)- where- m = integerFourthRoot' n---- | Check that the number 'isFourthPower' iff its 'integerFourthRoot' is exact.-isFourthPowerProperty :: Integral a => AnySign a -> Bool-isFourthPowerProperty (AnySign n) = (n < 0 && not t) || (n /= m ^ 4 && not t) || (n == m ^ 4 && t)- where- t = isFourthPower n- m = integerFourthRoot n---- | Check that the number 'isFourthPower'' iff its 'integerFourthRoot'' is exact.-isFourthPower'Property :: Integral a => NonNegative a -> Bool-isFourthPower'Property (NonNegative n) = (n /= m ^ 4 && not t) || (n == m ^ 4 && t)- where- t = isFourthPower' n- m = integerFourthRoot' n---- | Check that 'exactFourthRoot' returns an exact integer root of fourth power--- and is consistent with 'isFourthPower'.-exactFourthRootProperty :: Integral a => AnySign a -> Bool-exactFourthRootProperty (AnySign n) = case exactFourthRoot n of- Nothing -> not (isFourthPower n)- Just m -> isFourthPower n && n == m ^ 4---- | Check that 'isPossibleFourthPower' is consistent with 'exactFourthRoot'.-isPossibleFourthPowerProperty :: Integral a => NonNegative a -> Bool-isPossibleFourthPowerProperty (NonNegative n) = t || not t && isNothing m- where- t = isPossibleFourthPower n- m = exactFourthRoot n--testSuite :: TestTree-testSuite = testGroup "Fourth"- [ testGroup "integerFourthRoot"- [ testIntegralProperty "generic" integerFourthRootProperty- , testSmallAndQuick "generic Int" integerFourthRootProperty_Int- , testSmallAndQuick "generic Word" integerFourthRootProperty_Word- , testSmallAndQuick "generic Integer" integerFourthRootProperty_Integer-- , testIntegralProperty "almost Fourth" integerFourthRootProperty2- , testSmallAndQuick "almost Fourth Int" integerFourthRootProperty2_Int- , testSmallAndQuick "almost Fourth Word" integerFourthRootProperty2_Word--#if WORD_SIZE_IN_BITS == 64- , testCase "maxBound / 8 :: Int" integerFourthRootSpecialCase1_Int- , testCase "maxBound / 16 :: Word" integerFourthRootSpecialCase1_Word- , testCase "maxBound :: Word" integerFourthRootSpecialCase2-#endif- ]- , testIntegralProperty "integerFourthRoot'" integerFourthRoot'Property- , testIntegralProperty "isFourthPower" isFourthPowerProperty- , testIntegralProperty "isFourthPower'" isFourthPower'Property- , testIntegralProperty "exactFourthRoot" exactFourthRootProperty- , testIntegralProperty "isPossibleFourthPower" isPossibleFourthPowerProperty- ]
− test-suite/Math/NumberTheory/Powers/GeneralTests.hs
@@ -1,127 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.GeneralTests--- Copyright: (c) 2016 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Tests for Math.NumberTheory.Powers.General-----{-# LANGUAGE CPP #-}--{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Math.NumberTheory.Powers.GeneralTests- ( testSuite- ) where--import Test.Tasty-import Test.Tasty.HUnit--import Math.NumberTheory.Powers.General-import Math.NumberTheory.TestUtils---- | Check that 'integerRoot' @pow@ returns the largest integer @m@ with @m^pow <= n@.-integerRootProperty :: (Integral a, Integral b) => AnySign a -> Power b -> Bool-integerRootProperty (AnySign n) (Power pow) = (even pow && n < 0)- || (toInteger root ^ pow <= toInteger n && toInteger n < toInteger (root + 1) ^ pow)- where- root = integerRoot pow n---- | Check that the number 'isKthPower' iff its 'integerRoot' is exact.-isKthPowerProperty :: (Integral a, Integral b) => AnySign a -> Power b -> Bool-isKthPowerProperty (AnySign n) (Power pow) = (even pow && n < 0 && not t) || (n /= root ^ pow && not t) || (n == root ^ pow && t)- where- t = isKthPower pow n- root = integerRoot pow n---- | Check that 'exactRoot' returns an exact integer root--- and is consistent with 'isKthPower'.-exactRootProperty :: (Integral a, Integral b) => AnySign a -> Power b -> Bool-exactRootProperty (AnySign n) (Power pow) = case exactRoot pow n of- Nothing -> not (isKthPower pow n)- Just root -> isKthPower pow n && n == root ^ pow---- | Check that 'isPerfectPower' is consistent with 'highestPower'.-isPerfectPowerProperty :: Integral a => AnySign a -> Bool-isPerfectPowerProperty (AnySign n) = (k > 1 && t) || (k == 1 && not t)- where- t = isPerfectPower n- (_, k) = highestPower n---- | Check that the first component of 'highestPower' is square-free.-highestPowerProperty :: Integral a => AnySign a -> Bool-highestPowerProperty (AnySign n) = (n + 1 `elem` [0, 1, 2] && k == 3) || (b ^ k == n && b' == b && k' == 1)- where- (b, k) = highestPower n- (b', k') = highestPower b---- | Check that 'largePFPower' is consistent with documentation.-largePFPowerProperty :: Positive Integer -> Integer -> Bool-largePFPowerProperty (Positive bd) n = bd == 1 || b == 0 || d' /= 0 || n <= b * d * d || any (\p -> gcd n p > 1) [2..bd] || b ^ k == n- where- (b, k) = largePFPower bd n- (d, d') = bd `quotRem` b--highestPowerSpecialCases :: [Assertion]-highestPowerSpecialCases =- -- Freezes before d44a13b.- [ a ( 1013582159576576- , 1013582159576576- , 1)- -- Freezes before d44a13b.- , a ( 1013582159576576 ^ 7- , 1013582159576576- , 7)-- , a ( -2 ^ 63 :: Int- , -2 :: Int- , 63)-- , a ( (2 ^ 63 - 1) ^ 21- , 2 ^ 63 - 1- , 21)-- , a ( 576116746989720969230211509779286598589421531472851155101032940901763389787901933902294777750323196846498573545522289802689311975294763847414975335235584- , 576116746989720969230211509779286598589421531472851155101032940901763389787901933902294777750323196846498573545522289802689311975294763847414975335235584- , 1)-- , a ( -340282366920938463500268095579187314689- , -340282366920938463500268095579187314689- , 1)-- , a ( 268398749 :: Int- , 268398749 :: Int- , 1)-- , a ( 118372752099 :: Int- , 118372752099 :: Int- , 1)-- , a ( 1409777209 :: Int- , 37547 :: Int- , 2)-- , a ( -6277101735386680764856636523970481806547819498980467802113- , -18446744073709551617- , 3)-- , a ( -18446744073709551619 ^ 5- , -18446744073709551619- , 5)- ]- where- a (n, b, k) = assertEqual "highestPower" (b, k) (highestPower n)--testSuite :: TestTree-testSuite = testGroup "General"- [ testIntegral2Property "integerRoot" integerRootProperty- , testIntegral2Property "isKthPower" isKthPowerProperty- , testIntegral2Property "exactRoot" exactRootProperty- , testIntegralProperty "isPerfectPower" isPerfectPowerProperty- , testGroup "highestPower"- ( testIntegralProperty "highestPower" highestPowerProperty- : zipWith (\i a -> testCase ("special case " ++ show i) a) [1..] highestPowerSpecialCases- )- , testSmallAndQuick "largePFPower" largePFPowerProperty- ]
− test-suite/Math/NumberTheory/Powers/ModularTests.hs
@@ -1,91 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.ModularTests--- Copyright: (c) 2017 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Tests for Math.NumberTheory.Powers.Modular-----{-# LANGUAGE CPP #-}--{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Math.NumberTheory.Powers.ModularTests- ( testSuite- ) where--import Test.Tasty-import Test.Tasty.HUnit--import Numeric.Natural--import Math.NumberTheory.Powers.Modular-import Math.NumberTheory.TestUtils--#include "MachDeps.h"--powMod' :: Integer -> Natural -> Integer -> Integer-powMod' = powMod---- | Check that 'powMod' fits between 0 and m - 1.-powModProperty1 :: NonNegative Natural -> AnySign Integer -> Positive Integer -> Bool-powModProperty1 (NonNegative e) (AnySign b) (Positive m)- = let v = powMod' b e m in 0 <= v && v < m---- | Check that 'powMod'' is multiplicative by first argument.-powModProperty2 :: NonNegative Natural -> AnySign Integer -> AnySign Integer -> Positive Integer -> Bool-powModProperty2 (NonNegative e) (AnySign b1) (AnySign b2) (Positive m)- = (powMod' b1 e m * powMod' b2 e m) `mod` m == powMod' (b1 * b2) e m---- | Check that 'powMod' is additive by second argument.-powModProperty3 :: NonNegative Natural -> NonNegative Natural -> AnySign Integer -> Positive Integer -> Bool-powModProperty3 (NonNegative e1) (NonNegative e2) (AnySign b) (Positive m)- = (powMod' b e1 m * powMod' b e2 m) `mod` m == powMod' b (e1 + e2) m---- | Specialized to trigger 'powModInt'.-powModProperty_Int :: AnySign Int -> NonNegative Int -> Positive Int -> Bool-powModProperty_Int (AnySign b) (NonNegative e) (Positive m) = powModInt b e m == fromInteger (powMod' (fromIntegral b) (fromIntegral e) (fromIntegral m))---- | Specialized to trigger 'powModWord'.-powModProperty_Word :: AnySign Word -> NonNegative Word -> Positive Word -> Bool-powModProperty_Word (AnySign b) (NonNegative e) (Positive m) = powModWord b e m == fromInteger (powMod' (fromIntegral b) (fromIntegral e) (fromIntegral m))---- | Specialized to trigger 'powModInteger'.-powModProperty_Integer :: AnySign Integer -> NonNegative Integer -> Positive Integer -> Bool-powModProperty_Integer (AnySign b) (NonNegative e) (Positive m) = powMod b e m == fromInteger (powMod' (fromIntegral b) (fromIntegral e) (fromIntegral m))---- | Specialized to trigger 'powModNatural'.-powModProperty_Natural :: AnySign Natural -> NonNegative Natural -> Positive Natural -> Bool-powModProperty_Natural (AnySign b) (NonNegative e) (Positive m) = powMod b e m == fromInteger (powMod' (fromIntegral b) (fromIntegral e) (fromIntegral m))--#if WORD_SIZE_IN_BITS == 64--- | Large modulo m such that m^2 overflows.-powModSpecialCase1_Int :: Assertion-powModSpecialCase1_Int =- assertEqual "powModInt" (powModInt 3 101 (2^60-1)) 1018105167100379328---- | Large modulo m such that m^2 overflows.-powModSpecialCase1_Word :: Assertion-powModSpecialCase1_Word =- assertEqual "powModWord" (powModWord 3 101 (2^60-1)) 1018105167100379328-#endif--testSuite :: TestTree-testSuite = testGroup "Modular"- [ testGroup "powMod"- [ testSmallAndQuick "range" powModProperty1- , testSmallAndQuick "multiplicative by base" powModProperty2- , testSmallAndQuick "additive by exponent" powModProperty3-- , testSmallAndQuick "powModInt" powModProperty_Int- , testSmallAndQuick "powModWord" powModProperty_Word- , testSmallAndQuick "powModInteger" powModProperty_Integer- , testSmallAndQuick "powModNatural" powModProperty_Natural--#if WORD_SIZE_IN_BITS == 64- , testCase "large modulo :: Int" powModSpecialCase1_Int- , testCase "large modulo :: Word" powModSpecialCase1_Word-#endif- ]- ]
− test-suite/Math/NumberTheory/Powers/SquaresTests.hs
@@ -1,160 +0,0 @@--- |--- Module: Math.NumberTheory.Powers.SquaresTests--- Copyright: (c) 2016 Andrew Lelechenko--- Licence: MIT--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Tests for Math.NumberTheory.Powers.Squares-----{-# LANGUAGE CPP #-}--{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Math.NumberTheory.Powers.SquaresTests- ( testSuite- ) where--import Test.Tasty-import Test.Tasty.HUnit--import Data.Maybe--import Math.NumberTheory.Powers.Squares-import Math.NumberTheory.TestUtils--#include "MachDeps.h"---- | Check that 'integerSquareRoot' returns the largest integer @m@ with @m*m <= n@.------ (m + 1) ^ 2 /= n && m + 1 >= n `div` (m + 1)--- means--- (m + 1) ^ 2 > n--- but without overflow for bounded types-integerSquareRootProperty :: Integral a => NonNegative a -> Bool-integerSquareRootProperty (NonNegative n) = m >=0 && m * m <= n && (m + 1) ^ 2 /= n && m + 1 >= n `div` (m + 1)- where- m = integerSquareRoot n---- | Specialized to trigger 'isqrtInt''.-integerSquareRootProperty_Int :: NonNegative Int -> Bool-integerSquareRootProperty_Int = integerSquareRootProperty---- | Specialized to trigger 'isqrtWord'.-integerSquareRootProperty_Word :: NonNegative Word -> Bool-integerSquareRootProperty_Word = integerSquareRootProperty---- | Specialized to trigger 'isqrtInteger'.-integerSquareRootProperty_Integer :: NonNegative Integer -> Bool-integerSquareRootProperty_Integer = integerSquareRootProperty---- | Check that 'integerSquareRoot' returns the largest integer @m@ with @m*m <= n@, where @n@ has form @k@^2-1.-integerSquareRootProperty2 :: Integral a => Positive a -> Bool-integerSquareRootProperty2 (Positive k) = n < 0- || m >=0 && m * m <= n && (m + 1) ^ 2 /= n && m + 1 >= n `div` (m + 1)- where- n = k ^ 2 - 1- m = integerSquareRoot n---- | Specialized to trigger 'isqrtInt''.-integerSquareRootProperty2_Int :: Positive Int -> Bool-integerSquareRootProperty2_Int = integerSquareRootProperty2---- | Specialized to trigger 'isqrtWord'.-integerSquareRootProperty2_Word :: Positive Word -> Bool-integerSquareRootProperty2_Word = integerSquareRootProperty2---- | Specialized to trigger 'isqrtInteger'.-integerSquareRootProperty2_Integer :: Positive Integer -> Bool-integerSquareRootProperty2_Integer = integerSquareRootProperty2--#if WORD_SIZE_IN_BITS == 64---- | Check that 'integerSquareRoot' of 2^62-1 is 2^31-1, not 2^31.-integerSquareRootSpecialCase1_Int :: Assertion-integerSquareRootSpecialCase1_Int =- assertEqual "integerSquareRoot" (integerSquareRoot (maxBound `div` 2 :: Int)) (2 ^ 31 - 1)---- | Check that 'integerSquareRoot' of 2^62-1 is 2^31-1, not 2^31.-integerSquareRootSpecialCase1_Word :: Assertion-integerSquareRootSpecialCase1_Word =- assertEqual "integerSquareRoot" (integerSquareRoot (maxBound `div` 4 :: Word)) (2 ^ 31 - 1)---- | Check that 'integerSquareRoot' of 2^64-1 is 2^32-1, not 2^32.-integerSquareRootSpecialCase2 :: Assertion-integerSquareRootSpecialCase2 =- assertEqual "integerSquareRoot" (integerSquareRoot (maxBound :: Word)) (2 ^ 32 - 1)--#endif---- | Check that 'integerSquareRoot'' returns the largest integer @r@ with @r*r <= n@.-integerSquareRoot'Property :: Integral a => NonNegative a -> Bool-integerSquareRoot'Property (NonNegative n) = m >=0 && m * m <= n && (m + 1) ^ 2 /= n && m + 1 >= n `div` (m + 1)- where- m = integerSquareRoot' n---- | Check that the number 'isSquare' iff its 'integerSquareRoot' is exact.-isSquareProperty :: Integral a => AnySign a -> Bool-isSquareProperty (AnySign n) = (n < 0 && not t) || (n /= m * m && not t) || (n == m * m && t)- where- t = isSquare n- m = integerSquareRoot n---- | Check that the number 'isSquare'' iff its 'integerSquareRoot'' is exact.-isSquare'Property :: Integral a => NonNegative a -> Bool-isSquare'Property (NonNegative n) = (n /= m * m && not t) || (n == m * m && t)- where- t = isSquare' n- m = integerSquareRoot' n---- | Check that 'exactSquareRoot' returns an exact integer square root--- and is consistent with 'isSquare'.-exactSquareRootProperty :: Integral a => AnySign a -> Bool-exactSquareRootProperty (AnySign n) = case exactSquareRoot n of- Nothing -> not (isSquare n)- Just m -> isSquare n && n == m * m---- | Check that 'isPossibleSquare' is consistent with 'exactSquareRoot'--- and that 'isPossibleSquare2' is a refinement of 'isPossibleSquare'.-isPossibleSquareProperty :: Integral a => NonNegative a -> Bool-isPossibleSquareProperty (NonNegative n) = t || not t && not t2 && isNothing m- where- t = isPossibleSquare n- t2 = isPossibleSquare2 n- m = exactSquareRoot n---- | Check that 'isPossibleSquare2'' is consistent with 'exactSquareRoot'.-isPossibleSquare2Property :: Integral a => NonNegative a -> Bool-isPossibleSquare2Property (NonNegative n) = t || not t && isNothing m- where- t = isPossibleSquare2 n- m = exactSquareRoot n---testSuite :: TestTree-testSuite = testGroup "Squares"- [ testGroup "integerSquareRoot"- [ testIntegralProperty "generic" integerSquareRootProperty- , testSmallAndQuick "generic Int" integerSquareRootProperty_Int- , testSmallAndQuick "generic Word" integerSquareRootProperty_Word- , testSmallAndQuick "generic Integer" integerSquareRootProperty_Integer-- , testIntegralProperty "almost square" integerSquareRootProperty2- , testSmallAndQuick "almost square Int" integerSquareRootProperty2_Int- , testSmallAndQuick "almost square Word" integerSquareRootProperty2_Word- , testSmallAndQuick "almost square Integer" integerSquareRootProperty2_Integer--#if WORD_SIZE_IN_BITS == 64- , testCase "maxBound / 2 :: Int" integerSquareRootSpecialCase1_Int- , testCase "maxBound / 4 :: Word" integerSquareRootSpecialCase1_Word- , testCase "maxBound :: Word" integerSquareRootSpecialCase2-#endif- ]-- , testIntegralProperty "integerSquareRoot'" integerSquareRoot'Property- , testIntegralProperty "isSquare" isSquareProperty- , testIntegralProperty "isSquare'" isSquare'Property- , testIntegralProperty "exactSquareRoot" exactSquareRootProperty- , testIntegralProperty "isPossibleSquare" isPossibleSquareProperty- , testIntegralProperty "isPossibleSquare2" isPossibleSquare2Property- ]
test-suite/Math/NumberTheory/PrefactoredTests.hs view
@@ -7,8 +7,6 @@ -- Tests for Math.NumberTheory.Prefactored -- -{-# LANGUAGE CPP #-}- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.PrefactoredTests@@ -18,15 +16,15 @@ import Test.Tasty import Control.Arrow (second)+import Data.Euclidean import Data.List (tails) import Numeric.Natural -import Math.NumberTheory.Euclidean (Euclidean, coprime) import Math.NumberTheory.Euclidean.Coprimes import Math.NumberTheory.Prefactored import Math.NumberTheory.TestUtils -isValid :: Euclidean a => Prefactored a -> Bool+isValid :: (Eq a, Num a, GcdDomain a, Euclidean a) => Prefactored a -> Bool isValid pref = abs n == abs (product (map (uncurry (^)) fs)) && and [ coprime g h | ((g, _) : gs) <- tails fs, (h, _) <- gs ]
test-suite/Math/NumberTheory/Primes/CountingTests.hs view
@@ -36,7 +36,9 @@ , (10^10, 455052511) , (10^11, 4118054813) , (10^12, 37607912018)- , (10^13, 346065536839)+ -- Enable tests below to validate any changes to 'primeCount' implementation:+ -- certain routines are not triggered until very large numbers.+ -- , (10^13, 346065536839) -- , (10^14, 3204941750802) -- , (10^15, 29844570422669) -- , (10^16, 279238341033925)@@ -77,30 +79,27 @@ -- | Check that values of 'nthPrime' are positive.-nthPrimeProperty1 :: Positive Integer -> Bool-nthPrimeProperty1 (Positive n) = n > nthPrimeMaxArg- || unPrime (nthPrime n) > 0+nthPrimeProperty1 :: Positive Int -> Bool+nthPrimeProperty1 (Positive n) = unPrime (nthPrime n) > 0 -- | Check that 'nthPrime' is monotonically increasing function.-nthPrimeProperty2 :: Positive Integer -> Positive Integer -> Bool+nthPrimeProperty2 :: Positive Int -> Positive Int -> Bool nthPrimeProperty2 (Positive n1) (Positive n2)- = n1 > nthPrimeMaxArg- || n2 > nthPrimeMaxArg- || n1 <= n2 && p1 <= p2+ = n1 <= n2 && p1 <= p2 || n1 > n2 && p1 >= p2 where p1 = nthPrime n1 p2 = nthPrime n2 -- | Check that values of 'nthPrime' are prime.-nthPrimeProperty3 :: Positive Integer -> Bool+nthPrimeProperty3 :: Positive Int -> Bool nthPrimeProperty3 (Positive n) = isPrime $ unPrime $ nthPrime n -- | Check tabulated values. nthPrimeSpecialCases :: [Assertion] nthPrimeSpecialCases = map a table where- a (n, m) = assertBool "nthPrime" $ n > unPrime (nthPrime m)+ a (n, m) = assertBool "nthPrime" $ n > unPrime (nthPrime (fromInteger m)) -- | Check that values of 'approxPrimeCount' are non-negative.@@ -120,7 +119,7 @@ -- | Check that 'nthPrimeApprox' is consistent with 'nthPrimeApproxUnderestimateLimit'. nthPrimeApproxProperty2 :: Positive Integer -> Bool nthPrimeApproxProperty2 (Positive a) = a >= nthPrimeApproxUnderestimateLimit- || toInteger (nthPrimeApprox a) <= unPrime (nthPrime (toInteger a))+ || nthPrimeApprox a <= unPrime (nthPrime (fromInteger a)) testSuite :: TestTree
test-suite/Math/NumberTheory/Primes/FactorisationTests.hs view
@@ -16,16 +16,27 @@ import Test.Tasty import Test.Tasty.HUnit +import Control.Arrow import Control.Monad (zipWithM_) import Data.List (nub, sort)+import Data.Maybe -import Math.NumberTheory.Primes.Factorisation-import Math.NumberTheory.Primes.Testing+import Math.NumberTheory.Primes import Math.NumberTheory.TestUtils specialCases :: [(Integer, [(Integer, Word)])] specialCases =- [ (4181339589500970917,[(15034813,1),(278110515209,1)])+ [ (35,[(5,1),(7,1)])+ , (75,[(3,1),(5,2)])+ , (65521^2,[(65521,2)])+ , (65537^2,[(65537,2)])+ , (2147483647, [(2147483647, 1)])+ , (4294967291, [(4294967291, 1)])+ , (19000000000000000001, [(19000000000000000001, 1)])+ , (3 * 5^2 * 7^21, [(3,1), (5,2), (7, 21)])+ , (9223372036854775783, [(9223372036854775783, 1)])+ , (18446744073709551557, [(18446744073709551557, 1)])+ , (4181339589500970917,[(15034813,1),(278110515209,1)]) , (4181339589500970918,[(2,1),(3,2),(7,1),(2595773,1),(12784336241,1)]) , (2227144715990344929,[(3,1),(317,1),(17381911,1),(134731889,1)]) , (10489674846272137811130167281,[(1312601,1),(9555017,1),(836368815445393,1)])@@ -43,9 +54,12 @@ , (16757651897802863152387219654541878160,[(2,4),(5,1),(12323,1),(1424513,1),(6205871923,1),(1922815011093901,1)]) , (16757651897802863152387219654541878162,[(2,1),(29,1),(78173,1),(401529283,1),(1995634649,1),(4612433663779,1)]) , (16757651897802863152387219654541878163,[(11,1),(31,1),(112160981904206269,1),(438144115295608147,1)])- , (16757651897802863152387219654541878166,[(2,1),(23,1),(277,1),(505353699591289,1),(2602436338718275457,1)])+ -- , (16757651897802863152387219654541878166,[(2,1),(23,1),(277,1),(505353699591289,1),(2602436338718275457,1)]) , ((10 ^ 80 - 1) `div` 9, [(11,1),(17,1),(41,1),(73,1),(101,1),(137,1),(271,1),(3541,1),(9091,1),(27961,1), (1676321,1),(5070721,1),(5882353,1),(5964848081,1),(19721061166646717498359681,1)])+ , (623506907396924300595652906937, [(300137,1),(825131,2),(1746779,2)])+ , (626472835738582668418814215862, [(2,1),(150211,1),(11746151,2),(122939,2)])+ , (638396704483535474833679624037, [(3,1),(11,2),(100519,1),(104281,2),(1268419,2)]) ] lazyCases :: [(Integer, [(Integer, Word)])]@@ -57,28 +71,36 @@ ) ] +shortenNumber :: Integer -> String+shortenNumber n+ | l <= 10 = xs+ | otherwise = take 5 xs ++ "..." ++ drop (l - 5) xs+ where+ xs = show n+ l = length xs+ factoriseProperty1 :: Assertion-factoriseProperty1 = assertEqual "0" [] (factorise 1)+factoriseProperty1 = assertEqual "0" [] (factorise (1 :: Int)) factoriseProperty2 :: Positive Integer -> Bool factoriseProperty2 (Positive n) = factorise n == factorise (negate n) factoriseProperty3 :: Positive Integer -> Bool-factoriseProperty3 (Positive n) = all (isPrime . fst) (factorise n)+factoriseProperty3 (Positive n) = all (isJust . isPrime . unPrime . fst) (factorise n) factoriseProperty4 :: Positive Integer -> Bool-factoriseProperty4 (Positive n) = bases == nub (sort bases)+factoriseProperty4 (Positive n) = sort bases == nub (sort bases) where bases = map fst $ factorise n factoriseProperty5 :: Positive Integer -> Bool-factoriseProperty5 (Positive n) = product (map (uncurry (^)) (factorise n)) == n+factoriseProperty5 (Positive n) = product (map (\(p, k) -> unPrime p ^ k) (factorise n)) == n factoriseProperty6 :: (Integer, [(Integer, Word)]) -> Assertion-factoriseProperty6 (n, fs) = assertEqual (show n) (sort fs) (sort (factorise n))+factoriseProperty6 (n, fs) = assertEqual (show n) (sort fs) (sort $ map (first unPrime) $ factorise n) factoriseProperty7 :: (Integer, [(Integer, Word)]) -> Assertion-factoriseProperty7 (n, fs) = zipWithM_ (assertEqual (show n)) fs (factorise n)+factoriseProperty7 (n, fs) = zipWithM_ (assertEqual (show n)) fs (map (first unPrime) $ factorise n) testSuite :: TestTree testSuite = testGroup "Factorisation"@@ -86,10 +108,10 @@ [ testCase "0" factoriseProperty1 , testSmallAndQuick "negate" factoriseProperty2 , testSmallAndQuick "bases are prime" factoriseProperty3- , testSmallAndQuick "bases are ordered and distinct" factoriseProperty4+ , testSmallAndQuick "bases are distinct" factoriseProperty4 , testSmallAndQuick "factorback" factoriseProperty5 ] ++- map (\x -> testCase ("special case " ++ show (fst x)) (factoriseProperty6 x)) specialCases+ map (\x -> testCase ("special case " ++ shortenNumber (fst x)) (factoriseProperty6 x)) specialCases ++- map (\x -> testCase ("laziness " ++ show (fst x)) (factoriseProperty7 x)) lazyCases+ map (\x -> testCase ("laziness " ++ shortenNumber (fst x)) (factoriseProperty7 x)) lazyCases ]
test-suite/Math/NumberTheory/Primes/SequenceTests.hs view
@@ -7,6 +7,7 @@ ) where import Test.Tasty+import Test.Tasty.HUnit import Data.Bits import Data.Maybe@@ -35,7 +36,7 @@ => Proxy a -> Int -> Bool-toEnumProperty _ n = n <= 0 || unPrime (toEnum n :: Prime a) == fromInteger (unPrime (nthPrime (toInteger n)))+toEnumProperty _ n = n <= 0 || unPrime (toEnum n :: Prime a) == fromInteger (unPrime (nthPrime n)) fromEnumProperty :: (Enum (Prime a), Integral a)@@ -55,6 +56,29 @@ -> Bool predProperty p = unPrime p <= 2 || all (isNothing . isPrime) [unPrime (pred p) + 1 .. unPrime p - 1] +enumFrom2To2 :: Assertion+enumFrom2To2 = assertEqual "should be equal"+ [two]+ [two..two]+ where+ two = minBound :: Prime Word++enumFrom65500To65600 :: Assertion+enumFrom65500To65600 = assertEqual "should be equal"+ [65519, 65521, 65537, 65539, 65543, 65551, 65557, 65563, 65579, 65581, 65587, 65599]+ (map unPrime [low..high])+ where+ low = nextPrime (65500 :: Word)+ high = precPrime (65600 :: Word)++enumFrom2To100000 :: Assertion+enumFrom2To100000 = assertEqual "should be equal"+ (takeWhile (<= high) [low..])+ [low..high]+ where+ low = minBound :: Prime Word+ high = precPrime (100000 :: Word)+ enumFromProperty :: (Ord a, Enum (Prime a)) => Prime a@@ -119,6 +143,9 @@ , testSmallAndQuick "Integer" (predProperty @Integer) , testSmallAndQuick "Natural" (predProperty @Natural) ]+ , testCase "[2..2] == [2]" enumFrom2To2+ , testCase "[65500..65600]" enumFrom65500To65600+ , testCase "[2..100000]" enumFrom2To100000 , testGroup "enumFrom" [ testSmallAndQuick "Int" (enumFromProperty @Int) , testSmallAndQuick "Word" (enumFromProperty @Word)
test-suite/Math/NumberTheory/Primes/SieveTests.hs view
@@ -7,11 +7,10 @@ -- Tests for Math.NumberTheory.Primes.Sieve -- -{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}-{-# OPTIONS_GHC -fno-warn-deprecations #-} module Math.NumberTheory.Primes.SieveTests ( testSuite@@ -22,13 +21,13 @@ import Test.Tasty import Test.Tasty.HUnit +import Data.Bits import Data.Int import Data.Proxy (Proxy(..)) import Data.Word import Numeric.Natural (Natural) -import Math.NumberTheory.Primes (Prime, unPrime)-import Math.NumberTheory.Primes.Sieve+import Math.NumberTheory.Primes (Prime, unPrime, primes, nextPrime, precPrime, UniqueFactorisation) import Math.NumberTheory.Primes.Testing import Math.NumberTheory.TestUtils @@ -38,9 +37,6 @@ lim2 :: Num a => a lim2 = 100000 -lim3 :: Num a => a-lim3 = 1000- -- | Check that 'primes' matches 'isPrime'. primesProperty1 :: forall a. (Integral a, Show a) => Proxy a -> Assertion primesProperty1 _ = assertEqual "primes matches isPrime"@@ -55,37 +51,21 @@ -- | Check that 'primeList' from 'primeSieve' matches truncated 'primes'. primeSieveProperty1 :: AnySign Integer -> Bool primeSieveProperty1 (AnySign highBound')- = primeList (primeSieve highBound)- == takeWhile ((<= (highBound `max` 7)) . unPrime) primes+ = [nextPrime 2 .. precPrime highBound]+ == takeWhile (\p -> unPrime p <= highBound) primes where- highBound = highBound' `rem` lim1+ highBound = max 2 (highBound' `rem` lim1) -- | Check that 'primeList' from 'psieveList' matches 'primes'.-psieveListProperty1 :: forall a. (Integral a, Show a) => Proxy a -> Assertion+psieveListProperty1 :: forall a. (Integral a, Show a, Enum (Prime a), Bits a, UniqueFactorisation a) => Proxy a -> Assertion psieveListProperty1 _ = assertEqual "primes == primeList . psieveList" (take lim2 primes :: [Prime a])- (take lim2 $ concatMap primeList psieveList)+ (take lim2 [nextPrime 1..]) -psieveListProperty2 :: forall a. (Integral a, Show a) => Proxy a -> Assertion+psieveListProperty2 :: forall a. (Integral a, Bounded a, Show a) => Proxy a -> Assertion psieveListProperty2 _ = assertEqual "primes == primeList . psieveList"- (primes :: [Prime a])- (concat $ takeWhile (not . null) $ map primeList psieveList)---- | Check that 'sieveFrom' matches 'primeList' of 'psieveFrom'.-sieveFromProperty1 :: AnySign Integer -> Bool-sieveFromProperty1 (AnySign lowBound')- = take lim3 (sieveFrom lowBound)- == take lim3 (filter ((>= lowBound) . unPrime) (concatMap primeList $ psieveFrom lowBound))- where- lowBound = lowBound' `rem` lim1---- | Check that 'sieveFrom' matches 'isPrime' near 0.-sieveFromProperty2 :: AnySign Integer -> Bool-sieveFromProperty2 (AnySign lowBound')- = take lim3 (map unPrime (sieveFrom lowBound))- == take lim3 (filter (isPrime . toInteger) [lowBound `max` 0 ..])- where- lowBound = lowBound' `rem` lim1+ (map unPrime primes :: [a])+ (filter (isPrime . toInteger) [0..maxBound]) testSuite :: TestTree testSuite = testGroup "Sieve"@@ -111,9 +91,5 @@ , testCase "Int16" (psieveListProperty2 (Proxy :: Proxy Int16)) , testCase "Word8" (psieveListProperty2 (Proxy :: Proxy Word8)) , testCase "Word16" (psieveListProperty2 (Proxy :: Proxy Word16))- ]- , testGroup "sieveFrom"- [ testSmallAndQuick "psieveFrom" sieveFromProperty1- , testSmallAndQuick "isPrime near 0" sieveFromProperty2 ] ]
test-suite/Math/NumberTheory/Primes/TestingTests.hs view
@@ -16,8 +16,6 @@ import Test.Tasty import Test.Tasty.HUnit -import GHC.Integer.GMP.Internals (nextPrimeInteger)- import Math.NumberTheory.Primes.Testing import Math.NumberTheory.TestUtils @@ -31,28 +29,23 @@ isPrimeProperty2 n = isPrime n == isPrime (negate n) isPrimeProperty3 :: Assertion-isPrimeProperty3 = assertBool "Carmichael pseudoprimes" $ all (not . isPrime) pseudoprimes+isPrimeProperty3 = assertBool "Carmichael pseudoprimes" $ not $ any isPrime pseudoprimes where -- OEIS A002997 pseudoprimes = [561, 1105, 1729, 2465, 2821, 6601, 8911, 10585, 15841, 29341, 41041, 46657, 52633, 62745, 63973, 75361, 101101, 115921, 126217, 162401, 172081, 188461, 252601, 278545, 294409, 314821, 334153, 340561, 399001, 410041, 449065, 488881, 512461] isPrimeProperty4 :: Assertion-isPrimeProperty4 = assertBool "strong pseudoprimes to base 2" $ all (not . isPrime) pseudoprimes+isPrimeProperty4 = assertBool "strong pseudoprimes to base 2" $ not $ any isPrime pseudoprimes where -- OEIS A001262 pseudoprimes = [2047, 3277, 4033, 4681, 8321, 15841, 29341, 42799, 49141, 52633, 65281, 74665, 80581, 85489, 88357, 90751, 104653, 130561, 196093, 220729, 233017, 252601, 253241, 256999, 271951, 280601, 314821, 357761, 390937, 458989, 476971, 486737] isPrimeProperty5 :: Assertion-isPrimeProperty5 = assertBool "strong Lucas pseudoprimes" $ all (not . isPrime) pseudoprimes+isPrimeProperty5 = assertBool "strong Lucas pseudoprimes" $ not $ any isPrime pseudoprimes where -- OEIS A217255 pseudoprimes = [5459, 5777, 10877, 16109, 18971, 22499, 24569, 25199, 40309, 58519, 75077, 97439, 100127, 113573, 115639, 130139, 155819, 158399, 161027, 162133, 176399, 176471, 189419, 192509, 197801, 224369, 230691, 231703, 243629, 253259, 268349, 288919, 313499, 324899] -isPrimeProperty6 :: NonNegative Integer -> Bool-isPrimeProperty6 (NonNegative n) = if isPrime n- then nextPrimeInteger (n - 1) == n- else isPrime (nextPrimeInteger n)- isStrongFermatPPProperty :: NonNegative Integer -> Integer -> Bool isStrongFermatPPProperty (NonNegative n) b = not (isPrime n) || isStrongFermatPP n b @@ -64,7 +57,6 @@ , testCase "Carmichael pseudoprimes" isPrimeProperty3 , testCase "strong pseudoprimes base 2" isPrimeProperty4 , testCase "strong Lucas pseudoprimes" isPrimeProperty5- , testSmallAndQuick "matches GMP" isPrimeProperty6 ] , testGroup "isStrongFermatPP" [ testSmallAndQuick "matches isPrime" isStrongFermatPPProperty
test-suite/Math/NumberTheory/PrimesTests.hs view
@@ -7,7 +7,9 @@ -- Tests for Math.NumberTheory.Primes -- -{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+ {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.PrimesTests@@ -16,21 +18,42 @@ import Test.Tasty -import Math.NumberTheory.Primes (unPrime)-import Math.NumberTheory.Primes.Sieve (primeSieve, primeList, primes)+import Data.Bits+import Data.Int+import Data.Proxy++import Math.NumberTheory.Primes+import qualified Math.NumberTheory.Primes.IntSet as PS import Math.NumberTheory.TestUtils primesSumWonk :: Int -> Int-primesSumWonk upto = sum . takeWhile (< upto) . map unPrime . primeList $ primeSieve (toInteger upto)+primesSumWonk upto = sum $ map unPrime [nextPrime 2 .. precPrime upto] primesSum :: Int -> Int-primesSum upto = sum . takeWhile (< upto) . map unPrime $ primes+primesSum upto = sum . takeWhile (<= upto) . map unPrime $ primes primesSumProperty :: NonNegative Int -> Bool-primesSumProperty (NonNegative n) = primesSumWonk n == primesSum n+primesSumProperty (NonNegative n) = n < 2 || primesSumWonk n == primesSum n +symmetricDifferenceProperty :: [Prime Int] -> [Prime Int] -> Bool+symmetricDifferenceProperty xs ys = z1 == z2+ where+ x = PS.fromList xs+ y = PS.fromList ys+ z1 = (x PS.\\ PS.unPrimeIntSet y) <> (y PS.\\ PS.unPrimeIntSet x)+ z2 = PS.symmetricDifference x y +toPrimeIntegralTest :: forall a b. (Bits a, Integral a, Bits b, Integral b) => Proxy a -> Prime b -> Bool+toPrimeIntegralTest _ p =+ toIntegralSized (unPrime p) == (fmap unPrime (toPrimeIntegral p) :: Maybe a)+ testSuite :: TestTree testSuite = testGroup "Primes" [ testSmallAndQuick "primesSum" primesSumProperty+ , testSmallAndQuick "symmetricDifference" symmetricDifferenceProperty+ , testGroup "toPrimeIntegral"+ [ testSmallAndQuick "Int -> Integer" $ toPrimeIntegralTest @Integer @Int Proxy+ , testSmallAndQuick "Int -> Int8" $ toPrimeIntegralTest @Int8 @Int Proxy+ , testSmallAndQuick "Integer -> Int" $ toPrimeIntegralTest @Int @Integer Proxy+ ] ]
test-suite/Math/NumberTheory/Recurrences/BilinearTests.hs view
@@ -7,6 +7,8 @@ -- Tests for Math.NumberTheory.Recurrences.Bilinear -- +{-# LANGUAGE TypeApplications #-}+ {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Recurrences.BilinearTests@@ -16,164 +18,212 @@ import Test.Tasty import Test.Tasty.HUnit +import Control.Arrow+import Data.List (sort)+import qualified Data.List.Infinite as Inf import Data.Ratio -import Math.NumberTheory.Recurrences.Bilinear (bernoulli, binomial, euler,- eulerian1, eulerian2,- eulerPolyAt1, lah, stirling1,- stirling2)+import Math.NumberTheory.Primes+import Math.NumberTheory.Recurrences.Bilinear import Math.NumberTheory.TestUtils -binomialProperty1 :: NonNegative Int -> Bool-binomialProperty1 (NonNegative i) = length (binomial !! i) == i + 1+binomialProperty1 :: Word -> Bool+binomialProperty1 i = length (binomial @Integer Inf.!! i) == fromIntegral i + 1 -binomialProperty2 :: NonNegative Int -> Bool-binomialProperty2 (NonNegative i) = binomial !! i !! 0 == 1+binomialProperty2 :: Word -> Bool+binomialProperty2 i = take 1 (binomial @Integer Inf.!! i) == [1] -binomialProperty3 :: NonNegative Int -> Bool-binomialProperty3 (NonNegative i) = binomial !! i !! i == 1+binomialProperty3 :: Word -> Bool+binomialProperty3 i = binomial @Integer Inf.!! i !! fromIntegral i == 1 binomialProperty4 :: Positive Int -> Positive Int -> Bool binomialProperty4 (Positive i) (Positive j) = j >= i- || binomial !! i !! j- == binomial !! (i - 1) !! (j - 1)- + binomial !! (i - 1) !! j+ || binomial @Integer Inf.!! fromIntegral i !! j+ == binomial Inf.!! (fromIntegral i - 1) !! (j - 1)+ + binomial Inf.!! (fromIntegral i - 1) !! j -stirling1Property1 :: NonNegative Int -> Bool-stirling1Property1 (NonNegative i) = length (stirling1 !! i) == i + 1+binomialProperty5 :: Word -> Word -> Bool+binomialProperty5 n m' = n > 100000 ||+ sort (map (first unPrime) (factorise (binomial Inf.!! n !! fromIntegral m))) ==+ sort (map (first (toInteger . unPrime)) (binomialFactors n m))+ where+ m = m' `mod` (n + 1) -stirling1Property2 :: NonNegative Int -> Bool-stirling1Property2 (NonNegative i)- = stirling1 !! i !! 0- == if i == 0 then 1 else 0+binomialProperty6 :: Word -> Word -> Bool+binomialProperty6 n m' = n > 100000 ||+ binomial Inf.!! n !! fromIntegral m ==+ product (map (\(p, k) -> toInteger (unPrime p) ^ k) (binomialFactors n m))+ where+ m = m' `mod` (n + 1) -stirling1Property3 :: NonNegative Int -> Bool-stirling1Property3 (NonNegative i) = stirling1 !! i !! i == 1+binomialRotatedProperty2 :: Word -> Bool+binomialRotatedProperty2 i = Inf.head (binomialRotated @Integer Inf.!! i) == 1 +binomialRotatedProperty3 :: Word -> Bool+binomialRotatedProperty3 i = Inf.head (binomialRotated @Integer) Inf.!! i == 1++binomialRotatedProperty4 :: Positive Int -> Positive Int -> Bool+binomialRotatedProperty4 (Positive i) (Positive j)+ = binomialRotated @Integer Inf.!! fromIntegral i Inf.!! fromIntegral j+ == binomialRotated Inf.!! fromIntegral i Inf.!! (fromIntegral j - 1)+ + binomialRotated Inf.!! (fromIntegral i - 1) Inf.!! fromIntegral j++binomialLineProperty1 :: Word -> Word -> Bool+binomialLineProperty1 i j+ = j >= i+ || binomial @Integer Inf.!! i !! fromIntegral j == binomialLine (toInteger i) !! fromIntegral j++binomialLineProperty2 :: Word -> Word -> Bool+binomialLineProperty2 i j+ = binomialRotated @Integer Inf.!! i Inf.!! j == binomialLine (toInteger (i + j)) !! fromIntegral j++binomialDiagonalProperty1 :: Word -> Word -> Bool+binomialDiagonalProperty1 i j+ = binomialRotated @Integer Inf.!! i Inf.!! j == binomialDiagonal (toInteger i) Inf.!! j++binomialDiagonalProperty2 :: Word -> Word -> Bool+binomialDiagonalProperty2 i j+ = binomial @Integer Inf.!! (i + j) !! fromIntegral j == binomialDiagonal (toInteger i) Inf.!! j++stirling1Property1 :: Word -> Bool+stirling1Property1 i = length (stirling1 Inf.!! i) == fromIntegral i + 1++stirling1Property2 :: Word -> Bool+stirling1Property2 i+ = take 1 (stirling1 Inf.!! i)+ == [if i == 0 then 1 else 0]++stirling1Property3 :: Word -> Bool+stirling1Property3 i = stirling1 Inf.!! i !! fromIntegral i == 1+ stirling1Property4 :: Positive Int -> Positive Int -> Bool stirling1Property4 (Positive i) (Positive j) = j >= i- || stirling1 !! i !! j- == stirling1 !! (i - 1) !! (j - 1)- + (toInteger i - 1) * stirling1 !! (i - 1) !! j+ || stirling1 Inf.!! fromIntegral i !! j+ == stirling1 Inf.!! (fromIntegral i - 1) !! (j - 1)+ + (toInteger i - 1) * stirling1 Inf.!! (fromIntegral i - 1) !! j -stirling2Property1 :: NonNegative Int -> Bool-stirling2Property1 (NonNegative i) = length (stirling2 !! i) == i + 1+stirling2Property1 :: Word -> Bool+stirling2Property1 i = length (stirling2 Inf.!! i) == fromIntegral i + 1 -stirling2Property2 :: NonNegative Int -> Bool-stirling2Property2 (NonNegative i)- = stirling2 !! i !! 0- == if i == 0 then 1 else 0+stirling2Property2 :: Word -> Bool+stirling2Property2 i+ = take 1 (stirling2 Inf.!! i)+ == [if i == 0 then 1 else 0] -stirling2Property3 :: NonNegative Int -> Bool-stirling2Property3 (NonNegative i) = stirling2 !! i !! i == 1+stirling2Property3 :: Word -> Bool+stirling2Property3 i = stirling2 Inf.!! i !! fromIntegral i == 1 stirling2Property4 :: Positive Int -> Positive Int -> Bool stirling2Property4 (Positive i) (Positive j) = j >= i- || stirling2 !! i !! j- == stirling2 !! (i - 1) !! (j - 1)- + toInteger j * stirling2 !! (i - 1) !! j+ || stirling2 Inf.!! fromIntegral i !! j+ == stirling2 Inf.!! (fromIntegral i - 1) !! (j - 1)+ + toInteger j * stirling2 Inf.!! (fromIntegral i - 1) !! j -lahProperty1 :: NonNegative Int -> Bool-lahProperty1 (NonNegative i) = length (lah !! i) == i + 1+lahProperty1 :: Word -> Bool+lahProperty1 i = length (lah Inf.!! i) == fromIntegral i + 1 -lahProperty2 :: NonNegative Int -> Bool-lahProperty2 (NonNegative i)- = lah !! i !! 0- == product [1 .. i+1]+lahProperty2 :: Word -> Bool+lahProperty2 i+ = take 1 (lah Inf.!! i)+ == [product [1 .. i+1]] -lahProperty3 :: NonNegative Int -> Bool-lahProperty3 (NonNegative i) = lah !! i !! i == 1+lahProperty3 :: Word -> Bool+lahProperty3 i = lah Inf.!! i !! fromIntegral i == 1 lahProperty4 :: Positive Int -> Positive Int -> Bool lahProperty4 (Positive i) (Positive j) = j >= i- || lah !! i !! j- == sum [ stirling1 !! (i + 1) !! k * stirling2 !! k !! (j + 1) | k <- [j + 1 .. i + 1] ]+ || lah Inf.!! fromIntegral i !! j+ == sum [ stirling1 Inf.!! (fromIntegral i + 1) !! k * stirling2 Inf.!! fromIntegral k !! (j + 1) | k <- [j + 1 .. i + 1] ] -eulerian1Property1 :: NonNegative Int -> Bool-eulerian1Property1 (NonNegative i) = length (eulerian1 !! i) == i+eulerian1Property1 :: Word -> Bool+eulerian1Property1 i = length (eulerian1 Inf.!! i) == fromIntegral i eulerian1Property2 :: Positive Int -> Bool-eulerian1Property2 (Positive i) = eulerian1 !! i !! 0 == 1+eulerian1Property2 (Positive i)+ = take 1 (eulerian1 Inf.!! fromIntegral i)+ == [1] eulerian1Property3 :: Positive Int -> Bool-eulerian1Property3 (Positive i) = eulerian1 !! i !! (i - 1) == 1+eulerian1Property3 (Positive i) = eulerian1 Inf.!! fromIntegral i !! (i - 1) == 1 eulerian1Property4 :: Positive Int -> Positive Int -> Bool eulerian1Property4 (Positive i) (Positive j) = j >= i - 1- || eulerian1 !! i !! j- == (toInteger $ i - j) * eulerian1 !! (i - 1) !! (j - 1)- + (toInteger j + 1) * eulerian1 !! (i - 1) !! j+ || eulerian1 Inf.!! fromIntegral i !! j+ == toInteger (i - j) * eulerian1 Inf.!! (fromIntegral i - 1) !! (j - 1)+ + (toInteger j + 1) * eulerian1 Inf.!! (fromIntegral i - 1) !! j -eulerian2Property1 :: NonNegative Int -> Bool-eulerian2Property1 (NonNegative i) = length (eulerian2 !! i) == i+eulerian2Property1 :: Word -> Bool+eulerian2Property1 i = length (eulerian2 Inf.!! i) == fromIntegral i eulerian2Property2 :: Positive Int -> Bool eulerian2Property2 (Positive i)- = eulerian2 !! i !! 0 == 1+ = take 1 (eulerian2 Inf.!! fromIntegral i)+ == [1] eulerian2Property3 :: Positive Int -> Bool eulerian2Property3 (Positive i)- = eulerian2 !! i !! (i - 1)+ = eulerian2 Inf.!! fromIntegral i !! (i - 1) == product [1 .. toInteger i] eulerian2Property4 :: Positive Int -> Positive Int -> Bool eulerian2Property4 (Positive i) (Positive j) = j >= i - 1- || eulerian2 !! i !! j- == (toInteger $ 2 * i - j - 1) * eulerian2 !! (i - 1) !! (j - 1)- + (toInteger j + 1) * eulerian2 !! (i - 1) !! j+ || eulerian2 Inf.!! fromIntegral i !! j+ == toInteger (2 * i - j - 1) * eulerian2 Inf.!! (fromIntegral i - 1) !! (j - 1)+ + (toInteger j + 1) * eulerian2 Inf.!! (fromIntegral i - 1) !! j bernoulliSpecialCase1 :: Assertion-bernoulliSpecialCase1 = assertEqual "B_0 = 1" (bernoulli !! 0) 1+bernoulliSpecialCase1 = assertEqual "B_0 = 1" (Inf.head bernoulli) 1 bernoulliSpecialCase2 :: Assertion-bernoulliSpecialCase2 = assertEqual "B_1 = -1/2" (bernoulli !! 1) (- 1 % 2)+bernoulliSpecialCase2 = assertEqual "B_1 = -1/2" (bernoulli Inf.!! 1) (- 1 % 2) -bernoulliProperty1 :: NonNegative Int -> Bool-bernoulliProperty1 (NonNegative m)- = case signum (bernoulli !! m) of+bernoulliProperty1 :: Word -> Bool+bernoulliProperty1 m+ = case signum (bernoulli Inf.!! m) of 1 -> m == 0 || m `mod` 4 == 2 0 -> m /= 1 && odd m- -1 -> m == 1 || (m /= 0 && m `mod` 4 == 0)+ -1 -> m == 1 || (m /= 0 && m `rem` 4 == 0) _ -> False -bernoulliProperty2 :: NonNegative Int -> Bool-bernoulliProperty2 (NonNegative m)- = bernoulli !! m- == (if m == 0 then 1 else 0)- - sum [ bernoulli !! k- * (binomial !! m !! k % (toInteger $ m - k + 1))- | k <- [0 .. m - 1]+bernoulliProperty2 :: Word -> (Rational, Rational)+bernoulliProperty2 m =+ ( bernoulli Inf.!! m+ , (if m == 0 then 1 else 0)+ - sum [ bernoulli Inf.!! k+ * (binomial Inf.!! m !! fromIntegral k % toInteger (m - k + 1))+ | k <- map fromIntegral [(0 :: Int) .. fromIntegral m - 1] ]+ ) -- | For every odd positive integer @n@, @E_n@ is @0@. eulerProperty1 :: Positive Int -> Bool-eulerProperty1 (Positive n) = euler !! (2 * n - 1) == 0+eulerProperty1 (Positive n) = euler Inf.!! (2 * fromIntegral n - 1) == 0 -- | Every positive even index produces a negative result.-eulerProperty2 :: NonNegative Int -> Bool-eulerProperty2 (NonNegative n) = euler !! (2 + 4 * n) < 0+eulerProperty2 :: Word -> Bool+eulerProperty2 n = euler Inf.!! (2 + 4 * n) < 0 -- | The Euler number sequence is https://oeis.org/A122045 eulerSpecialCase1 :: Assertion eulerSpecialCase1 = assertEqual "euler"- (take 20 euler)+ (Inf.take 20 euler) [1, 0, -1, 0, 5, 0, -61, 0, 1385, 0, -50521, 0, 2702765, 0, -199360981, 0, 19391512145, 0, -2404879675441, 0] -- | For any even positive integer @n@, @E_n(1)@ is @0@. eulerPAt1Property1 :: Positive Int -> Bool-eulerPAt1Property1 (Positive n) = (eulerPolyAt1 !! (2 * n)) == 0+eulerPAt1Property1 (Positive n) = (eulerPolyAt1 Inf.!! (2 * fromIntegral n)) == 0 -- | The numerators in this sequence are from https://oeis.org/A198631 while the -- denominators are from https://oeis.org/A006519. eulerPAt1SpecialCase1 :: Assertion eulerPAt1SpecialCase1 = assertEqual "eulerPolyAt1"- (take 20 eulerPolyAt1)+ (Inf.take 20 eulerPolyAt1) (zipWith (%) [1, 1, 0, -1, 0, 1, 0, -17, 0, 31, 0, -691, 0, 5461, 0, -929569, 0, 3202291, 0, -221930581] [1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1, 16, 1, 2, 1, 4]) @@ -184,7 +234,18 @@ , testSmallAndQuick "left side" binomialProperty2 , testSmallAndQuick "right side" binomialProperty3 , testSmallAndQuick "recurrency" binomialProperty4+ , testSmallAndQuick "factorise . binomial = binomialFactors" binomialProperty5+ , testSmallAndQuick "binomial = factorBack . binomialFactors" binomialProperty6+ , testSmallAndQuick "line" binomialLineProperty1+ , testSmallAndQuick "diagonal" binomialDiagonalProperty2 ]+ , testGroup "binomialRotated"+ [ testSmallAndQuick "left side" binomialRotatedProperty2+ , testSmallAndQuick "right side" binomialRotatedProperty3+ , testSmallAndQuick "recurrency" binomialRotatedProperty4+ , testSmallAndQuick "line" binomialLineProperty2+ , testSmallAndQuick "diagonal" binomialDiagonalProperty1+ ] , testGroup "stirling1" [ testSmallAndQuick "shape" stirling1Property1 , testSmallAndQuick "left side" stirling1Property2@@ -219,7 +280,7 @@ [ testCase "B_0" bernoulliSpecialCase1 , testCase "B_1" bernoulliSpecialCase2 , testSmallAndQuick "sign" bernoulliProperty1- , testSmallAndQuick "recursive definition" bernoulliProperty2+ , testEqualSmallAndQuick "recursive definition" bernoulliProperty2 ] , testGroup "Euler numbers" [ testCase "First 20 elements of E_n are correct" eulerSpecialCase1
test-suite/Math/NumberTheory/Recurrences/LinearTests.hs view
@@ -7,8 +7,6 @@ -- Tests for Math.NumberTheory.Recurrences.Linear -- -{-# LANGUAGE CPP #-}- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Recurrences.LinearTests@@ -18,6 +16,11 @@ import Test.Tasty import Test.Tasty.HUnit +import Control.Arrow+import Data.List (sort)+import qualified Data.List.Infinite as Inf++import Math.NumberTheory.Primes import Math.NumberTheory.Recurrences.Linear import Math.NumberTheory.TestUtils @@ -26,8 +29,8 @@ fibonacciProperty1 (AnySign n) = fibonacci n + fibonacci (n + 1) == fibonacci (n +2) -- | Check that 'fibonacci' for negative indices is correctly defined.-fibonacciProperty2 :: NonNegative Int -> Bool-fibonacciProperty2 (NonNegative n) = fibonacci n == (if even n then negate else id) (fibonacci (- n))+fibonacciProperty2 :: Word -> Bool+fibonacciProperty2 n = fibonacci (fromIntegral n) == (if even n then negate else id) (fibonacci (- fromIntegral n)) -- | Check that 'fibonacciPair' is a pair of consequent 'fibonacci'. fibonacciPairProperty :: AnySign Int -> Bool@@ -47,8 +50,8 @@ lucasProperty1 (AnySign n) = lucas n + lucas (n + 1) == lucas (n +2) -- | Check that 'lucas' for negative indices is correctly defined.-lucasProperty2 :: NonNegative Int -> Bool-lucasProperty2 (NonNegative n) = lucas n == (if odd n then negate else id) (lucas (- n))+lucasProperty2 :: Word -> Bool+lucasProperty2 n = lucas (fromIntegral n) == (if odd n then negate else id) (lucas (- fromIntegral n)) -- | Check that 'lucasPair' is a pair of consequent 'lucas'. lucasPairProperty :: AnySign Int -> Bool@@ -63,22 +66,32 @@ lucasSpecialCase1 = assertEqual "lucas" (lucas 1) 1 -- | Check that 'generalLucas' matches its definition.-generalLucasProperty1 :: AnySign Integer -> AnySign Integer -> NonNegative Int -> Bool-generalLucasProperty1 (AnySign p) (AnySign q) (NonNegative n) = un1 == un1' && vn1 == vn1' && un2 == p * un1 - q * un && vn2 == p * vn1 - q * vn+generalLucasProperty1 :: AnySign Integer -> AnySign Integer -> Word -> Bool+generalLucasProperty1 (AnySign p) (AnySign q) n = un1 == un1' && vn1 == vn1' && un2 == p * un1 - q * un && vn2 == p * vn1 - q * vn where- (un, un1, vn, vn1) = generalLucas p q n- (un1', un2, vn1', vn2) = generalLucas p q (n + 1)+ (un, un1, vn, vn1) = generalLucas p q (fromIntegral n)+ (un1', un2, vn1', vn2) = generalLucas p q (fromIntegral n + 1) -- | Check that 'generalLucas' 1 (-1) is 'fibonacciPair' plus 'lucasPair'.-generalLucasProperty2 :: NonNegative Int -> Bool-generalLucasProperty2 (NonNegative n) = (un, un1) == fibonacciPair n && (vn, vn1) == lucasPair n+generalLucasProperty2 :: Word -> Bool+generalLucasProperty2 n = (un, un1) == fibonacciPair (fromIntegral n) && (vn, vn1) == lucasPair (fromIntegral n) where- (un, un1, vn, vn1) = generalLucas 1 (-1) n+ (un, un1, vn, vn1) = generalLucas 1 (-1) (fromIntegral n) -- | Check that 'generalLucas' p _ 0 is (0, 1, 2, p). generalLucasProperty3 :: AnySign Integer -> AnySign Integer -> Bool generalLucasProperty3 (AnySign p) (AnySign q) = generalLucas p q 0 == (0, 1, 2, p) +factorialProperty1 :: Word -> Bool+factorialProperty1 n = n > 100000 ||+ sort (map (first unPrime) (factorise (factorial Inf.!! n))) ==+ sort (map (first (toInteger . unPrime)) (factorialFactors n))++factorialProperty2 :: Word -> Bool+factorialProperty2 n = n > 100000 ||+ factorial Inf.!! n ==+ product (map (\(p, k) -> toInteger (unPrime p) ^ k) (factorialFactors n))+ testSuite :: TestTree testSuite = testGroup "Linear" [ testGroup "fibonacci"@@ -99,5 +112,9 @@ [ testSmallAndQuick "matches definition" generalLucasProperty1 , testSmallAndQuick "generalLucas 1 (-1)" generalLucasProperty2 , testSmallAndQuick "generalLucas _ _ 0" generalLucasProperty3+ ]+ , testGroup "factorial"+ [ testSmallAndQuick "factorise . factorial = factorialFactors" factorialProperty1+ , testSmallAndQuick "factorial = factorBack . factorialFactors" factorialProperty2 ] ]
test-suite/Math/NumberTheory/Recurrences/PentagonalTests.hs view
@@ -7,7 +7,7 @@ -- Tests for Math.NumberTheory.Recurrences.Pentagonal -- -{-# LANGUAGE CPP #-}+{-# LANGUAGE PostfixOperators #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -17,9 +17,11 @@ ( testSuite ) where +import Data.List.Infinite (Infinite(..), (...))+import qualified Data.List.Infinite as Inf import Data.Proxy (Proxy (..)) import GHC.Natural (Natural)-import GHC.TypeNats.Compat (SomeNat (..), someNatVal)+import GHC.TypeNats (SomeNat (..), someNatVal) import Math.NumberTheory.Moduli (Mod, getVal) import Math.NumberTheory.Recurrences (partition)@@ -30,7 +32,7 @@ -- | Helper to avoid writing @partition !!@ too many times. partition' :: Num a => Int -> a-partition' = (partition !!)+partition' = (partition Inf.!!) . fromIntegral -- | Check that the @k@-th generalized pentagonal number is -- @div (3 * k² - k) 2@, where @k ∈ {0, 1, -1, 2, -2, 3, -3, 4, ...}@.@@ -38,9 +40,9 @@ -- while @2@ is the @2 * 2 - 1 == 3@-rd, and so on. pentagonalNumbersProperty1 :: AnySign Int -> Bool pentagonalNumbersProperty1 (AnySign n)- | n == 0 = pents !! 0 == 0- | n > 0 = pents !! (2 * n - 1) == pent n- | otherwise = pents !! (2 * abs n) == pent n+ | n == 0 = Inf.head pents == 0+ | n > 0 = pents Inf.!! (2 * fromIntegral n - 1) == pent n+ | otherwise = pents Inf.!! (2 * fromIntegral (- n)) == pent n where pent m = div (3 * (m * m) - m) 2 @@ -48,7 +50,7 @@ -- https://oeis.org/A000041. partitionSpecialCase20 :: Assertion partitionSpecialCase20 = assertEqual "partition"- (take 20 partition)+ (Inf.take 20 partition) [1, 1, 2, 3, 5, 7, 11, 15, 22, 30, 42, 56, 77, 101, 135, 176, 231, 297, 385, 490] -- | Copied from @Math.NumberTheory.Recurrences.Pentagonal@ to test the@@ -58,13 +60,10 @@ -- | Copied from @Math.NumberTheory.Recurrences.Pentagonal@ to test the -- reference implementation of @partition@.-pents :: (Enum a, Num a) => [a]-pents = interleave (scanl (\acc n -> acc + 3 * n - 1) 0 [1..])- (scanl (\acc n -> acc + 3 * n - 2) 1 [2..])- where- interleave :: [a] -> [a] -> [a]- interleave (n : ns) (m : ms) = n : m : interleave ns ms- interleave _ _ = []+pents :: (Enum a, Num a) => Infinite a+pents = Inf.interleave+ (Inf.scanl (\acc n -> acc + 3 * n - 1) 0 (1...))+ (Inf.scanl (\acc n -> acc + 3 * n - 2) 1 (2...)) -- | Check that @p(n) = p(n-1) + p(n-2) - p(n-5) - p(n-7) + p(n-11) + ...@, -- where @p(x) = 0@ for any negative integer and @p(0) = 1@.@@ -73,16 +72,16 @@ partition' n == (sum . pentagonalSigns . map (\m -> partition' (n - m)) .- takeWhile (\m -> n - m >= 0) .- tail $ pents)+ Inf.takeWhile (\m -> n - m >= 0) .+ Inf.tail $ pents) -- | Check that -- @partition :: [Math.NumberTheory.Moduli.Mod n] == map (`mod` n) partition@. partitionProperty2 :: NonNegative Integer -> Positive Natural -> Bool partitionProperty2 (NonNegative m) n@(someNatVal . getPositive -> (SomeNat (Proxy :: Proxy n))) =- (take m' . map getVal $ (partition :: [Mod n])) ==- map helper (take m' partition :: [Integer])+ (Inf.take m' . Inf.map getVal $ (partition :: Infinite (Mod n))) ==+ map helper (Inf.take m' partition :: [Integer]) where m' = fromIntegral m n' = fromIntegral n@@ -92,8 +91,7 @@ testSuite = testGroup "Pentagonal" [ testGroup "partition" [ testSmallAndQuick "matches definition" partitionProperty1- , testSmallAndQuick "mapping residue modulus 'n' is the same as giving\- \'partition' type '[Mod n]'" partitionProperty2+ , testSmallAndQuick "mod n" partitionProperty2 , testCase "first 20 elements of partition are correct" partitionSpecialCase20 ]
+ test-suite/Math/NumberTheory/RootsOfUnityTests.hs view
@@ -0,0 +1,25 @@+-- |+-- Module: Math.NumberTheory.RootsOfUnityTests+-- Copyright: (c) 2018 Bhavik Mehta+-- License: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Tests for Math.NumberTheory.RootsOfUnity+--++module Math.NumberTheory.RootsOfUnityTests where++import Test.Tasty++import Data.Complex+import Data.Ratio+import Data.Semigroup++import Math.NumberTheory.DirichletCharacters (toRootOfUnity, toComplex)+import Math.NumberTheory.TestUtils (testSmallAndQuick, Positive(..))++rootOfUnityTest :: Integer -> Positive Integer -> Bool+rootOfUnityTest n (Positive d) = toComplex ((d `div` gcd n d) `stimes` toRootOfUnity (n % d)) == (1 :: Complex Double)++testSuite :: TestTree+testSuite = testSmallAndQuick "RootOfUnity contains roots of unity" rootOfUnityTest
test-suite/Math/NumberTheory/SmoothNumbersTests.hs view
@@ -7,64 +7,86 @@ -- Tests for Math.NumberTheory.SmoothNumbersTests -- +{-# LANGUAGE TypeApplications #-}+ {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.SmoothNumbersTests ( testSuite ) where -import Prelude hiding (mod)+import Prelude hiding (mod, rem) import Test.Tasty import Test.Tasty.HUnit import Data.Coerce-import Data.List (genericDrop, nub, sort)-import Data.Maybe (fromJust)-import qualified Data.Set as S+import Data.Euclidean+import Data.List (nub)+import Data.List.Infinite (Infinite(..))+import qualified Data.List.Infinite as Inf import Numeric.Natural -import Math.NumberTheory.Euclidean (Euclidean (..), WrappedIntegral (..)) import Math.NumberTheory.Primes (Prime (..)) import qualified Math.NumberTheory.Quadratic.GaussianIntegers as G import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E-import Math.NumberTheory.SmoothNumbers+import Math.NumberTheory.SmoothNumbers (SmoothBasis, fromList, isSmooth, smoothOver, smoothOver') import Math.NumberTheory.TestUtils -fromSetListProperty :: (Euclidean a, Ord a) => [a] -> Bool-fromSetListProperty xs = fromSet (S.fromList xs) == fromList (sort xs)--isSmoothPropertyHelper :: Euclidean a => (a -> Integer) -> [a] -> Int -> Int -> Bool+isSmoothPropertyHelper+ :: (Eq a, Num a, Euclidean a)+ => (a -> Integer)+ -> Infinite a+ -> Int+ -> Int+ -> Bool isSmoothPropertyHelper norm primes' i1 i2 =- let primes = take i1 primes'- basis = fromJust (fromList primes)+ let primes = Inf.take i1 primes'+ basis = fromList primes in all (isSmooth basis) $ take i2 $ smoothOver' norm basis isSmoothProperty1 :: Positive Int -> Positive Int -> Bool isSmoothProperty1 (Positive i1) (Positive i2) =- isSmoothPropertyHelper G.norm (map unPrime G.primes) i1 i2+ isSmoothPropertyHelper G.norm (fmap unPrime G.primes) i1 i2 isSmoothProperty2 :: Positive Int -> Positive Int -> Bool isSmoothProperty2 (Positive i1) (Positive i2) =- isSmoothPropertyHelper E.norm (map unPrime E.primes) i1 i2+ isSmoothPropertyHelper E.norm (fmap unPrime E.primes) i1 i2 -fromSmoothUpperBoundProperty :: Integral a => Positive a -> Bool-fromSmoothUpperBoundProperty (Positive n') = case fromSmoothUpperBound n of- Nothing -> n < 2- Just sb -> head (genericDrop (n - 1) (smoothOver (coerce sb))) == n- where- n = WrappedIntegral n' `mod` 5000+smoothOverInRange :: Integral a => SmoothBasis a -> a -> a -> [a]+smoothOverInRange s lo hi+ = takeWhile (<= hi)+ $ dropWhile (< lo)+ $ smoothOver s -smoothOverInRangeProperty :: Integral a => SmoothBasis a -> Positive a -> Positive a -> Bool-smoothOverInRangeProperty s (Positive lo') (Positive diff')- = xs == ys+smoothOverInRangeBF+ :: (Eq a, Enum a, GcdDomain a)+ => SmoothBasis a+ -> a+ -> a+ -> [a]+smoothOverInRangeBF prs lo hi+ = coerce+ $ filter (isSmooth prs)+ $ coerce [lo..hi]++smoothOverInRangeProperty+ :: (Show a, Integral a)+ => (SmoothBasis a, Positive a, Positive a)+ -> ([a], [a])+smoothOverInRangeProperty (s, Positive lo', Positive diff') =+ (map unwrapIntegral xs, map unwrapIntegral ys) where- lo = WrappedIntegral lo' `mod` 2^18- diff = WrappedIntegral diff' `mod` 2^18+ lo = WrapIntegral lo' `rem` 2^18+ diff = WrapIntegral diff' `rem` 2^18 hi = lo + diff xs = smoothOverInRange (coerce s) lo hi ys = smoothOverInRangeBF (coerce s) lo hi -smoothNumbersAreUniqueProperty :: Integral a => SmoothBasis a -> Positive Int -> Bool+smoothNumbersAreUniqueProperty+ :: (Show a, Integral a)+ => SmoothBasis a+ -> Positive Int+ -> Bool smoothNumbersAreUniqueProperty s (Positive len) = nub l == l where@@ -73,41 +95,32 @@ isSmoothSpecialCase1 :: Assertion isSmoothSpecialCase1 = assertBool "should be distinct" $ nub l == l where- b = fromJust $ fromList [1+3*G.ι,6+8*G.ι]+ b = fromList [1+3*G.ι,6+8*G.ι] l = take 10 $ map abs $ smoothOver' G.norm b +isSmoothSpecialCase2 :: Assertion+isSmoothSpecialCase2 = assertBool "should be smooth" $ isSmooth b 6+ where+ b = fromList [4, 3, 6, 10, 7::Int] testSuite :: TestTree testSuite = testGroup "SmoothNumbers"- [ testGroup "fromSet == fromList"- [ testSmallAndQuick "Int" (fromSetListProperty :: [Int] -> Bool)- , testSmallAndQuick "Word" (fromSetListProperty :: [Word] -> Bool)- , testSmallAndQuick "Integer" (fromSetListProperty :: [Integer] -> Bool)- , testSmallAndQuick "Natural" (fromSetListProperty :: [Natural] -> Bool)- ]- , testIntegralProperty "fromSmoothUpperBound" fromSmoothUpperBoundProperty- , testGroup "smoothOverInRange == smoothOverInRangeBF"- [ testSmallAndQuick "Int"- (smoothOverInRangeProperty :: SmoothBasis Int -> Positive Int -> Positive Int -> Bool)- , testSmallAndQuick "Word"- (smoothOverInRangeProperty :: SmoothBasis Word -> Positive Word -> Positive Word -> Bool)- , testSmallAndQuick "Integer"- (smoothOverInRangeProperty :: SmoothBasis Integer -> Positive Integer -> Positive Integer -> Bool)- , testSmallAndQuick "Natural"- (smoothOverInRangeProperty :: SmoothBasis Natural -> Positive Natural -> Positive Natural -> Bool)+ [ testGroup "smoothOverInRange == smoothOverInRangeBF"+ [ testEqualSmallAndQuick "Int" (smoothOverInRangeProperty @Int)+ , testEqualSmallAndQuick "Word" (smoothOverInRangeProperty @Word)+ , testEqualSmallAndQuick "Integer" (smoothOverInRangeProperty @Integer)+ , testEqualSmallAndQuick "Natural" (smoothOverInRangeProperty @Natural) ] , testGroup "smoothOver generates a list without duplicates"- [ testSmallAndQuick "Integer"- (smoothNumbersAreUniqueProperty :: SmoothBasis Integer -> Positive Int -> Bool)- , testSmallAndQuick "Natural"- (smoothNumbersAreUniqueProperty :: SmoothBasis Natural -> Positive Int -> Bool)+ [ testSmallAndQuick "Integer" (smoothNumbersAreUniqueProperty @Integer)+ , testSmallAndQuick "Natural" (smoothNumbersAreUniqueProperty @Natural) ]- , testGroup "Quadratic rings (Gaussian/Eisenstein)"- [ testGroup "Check that a list of smooth numbers generated by `smoothOver` \- \ only contains valid smooth numbers for the generated basis."- [ testSmallAndQuick "Gaussian" isSmoothProperty1+ , testGroup "Quadratic rings"+ [ testGroup "smoothOver generates valid smooth numbers"+ [ testSmallAndQuick "Gaussian" isSmoothProperty1 , testSmallAndQuick "Eisenstein" isSmoothProperty2 ] , testCase "all distinct for base [1+3*i,6+8*i]" isSmoothSpecialCase1+ , testCase "6 is smooth for base [4,3,6,10,7]" isSmoothSpecialCase2 ] ]
test-suite/Math/NumberTheory/TestUtils.hs view
@@ -12,7 +12,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -38,37 +37,43 @@ , testSameIntegralProperty3 , testIntegral2Property , testSmallAndQuick+ , testEqualSmallAndQuick -- * Export for @Zeta@ tests , assertEqualUpToEps++ -- * Export for Inverse tests+ , TestableIntegral++ , lawsToTest ) where -import Test.SmallCheck.Series (cons2)+import Test.QuickCheck.Classes+import Test.SmallCheck.Series (Positive(..), NonNegative(..), NonZero(..), Serial(..), Series, generate, (\/), cons2) import Test.Tasty import Test.Tasty.HUnit (Assertion, assertBool) import Test.Tasty.SmallCheck as SC-import Test.Tasty.QuickCheck as QC hiding (Positive, getPositive, NonNegative, generate, getNonNegative)--import Test.SmallCheck.Series (Positive(..), NonNegative(..), Serial(..), Series, generate, (\/))+import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..), NonZero(..), generate) import Data.Bits+import Data.Euclidean+import Data.Kind import Data.Semiring (Semiring)-import GHC.Exts import Numeric.Natural -import Math.NumberTheory.Euclidean import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E (EisensteinInteger(..)) import Math.NumberTheory.Quadratic.GaussianIntegers (GaussianInteger(..))-import Math.NumberTheory.Moduli.PrimitiveRoot (CyclicGroup(..))-import Math.NumberTheory.Primes (UniqueFactorisation, Prime, unPrime)+import Math.NumberTheory.Primes (Prime, UniqueFactorisation) import qualified Math.NumberTheory.SmoothNumbers as SN import Math.NumberTheory.TestUtils.MyCompose import Math.NumberTheory.TestUtils.Wrappers +#if !MIN_VERSION_QuickCheck(2,17,0) instance Arbitrary Natural where arbitrary = fromInteger <$> (arbitrary `suchThat` (>= 0)) shrink = map fromInteger . filter (>= 0) . shrink . toInteger+#endif instance Arbitrary E.EisensteinInteger where arbitrary = (E.:+) <$> arbitrary <*> arbitrary@@ -85,44 +90,14 @@ series = cons2 (:+) ---------------------------------------------------------------------------------- Cyclic group--instance (Eq a, Num a, UniqueFactorisation a, Arbitrary a) => Arbitrary (CyclicGroup a) where- arbitrary = frequency- [ (1, pure CG2)- , (1, pure CG4)- , (9, CGOddPrimePower- <$> (arbitrary :: Gen (Prime a)) `suchThatMap` isOddPrime- <*> (getPower <$> arbitrary))- , (9, CGDoubleOddPrimePower- <$> (arbitrary :: Gen (Prime a)) `suchThatMap` isOddPrime- <*> (getPower <$> arbitrary))- ]--instance (Monad m, Eq a, Num a, UniqueFactorisation a, Serial m a) => Serial m (CyclicGroup a) where- series = pure CG2- \/ pure CG4- \/ (CGOddPrimePower- <$> (series :: Series m (Prime a)) `suchThatMapSerial` isOddPrime- <*> (getPower <$> series))- \/ (CGDoubleOddPrimePower- <$> (series :: Series m (Prime a)) `suchThatMapSerial` isOddPrime- <*> (getPower <$> series))--isOddPrime- :: forall a. (Eq a, Num a, UniqueFactorisation a)- => Prime a- -> Maybe (Prime a)-isOddPrime p = if (unPrime p :: a) == 2 then Nothing else Just p--------------------------------------------------------------------------------- -- SmoothNumbers -instance (Ord a, Euclidean a, Arbitrary a) => Arbitrary (SN.SmoothBasis a) where- arbitrary = (fmap getPositive <$> arbitrary) `suchThatMap` SN.fromList+instance (Ord a, Num a, Euclidean a, Arbitrary a) => Arbitrary (SN.SmoothBasis a) where+ arbitrary = SN.fromList <$> arbitrary+ shrink xs = SN.fromList <$> shrink (SN.unSmoothBasis xs) -instance (Ord a, Euclidean a, Serial m a) => Serial m (SN.SmoothBasis a) where- series = (fmap getPositive <$> series) `suchThatMapSerial` SN.fromList+instance (Ord a, Num a, Euclidean a, Serial m a) => Serial m (SN.SmoothBasis a) where+ series = SN.fromList <$> series ------------------------------------------------------------------------------- @@ -131,12 +106,12 @@ class (f (g x)) => (f `Compose` g) x instance (f (g x)) => (f `Compose` g) x -type family ConcatMap (w :: * -> Constraint) (cs :: [*]) :: Constraint+type family ConcatMap (w :: Type -> Constraint) (cs :: [Type]) :: Constraint where ConcatMap w '[] = () ConcatMap w (c ': cs) = (w c, ConcatMap w cs) -type family Matrix (as :: [* -> Constraint]) (w :: * -> *) (bs :: [*]) :: Constraint+type family Matrix (as :: [Type -> Constraint]) (w :: Type -> Type) (bs :: [Type]) :: Constraint where Matrix '[] w bs = () Matrix (a ': as) w bs = (ConcatMap (a `Compose` w) bs, Matrix as w bs)@@ -152,7 +127,7 @@ testIntegralProperty :: forall wrapper bool. (TestableIntegral wrapper, SC.Testable IO bool, QC.Testable bool)- => String -> (forall a. (Euclidean a, Semiring a, Integral a, Bits a, UniqueFactorisation a, Show a) => wrapper a -> bool) -> TestTree+ => String -> (forall a. (GcdDomain a, Euclidean a, Semiring a, Integral a, Bits a, UniqueFactorisation a, Show a) => wrapper a -> bool) -> TestTree testIntegralProperty name f = testGroup name [ SC.testProperty "smallcheck Int" (f :: wrapper Int -> bool) , SC.testProperty "smallcheck Word" (f :: wrapper Word -> bool)@@ -170,7 +145,7 @@ testIntegralPropertyNoLarge :: forall wrapper bool. (TestableIntegral wrapper, SC.Testable IO bool, QC.Testable bool)- => String -> (forall a. (Euclidean a, Semiring a, Integral a, Bits a, UniqueFactorisation a, Show a) => wrapper a -> bool) -> TestTree+ => String -> (forall a. (Euclidean a, Semiring a, Integral a, Bits a, UniqueFactorisation a, Show a, Enum (Prime a)) => wrapper a -> bool) -> TestTree testIntegralPropertyNoLarge name f = testGroup name [ SC.testProperty "smallcheck Int" (f :: wrapper Int -> bool) , SC.testProperty "smallcheck Word" (f :: wrapper Word -> bool)@@ -184,7 +159,7 @@ testSameIntegralProperty :: forall wrapper1 wrapper2 bool. (TestableIntegral wrapper1, TestableIntegral wrapper2, SC.Testable IO bool, QC.Testable bool)- => String -> (forall a. (Euclidean a, Integral a, Bits a, UniqueFactorisation a, Show a) => wrapper1 a -> wrapper2 a -> bool) -> TestTree+ => String -> (forall a. (GcdDomain a, Euclidean a, Integral a, Bits a, UniqueFactorisation a, Show a) => wrapper1 a -> wrapper2 a -> bool) -> TestTree testSameIntegralProperty name f = testGroup name [ SC.testProperty "smallcheck Int" (f :: wrapper1 Int -> wrapper2 Int -> bool) , SC.testProperty "smallcheck Word" (f :: wrapper1 Word -> wrapper2 Word -> bool)@@ -275,17 +250,31 @@ ] testSmallAndQuick- :: SC.Testable IO a- => QC.Testable a- => String -> a -> TestTree+ :: (SC.Testable IO a, QC.Testable a)+ => String+ -> a+ -> TestTree testSmallAndQuick name f = testGroup name [ SC.testProperty "smallcheck" f , QC.testProperty "quickcheck" f ] +testEqualSmallAndQuick+ :: (Serial IO a, Arbitrary a, Show a, Eq b, Show b)+ => String+ -> (a -> (b, b))+ -> TestTree+testEqualSmallAndQuick name f = testGroup name+ [ SC.testProperty "smallcheck" (uncurry (==) . f)+ , QC.testProperty "quickcheck" (uncurry (===) . f)+ ] -- | Used in @Math.NumberTheory.Zeta.DirichletTests@ and -- @Math.NumberTheory.Zeta.RiemannTests@. assertEqualUpToEps :: String -> Double -> Double -> Double -> Assertion assertEqualUpToEps msg eps expected actual = assertBool msg (abs (expected - actual) < eps)++lawsToTest :: Laws -> TestTree+lawsToTest (Laws name props) =+ testGroup name $ map (uncurry QC.testProperty) props
test-suite/Math/NumberTheory/TestUtils/MyCompose.hs view
@@ -23,6 +23,8 @@ import Test.QuickCheck (Arbitrary) import Test.SmallCheck.Series (Serial) +-- | As of @base-4.19@ Data.Functor.Compose has every instance we need,+-- except for instance Arbitrary, which overzealously requires Arbitrary1. newtype MyCompose f g a = MyCompose { getMyCompose :: f (g a) } deriving (Eq, Ord, Show, Functor, Num, Enum, Bounded, Real, Integral, Arbitrary, Generic)
test-suite/Math/NumberTheory/TestUtils/Wrappers.hs view
@@ -7,9 +7,6 @@ -- Utils to test Math.NumberTheory -- -{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -27,19 +24,20 @@ import Control.Applicative import Data.Coerce+import Data.Euclidean import Data.Functor.Classes+import Data.Semiring (Semiring) -import Test.Tasty.QuickCheck as QC hiding (Positive, NonNegative, generate, getNonNegative, getPositive)-import Test.SmallCheck.Series (Positive(..), NonNegative(..), Serial(..), Series)+import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..), NonZero(..))+import Test.SmallCheck.Series (Positive(..), NonNegative(..), NonZero(..), Serial(..), Series) -import Math.NumberTheory.Euclidean (Euclidean) import Math.NumberTheory.Primes (Prime, UniqueFactorisation(..)) ------------------------------------------------------------------------------- -- AnySign newtype AnySign a = AnySign { getAnySign :: a }- deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real, Functor, Foldable, Traversable, Arbitrary, Euclidean)+ deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real, Functor, Foldable, Traversable, Arbitrary, Semiring, GcdDomain, Euclidean) instance (Monad m, Serial m a) => Serial m (AnySign a) where series = AnySign <$> series@@ -56,17 +54,14 @@ ------------------------------------------------------------------------------- -- Positive from smallcheck -deriving instance Functor Positive+deriving instance Semiring a => Semiring (Positive a)+deriving instance GcdDomain a => GcdDomain (Positive a) deriving instance Euclidean a => Euclidean (Positive a) instance (Num a, Ord a, Arbitrary a) => Arbitrary (Positive a) where arbitrary = Positive <$> (arbitrary `suchThat` (> 0)) shrink (Positive x) = Positive <$> filter (> 0) (shrink x) -instance (Num a, Bounded a) => Bounded (Positive a) where- minBound = Positive 1- maxBound = Positive (maxBound :: a)- instance Eq1 Positive where liftEq eq (Positive a) (Positive b) = a `eq` b @@ -79,17 +74,14 @@ ------------------------------------------------------------------------------- -- NonNegative from smallcheck -deriving instance Functor NonNegative+deriving instance Semiring a => Semiring (NonNegative a)+deriving instance GcdDomain a => GcdDomain (NonNegative a) deriving instance Euclidean a => Euclidean (NonNegative a) instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonNegative a) where arbitrary = NonNegative <$> (arbitrary `suchThat` (>= 0)) shrink (NonNegative x) = NonNegative <$> filter (>= 0) (shrink x) -instance (Num a, Bounded a) => Bounded (NonNegative a) where- minBound = NonNegative 0- maxBound = NonNegative (maxBound :: a)- instance Eq1 NonNegative where liftEq eq (NonNegative a) (NonNegative b) = a `eq` b @@ -100,15 +92,25 @@ liftShowsPrec shw _ p (NonNegative a) = shw p a ---------------------------------------------------------------------------------- NonZero from QuickCheck+-- NonZero from smallcheck -instance (Monad m, Num a, Eq a, Serial m a) => Serial m (NonZero a) where- series = NonZero <$> series `suchThatSerial` (/= 0)+deriving instance Semiring a => Semiring (NonZero a)+deriving instance GcdDomain a => GcdDomain (NonZero a)+deriving instance Euclidean a => Euclidean (NonZero a) -instance (Eq a, Num a, Enum a, Bounded a) => Bounded (NonZero a) where- minBound = if minBound == (0 :: a) then NonZero (succ minBound) else NonZero minBound- maxBound = if maxBound == (0 :: a) then NonZero (pred maxBound) else NonZero maxBound+instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonZero a) where+ arbitrary = NonZero <$> (arbitrary `suchThat` (/= 0))+ shrink (NonZero x) = NonZero <$> filter (/= 0) (shrink x) +instance Eq1 NonZero where+ liftEq eq (NonZero a) (NonZero b) = a `eq` b++instance Ord1 NonZero where+ liftCompare cmp (NonZero a) (NonZero b) = a `cmp` b++instance Show1 NonZero where+ liftShowsPrec shw _ p (NonZero a) = shw p a+ ------------------------------------------------------------------------------- -- Huge @@ -120,6 +122,7 @@ Positive l <- arbitrary ds <- vector l return $ Huge $ foldl1 (\acc n -> acc * 2^63 + n) ds+ shrink (Huge n) = Huge <$> shrink n instance Eq1 Huge where liftEq eq (Huge a) (Huge b) = a `eq` b@@ -134,7 +137,7 @@ -- Power newtype Power a = Power { getPower :: a }- deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real, Functor, Foldable, Traversable, Euclidean)+ deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real, Functor, Foldable, Traversable, Semiring, GcdDomain, Euclidean) instance (Monad m, Num a, Ord a, Serial m a) => Serial m (Power a) where series = Power <$> series `suchThatSerial` (> 0)
test-suite/Math/NumberTheory/UniqueFactorisationTests.hs view
@@ -7,7 +7,6 @@ -- Tests for Math.NumberTheory.ArithmeticFunctions -- -{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}
test-suite/Math/NumberTheory/Zeta/DirichletTests.hs view
@@ -14,6 +14,8 @@ ) where import Data.ExactPi (approximateValue)+import Data.List.Infinite (Infinite(..))+import qualified Data.List.Infinite as Inf import Test.Tasty import Test.Tasty.HUnit (Assertion, assertEqual, testCase)@@ -24,25 +26,25 @@ epsilon :: Double epsilon = 1e-14 -betas' :: [Double]+betas' :: Infinite Double betas' = betas epsilon betasOddSpecialCase1 :: Assertion betasOddSpecialCase1 = assertEqualUpToEps "beta(1) = pi/4" epsilon- (approximateValue $ betasOdd !! 0)+ (approximateValue $ Inf.head betasOdd) (pi / 4) betasOddSpecialCase2 :: Assertion betasOddSpecialCase2 = assertEqualUpToEps "beta(3) = pi^3/32" epsilon- (approximateValue $ betasOdd !! 1)+ (approximateValue $ betasOdd Inf.!! 1) (pi^3 / 32) betasOddSpecialCase3 :: Assertion betasOddSpecialCase3 = assertEqualUpToEps "beta(5) = 5*pi^5/1536" epsilon- (approximateValue $ betasOdd !! 2)+ (approximateValue $ betasOdd Inf.!! 2) ((5 * pi^5) / 1536) betasOddProperty1 :: Positive Int -> Bool@@ -50,45 +52,45 @@ = betaM < 1 || betaM < betaM1 where- betaM = approximateValue (betasOdd !! m)- betaM1 = approximateValue (betasOdd !! (m + 1))+ betaM = approximateValue (betasOdd Inf.!! fromIntegral m)+ betaM1 = approximateValue (betasOdd Inf.!! (fromIntegral m + 1)) -betasOddProperty2 :: NonNegative Int -> Bool-betasOddProperty2 (NonNegative m)+betasOddProperty2 :: Word -> Bool+betasOddProperty2 m = abs (betaM - betaM') < epsilon where- betaM = approximateValue (betasOdd !! m)- betaM' = betas' !! ((2 * m) + 1)+ betaM = approximateValue (betasOdd Inf.!! m)+ betaM' = betas' Inf.!! ((2 * m) + 1) betasSpecialCase1 :: Assertion betasSpecialCase1 = assertEqual "beta(0) = 1/2"- (betas' !! 0)+ (Inf.head betas') (1 / 2) betasSpecialCase2 :: Assertion betasSpecialCase2 = assertEqualUpToEps "beta(2) = 0.9159655" epsilon- (betas' !! 2)- (0.9159655941772190150546035149323841107)+ (betas' Inf.!! 2)+ 0.9159655941772190150546035149323841107 betasSpecialCase3 :: Assertion betasSpecialCase3 = assertEqualUpToEps "beta(4) = 0.9889445" epsilon- (betas' !! 4)- (0.9889445517411053361084226332283778213)+ (betas' Inf.!! 4)+ 0.9889445517411053361084226332283778213 betasProperty1 :: Positive Int -> Bool betasProperty1 (Positive m) = betaM <= betaM1 && betaM1 <= 1 where- betaM = betas' !! m- betaM1 = betas' !! (m + 1)+ betaM = betas' Inf.!! fromIntegral m+ betaM1 = betas' Inf.!! (fromIntegral m + 1) betasProperty2 :: NonNegative Int -> NonNegative Int -> Bool betasProperty2 (NonNegative e1) (NonNegative e2)- = maximum (take 35 $ drop 2 $ zipWith ((abs .) . (-)) (betas eps1) (betas eps2)) <= eps1 + eps2+ = maximum (Inf.take 35 $ Inf.drop 2 $ Inf.zipWith ((abs .) . (-)) (betas eps1) (betas eps2)) <= eps1 + eps2 where eps1, eps2 :: Double eps1 = max ((1.0 / 2) ^ e1) ((1.0 / 2) ^ 53)
test-suite/Math/NumberTheory/Zeta/RiemannTests.hs view
@@ -14,6 +14,8 @@ ) where import Data.ExactPi (approximateValue)+import Data.List.Infinite (Infinite(..))+import qualified Data.List.Infinite as Inf import Test.Tasty import Test.Tasty.HUnit (Assertion, assertEqual, testCase)@@ -27,19 +29,19 @@ zetasEvenSpecialCase1 :: Assertion zetasEvenSpecialCase1 = assertEqual "zeta(0) = -1/2"- (approximateValue $ zetasEven !! 0)+ (approximateValue $ Inf.head zetasEven) (-1 / 2) zetasEvenSpecialCase2 :: Assertion zetasEvenSpecialCase2 = assertEqualUpToEps "zeta(2) = pi^2/6" epsilon- (approximateValue $ zetasEven !! 1)+ (approximateValue $ zetasEven Inf.!! 1) (pi * pi / 6) zetasEvenSpecialCase3 :: Assertion zetasEvenSpecialCase3 = assertEqualUpToEps "zeta(4) = pi^4/90" epsilon- (approximateValue $ zetasEven !! 2)+ (approximateValue $ zetasEven Inf.!! 2) (pi ^ 4 / 90) zetasEvenProperty1 :: Positive Int -> Bool@@ -47,35 +49,35 @@ = zetaM < 1 || zetaM > zetaM1 where- zetaM = approximateValue (zetasEven !! m)- zetaM1 = approximateValue (zetasEven !! (m + 1))+ zetaM = approximateValue (zetasEven Inf.!! fromIntegral m)+ zetaM1 = approximateValue (zetasEven Inf.!! (fromIntegral m + 1)) zetasEvenProperty2 :: Positive Int -> Bool zetasEvenProperty2 (Positive m) = abs (zetaM - zetaM') < epsilon where- zetaM = approximateValue (zetasEven !! m)- zetaM' = zetas' !! (2 * m)+ zetaM = approximateValue (zetasEven Inf.!! fromIntegral m)+ zetaM' = zetas' Inf.!! (2 * fromIntegral m) -zetas' :: [Double]+zetas' :: Infinite Double zetas' = zetas epsilon zetasSpecialCase1 :: Assertion zetasSpecialCase1 = assertEqual "zeta(1) = Infinity"- (zetas' !! 1)+ (zetas' Inf.!! 1) (1 / 0) zetasSpecialCase2 :: Assertion zetasSpecialCase2 = assertEqualUpToEps "zeta(3) = 1.2020569" epsilon- (zetas' !! 3)+ (zetas' Inf.!! 3) 1.2020569031595942853997381615114499908 zetasSpecialCase3 :: Assertion zetasSpecialCase3 = assertEqualUpToEps "zeta(5) = 1.0369277" epsilon- (zetas' !! 5)+ (zetas' Inf.!! 5) 1.0369277551433699263313654864570341681 zetasProperty1 :: Positive Int -> Bool@@ -83,8 +85,8 @@ = zetaM >= zetaM1 && zetaM1 >= 1 where- zetaM = zetas' !! m- zetaM1 = zetas' !! (m + 1)+ zetaM = zetas' Inf.!! fromIntegral m+ zetaM1 = zetas' Inf.!! (fromIntegral m + 1) -- | Let z1 be an approximation of z with precision eps1, -- and z2 be an approximation of the same value with precision eps2.@@ -92,7 +94,7 @@ -- abs (z1 - z2) < eps1 + eps2. zetasProperty2 :: NonNegative Int -> NonNegative Int -> Bool zetasProperty2 (NonNegative e1) (NonNegative e2)- = maximum (take 35 $ drop 2 $ zipWith ((abs .) . (-)) (zetas eps1) (zetas eps2)) < eps1 + eps2+ = maximum (Inf.take 35 $ Inf.drop 2 $ Inf.zipWith ((abs .) . (-)) (zetas eps1) (zetas eps2)) < eps1 + eps2 where eps1, eps2 :: Double eps1 = max ((1.0 / 2) ^ e1) ((1.0 / 2) ^ 53)
test-suite/Test.hs view
@@ -1,4 +1,5 @@ import Test.Tasty+import Test.Tasty.Ingredients.Rerun import qualified Math.NumberTheory.EuclideanTests as Euclidean @@ -8,26 +9,23 @@ import qualified Math.NumberTheory.Moduli.ChineseTests as ModuliChinese import qualified Math.NumberTheory.Moduli.ClassTests as ModuliClass+import qualified Math.NumberTheory.Moduli.CbrtTests as ModuliCbrt import qualified Math.NumberTheory.Moduli.DiscreteLogarithmTests as ModuliDiscreteLogarithm import qualified Math.NumberTheory.Moduli.EquationsTests as ModuliEquations import qualified Math.NumberTheory.Moduli.JacobiTests as ModuliJacobi import qualified Math.NumberTheory.Moduli.PrimitiveRootTests as ModuliPrimitiveRoot+import qualified Math.NumberTheory.Moduli.SingletonTests as ModuliSingleton import qualified Math.NumberTheory.Moduli.SqrtTests as ModuliSqrt import qualified Math.NumberTheory.MoebiusInversionTests as MoebiusInversion-import qualified Math.NumberTheory.MoebiusInversion.IntTests as MoebiusInversionInt -import qualified Math.NumberTheory.Powers.CubesTests as Cubes-import qualified Math.NumberTheory.Powers.FourthTests as Fourth-import qualified Math.NumberTheory.Powers.GeneralTests as General-import qualified Math.NumberTheory.Powers.ModularTests as Modular-import qualified Math.NumberTheory.Powers.SquaresTests as Squares- import qualified Math.NumberTheory.PrefactoredTests as Prefactored import qualified Math.NumberTheory.PrimesTests as Primes import qualified Math.NumberTheory.Primes.CountingTests as Counting import qualified Math.NumberTheory.Primes.FactorisationTests as Factorisation+-- import qualified Math.NumberTheory.Primes.LinearAlgebraTests as LinearAlgebra+-- import qualified Math.NumberTheory.Primes.QuadraticSieveTests as QuadraticSieve import qualified Math.NumberTheory.Primes.SequenceTests as Sequence import qualified Math.NumberTheory.Primes.SieveTests as Sieve import qualified Math.NumberTheory.Primes.TestingTests as Testing@@ -47,19 +45,18 @@ import qualified Math.NumberTheory.Zeta.RiemannTests as Riemann import qualified Math.NumberTheory.Zeta.DirichletTests as Dirichlet +import qualified Math.NumberTheory.DirichletCharactersTests as DirichletChar++import qualified Math.NumberTheory.RootsOfUnityTests as RootsOfUnity++import qualified Math.NumberTheory.DiophantineTests as Diophantine+ main :: IO ()-main = defaultMain tests+main = defaultMainWithRerun tests tests :: TestTree tests = testGroup "All"- [ testGroup "Powers"- [ Cubes.testSuite- , Fourth.testSuite- , General.testSuite- , Modular.testSuite- , Squares.testSuite- ]- , Euclidean.testSuite+ [ Euclidean.testSuite , testGroup "Recurrences" [ RecurrencesPentagonal.testSuite , RecurrencesLinear.testSuite@@ -68,21 +65,22 @@ , testGroup "Moduli" [ ModuliChinese.testSuite , ModuliClass.testSuite+ , ModuliCbrt.testSuite , ModuliDiscreteLogarithm.testSuite , ModuliEquations.testSuite , ModuliJacobi.testSuite , ModuliPrimitiveRoot.testSuite+ , ModuliSingleton.testSuite , ModuliSqrt.testSuite ]- , testGroup "MoebiusInversion"- [ MoebiusInversion.testSuite- , MoebiusInversionInt.testSuite- ]+ , MoebiusInversion.testSuite , Prefactored.testSuite , testGroup "Primes" [ Primes.testSuite , Counting.testSuite , Factorisation.testSuite+ -- , LinearAlgebra.testSuite+ -- , QuadraticSieve.testSuite , Sequence.testSuite , Sieve.testSuite , Testing.testSuite@@ -98,9 +96,11 @@ , UniqueFactorisation.testSuite , Curves.testSuite , SmoothNumbers.testSuite-+ , Diophantine.testSuite , testGroup "Zeta" [ Riemann.testSuite , Dirichlet.testSuite ]+ , DirichletChar.testSuite+ , RootsOfUnity.testSuite ]