arithmoi 0.7.0.0 → 0.8.0.0

raw patch · 100 files changed

+4687/−2679 lines, 100 filesdep +deepseqdep −mtldep −natsdep ~QuickCheckdep ~basedep ~smallcheckPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

Dependencies removed: mtl, nats

Dependency ranges changed: QuickCheck, base, smallcheck, tasty, transformers

API changes (from Hackage documentation)

Files

• Changes +61/−0
• Math/NumberTheory/ArithmeticFunctions/Class.hs +0/−5
• Math/NumberTheory/ArithmeticFunctions/Mertens.hs +2/−5
• Math/NumberTheory/ArithmeticFunctions/Moebius.hs +2/−2
• Math/NumberTheory/ArithmeticFunctions/SieveBlock.hs +9/−7
• Math/NumberTheory/ArithmeticFunctions/SieveBlock/Unboxed.hs +2/−2
• Math/NumberTheory/ArithmeticFunctions/Standard.hs +22/−6
• Math/NumberTheory/Curves/Montgomery.hs +3/−4
• Math/NumberTheory/Euclidean.hs +165/−0
• Math/NumberTheory/Euclidean/Coprimes.hs +124/−0
• Math/NumberTheory/GCD.hs +13/−39
• Math/NumberTheory/GCD/LowLevel.hs +3/−0
• Math/NumberTheory/GaussianIntegers.hs +5/−222
• Math/NumberTheory/Moduli.hs +4/−0
• Math/NumberTheory/Moduli/Chinese.hs +2/−7
• Math/NumberTheory/Moduli/Class.hs +70/−36
• Math/NumberTheory/Moduli/DiscreteLogarithm.hs +123/−0
• Math/NumberTheory/Moduli/Equations.hs +137/−0
• Math/NumberTheory/Moduli/Jacobi.hs +61/−89
• Math/NumberTheory/Moduli/PrimitiveRoot.hs +84/−43
• Math/NumberTheory/Moduli/Sqrt.hs +130/−113
• Math/NumberTheory/Moduli/SqrtOld.hs +234/−0
• Math/NumberTheory/Powers/Cubes.hs +0/−7
• Math/NumberTheory/Powers/Fourth.hs +0/−7
• Math/NumberTheory/Powers/Modular.hs +14/−20
• Math/NumberTheory/Powers/Squares.hs +0/−3
• Math/NumberTheory/Powers/Squares/Internal.hs +2/−7
• Math/NumberTheory/Prefactored.hs +47/−47
• Math/NumberTheory/Primes.hs +1/−1
• Math/NumberTheory/Primes/Counting/Impl.hs +19/−5
• Math/NumberTheory/Primes/Factorisation.hs +0/−13
• Math/NumberTheory/Primes/Factorisation/Certified.hs +2/−4
• Math/NumberTheory/Primes/Factorisation/Montgomery.hs +11/−15
• Math/NumberTheory/Primes/Heap.hs +0/−366
• Math/NumberTheory/Primes/Sieve/Eratosthenes.hs +136/−24
• Math/NumberTheory/Primes/Sieve/Indexing.hs +3/−98
• Math/NumberTheory/Primes/Sieve/Misc.hs +0/−407
• Math/NumberTheory/Primes/Testing.hs +0/−15
• Math/NumberTheory/Primes/Testing/Certificates/Internal.hs +0/−3
• Math/NumberTheory/Primes/Testing/Probabilistic.hs +1/−13
• Math/NumberTheory/Primes/Types.hs +11/−9
• Math/NumberTheory/Quadratic/EisensteinIntegers.hs +315/−0
• Math/NumberTheory/Quadratic/GaussianIntegers.hs +254/−0
• Math/NumberTheory/Recurrencies.hs +18/−0
• Math/NumberTheory/Recurrencies/Bilinear.hs +95/−37
• Math/NumberTheory/Recurrencies/Linear.hs +2/−7
• Math/NumberTheory/Recurrencies/Pentagonal.hs +96/−0
• Math/NumberTheory/SmoothNumbers.hs +78/−56
• Math/NumberTheory/UniqueFactorisation.hs +27/−30
• Math/NumberTheory/Utils.hs +41/−57
• Math/NumberTheory/Utils/FromIntegral.hs +0/−3
• Math/NumberTheory/Zeta.hs +8/−102
• Math/NumberTheory/Zeta/Dirichlet.hs +171/−0
• Math/NumberTheory/Zeta/Riemann.hs +106/−0
• Math/NumberTheory/Zeta/Utils.hs +51/−0
• arithmoi.cabal +207/−190
• benchmark/Bench.hs +13/−0
• benchmark/Math/NumberTheory/ArithmeticFunctionsBench.hs +15/−10
• benchmark/Math/NumberTheory/DiscreteLogarithmBench.hs +66/−0
• benchmark/Math/NumberTheory/EisensteinIntegersBench.hs +26/−0
• benchmark/Math/NumberTheory/GCDBench.hs +17/−1
• benchmark/Math/NumberTheory/GaussianIntegersBench.hs +22/−0
• benchmark/Math/NumberTheory/JacobiBench.hs +21/−0
• benchmark/Math/NumberTheory/MertensBench.hs +0/−3
• benchmark/Math/NumberTheory/PrimitiveRootsBench.hs +40/−0
• benchmark/Math/NumberTheory/RecurrenciesBench.hs +26/−7
• benchmark/Math/NumberTheory/SieveBlockBench.hs +3/−21
• benchmark/Math/NumberTheory/SmoothNumbersBench.hs +21/−0
• test-suite/Math/NumberTheory/ArithmeticFunctions/MertensTests.hs +0/−3
• test-suite/Math/NumberTheory/ArithmeticFunctions/SieveBlockTests.hs +0/−3
• test-suite/Math/NumberTheory/ArithmeticFunctionsTests.hs +106/−57
• test-suite/Math/NumberTheory/CurvesTests.hs +0/−4
• test-suite/Math/NumberTheory/EisensteinIntegersTests.hs +208/−0
• test-suite/Math/NumberTheory/GCD/LowLevelTests.hs +0/−74
• test-suite/Math/NumberTheory/GCDTests.hs +53/−9
• test-suite/Math/NumberTheory/GaussianIntegersTests.hs +109/−33
• test-suite/Math/NumberTheory/Moduli/ClassTests.hs +2/−3
• test-suite/Math/NumberTheory/Moduli/DiscreteLogarithmTests.hs +54/−0
• test-suite/Math/NumberTheory/Moduli/EquationsTests.hs +47/−0
• test-suite/Math/NumberTheory/Moduli/JacobiTests.hs +66/−4
• test-suite/Math/NumberTheory/Moduli/PrimitiveRootTests.hs +31/−20
• test-suite/Math/NumberTheory/Moduli/SqrtTests.hs +170/−58
• test-suite/Math/NumberTheory/Powers/CubesTests.hs +0/−5
• test-suite/Math/NumberTheory/Powers/FourthTests.hs +0/−4
• test-suite/Math/NumberTheory/Powers/ModularTests.hs +2/−8
• test-suite/Math/NumberTheory/Powers/SquaresTests.hs +0/−4
• test-suite/Math/NumberTheory/PrefactoredTests.hs +4/−8
• test-suite/Math/NumberTheory/Primes/FactorisationTests.hs +3/−1
• test-suite/Math/NumberTheory/Primes/SieveTests.hs +80/−31
• test-suite/Math/NumberTheory/PrimesTests.hs +0/−11
• test-suite/Math/NumberTheory/Recurrencies/BilinearTests.hs +39/−1
• test-suite/Math/NumberTheory/Recurrencies/PentagonalTests.hs +105/−0
• test-suite/Math/NumberTheory/SmoothNumbersTests.hs +68/−0
• test-suite/Math/NumberTheory/TestUtils.hs +35/−23
• test-suite/Math/NumberTheory/TestUtils/Wrappers.hs +6/−5
• test-suite/Math/NumberTheory/UniqueFactorisationTests.hs +1/−6
• test-suite/Math/NumberTheory/Zeta/DirichletTests.hs +115/−0
• test-suite/Math/NumberTheory/Zeta/RiemannTests.hs +118/−0
• test-suite/Math/NumberTheory/ZetaTests.hs +0/−116
• test-suite/Test.hs +23/−20

@@ -1,3 +1,64 @@+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. 

@@ -25,11 +25,6 @@ import Data.Semigroup #endif -#if MIN_VERSION_base(4,8,0)-#else-import Data.Word-#endif- import Math.NumberTheory.UniqueFactorisation  -- | A typical arithmetic function operates on the canonical factorisation of

@@ -17,9 +17,6 @@   ) where  import qualified Data.Vector.Unboxed as U-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif  import Math.NumberTheory.Powers.Cubes import Math.NumberTheory.Powers.Squares@@ -27,8 +24,8 @@  -- | 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]+-- >>> map (mertens . (10 ^)) [0..9]+-- [1,-1,1,2,-23,-48,212,1037,1928,-222] -- -- The implementation follows Theorem 3.1 from <https://arxiv.org/pdf/1610.08551.pdf Computations of the Mertens function and improved bounds on the Mertens conjecture> by G. Hurst, excluding segmentation of sieves. mertens :: Word -> Int

@@ -126,8 +126,8 @@ -- -- Based on the sieving algorithm from p. 3 of <https://arxiv.org/pdf/1610.08551.pdf Computations of the Mertens function and improved bounds on the Mertens conjecture> by G. Hurst. It is approximately 5x faster than 'Math.NumberTheory.ArithmeticFunctions.SieveBlock.sieveBlockUnboxed'. ----- > > sieveBlockMoebius 1 10--- > [MoebiusP, MoebiusN, MoebiusN, MoebiusZ, MoebiusN, MoebiusP, MoebiusN, MoebiusZ, MoebiusZ, MoebiusP]+-- >>> sieveBlockMoebius 1 10+-- [MoebiusP, MoebiusN, MoebiusN, MoebiusZ, MoebiusN, MoebiusP, MoebiusN, MoebiusZ, MoebiusZ, MoebiusP] sieveBlockMoebius   :: Word   -> Word

@@ -32,9 +32,6 @@ import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV import GHC.Exts-#if __GLASGOW_HASKELL__ < 709-import Data.Monoid-#endif  import Math.NumberTheory.ArithmeticFunctions.Class import Math.NumberTheory.ArithmeticFunctions.Moebius (sieveBlockMoebius)@@ -58,8 +55,8 @@ -- -- This is a thin wrapper over 'sieveBlock', read more details there. ----- > > runFunctionOverBlock carmichaelA 1 10--- > [1,1,2,2,4,2,6,2,6,4]+-- >>> runFunctionOverBlock carmichaelA 1 10+-- [1,1,2,2,4,2,6,2,6,4] runFunctionOverBlock   :: ArithmeticFunction Word a   -> Word@@ -82,8 +79,13 @@ -- -- For example, following code lists smallest prime factors: ----- > > sieveBlock (SieveBlockConfig maxBound min (\p _ -> p) 2 10)--- > [2,3,2,5,2,7,2,3,2,11]+-- >>> sieveBlock (SieveBlockConfig maxBound (\p _ -> p) min) 2 10+-- [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 -> [(p,k)]) (++)) 2 10+-- [[(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   -> Word

@@ -76,8 +76,8 @@ -- -- For example, here is an analogue of divisor function 'tau': ----- > > sieveBlockUnboxed (SieveBlockConfig 1 (*) (\_ a -> a + 1) 1 10)--- > [1,2,2,3,2,4,2,4,3,4]+-- >>> sieveBlockUnboxed (SieveBlockConfig 1 (\_ a -> a + 1) (*)) 1 10+-- [1,2,2,3,2,4,2,4,3,4] sieveBlockUnboxed   :: V.Unbox a   => SieveBlockConfig a

@@ -26,6 +26,7 @@   , sigma, sigmaA   , totient, totientA   , jordan, jordanA+  , ramanujan, ramanujanA   , moebius, moebiusA, Moebius(..), runMoebius   , liouville, liouvilleA     -- * Additive functions@@ -51,12 +52,6 @@  import Numeric.Natural -#if MIN_VERSION_base(4,8,0)-#else-import Data.Foldable-import Data.Word-#endif- -- | Create a multiplicative function from the function on prime's powers. See examples below. multiplicative :: Num a => (Prime n -> Word -> a) -> ArithmeticFunction n a multiplicative f = ArithmeticFunction ((Product .) . f) getProduct@@ -154,6 +149,27 @@ jordanHelper pa 2 = (pa - 1) * pa jordanHelper pa k = (pa - 1) * pa ^ wordToInt (k - 1) {-# INLINE jordanHelper #-}++ramanujan :: Integer -> Integer+ramanujan = runFunction ramanujanA++-- | Calculates the <https://en.wikipedia.org/wiki/Ramanujan_tau_function Ramanujan tau function>+--   of a positive number @n@, using formulas given <http://www.numbertheory.org/php/tau.html here>+ramanujanA :: ArithmeticFunction Integer Integer+ramanujanA = multiplicative $ \(unPrime -> p) -> ramanujanHelper p++ramanujanHelper :: Integer -> Word -> Integer+ramanujanHelper _ 0 = 1+ramanujanHelper 2 1 = -24+ramanujanHelper p 1 = (65 * sigmaHelper (p ^ (11 :: Int)) 1 + 691 * sigmaHelper (p ^ (5 :: Int)) 1 - 691 * 252 * 2 * sum [sigma 5 k * sigma 5 (p-k) | k <- [1..(p `quot` 2)]]) `quot` 756+ramanujanHelper p k = sum $ zipWith3 (\a b c -> a * b * c) paPowers tpPowers binomials+  where pa = p ^ (11 :: Int)+        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+        tpPowers = reverse $ take (length binomials) $ iterate (* tp^(2::Int)) (if even k then 1 else tp)+{-# INLINE ramanujanHelper #-}  moebius :: UniqueFactorisation n => n -> Moebius moebius = runFunction moebiusA

@@ -33,10 +33,11 @@  import Data.Proxy import GHC.Exts-import GHC.Integer.GMP.Internals import GHC.Integer.Logarithms import GHC.TypeNats.Compat +import Math.NumberTheory.Utils (recipMod)+ -- | We use the Montgomery form of elliptic curve: -- b Y² = X³ + a X² + X (mod n). -- See Eq. (10.3.1.1) at p. 260 of <http://www.ams.org/journals/mcom/1987-48-177/S0025-5718-1987-0866113-7/S0025-5718-1987-0866113-7.pdf Speeding the Pollard and Elliptic Curve Methods of Factorization> by P. L. Montgomery.@@ -90,9 +91,7 @@ -- by K. Gaj, S. Kwon et al. newPoint :: Integer -> Integer -> Maybe SomePoint newPoint s n = do-    a24denRecip <- case recipModInteger a24den n of-      0 -> Nothing-      t -> Just t+    a24denRecip <- recipMod a24den n     a24 <- case a24num * a24denRecip `rem` n of       -- (a+2)/4 = 0 corresponds to singular curve with A = -2       0 -> Nothing

@@ -0,0 +1,165 @@+-- |+-- Module:      Math.NumberTheory.Euclidean+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- 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 'Eucledian' 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++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

@@ -0,0 +1,124 @@+-- |+-- Module:      Math.NumberTheory.Euclidean.Coprimes+-- Copyright:   (c) 2017-2018 Andrew Lelechenko+-- Licence:     MIT+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Container for pairwise coprime numbers.++{-# LANGUAGE CPP                 #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Math.NumberTheory.Euclidean.Coprimes+  ( splitIntoCoprimes+  , Coprimes+  , unCoprimes+  , singleton+  , insert+  ) where++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++-- | A list of pairwise coprime numbers+-- with their multiplicities.+newtype Coprimes a b = Coprimes {+  unCoprimes :: [(a, b)] -- ^ Unwrap.+  }+  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)+    where+      (x', g', xgs) = doPair (x `quot` g) xm g (xm + ym)+      xgs' = if g' == 1 then xgs else ((g', xm + ym) : xgs)++      (y', rests) = mapAccumL go (y `quot` g) xgs'+      go w (t, tm) = (w', if t' == 1 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 x xm y ym+  =  x `rem` x' == 0+  && y `rem` y' == 0+  && coprime x' y'+  && all (coprime x') (map fst rest)+  && all (coprime y') (map fst rest)+  && all (/= 1) (map 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)+  where+    (x', y', rest) = doPair x xm y ym++insertInternal+  :: forall a b.+     (Euclidean 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)+  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 [] = (old, (x, xm) : new)+    go _ _ ((0, _) : _) = ([(0, 1)], [])+    go (old, new) x ((y, ym) : rest)+      | y' == 1   = go (old, xys ++ new) x' rest+      | otherwise = go ((y', ym) : old, xys ++ new) x' rest+      where+        (x', y', xys) = doPair x xm y ym++-- | Wrap a non-zero number with its multiplicity into 'Coprimes'.+--+-- >>> 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)]++-- | Add a non-zero number with its multiplicity to 'Coprimes'.+--+-- >>> insert 360 1 (singleton 210 1)+-- 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 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+  (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+  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+-- list is a factorisation of the same number such that all factors+-- are coprime. Such transformation is crucial to continue factorisation+-- (lazily, in parallel or concurrent fashion) without+-- having to merge multiplicities of primes, which occurs more than in one+-- composite factor.+--+-- >>> splitIntoCoprimes [(140, 1), (165, 1)]+-- 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 = foldl (\acc (x, xm) -> insert x xm acc) mempty

@@ -21,19 +21,23 @@ -- When using this module, always compile with optimisations turned on to -- benefit from GHC's primops and the rewrite rules. -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP          #-}-{-# LANGUAGE LambdaCase   #-}-{-# LANGUAGE MagicHash    #-}+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MagicHash           #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-deprecations   #-}+ module Math.NumberTheory.GCD     ( binaryGCD     , extendedGCD     , coprime-    , splitIntoCoprimes     ) where  import Data.Bits+import Data.Semigroup+ import GHC.Word import GHC.Int @@ -80,6 +84,8 @@ binaryGCD :: (Integral a, Bits a) => a -> a -> a binaryGCD = binaryGCDImpl +{-# DEPRECATED binaryGCD "Use 'Math.NumberTheory.Euclidean.gcd'" #-}+ #if WORD_SIZE_IN_BITS < 64 {-# SPECIALISE binaryGCDImpl :: Word64 -> Word64 -> Word64,                                 Int64 -> Int64 -> Int64 #-}@@ -136,6 +142,7 @@       | s == 0    = (r, o1, o2)       | otherwise = case r `quotRem` s of                       (q, t) -> eGCD (o1 - q*n1) n1 (o2 - q*n2) n2 s t+{-# DEPRECATED extendedGCD "Use 'Math.NumberTheory.Euclidean.extendedGCD'" #-}  {-# RULES "coprime/Int"       coprime = coprimeInt@@ -170,6 +177,7 @@ --   Relies on twos complement or sign and magnitude representaion for signed types. coprime :: (Integral a, Bits a) => a -> a -> Bool coprime = coprimeImpl+{-# DEPRECATED coprime "Use 'Math.NumberTheory.Euclidean.coprime'" #-}  -- Separate implementation to give the rules a chance to fire by not inlining -- before phase 1, and yet have a specialisation for the types without rules@@ -251,37 +259,3 @@  cw32 :: Word32 -> Word32 -> Bool cw32 (W32# x#) (W32# y#) = coprimeWord# x# y#---- | 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--- list is a factorisation of the same number such that all factors--- are coprime. Such transformation is crucial to continue factorisation--- (lazily, in parallel or concurrent fashion) without--- having to merge multiplicities of primes, which occurs more than in one--- composite factor.------ > > splitIntoCoprimes [(140, 1), (165, 1)]--- > [(5,2),(28,1),(33,1)]--- > > splitIntoCoprimes [(360, 1), (210, 1)]--- > [(2,4),(3,3),(5,2),(7,1)]-splitIntoCoprimes :: (Integral a, Eq b, Num b) => [(a, b)] -> [(a, b)]-splitIntoCoprimes xs = if any ((== 0) . fst) ys then [(0, 1)] else go ys-  where-    ys = filter (/= (0, 0)) xs--    go = \case-      [] -> []-      ((1,  _) : rest) -> go rest-      ((x, xm) : rest) -> case popSuchThat (\(r, _) -> gcd x r /= 1) rest of-        Nothing            -> (x, xm) : go rest-        Just ((y, ym), zs) -> let g = gcd x y in-          go ((g, xm + ym) : (x `quot` g, xm) : (y `quot` g, ym) : zs)--popSuchThat :: (a -> Bool) -> [a] -> Maybe (a, [a])-popSuchThat predicate = go-  where-    go = \case-      [] -> Nothing-      (x : xs)-        | predicate x -> Just (x, xs)-        | otherwise   -> fmap (fmap (x :)) (go xs)

@@ -31,6 +31,9 @@  import Math.NumberTheory.Utils +{-# DEPRECATED gcdInt, gcdWord, gcdInt#, gcdWord# "Use Math.NumberTheory.Euclidean.gcd" #-}+{-# DEPRECATED coprimeInt, coprimeWord, coprimeInt#, coprimeWord# "Math.NumberTheory.Euclidean." #-}+ -- | Greatest common divisor of two 'Int's, calculated with the binary gcd algorithm. gcdInt :: Int -> Int -> Int gcdInt (I# a#) (I# b#) = I# (gcdInt# a# b#)

@@ -10,226 +10,9 @@ -- computing their prime factorisations. -- -{-# LANGUAGE BangPatterns #-}--module Math.NumberTheory.GaussianIntegers (-    GaussianInteger((:+)),-    ι,-    real,-    imag,-    conjugate,-    norm,-    divModG,-    divG,-    modG,-    quotRemG,-    quotG,-    remG,-    (.^),-    isPrime,-    primes,-    gcdG,-    gcdG',-    findPrime,-    findPrime',-    factorise,-) where--import qualified Math.NumberTheory.Moduli as Moduli-import qualified Math.NumberTheory.Powers as Powers-import qualified Math.NumberTheory.Primes.Factorisation as Factorisation-import qualified Math.NumberTheory.Primes.Sieve as Sieve-import qualified Math.NumberTheory.Primes.Testing as Testing--infix 6 :+-infixr 8 .^--- |A Gaussian integer is a+bi, where a and b are both integers.-data GaussianInteger = (:+) { real :: !Integer, imag :: !Integer } deriving (Eq)---- |The imaginary unit, where------ > ι .^ 2 == -1-ι :: GaussianInteger-ι = 0 :+ 1--instance Show GaussianInteger where-    show (a :+ b)-        | b == 0     = show a-        | a == 0     = s ++ b'-        | otherwise  = show a ++ op ++ b'-        where-            b' = if abs b == 1 then "ι" else show (abs b) ++ "*ι"-            op = if b > 0 then "+" else "-"-            s  = if b > 0 then "" else "-"--instance Num GaussianInteger where-    (+) (a :+ b) (c :+ d) = (a + c) :+ (b + d)-    (*) (a :+ b) (c :+ d) = (a * c - b * d) :+ (a * d + b * c)-    abs z@(a :+ b)-        | a == 0 && b == 0 =   z             -- origin-        | a >  0 && b >= 0 =   z             -- 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)    -- third quadrant: (-inf, 0) x (-inf, 0]i-        | otherwise        = (-b) :+   a     -- fourth quadrant: [0, inf) x (-inf, 0)i-    negate (a :+ b) = (-a) :+ (-b)-    fromInteger n = n :+ 0-    signum z@(a :+ b)-        | a == 0 && b == 0 = z               -- hole at origin-        | otherwise        = z `divG` abs z---- |Simultaneous 'quot' and 'rem'.-quotRemG :: GaussianInteger -> GaussianInteger -> (GaussianInteger, GaussianInteger)-quotRemG = divHelper quot---- |Gaussian integer division, truncating toward zero.-quotG :: GaussianInteger -> GaussianInteger -> GaussianInteger-n `quotG` d = q where (q,_) = quotRemG n d---- |Gaussian integer remainder, satisfying------ > (x `quotG` y)*y + (x `remG` y) == x-remG :: GaussianInteger -> GaussianInteger -> GaussianInteger-n `remG`  d = r where (_,r) = quotRemG n d---- |Simultaneous 'div' and 'mod'.-divModG :: GaussianInteger -> GaussianInteger -> (GaussianInteger, GaussianInteger)-divModG = divHelper div---- |Gaussian integer division, truncating toward negative infinity.-divG :: GaussianInteger -> GaussianInteger -> GaussianInteger-n `divG` d = q where (q,_) = divModG n d---- |Gaussian integer remainder, satisfying------ > (x `divG` y)*y + (x `modG` y) == x-modG :: GaussianInteger -> GaussianInteger -> GaussianInteger-n `modG` d = r where (_,r) = divModG n d--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)---- |Conjugate a Gaussian integer.-conjugate :: GaussianInteger -> GaussianInteger-conjugate (r :+ i) = r :+ (-i)---- |The square of the magnitude of a Gaussian integer.-norm :: GaussianInteger -> Integer-norm (x :+ y) = x * x + y * y---- |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---- |An infinite list of the Gaussian primes. Uses primes in Z to exhaustively--- generate all Gaussian primes, but not quite in order of ascending magnitude.-primes :: [GaussianInteger]-primes = [ g-         | p <- Sieve.primes-         , g <- if p `mod` 4 == 3-                then [p :+ 0]-                else-                    if p == 2-                    then [1 :+ 1]-                    else let x :+ y = findPrime' p-                         in [x :+ y, y :+ x]-         ]---- |Compute the GCD of two Gaussian integers. Enforces the precondition that each--- integer must be in the first quadrant (or zero).-gcdG :: GaussianInteger -> GaussianInteger -> GaussianInteger-gcdG g h = gcdG' (abs g) (abs h)---- |Compute the GCD of two Gauss integers. Does not check the precondition.-gcdG' :: GaussianInteger -> GaussianInteger -> GaussianInteger-gcdG' g h-    | h == 0    = g --done recursing-    | otherwise = gcdG' h (abs (g `modG` h))---- |Find a Gaussian integer whose norm is the given prime number.--- Checks the precondition that p is prime and that p `mod` 4 /= 3.-findPrime :: Integer -> GaussianInteger-findPrime p-    | p == 2 || (p `mod` 4 == 1 && Testing.isPrime p) = findPrime' p-    | otherwise = error "p must be prime, and not congruent to 3 (mod 4)"---- |Find a Gaussian integer whose norm is the given prime number. Does not--- check the precondition.-findPrime' :: Integer -> GaussianInteger-findPrime' p =-    let (Just c) = Moduli.sqrtModP (-1) p-        k  = Powers.integerSquareRoot p-        bs = [1 .. k]-        asbs = map (\b' -> ((b' * c) `mod` p, b')) bs-        (a, b) = head [ (a', b') | (a', b') <- asbs, a' <= k]-    in a :+ b---- |Raise a Gaussian integer to a given power.-(.^) :: (Integral a) => GaussianInteger -> a -> GaussianInteger-a .^ e-    | e < 0 && norm a == 1 =-        case a of-            1    :+ 0 -> 1-            (-1) :+ 0 -> if even e then 1 else (-1)-            0    :+ 1 -> (0 :+ (-1)) .^ (abs e `mod` 4)-            _         -> (0 :+ 1) .^ (abs e `mod` 4)-    | e < 0     = error "Cannot exponentiate non-unit Gaussian Int to negative power"-    | a == 0    = 0-    | e == 0    = 1-    | even e    = s * s-    | otherwise = a * a .^ (e - 1)-    where-    s = a .^ div e 2---- |Compute the prime factorisation of a Gaussian integer. This is unique up to units (+/- 1, +/- i).-factorise :: GaussianInteger -> [(GaussianInteger, Int)]-factorise g = helper (Factorisation.factorise $ norm g) g-    where-    helper [] g' = if g' == 1 then [] else [(g', 1)] -- include the unit, if it isn't 1-    helper ((!p, !e) : pt) g' =-        -- For a given prime factor p of the magnitude squared...-        let (!g'', !facs) = if p `mod` 4 == 3-            then-                -- if the p is congruent to 3 (mod 4), then g' is divisible by-                -- p^(e/2).-                let pow = div e 2-                    gp = fromInteger p-                in (g' `divG` (gp .^ pow), [(gp, pow)])-            else-                -- otherwise: find a Gaussian prime gp for which `norm gp ==-                -- p`. Then do trial divisions to find out how many times g' is-                -- divisible by gp or its conjugate.-                let gp = findPrime' p-                in trialDivide g' [gp, abs $ conjugate gp]-        in facs ++ helper pt g''---- Divide a Gaussian integer by a set of (relatively prime) Gaussian integers,--- as many times as possible, and return the final quotient as well as a count--- of how many times each factor divided the original.-trialDivide :: GaussianInteger -> [GaussianInteger] -> (GaussianInteger, [(GaussianInteger, Int)])-trialDivide = helper []-    where-    helper fs g [] = (g, fs)-    helper fs g (pf : pft)-        | g `modG` pf == 0 =-            let (cnt, g') = countEvenDivisions g pf-            in helper ((pf, cnt) : fs) g' pft-        | otherwise        = helper fs g pft+module Math.NumberTheory.GaussianIntegers+  {-# DEPRECATED "Use Math.NumberTheory.Quadratic.GaussianIntegers instead" #-}+  ( module Math.NumberTheory.Quadratic.GaussianIntegers+  ) where --- Divide a Gaussian integer by a possible factor, and return how many times--- the factor divided it evenly, as well as the result of dividing the original--- that many times.-countEvenDivisions :: GaussianInteger -> GaussianInteger -> (Int, GaussianInteger)-countEvenDivisions g pf = helper g 0-    where-    helper :: GaussianInteger -> Int -> (Int, GaussianInteger)-    helper g' acc-        | g' `modG` pf == 0 = helper (g' `divG` pf) (1 + acc)-        | otherwise     = (acc, g')+import Math.NumberTheory.Quadratic.GaussianIntegers

@@ -12,11 +12,15 @@ 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.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.Sqrt

@@ -17,9 +17,9 @@   ) where  import Control.Monad (foldM)-import GHC.Integer.GMP.Internals -import Math.NumberTheory.GCD (extendedGCD)+import Math.NumberTheory.Euclidean (extendedGCD)+import Math.NumberTheory.Utils (recipMod)  -- | Given a list @[(r_1,m_1), ..., (r_n,m_n)]@ of @(residue,modulus)@ --   pairs, @chineseRemainder@ calculates the solution to the simultaneous@@ -52,8 +52,3 @@ chineseRemainder2 (r1, md1) (r2,md2)     = case extendedGCD md1 md2 of         (_,u,v) -> ((1 - u*md1)*r1 + (1 - v*md2)*r2) `mod` (md1*md2)--recipMod :: Integer -> Integer -> Maybe Integer-recipMod x m = case recipModInteger x m of-  0 -> Nothing-  y -> Just y

@@ -9,7 +9,6 @@ -- Safe modular arithmetic with modulo on type level. -- -{-# LANGUAGE CPP                        #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -29,6 +28,11 @@   , invertMod   , powMod   , (^%)+  -- * Multiplicative group+  , MultMod+  , multElement+  , isMultElement+  , invertGroup   -- * Unknown modulo   , SomeMod(..)   , modulo@@ -40,19 +44,12 @@  import Data.Proxy import Data.Ratio+import Data.Semigroup import Data.Type.Equality import GHC.Integer.GMP.Internals import GHC.TypeNats.Compat -#if __GLASGOW_HASKELL__ < 709-import Data.Word-import Numeric.Natural (Natural)--powModNatural :: Natural -> Natural -> Natural -> Natural-powModNatural b e m = fromInteger $ powModInteger (toInteger b) (toInteger e) (toInteger m)-#else import GHC.Natural (Natural, powModNatural)-#endif  -- | Wrapper for residues modulo @m@. --@@ -60,10 +57,11 @@ -- The modulo is stored on type level, so it is impossible, for example, to add up by mistake -- residues with different moduli. ----- > > (3 :: Mod 10) + (4 :: Mod 12)--- > error: Couldn't match type ‘12’ with ‘10’...--- > > (3 :: Mod 10) + 8--- > (1 `modulo` 10)+-- >>> :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@@ -128,33 +126,36 @@ {-# INLINE getNatMod #-}  -- | The canonical representative of the residue class, always between 0 and @m-1@ inclusively.-getVal :: KnownNat m => Mod m -> Integer+getVal :: Mod m -> Integer getVal (Mod x) = toInteger x {-# INLINE getVal #-}  -- | The canonical representative of the residue class, always between 0 and @m-1@ inclusively.-getNatVal :: KnownNat m => Mod m -> Natural+getNatVal :: Mod m -> Natural getNatVal (Mod x) = x {-# INLINE getNatVal #-}  -- | Computes the modular inverse, if the residue is coprime with the modulo. ----- > > invertMod (3 :: Mod 10)--- > Just (7 `modulo` 10) -- because 3 * 7 = 1 :: Mod 10--- > > invertMod (4 :: Mod 10)--- > Nothing+-- >>> :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 '^', with much better performance. ----- > > powMod (3 :: Mod 10) 4+-- >>> :set -XDataKinds+-- >>> powMod (3 :: Mod 10) 4 -- > (1 `modulo` 10) powMod :: (KnownNat m, Integral a) => Mod m -> a -> Mod m powMod mx a@@ -185,18 +186,51 @@ -- 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 }+  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)+-- >>> 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.,@@ -286,12 +320,12 @@  -- | Computes the inverse value, if it exists. ----- > > invertSomeMod (3 `modulo` 10)--- > Just (7 `modulo` 10) -- because 3 * 7 = 1 :: Mod 10--- > > invertMod (4 `modulo` 10)--- > Nothing--- > > invertSomeMod (fromRational (2 % 5))--- > Just 5 % 2+-- >>> invertSomeMod (3 `modulo` 10)+-- Just (7 `modulo` 10) -- because 3 * 7 = 1 :: Mod 10+-- >>> invertMod (4 `modulo` 10)+-- Nothing+-- >>> invertSomeMod (fromRational (2 % 5))+-- Just 5 % 2 invertSomeMod :: SomeMod -> Maybe SomeMod invertSomeMod = \case   SomeMod m -> fmap SomeMod (invertMod m)@@ -307,8 +341,8 @@ -- | Drop-in replacement for '^', with much better performance. -- When -O is enabled, there is a rewrite rule, which specialises '^' to 'powSomeMod'. ----- > > powSomeMod (3 `modulo` 10) 4--- > (1 `modulo` 10)+-- >>> 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)

@@ -0,0 +1,123 @@+-- |+-- Module:       Math.NumberTheory.Moduli.DiscreteLogarithm+-- Copyright:    (c) 2018 Bhavik Mehta+-- License:      MIT+-- Maintainer:   Andrew Lelechenko <andrew.lelechenko@gmail.com>+-- Stability:    Provisional+-- Portability:  Non-portable+--++{-# 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.UniqueFactorisation  (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       (unPrime -> p) k -> discreteLogarithmPP p k (getVal a) (getVal b)+    CGDoubleOddPrimePower (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

@@ -0,0 +1,137 @@+-- |+-- Module:      Math.NumberTheory.Moduli.Equations+-- Copyright:   (c) 2018 Andrew Lelechenko+-- Licence:     MIT+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- Polynomial modular equations.+--++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns        #-}++module Math.NumberTheory.Moduli.Equations+  ( solveLinear+  , solveQuadratic+  ) where++import GHC.Integer.GMP.Internals++import Math.NumberTheory.Moduli.Chinese+import Math.NumberTheory.Moduli.Class+import Math.NumberTheory.Moduli.Sqrt+import Math.NumberTheory.UniqueFactorisation+import Math.NumberTheory.Utils (recipMod)++-------------------------------------------------------------------------------+-- Linear equations++-- | Find all solutions of ax + b ≡ 0 (mod m).+--+-- >>> :set -XDataKinds+-- >>> solveLinear (6 :: Mod 10) 4 -- solving 6x + 4 ≡ 0 (mod 10)+-- [(1 `modulo` 10),(6 `modulo` 10)]+solveLinear+  :: KnownNat m+  => Mod m   -- ^ a+  -> Mod m   -- ^ b+  -> [Mod m] -- ^ list of x+solveLinear a b = map fromInteger $ solveLinear' (getMod a) (getVal a) (getVal b)++solveLinear' :: Integer -> Integer -> Integer -> [Integer]+solveLinear' m a b = case solveLinearCoprime m' (a `quot` d) (b `quot` d) of+  Nothing -> []+  Just x  -> map (\i -> x + m' * i) [0 .. d - 1]+  where+    d = m `gcd` a `gcd` b+    m' = m `quot` d++solveLinearCoprime :: Integer -> Integer -> Integer -> Maybe Integer+solveLinearCoprime 1 _ _ = Just 0+solveLinearCoprime m a b = (\a1 -> negate b * a1 `mod` m) <$> recipMod a m++-------------------------------------------------------------------------------+-- Quadratic equations++-- | Find all solutions of ax² + bx + c ≡ 0 (mod m).+--+-- >>> :set -XDataKinds+-- >>> solveQuadratic (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+  -> Mod m   -- ^ b+  -> Mod m   -- ^ c+  -> [Mod m] -- ^ list of c+solveQuadratic a b c+  = map fromInteger+  $ fst+  $ combine+  $ map (\(p, n) -> (solveQuadraticPrimePower a' b' c' p n, unPrime p ^ n))+  $ factorise+  $ getMod a+  where+    a' = getVal a+    b' = getVal b+    c' = getVal c++    combine :: [([Integer], Integer)] -> ([Integer], Integer)+    combine = foldl+      (\(xs, xm) (ys, ym) -> ([ chineseRemainder2 (x, xm) (y, ym) | x <- xs, y <- ys ], xm * ym))+      ([0], 1)++solveQuadraticPrimePower+  :: Integer+  -> Integer+  -> Integer+  -> Prime Integer+  -> Word+  -> [Integer]+solveQuadraticPrimePower a b c p = go+  where+    go :: Word -> [Integer]+    go 0 = [0]+    go 1 = solveQuadraticPrime a b c p+    go k = concatMap (liftRoot k) (go (k - 1))++    -- Hensel lifting+    -- https://en.wikipedia.org/wiki/Hensel%27s_lemma#Hensel_lifting+    liftRoot :: Word -> Integer -> [Integer]+    liftRoot k r = case recipMod (2 * a * r + b) pk of+      Nothing -> case fr of+        0 -> map (\i -> r + pk `quot` p' * i) [0 .. p' - 1]+        _ -> []+      Just invDeriv -> [(r - fr * invDeriv) `mod` pk]+      where+        pk = p' ^ k+        fr = (a * r * r + b * r + c) `mod` pk++    p' :: Integer+    p' = unPrime p++solveQuadraticPrime+  :: Integer+  -> Integer+  -> Integer+  -> Prime Integer+  -> [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+  = solveLinear' p' b c+  | otherwise+  = map (\n -> n * recipModInteger (2 * a) p' `mod` p')+  $ map (subtract b)+  $ sqrtsModPrime (b * b - 4 * a * c) p+    where+      p' :: Integer+      p' = unPrime p+

@@ -1,36 +1,38 @@ -- | -- Module:      Math.NumberTheory.Moduli.Jacobi--- Copyright:   (c) 2011 Daniel Fischer, 2017 Andrew Lelechenko+-- Copyright:   (c) 2011 Daniel Fischer, 2017-2018 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com> -- Stability:   Provisional -- Portability: Non-portable (GHC extensions) ----- Jacobi symbol.+-- <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol>+-- is a generalization of the Legendre symbol, useful for primality+-- testing and integer factorization. -- -{-# LANGUAGE CPP        #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP          #-}+{-# LANGUAGE LambdaCase   #-} +{-# OPTIONS_GHC -fno-warn-deprecations  #-}+ module Math.NumberTheory.Moduli.Jacobi   ( JacobiSymbol(..)   , jacobi   , jacobi'   ) where -import Data.Array.Unboxed import Data.Bits #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif+import Numeric.Natural -import Math.NumberTheory.Unsafe import Math.NumberTheory.Utils --- | Type for result of 'jacobi'.+-- | Represents three possible values of+-- <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol>. data JacobiSymbol = MinusOne | Zero | One   deriving (Eq, Ord, Show) @@ -50,103 +52,73 @@   Zero     -> Zero   One      -> MinusOne --- | Jacobi symbol of two numbers.---   The \"denominator\" must be odd and positive, this condition is checked.+-- | <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 both numbers have a common prime factor, the result---   is @0@, otherwise it is &#177;1.+-- 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"-  | b == 1      = One-  | otherwise   = jacobi' a b   -- b odd, > 1+  | 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 --- Invariant: b > 1 and odd--- | Jacobi symbol of two numbers without validity check of---   the \"denominator\".-{-# SPECIALISE jacobi' :: Integer -> Integer -> JacobiSymbol,-                          Int -> Int -> JacobiSymbol,-                          Word -> Word -> JacobiSymbol-  #-} jacobi' :: (Integral a, Bits a) => a -> a -> JacobiSymbol+jacobi' 0 _ = Zero+jacobi' 1 _ = One jacobi' a b-  | a == 0      = Zero-  | a == 1      = One-  | a < 0       = let n | rem4 b == 1 = One-                        | otherwise   = MinusOne-                      -- Blech, minBound may pose problems-                      (z,o) = shiftToOddCount (abs $ toInteger a)-                      s | evenI z || unsafeAt jac2 (rem8 b) == 1 = n-                        | otherwise                              = negJS n-                  in s <> jacobi' (fromInteger 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 | rem4 o .&. rem4 b == 1 = One-                                   | otherwise              = MinusOne-                                 s | evenI z || unsafeAt jac2 (rem8 b) == 1 = r-                                   | otherwise                              = negJS r-                             in jacOL s b o-  | otherwise   = case rem4 a .&. rem4 b of-                    3 -> jacOL MinusOne b a-                    _ -> jacOL One      b a+  | 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+{-# DEPRECATED jacobi' "Use 'jacobi' instead" #-}  -- numerator positive and smaller than denominator-{-# SPECIALISE jacPS :: JacobiSymbol -> Integer -> Integer -> JacobiSymbol,-                        JacobiSymbol -> Int -> Int -> JacobiSymbol,-                        JacobiSymbol -> Word -> Word -> JacobiSymbol-  #-} jacPS :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol-jacPS j a b-  | evenI a     = case shiftToOddCount a of-                    (z,o) | evenI z || unsafeAt jac2 (rem8 b) == 1 ->-                              jacOL (if rem4 o .&. rem4 b == 3 then (negJS j) else j) b o-                          | otherwise ->-                              jacOL (if rem4 o .&. rem4 b == 3 then j else (negJS j)) b o-  | otherwise   = jacOL (if rem4 a .&. rem4 b == 3 then (negJS j) else j) b a+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-{-# SPECIALISE jacOL :: JacobiSymbol -> Integer -> Integer -> JacobiSymbol,-                        JacobiSymbol -> Int -> Int -> JacobiSymbol,-                        JacobiSymbol -> Word -> Word -> JacobiSymbol-  #-} jacOL :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol-jacOL j a b-  | b == 1    = j-  | otherwise = case a `rem` b of-                 0 -> Zero-                 r -> jacPS j r b+jacOL !acc _ 1 = acc+jacOL !acc a b = case a `rem` b of+  0 -> Zero+  r -> jacPS acc r b  -- Utilities --- For large Integers, going via Int is much faster than bit-fiddling--- on the Integer, so we do that.-{-# SPECIALISE evenI :: Integer -> Bool,-                        Int -> Bool,-                        Word -> Bool-  #-}-evenI :: Integral a => a -> Bool-evenI n = fromIntegral n .&. 1 == (0 :: Int)--{-# SPECIALISE rem4 :: Integer -> Int,-                       Int -> Int,-                       Word -> Int-  #-}-rem4 :: Integral a => a -> Int-rem4 n = fromIntegral n .&. 3+-- Sadly, GHC do not optimise `Prelude.even` to a bit test automatically.+evenI :: Bits a => a -> Bool+evenI n = not (n `testBit` 0) -{-# SPECIALISE rem8 :: Integer -> Int,-                       Int -> Int,-                       Word -> Int-  #-}-rem8 :: Integral a => a -> Int-rem8 n = fromIntegral n .&. 7+-- For an odd input @n@ test whether n `rem` 4 == 1+rem4is3 :: Bits a => a -> Bool+rem4is3 n = n `testBit` 1 -jac2 :: UArray Int Int-jac2 = array (0,7) [(0,0),(1,1),(2,0),(3,-1),(4,0),(5,-1),(6,0),(7,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

@@ -10,6 +10,7 @@ --  {-# LANGUAGE CPP                  #-}+{-# LANGUAGE DeriveGeneric        #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE LambdaCase           #-} {-# LANGUAGE StandaloneDeriving   #-}@@ -17,27 +18,38 @@ {-# LANGUAGE UndecidableInstances #-}  module Math.NumberTheory.Moduli.PrimitiveRoot-  ( isPrimitiveRoot-    -- * Cyclic groups-  , CyclicGroup(..)+  ( -- * Cyclic groups+    CyclicGroup(..)   , cyclicGroupFromModulo   , cyclicGroupToModulo+  , groupSize+    -- * Primitive roots+  , PrimitiveRoot+  , unPrimitiveRoot+  , getGroup+  , isPrimitiveRoot   , isPrimitiveRoot'   ) where -#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative-import Data.Word+#if __GLASGOW_HASKELL__ < 803+import Data.Semigroup #endif  import Math.NumberTheory.ArithmeticFunctions (totient)-import Math.NumberTheory.Moduli (Mod, getNatMod, getNatVal, KnownNat)+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.UniqueFactorisation import Math.NumberTheory.Utils.FromIntegral +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.@@ -50,18 +62,22 @@   -- ^ Residues modulo @p@^@k@ for __odd__ prime @p@.   | CGDoubleOddPrimePower (Prime a) Word   -- ^ Residues modulo 2@p@^@k@ for __odd__ prime @p@.+  deriving (Generic) +instance NFData (Prime a) => NFData (CyclicGroup a)++deriving instance Eq   (Prime a) => Eq   (CyclicGroup a) deriving instance Show (Prime a) => Show (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 (PrimeNat 13) 3)--- > > cyclicGroupFromModulo (4 * 13)--- > Nothing+-- >>> cyclicGroupFromModulo 4+-- Just CG4+-- >>> cyclicGroupFromModulo (2 * 13 ^ 3)+-- Just (CGDoubleOddPrimePower (PrimeNat 13) 3)+-- >>> cyclicGroupFromModulo (4 * 13)+-- Nothing cyclicGroupFromModulo   :: (Ord a, Integral a, UniqueFactorisation a)   => a@@ -88,61 +104,86 @@ -- | Extract modulo and its factorisation from -- a cyclic multiplicative group of residues. ----- > > cyclicGroupToModulo CG4--- > Prefactored {prefValue = 4, prefFactors = [(2, 2)]}--- > > cyclicGroupToModulo (CGDoubleOddPrimePower (PrimeNat 13) 3)--- > Prefactored {prefValue = 4394, prefFactors = [(2, 1), (13, 3)]}+-- >>> cyclicGroupToModulo CG4+-- Prefactored {prefValue = 4, prefFactors = Coprimes {unCoprimes = fromList [(2,2)]}}+--+-- >>> :set -XTypeFamilies+-- >>> cyclicGroupToModulo (CGDoubleOddPrimePower (PrimeNat 13) 3)+-- Prefactored {prefValue = 4394, prefFactors = Coprimes {unCoprimes = fromList [(2,1),(13,3)]}} cyclicGroupToModulo-  :: (Integral a, UniqueFactorisation a)+  :: (E.Euclidean a, Ord a, UniqueFactorisation a)   => CyclicGroup a   -> Prefactored a cyclicGroupToModulo = fromFactors . \case-  CG2                       -> [(2, 1)]-  CG4                       -> [(2, 2)]-  CGOddPrimePower p k       -> [(unPrime p, k)]-  CGDoubleOddPrimePower p k -> [(2, 1), (unPrime p, k)]+  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 primitive roots of n.+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+-- >>> let Just cg = cyclicGroupFromModulo 13+-- >>> isPrimitiveRoot' cg 1+-- False+-- >>> isPrimitiveRoot' cg 2+-- True isPrimitiveRoot'   :: (Integral a, UniqueFactorisation a)   => CyclicGroup a   -> a   -> Bool-isPrimitiveRoot' cg r = r /= 0 && gcd r (prefValue m) == 1 && all (/= 1) exps+-- 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-    -- https://en.wikipedia.org/wiki/Primitive_root_modulo_n#Finding_primitive_roots-    m    = cyclicGroupToModulo cg-    phi  = totient m-    pows = map (\pk -> prefValue phi `quot` unPrime (fst pk)) (factorise phi)-    exps = map (\p -> powMod r p (prefValue m)) pows+    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>. ----- > > isPrimitiveRoot (1 :: Mod 13)--- > False--- > > isPrimitiveRoot (2 :: Mod 13)--- > True+-- >>> :set -XDataKinds+-- >>> isPrimitiveRoot (1 :: Mod 13)+-- False+-- >>> isPrimitiveRoot (2 :: Mod 13)+-- True -- -- Here is how to list all primitive roots: ----- > > filter isPrimitiveRoot [minBound .. maxBound] :: [Mod 13]--- > [(2 `modulo` 13), (6 `modulo` 13), (7 `modulo` 13), (11 `modulo` 13)]+-- >>> mapMaybe isPrimitiveRoot [minBound .. maxBound] :: [Mod 13]+-- [(2 `modulo` 13), (6 `modulo` 13), (7 `modulo` 13), (11 `modulo` 13)] -- -- This function is a convenient wrapper around 'isPrimitiveRoot''. The latter -- provides better control and performance, if you need them. isPrimitiveRoot   :: KnownNat n   => Mod n-  -> Bool-isPrimitiveRoot r = case cyclicGroupFromModulo (getNatMod r) of-  Nothing -> False-  Just cg -> isPrimitiveRoot' cg (getNatVal r)+  -> 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, Ord a, UniqueFactorisation a) => CyclicGroup a -> Prefactored a+groupSize = totient . cyclicGroupToModulo

@@ -10,86 +10,160 @@ --  {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP          #-}  module Math.NumberTheory.Moduli.Sqrt-  ( sqrtModP-  , sqrtModPList-  , sqrtModP'-  , tonelliShanks-  , sqrtModPP-  , sqrtModPPList-  , sqrtModF-  , sqrtModFList+  ( -- * New interface+    sqrtsMod+  , sqrtsModFactorisation+  , sqrtsModPrimePower+  , sqrtsModPrime+    -- * Old interface+  , Old.sqrtModP+  , Old.sqrtModPList+  , Old.sqrtModP'+  , Old.tonelliShanks+  , Old.sqrtModPP+  , Old.sqrtModPPList+  , Old.sqrtModF+  , Old.sqrtModFList   ) where +import Control.Arrow hiding (loop) import Control.Monad (liftM2) import Data.Bits-import Data.List (nub)-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif-import GHC.Integer.GMP.Internals  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 qualified Math.NumberTheory.Primes.Factorisation as F (factorise)+import Math.NumberTheory.Primes.Types import Math.NumberTheory.Primes.Sieve (sieveFrom)-import Math.NumberTheory.Utils (shiftToOddCount, splitOff)+import Math.NumberTheory.Utils (shiftToOddCount, splitOff, recipMod)+import Math.NumberTheory.Utils.FromIntegral --- | @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.+import qualified Math.NumberTheory.Moduli.SqrtOld as Old++-- | List all modular square roots. -----   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)+-- >>> :set -XDataKinds+-- >>> sqrtsMod (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))+  where+    factorise = map (PrimeNat . integerToNatural *** intToWord) . F.factorise --- | @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-                        _      -> []+-- | List all square roots modulo a number, which factorisation is passed as a second argument.+--+-- >>> sqrtsModFactorisation 1 (factorise 60)+-- [1,49,41,29,31,19,11,59]+sqrtsModFactorisation :: Integer -> [(Prime Integer, Word)] -> [Integer]+sqrtsModFactorisation _ []  = [0]+sqrtsModFactorisation n pps = map fst $ foldl1 (liftM2 comb) cs+  where+    ms :: [Integer]+    ms = map (\(PrimeNat p, pow) -> toInteger p ^ pow) pps +    rs :: [[Integer]]+    rs = map (\(p, pow) -> sqrtsModPrimePower n p pow) 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)++-- | List all square roots modulo power of a prime.+--+-- >>> sqrtsModPrimePower 7 (fromJust (isPrime 3)) 2+-- [4,5]+-- >>> sqrtsModPrimePower 9 (fromJust (isPrime 3)) 3+-- [3,12,21,24,6,15]+sqrtsModPrimePower :: Integer -> Prime Integer -> Word -> [Integer]+sqrtsModPrimePower nn p 1 = sqrtsModPrime nn p+sqrtsModPrimePower nn (PrimeNat (toInteger -> 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)+      | odd kk    -> []+      | otherwise -> case (if prime == 2 then sqM2P n expo' else sqrtModPP' n prime expo') of+        Nothing -> []+        Just r  -> let rr = r * prime ^ k in+          if prime == 2 && k + 1 == t+          then go rr os+          else go rr os ++ go (primeExpo - rr) os+      where+        k = intToWord kk `quot` 2+        t = (if prime == 2 then expo - k - 1 else expo - k) `max` ((expo + 1) `quot` 2)+        expo' = expo - 2 * k+        os = [0, prime ^ t .. primeExpo - 1]++        -- equivalent to map ((`mod` primeExpo) . (+ r)) rs,+        -- but avoids division+        go r rs = map (+ r) ps ++ map (+ (r - primeExpo)) qs+          where+            (ps, qs) = span (< primeExpo - r) rs++-- | List all square roots by prime modulo.+--+-- >>> sqrtsModPrime 1 (fromJust (isPrime 5))+-- [1,4]+-- >>> sqrtsModPrime 0 (fromJust (isPrime 5))+-- [0]+-- >>> sqrtsModPrime 2 (fromJust (isPrime 5))+-- []+sqrtsModPrime :: Integer -> Prime Integer -> [Integer]+sqrtsModPrime n (PrimeNat 2) = [n `mod` 2]+sqrtsModPrime n (PrimeNat (toInteger -> prime)) = case jacobi n prime of+  MinusOne -> []+  Zero     -> [0]+  One      -> let r = sqrtModP' (n `mod` prime) prime in [r, prime - r]++-------------------------------------------------------------------------------+-- Internals+ -- | @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+    | rem4 prime == 3 = powMod square ((prime + 1) `quot` 4) prime+    | square `mod` prime == prime - 1+                    = sqrtOfMinusOne prime     | otherwise     = tonelliShanks square prime +-- | 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]+  where+    k = (p - 1) `quot` 4+ -- | @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+    generator = powMod nonSquare q prime+    rc = powMod square ((q+1) `quot` 2) prime+    t1 = powMod 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 :: Integer -> Integer -> Integer -> Int -> Integer     loop !r t c m         | t == 1    = r         | otherwise = loop nextR nextT nextC nextM@@ -100,26 +174,22 @@             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+-- | prime must be odd, n must be coprime with prime+sqrtModPP' :: Integer -> Integer -> Word -> Maybe Integer+sqrtModPP' n prime expo = case sqrtsModPrime n (PrimeNat (fromInteger prime)) of+                            []    -> Nothing+                            r : _ -> fixup r   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+                          (e,q) | expo <= intToWord 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 <= ex    = root'+        | expo <= intToWord ex    = root'         | otherwise     = hoist inv root' (nelim `mod` prime) (prime^ex)           where             root' = (root + (inv*(prime-elim))*pp) `mod` (prime*pp)@@ -127,8 +197,8 @@             (ex, nelim) = splitOff prime diff'  -- dirty, dirty-sqM2P :: Integer -> Int -> Maybe Integer-sqM2P n e+sqM2P :: Integer -> Word -> Maybe Integer+sqM2P n (wordToInt -> e)     | e < 2     = Just (n `mod` 2)     | n' == 0   = Just 0     | odd k     = Nothing@@ -136,9 +206,9 @@       where         mdl = 1 `shiftL` e         n' = n `mod` mdl-        (k,s) = shiftToOddCount n'+        (k, s) = shiftToOddCount n'         k2 = k `quot` 2-        e2 = e-k+        e2 = e - k         solve _ 1 = Just 1         solve 1 _ = Just 1         solve r _@@ -154,60 +224,12 @@                         d = x'*x' - r                         pw' = if d == 0 then e2 else 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 @@ -218,12 +240,7 @@       where         primelist = [3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67]                         ++ sieveFrom (68 + n `rem` 4) -- prevent sharing-        search (p:ps) = case jacobi' p n of+        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

@@ -0,0 +1,234 @@+-- |+-- Module:      Math.NumberTheory.Moduli.Sqrt+-- Copyright:   (c) 2011 Daniel Fischer+-- Licence:     MIT+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- Modular square roots.+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP          #-}++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)+#if __GLASGOW_HASKELL__ < 709+import Data.Word+#endif+import GHC.Integer.GMP.Internals++import Math.NumberTheory.Moduli.Chinese+import Math.NumberTheory.Moduli.Jacobi+import Math.NumberTheory.Primes.Sieve (sieveFrom)+import Math.NumberTheory.Utils (shiftToOddCount, splitOff)++{-# 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+                          (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 <= 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+        (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 (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 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]+                        ++ 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

@@ -197,24 +197,17 @@ appCuRt :: Integer -> Integer appCuRt (S# i#) = case double2Int# (int2Double# i# **## (1.0## /## 3.0##)) of                     r# -> S# r#-#if __GLASGOW_HASKELL__ < 709-appCuRt n@(J# s# _)-    | isTrue# (s# <# THRESH#)   = floor (fromInteger n ** (1.0/3.0) :: Double)-#else appCuRt n@(Jp# bn#)     | isTrue# ((sizeofBigNat# bn#) <# THRESH#) =           floor (fromInteger n ** (1.0/3.0) :: Double)-#endif     | 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#-#if __GLASGOW_HASKELL__ >= 709 -- There's already handling for negative in integerCubeRoot, -- but integerCubeRoot' is exported directly too. appCuRt _ = error "integerCubeRoot': negative argument"-#endif  -- not very discriminating, but cheap, so it's an overall gain cr512 :: UArray Int Bool

@@ -138,24 +138,17 @@ -- About 48 bits should be correct for large Integers. appBiSqrt :: Integer -> Integer appBiSqrt (S# i#) = S# (double2Int# (sqrtDouble# (sqrtDouble# (int2Double# i#))))-#if __GLASGOW_HASKELL__ < 709-appBiSqrt n@(J# s# _)-    | isTrue# (s# <# THRESH#)   = floor (sqrt . sqrt $ fromInteger n :: Double)-#else appBiSqrt n@(Jp# bn#)     | isTrue# ((sizeofBigNat# bn#) <# THRESH#) =           floor (sqrt . sqrt $ fromInteger n :: Double)-#endif     | 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#-#if __GLASGOW_HASKELL__ >= 709 -- There's already a check for negative in integerFourthRoot, -- but integerFourthRoot' is exported directly too. appBiSqrt _ = error "integerFourthRoot': negative argument"-#endif   biSqRes256 :: UArray Int Bool

@@ -14,29 +14,25 @@  module Math.NumberTheory.Powers.Modular   ( powMod-#if __GLASGOW_HASKELL__ > 709   , powModWord   , powModInt-#endif   ) where  import qualified GHC.Integer.GMP.Internals as GMP (powModInteger) -#if __GLASGOW_HASKELL__ > 709 import GHC.Exts (Word(..)) import GHC.Natural (powModNatural) import qualified GHC.Integer.GMP.Internals as GMP (powModWord) import Math.NumberTheory.Utils.FromIntegral-#endif  -- | @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+-- >>> powMod 2 3 5+-- 3+-- >>> powMod 3 12345678901234567890 1001+-- 1 -- -- See also 'Math.NumberTheory.Moduli.Class.powMod' and 'Math.NumberTheory.Moduli.Class.powSomeMod'. --@@ -46,12 +42,12 @@ -- 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 :: Int64)--- > 1115647832265427613 -- incorrect due to overflow--- > > powModInt 3 101 (2^60-1 :: Int)--- > 1018105167100379328 -- correct+-- >>> powMod 3 101 (2^60-1 :: Integer)+-- 1018105167100379328 -- correct+-- >>> powMod 3 101 (2^60-1 :: Int64)+-- 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"@@ -71,7 +67,6 @@ powModInteger :: Integer -> Integer -> Integer -> Integer powModInteger b e m = GMP.powModInteger (b `mod` m) e m -#if __GLASGOW_HASKELL__ > 709 {-# RULES "powMod/Natural" powMod = powModNatural "powMod/Word"    powMod = powModWord@@ -80,18 +75,17 @@  -- | Specialised version of 'powMod', able to handle large moduli correctly. ----- > > powModWord 3 101 (2^60-1)--- > 1018105167100379328+-- >>> 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 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)-#endif

@@ -29,9 +29,6 @@ import Data.Array.ST  import Data.Bits-#if __GLASGOW_HASKELL__ < 709-import Data.Word        -- Moved to GHC.Types-#endif  import Math.NumberTheory.Unsafe 

@@ -14,6 +14,8 @@ {-# LANGUAGE CPP              #-} {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_HADDOCK hide #-}+ module Math.NumberTheory.Powers.Squares.Internal   ( karatsubaSqrt   , isqrtA@@ -66,24 +68,17 @@ -- for large Integers. appSqrt :: Integer -> Integer appSqrt (S# i#) = S# (double2Int# (sqrtDouble# (int2Double# i#)))-#if __GLASGOW_HASKELL__ < 709-appSqrt n@(J# s# _)-    | isTrue# (s# <# THRESH#) = floor (sqrt $ fromInteger n :: Double)-#else appSqrt n@(Jp# bn#)     | isTrue# ((sizeofBigNat# bn#) <# THRESH#) =           floor (sqrt $ fromInteger n :: Double)-#endif     | 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#-#if __GLASGOW_HASKELL__ >= 709 -- There's already a check for negative in integerSquareRoot, -- but integerSquareRoot' is exported directly too. appSqrt _ = error "integerSquareRoot': negative argument"-#endif   -- Integer square root with remainder, using the Karatsuba Square Root

@@ -9,9 +9,11 @@ -- Type for numbers, accompanied by their factorisation. -- -{-# LANGUAGE CPP          #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP           #-}+{-# LANGUAGE TypeFamilies  #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-}+ module Math.NumberTheory.Prefactored   ( Prefactored(prefValue, prefFactors)   , fromValue@@ -20,13 +22,11 @@  import Control.Arrow -import Math.NumberTheory.GCD (splitIntoCoprimes)-import Math.NumberTheory.UniqueFactorisation+import Data.Semigroup -#if MIN_VERSION_base(4,8,0)-#else-import Data.Word-#endif+import Math.NumberTheory.Euclidean+import Math.NumberTheory.Euclidean.Coprimes+import Math.NumberTheory.UniqueFactorisation  -- | A container for a number and its pairwise coprime (but not neccessarily prime) -- factorisation.@@ -36,43 +36,44 @@ -- -- For instance, let @p@ and @q@ be big primes: ----- > > let p, q :: Integer--- > >     p = 1000000000000000000000000000057--- > >     q = 2000000000000000000000000000071+-- >>> let p, q :: Integer+-- >>>     p = 1000000000000000000000000000057+-- >>>     q = 2000000000000000000000000000071 -- -- It would be  difficult to compute prime factorisation of their product -- as is: -- 'factorise' would take ages. Things become different if we simply -- change types of @p@ and @q@ to prefactored ones: ----- > > let p, q :: Prefactored Integer--- > >     p = 1000000000000000000000000000057--- > >     q = 2000000000000000000000000000071+-- >>> let p, q :: Prefactored Integer+-- >>>     p = 1000000000000000000000000000057+-- >>>     q = 2000000000000000000000000000071 -- -- Now prime factorisation is done instantly: ----- > > factorise (p * q)--- > [(PrimeNat 1000000000000000000000000000057, 1), (PrimeNat 2000000000000000000000000000071, 1)]--- > > factorise (p^2 * q^3)--- > [(PrimeNat 1000000000000000000000000000057, 2), (PrimeNat 2000000000000000000000000000071, 3)]+-- >>> factorise (p * q)+-- [(PrimeNat 1000000000000000000000000000057, 1), (PrimeNat 2000000000000000000000000000071, 1)]+-- >>> factorise (p^2 * q^3)+-- [(PrimeNat 1000000000000000000000000000057, 2), (PrimeNat 2000000000000000000000000000071, 3)] -- -- Moreover, we can instantly compute 'totient' and its iterations. -- It works fine, because output of 'totient' is also prefactored. ----- > > prefValue $ totient (p^2 * q^3)--- > 8000000000000000000000000001752000000000000000000000000151322000000000000000000000006445392000000000000000000000135513014000000000000000000001126361040--- > > prefValue $ totient $ totient (p^2 * q^3)--- > 2133305798262843681544648472180210822742702690942899511234131900112583590230336435053688694839034890779375223070157301188739881477320529552945446912000+-- >>> prefValue $ totient (p^2 * q^3)+-- 8000000000000000000000000001752000000000000000000000000151322000000000000000000000006445392000000000000000000000135513014000000000000000000001126361040+-- >>> prefValue $ totient $ totient (p^2 * q^3)+-- 2133305798262843681544648472180210822742702690942899511234131900112583590230336435053688694839034890779375223070157301188739881477320529552945446912000 -- -- Let us look under the hood: ----- > > prefFactors $ totient (p^2 * q^3)--- > [(2, 4), (41666666666666666666666666669, 1), (3, 3), (111111111111111111111111111115, 1),--- > (1000000000000000000000000000057, 1), (2000000000000000000000000000071, 2)]--- > > prefFactors $ totient $ totient (p^2 * q^3)--- > [(2, 22), (39521, 1), (5, 3), (199937, 1), (3, 8), (6046667, 1), (227098769, 1),--- > (85331809838489, 1), (361696272343, 1), (22222222222222222222222222223, 1),--- > (41666666666666666666666666669, 1), (2000000000000000000000000000071, 1)]+-- >>> prefFactors $ totient (p^2 * q^3)+-- Coprimes {unCoprimes = fromList [(2,4),(3,3),+--   (41666666666666666666666666669,1),(111111111111111111111111111115,1),+--   (1000000000000000000000000000057,1),(2000000000000000000000000000071,2)]}+-- >>> prefFactors $ totient $ totient (p^2 * q^3)+-- Coprimes {unCoprimes = fromList [(2,22),(3,8),(5,3),(39521,1),(199937,1),(6046667,1),+--   (227098769,1),(361696272343,1),(85331809838489,1),(22222222222222222222222222223,1),+--   (41666666666666666666666666669,1),(2000000000000000000000000000071,1)]} -- -- Pairwise coprimality of factors is crucial, because it allows -- us to process them independently, possibly even@@ -84,47 +85,46 @@ data Prefactored a = Prefactored   { prefValue   :: a     -- ^ Number itself.-  , prefFactors :: [(a, Word)]+  , prefFactors :: Coprimes a Word     -- ^ List of pairwise coprime (but not neccesarily prime) factors,     -- accompanied by their multiplicities.   } deriving (Show)  -- | Create 'Prefactored' from a given number. ----- > > fromValue 123--- > Prefactored {prefValue = 123, prefFactors = [(123, 1)]}-fromValue :: a -> Prefactored a-fromValue a = Prefactored a [(a, 1)]+-- >>> fromValue 123+-- Prefactored {prefValue = 123, prefFactors = Coprimes {unCoprimes = fromList [(123,1)]}}+fromValue :: (Eq a, Num 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.--- If you cannot ensure coprimality, use 'splitIntoCoprimes'. ----- > > fromFactors (splitIntoCoprimes [(140, 1), (165, 1)])--- > Prefactored {prefValue = 23100, prefFactors = [(5, 2), (28, 1), (33, 1)]}--- > > fromFactors (splitIntoCoprimes [(140, 2), (165, 3)])--- > Prefactored {prefValue = 88045650000, prefFactors = [(5, 5), (28, 2), (33, 3)]}-fromFactors :: Integral a => [(a, Word)] -> Prefactored a-fromFactors as = Prefactored (product (map (uncurry (^)) as)) (splitIntoCoprimes as)+-- >>> fromFactors (splitIntoCoprimes [(140, 1), (165, 1)])+-- Prefactored {prefValue = 23100, prefFactors = Coprimes {unCoprimes = fromList [(5,2),(28,1),(33,1)]}}+-- >>> fromFactors (splitIntoCoprimes [(140, 2), (165, 3)])+-- Prefactored {prefValue = 88045650000, prefFactors = Coprimes {unCoprimes = fromList [(5,5),(28,2),(33,3)]}}+fromFactors :: Num a => Coprimes a Word -> Prefactored a+fromFactors as = Prefactored (product (map (uncurry (^)) (unCoprimes as))) as -instance (Integral a, UniqueFactorisation a) => Num (Prefactored a) where+instance (Euclidean a, Ord a) => Num (Prefactored a) where   Prefactored v1 _ + Prefactored v2 _     = fromValue (v1 + v2)   Prefactored v1 _ - Prefactored v2 _     = fromValue (v1 - v2)   Prefactored v1 f1 * Prefactored v2 f2-    = Prefactored (v1 * v2) (splitIntoCoprimes (f1 ++ f2))+    = Prefactored (v1 * v2) (f1 <> f2)   negate (Prefactored v f) = Prefactored (negate v) f   abs (Prefactored v f)    = Prefactored (abs v) f-  signum (Prefactored v _) = Prefactored (signum v) []+  signum (Prefactored v _) = Prefactored (signum v) mempty   fromInteger n = fromValue (fromInteger n)  type instance Prime (Prefactored a) = Prime a -instance UniqueFactorisation a => UniqueFactorisation (Prefactored a) where+instance (Eq a, Num a, UniqueFactorisation a) => UniqueFactorisation (Prefactored a) where   unPrime p = fromValue (unPrime p)   factorise (Prefactored _ f)-    = concatMap (\(x, xm) -> map (second (* xm)) (factorise x)) f-  isPrime (Prefactored _ f) = case f of+    = concatMap (\(x, xm) -> map (second (* xm)) (factorise x)) (unCoprimes f)+  isPrime (Prefactored _ f) = case unCoprimes f of     [(n, 1)] -> isPrime n     _        -> Nothing

@@ -15,5 +15,5 @@  import Math.NumberTheory.Primes.Sieve import Math.NumberTheory.Primes.Counting-import Math.NumberTheory.Primes.Testing hiding (FactorSieve)+import Math.NumberTheory.Primes.Testing import Math.NumberTheory.Primes.Factorisation

@@ -8,7 +8,11 @@ -- -- Number of primes not exceeding @n@, @&#960;(n)@, and @n@-th prime. ---{-# LANGUAGE CPP, BangPatterns, FlexibleContexts #-}+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}+ {-# OPTIONS_GHC -fspec-constr-count=24 #-} {-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Primes.Counting.Impl@@ -140,14 +144,18 @@ -- highSieve a surp gap = error "Oh shit"  sieveCount :: COUNT_T -> COUNT_T -> COUNT_T -> Integer-sieveCount ub cr sr = runST $ do+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 voff !wi !ri uar sves+    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"@@ -160,6 +168,7 @@           | 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@@ -198,7 +207,10 @@       _ -> error "No primes sieved"  calc :: COUNT_T -> COUNT_T -> Integer-calc lim plim = runST $ do+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@@ -206,7 +218,8 @@     unsafeWrite ar1 0 lim     unsafeWrite ar1 1 1     !ar2 <- unsafeNewArray_ (0,end-1)-    let go cap pix old new+    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@@ -216,6 +229,7 @@                         !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

@@ -23,10 +23,6 @@     , stepFactorisation     , factorise'     , defaultStdGenFactorisation'-      -- *** Factor sieves-    , FactorSieve-    , factorSieve-    , sieveFactor       -- *** Trial division     , trialDivisionTo       -- ** Partial factorisation@@ -35,19 +31,10 @@     , curveFactorisation       -- *** Single curve worker     , montgomeryFactorisation-      -- * Totients-    , TotientSieve-    , totientSieve-    , sieveTotient-      -- * Carmichael function-    , CarmichaelSieve-    , carmichaelSieve-    , sieveCarmichael     ) where  import Math.NumberTheory.Primes.Factorisation.Montgomery import Math.NumberTheory.Primes.Factorisation.TrialDivision-import Math.NumberTheory.Primes.Sieve.Misc  -- $algorithm --

@@ -18,12 +18,10 @@   ) where  import System.Random-import Control.Monad.State.Strict-#if __GLASGOW_HASKELL__ < 709-import Control.Applicative-#endif+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

@@ -50,12 +50,8 @@   ) where  import Control.Arrow+import Control.Monad.Trans.State.Lazy import System.Random-import Control.Monad.State.Lazy-#if __GLASGOW_HASKELL__ < 709-import Control.Applicative-import Data.Word-#endif import Data.Bits import Data.IntMap (IntMap) import qualified Data.IntMap as IM@@ -64,11 +60,12 @@ #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif+import Data.Traversable  import GHC.TypeNats.Compat  import Math.NumberTheory.Curves.Montgomery-import Math.NumberTheory.GCD (splitIntoCoprimes)+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')@@ -78,16 +75,15 @@ import Math.NumberTheory.Unsafe import Math.NumberTheory.Utils --- | @'factorise' n@ produces the prime factorisation of @n@, including---   a factor of @(-1)@ if @n < 0@. @'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@.+-- | @'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@. factorise :: Integer -> [(Integer,Int)] factorise n-    | n < 0     = (-1,1):factorise (-n)-    | n == 0    = error "0 has no prime factorisation"-    | n == 1    = []-    | otherwise = 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,Int)]@@ -221,7 +217,7 @@             SomeMod sm -> case montgomeryFactorisation b1 b2 sm of               Nothing -> workFact m b1 b2 (count - 1)               Just d  -> do-                let cs = splitIntoCoprimes [(d, 1), (m `quot` d, 1)]+                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.

@@ -1,366 +0,0 @@--- |--- Module:      Math.NumberTheory.Primes.Heap--- Copyright:   (c) 2011 Daniel Fischer--- Licence:     MIT--- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions)------ Prime generation using a priority queue for the composites.--- The algorithm is basically the one described in--- <http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf>, but--- it uses a more efficient heap for the priority queue and a--- larger wheel, thus it is faster (in particular, the speed--- penalty for @'Integer'@ is much smaller) and uses less memory.--- It is nevertheless very slow compared to a bit sieve.--- This module is mainly intended for comparison and verification.-{-# LANGUAGE BangPatterns, CPP, MonoLocalBinds #-}-{-# OPTIONS_GHC -funbox-strict-fields #-}-{-# OPTIONS_GHC -fno-float-in -fno-spec-constr -fno-full-laziness #-}-module Math.NumberTheory.Primes.Heap {-# DEPRECATED "Use Math.NumberTheory.Primes.Sieve instead" #-} (primes, sieveFrom) where--import Data.Array.Unboxed-import Data.Array.ST-import Control.Monad.ST-import Data.List (foldl')-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif--import Math.NumberTheory.Unsafe--#ifndef SH_SIZE-#define SH_SIZE 31-#endif---- Composites to eliminate, components are--- composite, multiple of prime--- prime--- index of step to find next multiple of prime-data Del a = D !a !a {-# UNPACK #-} !Int--step :: Integral a => Int -> a--- {-# INLINE step #-}-step i = fromIntegral (steps `unsafeAt` i)---- Priority queue as baby heap--- Invariant: left subheap one larger than right or both--- have the same size (and of course, heap property)-data Hipp a-    = E-    | H !a !a {-# UNPACK #-} !Int !(Hipp a) !(Hipp a)----- push composite-data down the heap-{-# SPECIALISE push :: Int -> Int -> Int -> Hipp Int -> Hipp Int #-}-{-# SPECIALISE push :: Word -> Word -> Int -> Hipp Word -> Hipp Word #-}-{-# SPECIALISE push :: Integer -> Integer -> Int -> Hipp Integer -> Hipp Integer #-}-push :: Integral a => a -> a -> Int -> Hipp a -> Hipp a-push !c !p !w = go-  where-    less = (< c)-    go (H hc hp hw l r)-        | less hc   = H hc hp hw (go r) l-        | otherwise = H c p w (push hc hp hw r) l-    go _ = H c p w E E---- bubble down increased top to regain heap invariant-{-# SPECIALISE bubble :: Hipp Int -> Hipp Int #-}-{-# SPECIALISE bubble :: Hipp Word -> Hipp Word #-}-{-# SPECIALISE bubble :: Hipp Integer -> Hipp Integer #-}-bubble :: Integral a => Hipp a -> Hipp a-bubble h@(H c p w l r) =-    case r of-        E -> case l of-                E -> h-                H lc lp lw ll lr-                    | lc < c -> H lc lp lw (H c p w ll lr) r-                    | otherwise -> h-        H rc rp rw rl rr ->-          case l of-            H lc lp lw ll lr-                | lc < c -> if lc < rc-                              then H lc lp lw (mkHipp c p w ll lr) r-                              else H rc rp rw l (mkHipp c p w rl rr)-                | rc < c -> H rc rp rw l (mkHipp c p w rl rr)-                | otherwise -> h-            _ -> error "Heap invariant violated, left smaller than right!"-bubble h = h---- join two heaps and composite-data-{-# SPECIALISE-    mkHipp :: Int -> Int -> Int -> Hipp Int -> Hipp Int -> Hipp Int,-              Integer -> Integer -> Int -> Hipp Integer -> Hipp Integer -> Hipp Integer,-              Word -> Word -> Int -> Hipp Word -> Hipp Word -> Hipp Word-  #-}-mkHipp :: Integral a => a -> a -> Int -> Hipp a -> Hipp a -> Hipp a-mkHipp !c !p !w = go-  where-    less = (< c)-    go l r =-      case r of-        E -> case l of-                E -> H c p w l r-                H lc lp lw _ _-                    | less lc -> H lc lp lw (H c p w E E) E-                    | otherwise -> H c p w l r-        H rc rp rw rl rr ->-          case l of-            H lc lp lw ll lr-                | less lc -> if lc < rc-                                then H lc lp lw (go ll lr) r-                                else H rc rp rw l (go rl rr)-                | less rc -> H rc rp rw l (go rl rr)-                | otherwise -> H c p w l r-            _ -> error "Heap invariant violated, left smaller than right!"---- increase the top of the heap and re-heap-{-# SPECIALISE inc :: Hipp Int -> Hipp Int #-}-{-# SPECIALISE inc :: Hipp Word -> Hipp Word #-}-{-# SPECIALISE inc :: Hipp Integer -> Hipp Integer #-}-inc :: Integral a => Hipp a -> Hipp a-inc (H c p i l r)-  = {-# SCC "incBubble" #-} bubble (H (c+p*step i) p (nextIndex i) l r)-inc h   = h---- while top of heap equals composite, increase and re-heap-{-# SPECIALISE adjust :: Int -> Hipp Int -> Hipp Int #-}-{-# SPECIALISE adjust :: Word -> Hipp Word -> Hipp Word #-}-{-# SPECIALISE adjust :: Integer -> Hipp Integer -> Hipp Integer #-}-adjust :: Integral a => a -> Hipp a -> Hipp a-adjust cm h@(H v _ _ _ _)-    | cm == v   = adjust cm (inc h)-adjust _ h      = h---- build a heap from a sorted list of Del's-{-# SPECIALISE buildH :: [Del Int] -> Hipp Int #-}-{-# SPECIALISE buildH :: [Del Word] -> Hipp Word #-}-{-# SPECIALISE buildH :: [Del Integer] -> Hipp Integer #-}-buildH :: Integral a => [Del a] -> Hipp a-buildH [] = E-buildH (D s p w : tl) = H s p w l r-      where-        (ll,rl) = goSplit [] [] tl-        goSplit xs ys [] = (reverse ys, reverse xs)-        goSplit xs ys (d:ds) = goSplit ys (d:xs) ds-        l = buildH ll-        r = buildH rl---- Simple sieve pushing each prime immediately onto the heap,--- feeds the feeder, runs at about fourth root of the main sieve.-{-# SPECIALISE simpleSieve :: Hipp Int -> Int -> Int -> [Del Int] #-}-{-# SPECIALISE simpleSieve :: Hipp Word -> Word -> Int -> [Del Word] #-}-{-# SPECIALISE simpleSieve :: Hipp Integer -> Integer -> Int -> [Del Integer] #-}-simpleSieve :: Integral a => Hipp a -> a -> Int -> [Del a]-simpleSieve h@(H nc _ _ _ _) cd !i-  | cd < nc   = D s cd i : simpleSieve ({-# SCC "simplePush" #-} push s cd i h) (cd + step i) (nextIndex i)-    | otherwise = simpleSieve (adjust cd h) (cd + step i) (nextIndex i)-      where-        s = cd*cd-simpleSieve _ _ _ = []  -- would violate an invariant---- Feeder sieve, produces composites at the rate of the progress of the main sieve,--- hence primes at about the square root of it, thus needs about fourth root heap--- space. The two-step feeding makes the feeder produce faster and hence the main--- sieve (since we have only one O(n^0.5) heap and not two.--- Using two heaps, one small for multiples of small primes which change often--- and one for multiples of larger primes which are less frequently updated--- speeds things up.-{-# SPECIALISE feederSieve :: [Del Int] -> Hipp Int -> Hipp Int -> Int -> Int -> [Del Int] #-}-{-# SPECIALISE feederSieve :: [Del Word] -> Hipp Word -> Hipp Word -> Word -> Int -> [Del Word] #-}-{-# SPECIALISE feederSieve :: [Del Integer] -> Hipp Integer -> Hipp Integer -> Integer -> Int -> [Del Integer] #-}-feederSieve :: Integral a => [Del a] -> Hipp a -> Hipp a -> a -> Int -> [Del a]-feederSieve dls@((D s p u):ds) sh@(H sc _ _ _ _) lh@(H lc _ _ _ _) cd i-    | cd == sc  = feederSieve dls (adjust cd (inc sh)) (adjust cd lh) cd' j-    | cd == lc  = feederSieve dls sh (adjust cd (inc lh)) cd' j-    | cd == s   = feederSieve ds sh (push (s + p*step u) p (nextIndex u) lh) cd' j-    | otherwise = D (cd*cd) cd i : feederSieve dls sh lh cd' j-      where-        !cd' = cd + step i-        !j   = nextIndex i-feederSieve _ _ _ _ _ = []  -- invariant violated---- Build the feeder sieve, arguments are--- first prime whose multiples have to be eliminated--- index of step for this prime.-{-# SPECIALISE feeder :: Int -> Int -> [Del Int] #-}-{-# SPECIALISE feeder :: Word -> Int -> [Del Word] #-}-{-# SPECIALISE feeder :: Integer -> Int -> [Del Integer] #-}-feeder :: Integral a => a -> Int -> [Del a]-feeder p i = feederSieve lrg sh lh p i-      where-        (sml,D s lp w : lrg) = splitAt SH_SIZE (D q p i : {-# SCC "simple" #-} simpleSieve (H q p i E E) (p+step i) (nextIndex i))-        sh = buildH sml-        lh = H s lp w E E-        q  = p*p---- The main sieve. Code almost identical to feederSieve, but we don't construct the Del,--- which gains some performance.-{-# SPECIALISE primeSieve :: [Del Int] -> Hipp Int -> Hipp Int -> Int -> Int -> [Int] #-}-{-# SPECIALISE primeSieve :: [Del Word] -> Hipp Word -> Hipp Word -> Word -> Int -> [Word] #-}-{-# SPECIALISE primeSieve :: [Del Integer] -> Hipp Integer -> Hipp Integer -> Integer -> Int -> [Integer] #-}-primeSieve :: Integral a => [Del a] -> Hipp a -> Hipp a -> a -> Int -> [a]-primeSieve dls@((D s p u):ds) sh@(H sc _ _ _ _) lh@(H lc _ _ _ _) cd i-    | cd == sc  = primeSieve dls ({-# SCC "adjSmall" #-} adjust cd (inc sh)) ({-# SCC "adjLarge" #-}adjust cd lh) cd' j-    | cd == lc  = primeSieve dls sh (adjust cd (inc lh)) cd' j-    | cd == s   = primeSieve ds sh (push (s + p*step u) p (nextIndex u) lh) cd' j-    | otherwise = cd : primeSieve dls sh lh cd' j-      where-        !cd' = cd + step i-        !j   = nextIndex i-primeSieve _ _ _ _ _ = []   -- invariant violated---- | A list of primes. The sieve does not handle overflow, hence for---   bounded types, garbage occurs near @'maxBound'@. If primes that---   large are requested, use------ @---   'map' 'fromInteger' $ 'takeWhile' (<= 'fromIntegral' 'maxBound') 'primes'--- @------   instead. Checking for overflow would be slower. The sieve is specialised---   for @'Int'@, @'Word'@ and @'Integer'@, since these are the most commonly---   used. For the fixed-width @Int@ or @Word@ types, sieving at one of the---   specialised types and converting is faster.---   To ensure sharing of the list of primes, bind it to a monomorphic variable,---   to make sure that it is not shared, use @'sieveFrom'@ with different---   arguments.-{-# SPECIALISE primes :: [Int] #-}-{-# SPECIALISE primes :: [Word] #-}-{-# SPECIALISE primes :: [Integer] #-}-primes :: Integral a => [a]-primes = 2:3:5:7:11:13:sieve 17 0---- | @'sieveFrom' n@ generates the list of primes @>= n@.---   The remarks about overflow and performance in the documentation---   of @'primes'@ apply here too.-{-# SPECIALISE sieveFrom :: Int -> [Int] #-}-{-# SPECIALISE sieveFrom :: Word -> [Word] #-}-{-# SPECIALISE sieveFrom :: Integer -> [Integer] #-}-sieveFrom :: Integral a => a -> [a]-sieveFrom from-    | fromIntegral from < (32768 :: Integer)-        = dropWhile (< from) (foldr ((:) . fromIntegral) (sieve sp si) wheelPrimes)-    | otherwise-        = primeSieve dls sh lh start (nextIndex i0)-      where-        -- trick the compiler into not CAFing feeder 17 0-        sp  | odd from  = 17-            | otherwise = fromIntegral (remainders `unsafeAt` 0)-        si  | even from = 0-            | otherwise = (steps `unsafeAt` 0)-2-        (q, r)      = (from - 18) `quotRem` 30030-        i0          = findIx (fromIntegral r + 17)-        -- last number coprime to all wheel primes < from-        before      = 30030*q + fromIntegral (remainders `unsafeAt` i0)-        -- first candidate-        !start       = before + step i0-        (sml, lrg)  = splitAt SH_SIZE (feeder sp si)-        !sh          = foldl' pushD E [findMulIx p | D _ p _ <- sml]-        (lh, dls)   = {-# SCC "munch" #-} munch E lrg-        pushD h (c, p, i) = push c p i h-        findMulIx p = ((p*mp), p, (nextIndex ip))-          where-            fpq         = before `quot` p-            (qq, qr)    = (fpq-17) `quotRem` 30030-            !ip         = findIx (fromIntegral qr + 17)-            !mp         = 30030*qq + fromIntegral (remainders `unsafeAt` ip) + step ip-        munch !h dels@(D s p _ : ds)-            | before < s    = (h,dels)-            | otherwise     = munch h' ds-              where-                !(!c, pr, i)    = findMulIx p-                h'          = push c pr i h-        munch h [] = (h,[])---- Build main sieve.-{-# SPECIALISE sieve :: Int -> Int -> [Int] #-}-{-# SPECIALISE sieve :: Word -> Int -> [Word] #-}-{-# SPECIALISE sieve :: Integer -> Int -> [Integer] #-}-sieve :: Integral a => a -> Int -> [a]-sieve p i = primeSieve lrg sh lh p i-      where-        (sml,D s lp j : lrg) = splitAt SH_SIZE (feeder p i)-        !sh = buildH sml-        lh = H s lp j E E---- next step index, we have 5760 numbers coprime to all wheel--- primes in [1 .. product wheelPrimes]-{-# INLINE nextIndex #-}-nextIndex :: Int -> Int-nextIndex 5759 = 0-nextIndex i = i+1---- The six smallest primes, that makes the supporting arrays small enough--- and avoids enough composites to get acceptable speed (for sufficiently--- generous values of acceptable).-wheelPrimes :: [Int]-wheelPrimes = 2:3:5:7:11:13:[]---- index of largest coprime <= r-findIx :: Int -> Int-findIx r-    | 30030 < r = 5759-    | r == m    = a-    | r < m     = down (a-1)-    | otherwise = up a-      where-        a = max 0 (min 5758 ((192*r) `quot` 1001 - 1))-        m = remainders `unsafeAt` a-        down k-            | k < 0                         = 0-            | r < (remainders `unsafeAt` k) = down (k-1)-            | otherwise                     = k-        up k-            | k+1 > 5759                        = 5759-            | r < (remainders `unsafeAt` (k+1)) = k-            | otherwise                         = up (k+1)---- array of numbers coprime to all wheel primes in wheel range-remainders :: UArray Int Int-remainders = runSTUArray $ do-    sar <- newArray (0,30029) True :: ST s (STUArray s Int Bool)-    let n2 30030 = return ()-        n2 i = unsafeWrite sar i False >> n2 (i+2)-        n3 30033 = return ()-        n3 i = unsafeWrite sar i False >> n3 (i+6)-        n5 30035 = return ()-        n5 i = unsafeWrite sar i False-                >> unsafeWrite sar (i+20) False >> n5 (i+30)-        n7 30037 = return ()-        n7 i = unsafeWrite sar i False >> n7 (i+14)-        n11 30041 = return ()-        n11 i = unsafeWrite sar i False >> n11 (i+22)-        n13 30043 = return ()-        n13 i = unsafeWrite sar i False >> n13 (i+26)-    n2 0-    n3 3-    n5 5-    n7 7-    n11 11-    n13 13-    rar <- newArray_ (0,5759) :: ST s (STUArray s Int Int)-    let loop 30031 _ = unsafeWrite rar 5759 30031 >> return rar-        loop i !r = do-            c <- unsafeRead sar i-            if c-                then do-                    unsafeWrite rar r i-                    loop (i+2) (r+1)-                else loop (i+2) r-    loop 17 0---- distance from one coprime remainder to the next-steps :: UArray Int Int-steps = runSTUArray $ do-    sar <- newArray_ (0,5759) :: ST s (STUArray s Int Int)-    let loop 5759 p = do-            unsafeWrite sar 5759 (30047-p)-            return sar-        loop i p = do-            let !j = i+1-                !n = remainders `unsafeAt` j-            unsafeWrite sar i (n-p)-            loop j n-    loop 0 17-

@@ -8,7 +8,12 @@ -- -- Sieve ---{-# LANGUAGE CPP, BangPatterns, FlexibleContexts #-}+{-# 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@@ -23,9 +28,7 @@     , countFromTo     , countAll     , countToNth-    , sieveBytes     , sieveBits-    , sieveWords     , sieveRange     , sieveTo     ) where@@ -34,15 +37,18 @@  import Control.Monad.ST import Data.Array.ST+import Data.Array.Unboxed+import Data.Proxy import Control.Monad (when) import Data.Bits-#if __GLASGOW_HASKELL__ < 709 || WORD_SIZE_IN_BITS == 32+#if WORD_SIZE_IN_BITS == 32 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 @@ -106,25 +112,62 @@  -- | Generate a list of primes for consumption from a --   'PrimeSieve'.-primeList :: PrimeSieve -> [Integer]-primeList (PS 0 bs) = 2:3:5:[toPrim i | let (lo,hi) = bounds bs-                                      , i <- [lo .. hi]-                                      , unsafeAt bs i-                                      ]-primeList (PS vO bs) = [vO + toPrim i-                            | let (lo,hi) = bounds bs-                            , i <- [lo .. hi]-                            , unsafeAt bs i-                            ]+primeList :: forall a. Integral a => PrimeSieve -> [a]+primeList ps@(PS v _)+  | doesNotFit (Proxy :: Proxy a) v+              = [] -- has an overflow already happened?+  | v == 0    = takeWhileIncreasing $ 2 : 3 : 5 : primeListInternal ps+  | otherwise = takeWhileIncreasing $ primeListInternal ps --- | List of primes.---   Since the sieve uses unboxed arrays, overflow occurs at some point.---   On 64-bit systems, that point is beyond the memory limits, on---   32-bit systems, it is at about @1.7*10^18@.-primes :: [Integer]-primes = 2:3:5:concat [[vO + toPrim i | i <- [0 .. li], unsafeAt bs i]-                                | PS vO bs <- psieveList, let (_,li) = bounds bs]+primeListInternal :: Num a => PrimeSieve -> [a]+primeListInternal (PS v0 bs)+  = map ((+ fromInteger v0) . toPrim)+  $ filter (unsafeAt bs) [lo..hi]+  where+    (lo, hi) = bounds bs +-- | Returns true if integer is beyond representation range of type a.+doesNotFit :: forall a. Integral a => Proxy a -> Integer -> Bool+doesNotFit _ v = toInteger (fromInteger v :: a) /= v++-- | Extracts the longest strictly increasing prefix of the list+-- (possibly infinite).+takeWhileIncreasing :: Ord a => [a] -> [a]+takeWhileIncreasing = \case+  []     -> []+  x : xs -> x : foldr go (const []) xs x+    where+      go :: Ord a => a -> (a -> [a]) -> a -> [a]+      go y f z = if z < y then y : f y else []++-- | Ascending list of primes.+--+-- >>> take 10 primes+-- [2, 3, 5, 7, 11, 13, 17, 19, 23, 29]+--+-- '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 :: Int+-- 15485867+-- (5.32 secs, 6,945,267,496 bytes)+-- >>> primes !! 1000000 :: Int+-- 15485867+-- (5.19 secs, 6,945,267,496 bytes)+--+-- against+--+-- >>> let primes' = primes :: [Int]+-- >>> primes' !! 1000000 :: Int+-- 15485867+-- (5.29 secs, 6,945,269,856 bytes)+-- >>> primes' !! 1000000 :: Int+-- 15485867+-- (0.02 secs, 336,232 bytes)+primes :: (Ord a, Num a) => [a]+primes = takeWhileIncreasing $ 2 : 3 : 5 : concatMap primeListInternal psieveList+ -- | List of primes in the form of a list of 'PrimeSieve's, more compact than --   'primes', thus it may be better to use @'psieveList' >>= 'primeList'@ --   than keeping the list of primes alive during the entire run.@@ -134,7 +177,7 @@     plim = 4801     -- prime #647, 644 of them to use     sqlim = plim*plim     cache = runSTUArray $ do-        sieve <- sieveTo 4801+        sieve <- sieveTo (4801 :: Integer)         new <- unsafeNewArray_ (0,1287) :: ST s (STUArray s Int CacheWord)         let fill j indx               | 1279 < indx = return new    -- index of 4801 = 159*30 + 31 ~> 159*8+7@@ -335,7 +378,7 @@ psieveFrom :: Integer -> [PrimeSieve] psieveFrom n = makeSieves plim sqlim bitOff valOff cache     where-      k0 = max 0 (n-7) `quot` 30+      k0 = ((n `max` 7) - 7) `quot` 30 -- beware arithmetic underflow       valOff = 30*k0       bitOff = 8*k0       start = valOff+7@@ -403,7 +446,7 @@                       bnd = bd0 + bd0 `quot` 32 + 37                       !sv = primeSieve bnd                   in countToNth (n-3) [sv]-  | otherwise   = countToNth (n-3) (psieveFrom (fromIntegral $ fromInteger n .&. (7 :: Int)))+  | 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@@ -456,3 +499,72 @@              | otherwise ->                let !na = a `shiftR` 1                in go bs na (msk `uncheckedShiftR` na) ix wd++{-# INLINE delta #-}+delta :: Int -> Int+delta i = unsafeAt deltas i++deltas :: UArray Int Int+deltas = listArray (0,7) [4,2,4,2,4,6,2,6]++{-# INLINE tau #-}+tau :: Int -> Int+tau i = unsafeAt taus i++taus :: UArray Int Int+taus = listArray (0,63)+        [  7,  4,  7,  4,  7, 12,  3, 12+        , 12,  6, 11,  6, 12, 18,  5, 18+        , 14,  7, 13,  7, 14, 21,  7, 21+        , 18,  9, 19,  9, 18, 27,  9, 27+        , 20, 10, 21, 10, 20, 30, 11, 30+        , 25, 12, 25, 12, 25, 36, 13, 36+        , 31, 15, 31, 15, 31, 47, 15, 47+        , 33, 17, 33, 17, 33, 49, 17, 49+        ]++{-# INLINE byte #-}+byte :: Int -> Int+byte i = unsafeAt startByte i++startByte :: UArray Int Int+startByte = listArray (0,7) [1,3,5,9,11,17,27,31]++{-# INLINE idx #-}+idx :: Int -> Int+idx i = unsafeAt startIdx i++startIdx :: UArray Int Int+startIdx = listArray (0,7) [4,7,4,4,7,4,7,7]++{-# INLINE mu #-}+mu :: Int -> Int+mu i = unsafeAt mArr i++{-# INLINE nu #-}+nu :: Int -> Int+nu i = unsafeAt nArr i++mArr :: UArray Int Int+mArr = listArray (0,63)+        [ 1,  2,  2,  3,  4,  5,  6,  7+        , 2,  3,  4,  6,  6,  8, 10, 11+        , 2,  4,  5,  7,  8,  9, 12, 13+        , 3,  6,  7,  9, 10, 12, 16, 17+        , 4,  6,  8, 10, 11, 14, 18, 19+        , 5,  8,  9, 12, 14, 17, 22, 23+        , 6, 10, 12, 16, 18, 22, 27, 29+        , 7, 11, 13, 17, 19, 23, 29, 31+        ]++nArr :: UArray Int Int+nArr = listArray (0,63)+        [ 4, 3, 7, 6, 2, 1, 5, 0+        , 3, 7, 5, 0, 6, 2, 4, 1+        , 7, 5, 4, 1, 0, 6, 3, 2+        , 6, 0, 1, 4, 5, 7, 2, 3+        , 2, 6, 0, 5, 7, 3, 1, 4+        , 1, 2, 6, 7, 3, 4, 0, 5+        , 5, 4, 3, 2, 1, 0, 7, 6+        , 0, 1, 2, 3, 4, 5, 6, 7+        ]

@@ -6,18 +6,13 @@ -- Stability:   Provisional -- Portability: Non-portable (GHC extensions) --+-- Auxiliary stuff, conversion between number and index,+-- remainders modulo 30 and related things. {-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Primes.Sieve.Indexing     ( idxPr     , toPrim-    , toIdx     , rho-    , delta-    , tau-    , byte-    , idx-    , mu-    , nu     ) where  import Data.Array.Unboxed@@ -25,13 +20,6 @@  import Math.NumberTheory.Unsafe --- Auxiliary stuff, conversion between number and index,--- remainders modulo 30 and related things.---- {-# SPECIALISE idxPr :: Integer -> (Int,Int),---                         Int -> (Int,Int),---                         Word -> (Int,Int)---   #-} {-# INLINE idxPr #-} idxPr :: Integral a => a -> (Int,Int) idxPr n0@@ -45,99 +33,16 @@     rm2 = rm1 `quot` 3     rm3 = min 7 (if rm2 > 5 then rm2-1 else rm2) --- {-# SPECIALISE toPrim :: Int -> Integer,---                          Int -> Int,---                          Int -> Word,---                          Int -> Word16---     #-} {-# INLINE toPrim #-}-toPrim :: Integral a => Int -> a+toPrim :: Num a => Int -> a toPrim ix = 30*fromIntegral k + fromIntegral (rho i)   where     i = ix .&. 7     k = ix `shiftR` 3 --- Assumes n >= 7, gcd n 30 == 1-{-# INLINE toIdx #-}-toIdx :: Integral a => a -> Int-toIdx n = 8*fromIntegral q+r2-  where-    (q,r) = (n-7) `quotRem` 30-    r1 = fromIntegral r `quot` 3-    r2 = min 7 (if r1 > 5 then r1-1 else r1)- {-# INLINE rho #-} rho :: Int -> Int rho i = unsafeAt residues i  residues :: UArray Int Int residues = listArray (0,7) [7,11,13,17,19,23,29,31]--{-# INLINE delta #-}-delta :: Int -> Int-delta i = unsafeAt deltas i--deltas :: UArray Int Int-deltas = listArray (0,7) [4,2,4,2,4,6,2,6]--{-# INLINE tau #-}-tau :: Int -> Int-tau i = unsafeAt taus i--taus :: UArray Int Int-taus = listArray (0,63)-        [  7,  4,  7,  4,  7, 12,  3, 12-        , 12,  6, 11,  6, 12, 18,  5, 18-        , 14,  7, 13,  7, 14, 21,  7, 21-        , 18,  9, 19,  9, 18, 27,  9, 27-        , 20, 10, 21, 10, 20, 30, 11, 30-        , 25, 12, 25, 12, 25, 36, 13, 36-        , 31, 15, 31, 15, 31, 47, 15, 47-        , 33, 17, 33, 17, 33, 49, 17, 49-        ]--{-# INLINE byte #-}-byte :: Int -> Int-byte i = unsafeAt startByte i--startByte :: UArray Int Int-startByte = listArray (0,7) [1,3,5,9,11,17,27,31]--{-# INLINE idx #-}-idx :: Int -> Int-idx i = unsafeAt startIdx i--startIdx :: UArray Int Int-startIdx = listArray (0,7) [4,7,4,4,7,4,7,7]--{-# INLINE mu #-}-mu :: Int -> Int-mu i = unsafeAt mArr i--{-# INLINE nu #-}-nu :: Int -> Int-nu i = unsafeAt nArr i--mArr :: UArray Int Int-mArr = listArray (0,63)-        [ 1,  2,  2,  3,  4,  5,  6,  7-        , 2,  3,  4,  6,  6,  8, 10, 11-        , 2,  4,  5,  7,  8,  9, 12, 13-        , 3,  6,  7,  9, 10, 12, 16, 17-        , 4,  6,  8, 10, 11, 14, 18, 19-        , 5,  8,  9, 12, 14, 17, 22, 23-        , 6, 10, 12, 16, 18, 22, 27, 29-        , 7, 11, 13, 17, 19, 23, 29, 31-        ]--nArr :: UArray Int Int-nArr = listArray (0,63)-        [ 4, 3, 7, 6, 2, 1, 5, 0-        , 3, 7, 5, 0, 6, 2, 4, 1-        , 7, 5, 4, 1, 0, 6, 3, 2-        , 6, 0, 1, 4, 5, 7, 2, 3-        , 2, 6, 0, 5, 7, 3, 1, 4-        , 1, 2, 6, 7, 3, 4, 0, 5-        , 5, 4, 3, 2, 1, 0, 7, 6-        , 0, 1, 2, 3, 4, 5, 6, 7-        ]

@@ -1,407 +0,0 @@--- |--- Module:      Math.NumberTheory.Primes.Sieve.Misc--- Copyright:   (c) 2011 Daniel Fischer--- Licence:     MIT--- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions)----{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE MonoLocalBinds      #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fspec-constr-count=8 #-}-{-# OPTIONS_HADDOCK hide #-}-module Math.NumberTheory.Primes.Sieve.Misc-    ( -- * Types-      FactorSieve-    , TotientSieve-    , CarmichaelSieve-      -- * Functions-      -- ** Smallest prime factors-    , factorSieve-    , sieveFactor-    , fsBound-    , fsPrimeTest-      -- ** Totients-    , totientSieve-    , sieveTotient-      -- ** Carmichael-    , carmichaelSieve-    , sieveCarmichael-    ) where--import Control.Monad.ST-import Data.Array.ST-import Data.Array.Unboxed-import Control.Monad (when)-import Data.Bits-import GHC.Word--import System.Random--import Math.NumberTheory.Powers.Squares (integerSquareRoot')-import Math.NumberTheory.Primes.Sieve.Indexing-import Math.NumberTheory.Primes.Factorisation.Montgomery-import Math.NumberTheory.Unsafe-import Math.NumberTheory.Utils--{-# DEPRECATED FactorSieve, TotientSieve, CarmichaelSieve, factorSieve, sieveFactor, fsBound, fsPrimeTest, totientSieve, sieveTotient, carmichaelSieve, sieveCarmichael "Use new interface for sieves, provided by \"Math.NumberTheory.ArithmeticFunctions.SieveBlock\"" #-}--{--IMPORTANT NOTICE: Not all sieves use the same layout!--FactorSieve:--   To remain as efficient as possible, FactorSieve omits only even numbers.-   To relate an odd number x to its index i:--       i = (x `div` 2) - 1-       x = i * 2 + 3--TotientSieve, CarmichaelSieve:--   These sieves use a (2,3,5) wheel optimization, sacrificing performance to save-   more memory. The only indices stored are those coprime to 2, 3, and 5.-   To relate such an integer x to its index i:--       i = toIdx x-       x = toPrim i--}---- | A compact store of smallest prime factors.-data FactorSieve = FS {-# UNPACK #-} !Word {-# UNPACK #-} !(UArray Int Word16)---- | A compact store of totients.-data TotientSieve = TS {-# UNPACK #-} !Word {-# UNPACK #-} !(UArray Int Word)---- | A compact store of values of the Carmichael function.-data CarmichaelSieve = CS {-# UNPACK #-} !Word {-# UNPACK #-} !(UArray Int Word)---- | @'factorSieve' n@ creates a store of smallest prime factors of the numbers not exceeding @n@.---   If you need to factorise many smallish numbers, this can give a big speedup since it avoids---   many superfluous divisions. However, a too large sieve leads to a slowdown due to cache misses.---   The prime factors are stored as 'Word16' for compactness, so @n@ must be---   smaller than @2^32@.-factorSieve :: Integer -> FactorSieve-factorSieve bound-  | 4294967295 < bound  = error "factorSieve: overflow"-  | bound < 8   = FS 7 (array (0,2) [(0,0),(1,0),(2,0)])-  | otherwise   = FS bnd fSieve-    where-      bnd = fromInteger bound-      ibnd = fromInteger ((bound - 3) `quot` 2)-      svbd = (fromInteger (integerSquareRoot' bound) - 1) `quot` 2-      fSieve = runSTUArray $ do-          sieve <- newArray (0,ibnd) 0 :: ST s (STUArray s Int Word16)-          let sift i-                  | i < svbd = do-                      sp <- unsafeRead sieve i-                      when (sp == 0) (mark (2*i+3) (2*i*(i+3)+3))-                      sift (i+1)-                  | otherwise = return sieve-              mark p j-                  | j > ibnd    = return ()-                  | otherwise   = do-                      sp <- unsafeRead sieve j-                      when (sp == 0) (unsafeWrite sieve j $ fromIntegral p)-                      mark p (j+p)-          sift 0---- | @'fsBound' sieve@ tells the limit to which the sieve stores the smallest prime factors.-fsBound :: FactorSieve -> Word-fsBound (FS b _) = b---- | @'fsPrimeTest' sieve n@ checks in the sieve whether @n@ is prime. If @n@ is larger---   than the sieve can handle, an error is raised.-fsPrimeTest :: FactorSieve -> Integer -> Bool-fsPrimeTest fs@(FS bnd sve) n-    | n < 0     = fsPrimeTest fs (-n)-    | n < 2     = False-    | fromInteger n .&. (1 :: Int) == 0 = n == 2-    | n <= fromIntegral bnd = sve `unsafeAt` (fromInteger (n `shiftR` 1) - 1) == 0-    | otherwise = error "Out of bounds"---- | @'sieveFactor' fs n@ finds the prime factorisation of @n@ using the 'FactorSieve' @fs@.---   For negative @n@, a factor of @-1@ is included with multiplicity @1@.---   After stripping any present factors @2@, the remaining cofactor @c@ (if larger---   than @1@) is factorised with @fs@. This is most efficient of course if @c@ does not---   exceed the bound with which @fs@ was constructed. If it does, trial division is performed---   until either the cofactor falls below the bound or the sieve is exhausted. In the latter---   case, the elliptic curve method is used to finish the factorisation.-sieveFactor :: FactorSieve -> Integer -> [(Integer,Int)]-sieveFactor (FS bnd sve) = check-  where-    bound = fromIntegral bnd-    check 0 = error "0 has no prime factorisation"-    check 1 = []-    check n-      | n < 0       = (-1,1) : check (-n)-      | n <= bound  = go2w (fromIntegral n)     -- avoid expensive Integer ops if possible-      | fromInteger n .&. (1 :: Int) == 1 = sieveLoop n-      | otherwise   = go2 n-    go2w n-        | n .&. 1 == 1 = intLoop ((n-3) `shiftR` 1)-        | otherwise = case shiftToOddCount n of-                        (k,m) -> (2,k) : if m == 1 then [] else intLoop ((m-3) `shiftR` 1)-    go2 n = case shiftToOddCount n of-              (k,m) -> (2,k) : if m == 1 then [] else sieveLoop m-    sieveLoop n-        | bound < n  = tdLoop n (integerSquareRoot' n) 0-        | otherwise = intLoop (fromIntegral (n `shiftR` 1)-1)-    intLoop :: Word -> [(Integer,Int)]-    intLoop !n = case unsafeAt sve (fromIntegral n) of-                  0 -> [(2*fromIntegral n+3,1)]-                  p -> let p' = fromIntegral p in countLoop p' (n `quot` p' - 1) 1-    countLoop !p !i !c-        = case unsafeAt sve (fromIntegral i) of-            0 | p-3 == 2*i -> [(fromIntegral p,c+1)]-              | otherwise  -> (fromIntegral p,c) : (2*fromIntegral i+3,1) : []-            q | fromIntegral q == p -> countLoop p (i `quot` p - 1) (c+1)-              | otherwise -> (fromIntegral p, c) : intLoop i-    lstIdx = snd (bounds sve)-    tdLoop n sr ix-        | lstIdx < ix   = curve n-        | sr < p        = [(n,1)]-        | pix /= 0      = tdLoop n sr (ix+1)    -- not a prime-        | otherwise     = case splitOff p n of-                            (0,_) -> tdLoop n sr (ix+1)-                            (k,m) -> (p,k) : case m of-                                               1 -> []-                                               j | j <= bound -> intLoop (fromIntegral (j `shiftR` 1) - 1)-                                                 | otherwise -> tdLoop j (integerSquareRoot' j) (ix+1)-          where-            p = fromIntegral $ 2 * ix + 3-            pix = unsafeAt sve ix-    curve n = stdGenFactorisation (Just (bound*(bound+2))) (mkStdGen $ fromIntegral n `xor` 0xdecaf00d) Nothing n---- | @'totientSieve' n@ creates a store of the totients of the numbers not exceeding @n@.---   A 'TotientSieve' only stores values for numbers coprime to @30@ to reduce space usage.---   The maximal admissible value for @n@ is @'fromIntegral' ('maxBound' :: 'Word')@.-totientSieve :: Integer -> TotientSieve-totientSieve bound-  | fromIntegral (maxBound :: Word) < bound  = error "totientSieve: overflow"-  | bound < 8   = TS 7 (array (0,0) [(0,6)])-  | otherwise   = TS bnd (totSieve bnd)-    where-      bnd = fromInteger bound---- | @'sieveTotient' ts n@ finds the totient @&#960;(n)@, i.e. the number of integers @k@ with---   @1 <= k <= n@ and @'gcd' n k == 1@, in other words, the order of the group of units---   in @&#8484;/(n)@, using the 'TotientSieve' @ts@.---   First, factors of @2, 3@ and @5@ are handled individually, if the remaining---   cofactor of @n@ is within the sieve range, its totient is looked up, otherwise---   the calculation falls back on factorisation, first by trial division and---   if necessary, elliptic curves.-sieveTotient :: TotientSieve -> Integer -> Integer-sieveTotient (TS bnd sve) = check-  where-    bound = fromIntegral bnd-    check n-        | n < 1     = error "Totient only defined for positive numbers"-        | n == 1    = 1-        | otherwise = go2 n-    go2 n = case shiftToOddCount n of-              (0,_) -> go3 1 n-              (k,m) -> let tt = (shiftL 1 (k-1)) in if m == 1 then tt else go3 tt m-    go3 !tt n = case splitOff 3 n of-                  (0,_) -> go5 tt n-                  (k,m) -> let nt = tt*(2*3^(k-1)) in if m == 1 then nt else go5 nt m-    go5 !tt n = case splitOff 5 n of-                  (0,_) -> sieveLoop tt n-                  (k,m) -> let nt = tt*(4*5^(k-1)) in if m == 1 then nt else sieveLoop nt m-    sieveLoop !tt n-        | bound < n = tdLoop tt n (integerSquareRoot' n) 0-        | otherwise = case unsafeAt sve (toIdx n) of-                        nt -> tt*fromIntegral nt-    lstIdx = snd (bounds sve)-    tdLoop !tt n sr ix-        | lstIdx < ix   = curve tt n-        | sr < p'       = tt*(n-1)      -- n is a prime-        | pix /= p-1    = tdLoop tt n sr (ix+1)    -- not a prime, next-        | otherwise     = case splitOff p' n of-                            (0,_) -> tdLoop tt n sr (ix+1)-                            (k,m) -> let nt = tt*ppTotient (p',k)-                                     in case m of-                                          1 -> nt-                                          j | j <= bound -> nt*fromIntegral (unsafeAt sve (toIdx j))-                                            | otherwise  -> tdLoop nt j (integerSquareRoot' j) (ix+1)-          where-            p = toPrim ix-            p' = fromIntegral p-            pix = unsafeAt sve ix-    curve tt n = tt * totientFromCanonical (stdGenFactorisation (Just (bound*(bound+2))) (mkStdGen $ fromIntegral n `xor` 0xdecaf00d) Nothing n)---- | Calculate the totient from the canonical factorisation.-totientFromCanonical :: [(Integer,Int)] -> Integer-totientFromCanonical = product . map ppTotient---- | Totient of a prime power.-ppTotient :: (Integer, Int) -> Integer-ppTotient (p, 1) = p - 1-ppTotient (p, k) = (p - 1) * p ^ (k - 1)---- | @'carmichaelSieve' n@ creates a store of values of the Carmichael function---   for numbers not exceeding @n@.---   Like a 'TotientSieve', a 'CarmichaelSieve' only stores values for numbers coprime to @30@---   to reduce space usage. The maximal admissible value for @n@ is @'fromIntegral' ('maxBound' :: 'Word')@.-carmichaelSieve :: Integer -> CarmichaelSieve-carmichaelSieve bound-  | fromIntegral (maxBound :: Word) < bound  = error "carmichaelSieve: overflow"-  | bound < 8   = CS 7 (array (0,0) [(0,6)])-  | otherwise   = CS bnd (carSieve bnd)-    where-      bnd = fromInteger bound---- | @'sieveCarmichael' cs n@ finds the value of @&#955;(n)@ (or @&#968;(n)@), the smallest positive---   integer @e@ such that for all @a@ with @gcd a n == 1@ the congruence @a^e &#8801; 1 (mod n)@ holds,---   in other words, the (smallest) exponent of the group of units in @&#8484;/(n)@.---   The strategy is analogous to 'sieveTotient'.-sieveCarmichael :: CarmichaelSieve -> Integer -> Integer-sieveCarmichael (CS bnd sve) = check-  where-    bound = fromIntegral bnd-    check n-        | n < 1     = error "Carmichael function only defined for positive numbers"-        | n == 1    = 1-        | otherwise = go2 n-    go2 n = case shiftToOddCount n of-              (0,_) -> go3 1 n-              (k,m) -> let tt = case k of-                                  1 -> 1-                                  2 -> 2-                                  _ -> (shiftL 1 (k-2))-                       in if m == 1 then tt else go3 tt m-    go3 !tt n = case splitOff 3 n of-                  (0,_) -> go5 tt n-                  (k,1) | tt == 1   -> 2*3^(k-1)-                        | otherwise -> tt*3^(k-1)-                  (k,m) | tt == 1   -> go5 (2*3^(k-1)) m-                        | otherwise -> go5 (tt*3^(k-1)) m-    go5 !tt n = case splitOff 5 n of-                  (0,_) -> sieveLoop tt n-                  (k,m) -> let tt' = case fromInteger tt .&. (3 :: Int) of-                                       0 -> tt-                                       2 -> 2*tt-                                       _ -> 4*tt-                               nt = tt'*5^(k-1)-                           in if m == 1 then nt else sieveLoop nt m-    sieveLoop !tt n-        | bound < n = tdLoop tt n (integerSquareRoot' n) 0-        | otherwise = case unsafeAt sve (toIdx n) of-                        nt -> tt `lcm` fromIntegral nt-    lstIdx = snd (bounds sve)-    tdLoop !tt n sr ix-        | lstIdx < ix   = curve tt n-        | sr < p'       = tt `lcm` (n-1)      -- n is a prime-        | pix /= p-1    = tdLoop tt n sr (ix+1)    -- not a prime, next-        | otherwise     = case splitOff p' n of-                            (0,_) -> tdLoop tt n sr (ix+1)-                            (k,m) -> let nt = (lcm tt (p'-1))*p'^(k-1)-                                     in case m of-                                          1 -> nt-                                          j | j <= bound -> nt `lcm` fromIntegral (unsafeAt sve (toIdx j))-                                            | otherwise  -> tdLoop nt j (integerSquareRoot' j) (ix+1)-          where-            p = toPrim ix-            p' = fromIntegral p-            pix = unsafeAt sve ix-    curve tt n = tt `lcm` carmichaelFromCanonical (stdGenFactorisation (Just (bound*(bound+2))) (mkStdGen $ fromIntegral n `xor` 0xdecaf00d) Nothing n)---- | Calculate the Carmichael function from the factorisation.---   Requires that the list of prime factors is strictly ascending.-carmichaelFromCanonical :: [(Integer, Int)] -> Integer-carmichaelFromCanonical = go2-  where-    go2 ((2, k) : ps) = let acc = case k of-                                  1 -> 1-                                  2 -> 2-                                  _ -> 1 `shiftL` (k-2)-                        in go acc ps-    go2 ps = go 1 ps-    go !acc ((p, 1) : pps) = go (lcm acc (p - 1)) pps-    go acc ((p, k) : pps)  = go ((lcm acc (p - 1)) * p ^ (k - 1)) pps-    go acc []              = acc---- NOTE: This is a legacy implementation of FactorSieve which uses the---       same (2,3,5) wheel optimization as the other sieves.---       It is still used to generate the other sieves.-spfSieve :: Word -> ST s (STUArray s Int Word)-spfSieve bound = do-  let (octs,lidx) = idxPr bound-      !mxidx = 8*octs+lidx-      mxval :: Word-      mxval = 30*fromIntegral octs + fromIntegral (rho lidx)-      !mxsve = integerSquareRoot' mxval-      (kr,r) = idxPr mxsve-      !svbd = 8*kr+r-  ar <- newArray (0,mxidx) 0-  let start k i = 8*(k*(30*k+2*rho i) + byte i) + idx i-      tick p stp off j ix-        | mxidx < ix    = return ()-        | otherwise = do-          s <- unsafeRead ar ix-          when (s == 0) (unsafeWrite ar ix p)-          tick p stp off ((j+1) .&. 7) (ix + stp*delta j + tau (off+j))-      sift ix-        | svbd < ix = return ar-        | otherwise = do-          e <- unsafeRead ar ix-          when (e == 0)  (do let i = ix .&. 7-                                 k = ix `shiftR` 3-                                 !off = i `shiftL` 3-                                 !stp = ix - i-                                 !p = toPrim ix-                             tick p stp off i (start k i))-          sift (ix+1)-  sift 0--totSieve :: Word -> UArray Int Word-totSieve bound = runSTUArray $ do-    ar <- spfSieve bound-    (_,lst) <- getBounds ar-    let tot ix-          | lst < ix    = return ar-          | otherwise   = do-            p <- unsafeRead ar ix-            if p == 0-                then unsafeWrite ar ix (toPrim ix - 1)-                else do let !n = toPrim ix-                            (tp,m) = unFact p (n `quot` p)-                        case m of-                          1 -> unsafeWrite ar ix tp-                          _ -> do-                            tm <- unsafeRead ar (toIdx m)-                            unsafeWrite ar ix (tp*tm)-            tot (ix+1)-    tot 0--carSieve :: Word -> UArray Int Word-carSieve bound = runSTUArray $ do-    ar <- spfSieve bound-    (_,lst) <- getBounds ar-    let car ix-          | lst < ix    = return ar-          | otherwise   = do-            p <- unsafeRead ar ix-            if p == 0-                then unsafeWrite ar ix (toPrim ix - 1)-                else do let !n = toPrim ix-                            (tp,m) = unFact p (n `quot` p)-                        case m of-                          1 -> unsafeWrite ar ix tp-                          _ -> do-                            tm <- unsafeRead ar (toIdx m)-                            unsafeWrite ar ix (lcm tp tm)-            car (ix+1)-    car 0---- Find the p-part of the totient of (p*m) and the cofactor--- of the p-power in m.-{-# INLINE unFact #-}-unFact :: Word -> Word -> (Word,Word)-unFact p m = go (p-1) m-  where-    go !tt k = case k `quotRem` p of-                 (q,0) -> go (p*tt) q-                 _ -> (tt,k)

@@ -19,9 +19,6 @@     , millerRabinV     , isStrongFermatPP     , isFermatPP-      -- * Using a sieve-    , FactorSieve-    , fsIsPrime       -- * Trial division     , trialDivisionPrimeTo     ) where@@ -29,15 +26,3 @@ import Math.NumberTheory.Primes.Testing.Probabilistic import Math.NumberTheory.Primes.Testing.Certified import Math.NumberTheory.Primes.Factorisation.TrialDivision-import Math.NumberTheory.Primes.Sieve.Misc--{-# DEPRECATED fsIsPrime "Use new interface for sieves, provided by Math.NumberTheory.ArithmeticFunctions.SieveBlock" #-}---- | Test primality using a 'FactorSieve'. If @n@ is out of bounds---   of the sieve, fall back to 'isPrime'.-fsIsPrime :: FactorSieve -> Integer -> Bool-fsIsPrime fs n-    | n < 0     = fsIsPrime fs (-n)-    | n <= fromIntegral (fsBound fs)    = fsPrimeTest fs n-    | otherwise = isPrime n-

@@ -30,9 +30,6 @@     ) where  import Data.List-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif import Data.Bits import Data.Maybe import GHC.Integer.GMP.Internals

@@ -156,7 +156,7 @@       square = isPossibleSquare2 n && r*r == n       r = integerSquareRoot n       d = find True 5-      find !pos cd = case jacobi' (n `rem` cd) cd of+      find !pos cd = case jacobi (n `rem` cd) cd of                        MinusOne -> if pos then cd else (-cd)                        Zero     -> if cd == n then 1 else 0                        One      -> find (not pos) (cd+2)@@ -187,16 +187,10 @@           v2n1  = ((un1 - (2*q)*un)*vn-qn) `rem` n           q2n   = (qn*qn) `rem` n           q2n1  = (qn*qn*q) `rem` n-#if __GLASGOW_HASKELL__ < 709-testLucas n q (J# s# ba#) = test (s# -# 1#)-  where-    test j# = case indexWordArray# ba# j# of-#else testLucas n q (Jp# bn#) = test (s# -# 1#)   where     s# = sizeofBigNat# bn#     test j# = case indexBigNat# bn# j# of-#endif                 0## -> test (j# -# 1#)                 w# -> look (j# -# 1#) (W# w#) (WORD_SIZE_IN_BITS - 1)     look j# w i@@ -205,11 +199,7 @@     go k# w i un un1 vn qn       | i < 0       = if isTrue# (k# <# 0#)                          then (un,vn,qn)-#if __GLASGOW_HASKELL__ < 709-                         else go (k# -# 1#) (W# (indexWordArray# ba# k#)) (WORD_SIZE_IN_BITS - 1) un un1 vn qn-#else                          else go (k# -# 1#) (W# (indexBigNat# bn# k#)) (WORD_SIZE_IN_BITS - 1) un un1 vn qn-#endif       | testBit w i = go k# w (i-1) u2n1 u2n2 v2n1 q2n1       | otherwise   = go k# w (i-1) u2n u2n1 v2n q2n         where@@ -220,7 +210,5 @@           v2n1  = ((un1 - (2*q)*un)*vn-qn) `rem` n           q2n   = (qn*qn) `rem` n           q2n1  = (qn*qn*q) `rem` n-#if __GLASGOW_HASKELL__ >= 709 -- Listed as a precondition of lucasTest testLucas _ _ _ = error "lucasTest: negative argument"-#endif

@@ -10,8 +10,9 @@ -- Should not be exposed to users. -- -{-# LANGUAGE CPP          #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP           #-}+{-# LANGUAGE TypeFamilies  #-}+{-# LANGUAGE DeriveGeneric #-}  module Math.NumberTheory.Primes.Types   ( Prime@@ -19,23 +20,24 @@   , PrimeNat(..)   ) where -#if MIN_VERSION_base(4,8,0)-#else-import Data.Word-#endif- import Numeric.Natural+import GHC.Generics+import Control.DeepSeq  newtype Prm = Prm { unPrm :: Word }-  deriving (Eq, Ord)+  deriving (Eq, Ord, Generic) +instance NFData Prm+ instance Show Prm where   showsPrec d (Prm p) r = (if d > 10 then "(" ++ s ++ ")" else s) ++ r     where       s = "Prm " ++ show p  newtype PrimeNat = PrimeNat { unPrimeNat :: Natural }-  deriving (Eq, Ord)+  deriving (Eq, Ord, Generic)++instance NFData PrimeNat  instance Show PrimeNat where   showsPrec d (PrimeNat p) r = (if d > 10 then "(" ++ s ++ ")" else s) ++ r

@@ -0,0 +1,315 @@+-- |+-- Module:      Math.NumberTheory.EisensteinIntegers+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- This module exports functions for manipulating Eisenstein integers, including+-- computing their prime factorisations.+--++{-# LANGUAGE BangPatterns   #-}+{-# LANGUAGE DeriveGeneric  #-}+{-# LANGUAGE RankNTypes     #-}++module Math.NumberTheory.Quadratic.EisensteinIntegers+  ( EisensteinInteger(..)+  , ω+  , conjugate+  , norm+  , associates+  , ids++  , divideByThree++  -- * Primality functions+  , factorise+  , findPrime+  , isPrime+  , primes+  ) where++import Data.List                                       (mapAccumL, partition)+import Data.Maybe                                      (fromMaybe)+import Data.Ord                                        (comparing)+import GHC.Generics                                    (Generic)++import qualified Math.NumberTheory.Euclidean            as ED+import Math.NumberTheory.Moduli.Sqrt+import qualified Math.NumberTheory.Primes.Factorisation as Factorisation+import Math.NumberTheory.Primes.Types                   (PrimeNat(..))+import qualified Math.NumberTheory.Primes.Sieve         as Sieve+import qualified Math.NumberTheory.Primes.Testing       as Testing+import Math.NumberTheory.Utils                          (mergeBy)+import Math.NumberTheory.Utils.FromIntegral             (integerToNatural)++infix 6 :+++-- | An Eisenstein integer is a + bω, where a and b are both integers.+data EisensteinInteger = (:+) { real :: !Integer, imag :: !Integer }+    deriving (Eq, Ord, Generic)++-- | The imaginary unit for Eisenstein integers, where+--+-- > ω == (-1/2) + ((sqrt 3)/2)ι == exp(2*pi*ι/3)+-- and ι is the usual imaginary unit with ι² == -1.+ω :: EisensteinInteger+ω = 0 :+ 1++instance Show EisensteinInteger where+    show (a :+ b)+        | b == 0     = show a+        | a == 0     = s ++ b'+        | otherwise  = show a ++ op ++ b'+        where+            b' = if abs b == 1 then "ω" else show (abs b) ++ "*ω"+            op = if b > 0 then "+" else "-"+            s  = if b > 0 then "" else "-"++instance Num EisensteinInteger where+    (+) (a :+ b) (c :+ d) = (a + c) :+ (b + d)+    (*) (a :+ b) (c :+ d) = (a * c - b * d) :+ (b * (c - d) + a * d)+    abs = fst . absSignum+    negate (a :+ b) = (-a) :+ (-b)+    fromInteger n = n :+ 0+    signum = snd . absSignum++-- | Returns an @EisensteinInteger@'s sign, and its associate in the first+-- sextant.+absSignum :: EisensteinInteger -> (EisensteinInteger, EisensteinInteger)+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++-- | List of all Eisenstein units, counterclockwise across all sextants,+-- starting with @1@.+ids :: [EisensteinInteger]+ids = take 6 (iterate ((1 + ω) *) 1)++-- | Produce a list of an @EisensteinInteger@'s associates.+associates :: EisensteinInteger -> [EisensteinInteger]+associates e = map (e *) ids++-- | Takes an Eisenstein prime whose norm is of the form @3k + 1@ with @k@+-- a nonnegative integer, and return its primary associate.+-- * Does *not* check for this precondition.+-- * @head@ will fail when supplied a number unsatisfying it.+primary :: EisensteinInteger -> EisensteinInteger+primary = head . filter (\p -> p `ED.mod` 3 == 2) . associates++instance ED.Euclidean EisensteinInteger where+  quotRem = divHelper quot+  divMod  = divHelper div++-- | 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)++-- | Conjugate a Eisenstein integer.+conjugate :: EisensteinInteger -> EisensteinInteger+conjugate (a :+ b) = (a - b) :+ (-b)++-- | The square of the magnitude of a Eisenstein integer.+norm :: EisensteinInteger -> Integer+norm (a :+ b) = a*a - a * b + b*b++-- | Checks if a given @EisensteinInteger@ is prime. @EisensteinInteger@s+-- whose norm is a prime congruent to @0@ or @1@ modulo 3 are prime.+-- See <http://thekeep.eiu.edu/theses/2467 Bandara, Sarada, "An Exposition of the Eisenstein Integers" (2016)>,+-- page 12.+isPrime :: EisensteinInteger -> Bool+isPrime e | e == 0                     = False+          -- 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+          | otherwise = False+  where nE       = norm e+        a' :+ b' = abs e++-- | Remove @1 - ω@ factors from an @EisensteinInteger@, and calculate that+-- prime's multiplicity in the number's factorisation.+divideByThree :: EisensteinInteger -> (Int, EisensteinInteger)+divideByThree = go 0+  where+    go :: Int -> EisensteinInteger -> (Int, EisensteinInteger)+    go !n z@(a :+ b) | r1 == 0 && r2 == 0 = go (n + 1) (q1 :+ q2)+                      | otherwise          = (n, abs z)+      where+        -- @(a + a - b) :+ (a + b)@ is @z * (2 :+ 1)@, and @z * (2 :+ 1)/3@+        -- is the same as @z / (1 :+ (-1))@.+        (q1, r1) = divMod (a + a - b) 3+        (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 form @3n+1@ is actually of 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:+-- @z^2 - z + 9k^2 ≡ 9k^2 - 1 (mod 6k+1)@+-- @(z+3k)^2 ≡ 9k^2-1 (mod 6k+1)@+-- @z+3k = sqrtMod(9k^2-1)@+-- @z = sqrtMod(9k^2-1) - 3k@+--+-- * For example, let @p = 7@, then @k = 1@. Square root of @9*1^2-1 modulo 7@ is @1@.+-- * And @z = 1 - 3*1 = -2 ≡ 5 (mod 7)@.+-- * Truly, @norm (5 :+ 1) = 25 - 5 + 1 = 21 ≡ 0 (mod 7)@.+findPrime :: Integer -> EisensteinInteger+findPrime p = case sqrtsModPrime (9*k*k - 1) (PrimeNat . integerToNatural $ p) of+    []    -> error "findPrime: argument must be prime p = 6k + 1"+    z : _ -> ED.gcd (p :+ 0) ((z - 3 * k) :+ 1)+    where+        k :: Integer+        k = p `div` 6++-- | An infinite list of Eisenstein primes. Uses primes in Z to exhaustively+-- generate all Eisenstein primes in order of ascending magnitude.+-- * 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 :: [EisensteinInteger]+primes = (2 :+ 1) : mergeBy (comparing norm) l r+  where (leftPrimes, rightPrimes) = partition (\p -> p `mod` 3 == 2) Sieve.primes+        rightPrimes' = filter (\prime -> prime `mod` 3 == 1) $ tail rightPrimes+        l = [p :+ 0 | p <- leftPrimes]+        r = [g | p <- rightPrimes', let x :+ y = findPrime p, g <- [x :+ y, x :+ (x - y)]]++-- | Compute the prime factorisation of a Eisenstein integer. This is unique+-- up to units (+/- 1, +/- ω, +/- ω²).+-- * Unit factors are not included in the result.+-- * All prime factors are primary i.e. @e ≡ 2 (modE 3)@, for an Eisenstein+-- prime factor @e@.+--+-- * This function works by factorising the norm of an Eisenstein integer+-- and then, for each prime factor, finding the Eisenstein prime whose norm+-- is said prime factor with @findPrime@.+--+-- * This is only possible because the norm function of the Euclidean Domain of+-- Eisenstein integers is multiplicative: @norm (e1 * e2) == norm e1 * norm e2@+-- for any two @EisensteinInteger@s @e1, e2@.+--+-- * In the previously mentioned work <http://thekeep.eiu.edu/theses/2467 Bandara, Sarada, "An Exposition of the Eisenstein Integers" (2016)>,+-- in Theorem 8.4 in Chapter 8, a way is given to express any Eisenstein+-- integer @μ@ as @(-1)^a * ω^b * (1 - ω)^c * product [π_i^a_i | i <- [1..N]]@+-- where @a, b, c, a_i@ are nonnegative integers, @N > 1@ is an integer and+-- @π_i@ are primary primes (for a primary Eisenstein prime @p@,+-- @p ≡ 2 (modE 3)@, see @primary@ above).+--+-- * Aplying @norm@ to both sides of Theorem 8.4:+--    @norm μ = norm ((-1)^a * ω^b * (1 - ω)^c * product [ π_i^a_i | i <- [1..N]])@+-- == @norm μ = norm ((-1)^a) * norm (ω^b) * norm ((1 - ω)^c) * norm (product [ π_i^a_i | i <- [1..N]])@+-- == @norm μ = (norm (-1))^a * (norm ω)^b * (norm (1 - ω))^c * product [ norm (π_i^a_i) | i <- [1..N]]@+-- == @norm μ = (norm (-1))^a * (norm ω)^b * (norm (1 - ω))^c * product [ (norm π_i)^a_i) | i <- [1..N]]@+-- == @norm μ = 1^a * 1^b * 3^c * product [ (norm π_i)^a_i) | i <- [1..N]]@+-- == @norm μ = 3^c * product [ (norm π_i)^a_i) | i <- [1..N]]@+-- where @a, b, c, a_i@ are nonnegative integers, and @N > 1@ is an integer.+--+-- * The remainder of the Eisenstein integer factorisation problem is about+-- finding appropriate @[e_i | i <- [1..M]@ such that+-- @(nub . map norm) [e_i | i <- [1..N]] == [π_i | i <- [1..N]]@+-- where @ 1 < N <= M@ are integers, @nub@ removes duplicates and @==@+-- is equality on sets.+--+-- * The reason @M >= N@ is because the prime factors of an Eisenstein integer+-- may include a prime factor and its conjugate, meaning the number may have+-- more Eisenstein prime factors than its norm has integer prime factors.+factorise :: EisensteinInteger -> [(EisensteinInteger, Int)]+factorise g = concat $+              snd $+              mapAccumL go (abs g) (Factorisation.factorise $ norm g)+  where+    go :: EisensteinInteger -> (Integer, Int) -> (EisensteinInteger, [(EisensteinInteger, Int)])+    go z (3, e) | e == n    = (q, [(2 :+ 1, e)])+                | otherwise = error $ "3 is a prime factor of the norm of z\+                                      \ == " ++ show z ++ " with multiplicity\+                                      \ " ++ show e ++ " but (1 - ω) only\+                                      \ divides z " ++ show n ++ "times."+      where+        -- Remove all @1 :+ (-1)@ (which is associated to @2 :+ 1@) factors+        -- from the argument.+        (n, q) = divideByThree z+    go z (p, e) | p `mod` 3 == 2 =+                    let e' = e `quot` 2 in (z `quotI` (p ^ e'), [(p :+ 0, e')])++                -- The @`mod` 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.+                -- This @otherwise@ is mandatorily @`mod` 3 == 1@.+                | otherwise   = (z', filter ((> 0) . snd) [(gp, k), (gp', k')])+      where+        gp@(x :+ y)      = primary $ findPrime p+        -- @gp'@ is @gp@'s conjugate.+        gp'              = primary $ abs $ x :+ (x - y)+        (k, k', z') = divideByPrime gp gp' p e z++        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.+divideByPrime+    :: EisensteinInteger   -- ^ Eisenstein prime @p@+    -> EisensteinInteger   -- ^ Conjugate of @p@+    -> Integer             -- ^ Precomputed norm of @p@, of form @4k + 1@+    -> Int                 -- ^ Expected number of factors (either @p@ or @conjugate p@)+                           --   in Eisenstein integer @z@+    -> EisensteinInteger   -- ^ Eisenstein integer @z@+    -> ( Int               -- Multiplicity of factor @p@ in @z@+       , Int               -- Multiplicity of factor @conjigate p@ in @z@+       , EisensteinInteger -- Remaining Eisenstein integer+       )+divideByPrime p p' np k = go k 0+    where+        go :: Int -> Int -> EisensteinInteger -> (Int, Int, EisensteinInteger)+        go 0 d z = (d, d, z)+        go c d z | c >= 2, Just z' <- z `quotEvenI` np = go (c - 2) (d + 1) z'+        go c d z = (d + d1, d + d2, z'')+            where+                (d1, z') = go1 c 0 z+                d2 = c - d1+                z'' = head $ drop d2+                    $ iterate (\g -> fromMaybe err $ (g * p) `quotEvenI` np) z'++        go1 :: Int -> Int -> EisensteinInteger -> (Int, EisensteinInteger)+        go1 0 d z = (d, z)+        go1 c d z+            | Just z' <- (z * p') `quotEvenI` np+            = go1 (c - 1) (d + 1) z'+            | otherwise+            = (d, z)++        err = error $ "divideByPrime: malformed arguments" ++ show (p, np, k)++-- | Divide an Eisenstein integer by an even integer.+quotEvenI :: EisensteinInteger -> Integer -> Maybe EisensteinInteger+quotEvenI (x :+ y) n+    | xr == 0 , yr == 0 = Just (xq :+ yq)+    | otherwise         = Nothing+  where+    (xq, xr) = x `quotRem` n+    (yq, yr) = y `quotRem` n

@@ -0,0 +1,254 @@+-- |+-- Module:      Math.NumberTheory.GaussianIntegers+-- Copyright:   (c) 2016 Chris Fredrickson, Google Inc.+-- Licence:     MIT+-- Maintainer:  Chris Fredrickson <chris.p.fredrickson@gmail.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- This module exports functions for manipulating Gaussian integers, including+-- computing their prime factorisations.+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}++module Math.NumberTheory.Quadratic.GaussianIntegers (+    GaussianInteger(..),+    ι,+    conjugate,+    norm,+    (.^),+    isPrime,+    primes,+    gcdG,+    gcdG',+    findPrime,+    findPrime',+    factorise,+) where++import Control.DeepSeq (NFData)+import Data.List (mapAccumL, partition)+import Data.Maybe (fromMaybe)+import Data.Ord (comparing)+import GHC.Generics+++import qualified Math.NumberTheory.Euclidean as ED+import Math.NumberTheory.Moduli.Sqrt+import Math.NumberTheory.Powers (integerSquareRoot)+import Math.NumberTheory.Primes.Types (PrimeNat(..))+import qualified Math.NumberTheory.Primes.Factorisation as Factorisation+import qualified Math.NumberTheory.Primes.Sieve as Sieve+import qualified Math.NumberTheory.Primes.Testing as Testing+import Math.NumberTheory.Utils              (mergeBy)+import Math.NumberTheory.Utils.FromIntegral (integerToNatural)++infix 6 :++infixr 8 .^+-- |A Gaussian integer is a+bi, where a and b are both integers.+data GaussianInteger = (:+) { real :: !Integer, imag :: !Integer }+    deriving (Eq, Ord, Generic)++instance NFData GaussianInteger++-- |The imaginary unit, where+--+-- > ι .^ 2 == -1+ι :: GaussianInteger+ι = 0 :+ 1++instance Show GaussianInteger where+    show (a :+ b)+        | b == 0     = show a+        | a == 0     = s ++ b'+        | otherwise  = show a ++ op ++ b'+        where+            b' = if abs b == 1 then "ι" else show (abs b) ++ "*ι"+            op = if b > 0 then "+" else "-"+            s  = if b > 0 then "" else "-"++instance Num GaussianInteger where+    (+) (a :+ b) (c :+ d) = (a + c) :+ (b + d)+    (*) (a :+ b) (c :+ d) = (a * c - b * d) :+ (a * d + b * c)+    abs = fst . absSignum+    negate (a :+ b) = (-a) :+ (-b)+    fromInteger n = n :+ 0+    signum = snd . absSignum++absSignum :: GaussianInteger -> (GaussianInteger, GaussianInteger)+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++instance ED.Euclidean GaussianInteger where+    quotRem = divHelper quot+    divMod  = divHelper div++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)++-- |Conjugate a Gaussian integer.+conjugate :: GaussianInteger -> GaussianInteger+conjugate (r :+ i) = r :+ (-i)++-- |The square of the magnitude of a Gaussian integer.+norm :: GaussianInteger -> Integer+norm (x :+ y) = x * x + y * y++-- |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++-- |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 :: [GaussianInteger]+primes = (1 :+ 1): mergeBy (comparing norm) l r+  where (leftPrimes, rightPrimes) = partition (\p -> p `mod` 4 == 3) (tail Sieve.primes)+        l = [p :+ 0 | p <- leftPrimes]+        r = [g | p <- rightPrimes, let x :+ y = findPrime p, g <- [x :+ y, y :+ x]]+++-- | Compute the GCD of two Gaussian integers. Result is always+-- in the first quadrant.+gcdG :: GaussianInteger -> GaussianInteger -> GaussianInteger+gcdG = ED.gcd+{-# DEPRECATED gcdG "Use 'Math.NumberTheory.Euclidean.gcd' instead." #-}++gcdG' :: GaussianInteger -> GaussianInteger -> GaussianInteger+gcdG' = ED.gcd+{-# DEPRECATED gcdG' "Use 'Math.NumberTheory.Euclidean.gcd' instead." #-}++-- |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>.+findPrime :: Integer -> GaussianInteger+findPrime p = case sqrtsModPrime (-1) (PrimeNat . integerToNatural $ p) of+    []    -> error "findPrime: an argument must be prime p = 4k + 1"+    z : _ -> go p z -- Effectively we calculate gcdG' (p :+ 0) (z :+ 1)+    where+        sqrtp :: Integer+        sqrtp = integerSquareRoot p++        go :: Integer -> Integer -> GaussianInteger+        go g h+            | g <= sqrtp = g :+ h+            | otherwise  = go h (g `mod` h)++findPrime' :: Integer -> GaussianInteger+findPrime' = findPrime+{-# DEPRECATED findPrime' "Use 'findPrime' instead." #-}++-- |Raise a Gaussian integer to a given power.+(.^) :: (Integral a) => GaussianInteger -> a -> GaussianInteger+a .^ e+    | e < 0 && norm a == 1 =+        case a of+            1    :+ 0 -> 1+            (-1) :+ 0 -> if even e then 1 else (-1)+            0    :+ 1 -> (0 :+ (-1)) .^ (abs e `mod` 4)+            _         -> (0 :+ 1) .^ (abs e `mod` 4)+    | e < 0     = error "Cannot exponentiate non-unit Gaussian Int to negative power"+    | a == 0    = 0+    | e == 0    = 1+    | even e    = s * s+    | otherwise = a * a .^ (e - 1)+    where+    s = a .^ div e 2+{-# DEPRECATED (.^) "Use (^) instead." #-}++-- |Compute the prime factorisation of a Gaussian integer. This is unique up to units (+/- 1, +/- i).+-- Unit factors are not included in the result.+factorise :: GaussianInteger -> [(GaussianInteger, Int)]+factorise g = concat $ snd $ mapAccumL go g (Factorisation.factorise $ norm g)+    where+        go :: GaussianInteger -> (Integer, Int) -> (GaussianInteger, [(GaussianInteger, Int)])+        go z (2, e) = (divideByTwo z, [(1 :+ 1, e)])+        go z (p, e)+            | p `mod` 4 == 3+            = let e' = e `quot` 2 in (z `quotI` (p ^ e'), [(p :+ 0, e')])+            | otherwise+            = (z', filter ((> 0) . snd) [(gp, k), (gp', k')])+                where+                    gp = findPrime p+                    (k, k', z') = divideByPrime gp p e z+                    gp' = abs (conjugate gp)++-- | Remove all (1:+1) factors from the argument,+-- avoiding complex division.+divideByTwo :: GaussianInteger -> GaussianInteger+divideByTwo z@(x :+ y)+    | even x, even y+    = divideByTwo $ z `quotI` 2+    | odd x, odd y+    = (x - y) `quot` 2 :+ (x + y) `quot` 2+    | otherwise+    = z++-- | Remove p and conj p factors from the argument,+-- avoiding complex division.+divideByPrime+    :: GaussianInteger   -- ^ Gaussian prime p+    -> Integer           -- ^ Precomputed norm of p, of form 4k + 1+    -> Int               -- ^ Expected number of factors (either p or conj p)+                         --   in Gaussian integer z+    -> GaussianInteger   -- ^ Gaussian integer z+    -> ( Int             -- Multiplicity of factor p in z+       , Int             -- Multiplicity of factor conj p in z+       , GaussianInteger -- Remaining Gaussian integer+       )+divideByPrime p np k = go k 0+    where+        go :: Int -> Int -> GaussianInteger -> (Int, Int, GaussianInteger)+        go 0 d z = (d, d, z)+        go c d z+            | c >= 2+            , Just z' <- z `quotEvenI` np+            = go (c - 2) (d + 1) z'+        go c d z = (d + d1, d + d2, z'')+            where+                (d1, z') = go1 c 0 z+                d2 = c - d1+                z'' = head $ drop d2+                    $ iterate (\g -> fromMaybe err $ (g * p) `quotEvenI` np) z'++        go1 :: Int -> Int -> GaussianInteger -> (Int, GaussianInteger)+        go1 0 d z = (d, z)+        go1 c d z+            | Just z' <- (z * conjugate p) `quotEvenI` np+            = go1 (c - 1) (d + 1) z'+            | otherwise+            = (d, z)++        err = error $ "divideByPrime: malformed arguments" ++ show (p, np, k)++quotI :: GaussianInteger -> Integer -> GaussianInteger+quotI (x :+ y) n = (x `quot` n :+ y `quot` n)++quotEvenI :: GaussianInteger -> Integer -> Maybe GaussianInteger+quotEvenI (x :+ y) n+    | xr == 0+    , yr == 0+    = Just (xq :+ yq)+    | otherwise+    = Nothing+    where+        (xq, xr) = x `quotRem` n+        (yq, yr) = y `quotRem` n

@@ -0,0 +1,18 @@+-- |+-- Module:      Math.NumberTheory.Recurrencies+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--++module Math.NumberTheory.Recurrencies+    ( module Math.NumberTheory.Recurrencies.Linear+    , module Math.NumberTheory.Recurrencies.Bilinear+    , module Math.NumberTheory.Recurrencies.Pentagonal+    ) where++import Math.NumberTheory.Recurrencies.Bilinear+import Math.NumberTheory.Recurrencies.Linear+import Math.NumberTheory.Recurrencies.Pentagonal (partition)

@@ -14,25 +14,26 @@ -- 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)+-- >>> :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)+-- >>> 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) -{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Math.NumberTheory.Recurrencies.Bilinear   ( binomial@@ -42,24 +43,21 @@   , eulerian1   , eulerian2   , bernoulli+  , euler+  , eulerPolyAt1   ) where  import Data.List import Data.Ratio import Numeric.Natural -#if MIN_VERSION_base(4,8,0)-#else-import Data.Word-#endif- import Math.NumberTheory.Recurrencies.Linear (factorial)  -- | Infinite zero-based table of binomial coefficients (also known as Pascal triangle): -- @binomial !! n !! k == n! \/ k! \/ (n - k)!@. ----- > > take 5 (map (take 5) binomial)--- > [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1]]+-- >>> take 5 (map (take 5) binomial)+-- [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1]] -- -- 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@.@@ -77,8 +75,8 @@  -- | Infinite zero-based table of <https://en.wikipedia.org/wiki/Stirling_numbers_of_the_first_kind Stirling numbers of the first kind>. ----- > > take 5 (map (take 5) stirling1)--- > [[1],[0,1],[0,1,1],[0,2,3,1],[0,6,11,6,1]]+-- >>> take 5 (map (take 5) stirling1)+-- [[1],[0,1],[0,1,1],[0,2,3,1],[0,6,11,6,1]] -- -- 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@.@@ -95,8 +93,8 @@  -- | Infinite zero-based table of <https://en.wikipedia.org/wiki/Stirling_numbers_of_the_second_kind Stirling numbers of the second kind>. ----- > > take 5 (map (take 5) stirling2)--- > [[1],[0,1],[0,1,1],[0,1,3,1],[0,1,7,6,1]]+-- >>> take 5 (map (take 5) stirling2)+-- [[1],[0,1],[0,1,1],[0,1,3,1],[0,1,7,6,1]] -- -- 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@.@@ -114,8 +112,8 @@ -- | Infinite one-based table of <https://en.wikipedia.org/wiki/Lah_number Lah numbers>. -- @lah !! n !! k@ equals to lah(n + 1, k + 1). ----- > > take 5 (map (take 5) lah)--- > [[1],[2,1],[6,6,1],[24,36,12,1],[120,240,120,20,1]]+-- >>> take 5 (map (take 5) lah)+-- [[1],[2,1],[6,6,1],[24,36,12,1],[120,240,120,20,1]] -- -- 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@.@@ -131,8 +129,8 @@  -- | Infinite zero-based table of <https://en.wikipedia.org/wiki/Eulerian_number Eulerian numbers of the first kind>. ----- > > take 5 (map (take 5) eulerian1)--- > [[],[1],[1,1],[1,4,1],[1,11,11,1]]+-- >>> take 5 (map (take 5) eulerian1)+-- [[],[1],[1,1],[1,4,1],[1,11,11,1]] -- -- 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@.@@ -148,8 +146,8 @@  -- | Infinite zero-based table of <https://en.wikipedia.org/wiki/Eulerian_number#Eulerian_numbers_of_the_second_kind Eulerian numbers of the second kind>. ----- > > take 5 (map (take 5) eulerian2)--- > [[],[1],[1,2],[1,8,6],[1,22,58,24]]+-- >>> take 5 (map (take 5) eulerian2)+-- [[],[1],[1,2],[1,8,6],[1,22,58,24]] -- -- 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@.@@ -167,20 +165,61 @@ -- computed via <https://en.wikipedia.org/wiki/Bernoulli_number#Connection_with_Stirling_numbers_of_the_second_kind connection> -- with 'stirling2'. ----- > > take 5 bernoulli--- > [1 % 1,(-1) % 2,1 % 6,0 % 1,(-1) % 30]+-- >>> take 5 bernoulli+-- [1 % 1,(-1) % 2,1 % 6,0 % 1,(-1) % 30] -- -- 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 = map f stirling2-  where-    f = sum . zipWith4 (\sgn denom fact stir -> sgn * fact * stir % denom) (cycle [1, -1]) [1..] factorial+bernoulli = helperForB_E_EP id (map recip [1..]) {-# SPECIALIZE bernoulli :: [Ratio Int] #-} {-# SPECIALIZE bernoulli :: [Rational] #-} +-- | 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>+-- by Kwang-Wu Chen, second formula of the Corollary in page 7.+-- Sequence <https://oeis.org/A122045 A122045> in OEIS.+--+-- >>> 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+  where+    as :: [Ratio a]+    as = 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])++    dups :: forall x . [x] -> [x]+    dups = foldr (\n list -> n : n : list) []+{-# SPECIALIZE euler' :: [Ratio Int]     #-}+{-# SPECIALIZE euler' :: [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'++-- | 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>+-- by Kwang-Wu Chen, third formula of the Corollary in page 7.+-- Element-by-element division of sequences <https://oeis.org/A198631 A1986631>+-- and <https://oeis.org/A006519 A006519> in OEIS.+--+-- >>> 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]      #-}+ ------------------------------------------------------------------------------- -- Utils @@ -195,3 +234,22 @@       []       -> let v = f m y a in [v]       (z : zs) -> let v = f m y z in (v : go (succ m) z zs) {-# INLINE zipIndexedListWithTail #-}++-- | Helper for common code in @bernoulli, euler, eulerPolyAt1. All three+-- sequences rely on @stirling2@ and have the same general structure of+-- 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.+--+-- 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+  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]     #-}

@@ -23,15 +23,10 @@ import Data.Bits import Numeric.Natural -#if MIN_VERSION_base(4,8,0)-#else-import Data.Word-#endif- -- | Infinite zero-based table of factorials. ----- > > take 5 factorial--- > [1,1,2,6,24]+-- >>> take 5 factorial+-- [1,1,2,6,24] -- -- The time-and-space behaviour of 'factorial' is similar to described in -- "Math.NumberTheory.Recurrencies.Bilinear#memory".

@@ -0,0 +1,96 @@+-- |+-- Module:      Math.NumberTheory.Recurrencies.Pentagonal+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- Values of <https://en.wikipedia.org/wiki/Partition_(number_theory)#Partition_function partition function>.+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes   #-}++module Math.NumberTheory.Recurrencies.Pentagonal+  ( partition+  , pentagonalSigns+  , pents+  ) where++import qualified Data.IntMap as IM+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])++-- [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.++-- | Infinite zero-based table of <https://oeis.org/A000041 partition numbers>.+--+-- >>> take 10 partition+-- [1, 1, 2, 3, 5, 7, 11, 15, 22, 30]+--+-- >>> :set -XDataKinds+-- >>> partition !! 1000 :: Mod 1000+-- (991 `modulo` 1000)+partition :: Num a => [a]+partition = 1 : go (IM.singleton 0 1) 1+  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] #-}

@@ -12,6 +12,8 @@ -- over a set {3, 4}, and 24 is not. -- +{-# LANGUAGE ScopedTypeVariables #-}+ module Math.NumberTheory.SmoothNumbers   ( -- * Create a smooth basis     SmoothBasis@@ -24,68 +26,77 @@   , smoothOverInRangeBF   ) where -import Data.List (sort, nub)+import Prelude hiding (div, mod, gcd)+import Data.Coerce+import Data.List (nub) import qualified Data.Set as S+import Math.NumberTheory.Euclidean import Math.NumberTheory.Primes.Sieve (primes)  -- | An abstract representation of a smooth basis. -- It consists of a set of coprime numbers ≥2.-newtype SmoothBasis a = SmoothBasis { unSmoothBasis :: [a] } deriving Show+newtype SmoothBasis a = SmoothBasis { unSmoothBasis :: [a] } deriving (Eq, Show)  -- | Build a 'SmoothBasis' from a set of coprime numbers ≥2. ----- > > fromSet (Set.fromList [2, 3])--- > Just (SmoothBasis [2, 3])--- > > fromSet (Set.fromList [2, 4]) -- should be coprime--- > Nothing--- > > fromSet (Set.fromList [1, 3]) -- should be >= 2--- > Nothing-fromSet :: Integral a => S.Set a -> Maybe (SmoothBasis a)+-- >>> import qualified Data.Set as Set+-- >>> fromSet (Set.fromList [2, 3])+-- Just (SmoothBasis [2, 3])+-- >>> fromSet (Set.fromList [2, 4]) -- should be coprime+-- Nothing+-- >>> fromSet (Set.fromList [1, 3]) -- should be >= 2+-- Nothing+fromSet :: Euclidean a => S.Set a -> Maybe (SmoothBasis a) fromSet s = if isValid l then Just (SmoothBasis l) else Nothing where l = S.elems s  -- | Build a 'SmoothBasis' from a list of coprime numbers ≥2. ----- > > fromList [2, 3]--- > Just (SmoothBasis [2, 3])--- > > fromList [2, 2]--- > Just (SmoothBasis [2])--- > > fromList [2, 4] -- should be coprime--- > Nothing--- > > fromList [1, 3] -- should be >= 2--- > Nothing-fromList :: Integral a => [a] -> Maybe (SmoothBasis a)-fromList l = if isValid l' then Just (SmoothBasis l') else Nothing where l' = nub $ sort l+-- >>> fromList [2, 3]+-- Just (SmoothBasis [2, 3])+-- >>> fromList [2, 2]+-- Just (SmoothBasis [2])+-- >>> fromList [2, 4] -- should be coprime+-- Nothing+-- >>> fromList [1, 3] -- should be >= 2+-- Nothing+fromList :: Euclidean a => [a] -> Maybe (SmoothBasis a)+fromList l = if isValid l' then Just (SmoothBasis l') else Nothing+  where+    l' = nub l  -- | Build a 'SmoothBasis' from a list of primes below given bound. ----- > > fromSmoothUpperBound 10--- > Just (SmoothBasis [2, 3, 5, 7])--- > > fromSmoothUpperBound 1--- > Nothing+-- >>> fromSmoothUpperBound 10+-- Just (SmoothBasis [2, 3, 5, 7])+-- >>> fromSmoothUpperBound 1+-- Nothing fromSmoothUpperBound :: Integral a => a -> Maybe (SmoothBasis a) fromSmoothUpperBound n = if (n < 2)                          then Nothing-                         else Just $ SmoothBasis $ map fromInteger $ takeWhile (<= nI) primes-                         where nI = toInteger n+                         else Just $ SmoothBasis $ takeWhile (<= n) primes  -- | Generate an infinite ascending list of -- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers> -- over a given smooth basis. ----- > > take 10 (smoothOver (fromJust (fromList [2, 5])))--- > [1, 2, 4, 5, 8, 10, 16, 20, 25, 32]+-- >>> import Data.Maybe+-- >>> take 10 (smoothOver (fromJust (fromList [2, 5])))+-- [1, 2, 4, 5, 8, 10, 16, 20, 25, 32] smoothOver :: Integral a => SmoothBasis a -> [a] smoothOver pl = foldr (\p l -> mergeListLists $ iterate (map (p*)) l) [1] (unSmoothBasis pl)-                where-                      {-# INLINE mergeListLists #-}-                      mergeListLists      = foldr go1 []-                        where go1 (h:t) b = h:(go2 t b)-                              go1 _     b = b+  where+    {-# INLINE mergeListLists #-}+    mergeListLists      = foldr go1 []+      where+        go1 :: Ord a => [a] -> [a] -> [a]+        go1 (h:t) b = h:(go2 t b)+        go1 _     b = b -                              go2 a@(ah:at) b@(bh:bt)-                                | bh < ah   = bh : (go2 a bt)-                                | otherwise = ah : (go2 at b) -- no possibility of duplicates-                              go2 a b = if null a then b else a+        go2 :: Ord a => [a] -> [a] -> [a]+        go2 a@(ah:at) b@(bh:bt)+          | bh < ah   = bh : (go2 a bt)+          | otherwise = ah : (go2 at b) -- no possibility of duplicates+        go2 a b = if null a then b else a  -- | Generate an ascending list of -- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers>@@ -95,10 +106,15 @@ -- for short, but distant ranges; -- consider using 'smoothOverInRangeBF' in such cases. ----- > > smoothOverInRange (fromJust (fromList [2, 5])) 100 200--- > [100, 125, 128, 160, 200]-smoothOverInRange   :: Integral a => SmoothBasis a -> a -> a -> [a]-smoothOverInRange s lo hi = takeWhile (<= hi) $ dropWhile (< lo) (smoothOver s)+-- >>> 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 (WrappedIntegral a))  -- | Generate an ascending list of -- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers>@@ -110,21 +126,27 @@ -- -- Suffix BF stands for the brute force algorithm, involving a lot of divisions. ----- > > smoothOverInRangeBF (fromJust (fromList [2, 5])) 100 200--- > [100, 125, 128, 160, 200]-smoothOverInRangeBF :: Integral a => SmoothBasis a -> a -> a -> [a]-smoothOverInRangeBF prs lo hi = filter (mf prs') [lo..hi]-                                where mf []     n    = (n == 1) -- mf means manually factor-                                      mf pl@(p:ps) n = if (mod n p == 0)-                                                       then mf pl (div n p)-                                                       else mf ps n-                                      prs'           = unSmoothBasis prs+-- >>> import Data.Maybe+-- >>> smoothOverInRangeBF (fromJust (fromList [2, 5])) 100 200+-- [100, 125, 128, 160, 200]+smoothOverInRangeBF :: forall a. Integral a => SmoothBasis a -> a -> a -> [a]+smoothOverInRangeBF prs lo hi+  = coerce+  $ filter (mf prs')+  $ coerce [lo..hi]+  where+    mf :: [WrappedIntegral a] -> WrappedIntegral a -> Bool+    mf _         0 = False+    mf []        n = n == 1 -- mf means manually factor+    mf pl@(p:ps) n = if mod n p == 0+                     then mf pl (div n p)+                     else mf ps n+    prs'           = coerce $ unSmoothBasis prs  -- | isValid assumes that the list is sorted and unique and then checks if the list is suitable to be a SmoothBasis.-isValid :: (Integral a) => [a] -> Bool-isValid pl = if (length pl == 0) then False else v' pl-             where v' []        = True-                   v' (x:xs)    = if (x < 2 || (not $ rpl x xs)) then False else v' xs-                   rpl _ []     = True  -- rpl means relatively prime to the rest of the list-                   rpl n (x:xs) = if (gcd n x > 1) then False else rpl n xs-+isValid :: Euclidean a => [a] -> Bool+isValid pl = length pl /= 0 && v' pl+  where+    v' :: Euclidean a => [a] -> Bool+    v' []     = True+    v' (x:xs) = x /= 0 && abs x /= 1 && abs x == x && all (coprime x) xs && v' xs

@@ -9,8 +9,9 @@ -- An abstract type class for unique factorisation domains. -- -{-# LANGUAGE CPP          #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE DefaultSignatures #-}  module Math.NumberTheory.UniqueFactorisation   ( Prime@@ -20,15 +21,11 @@ import Control.Arrow import Data.Coerce -#if MIN_VERSION_base(4,8,0)-#else-import Data.Word-#endif--import Math.NumberTheory.Primes.Factorisation as F (factorise')+import qualified Math.NumberTheory.Primes.Factorisation as F (factorise) import Math.NumberTheory.Primes.Testing.Probabilistic as T (isPrime) import Math.NumberTheory.Primes.Types (Prime, Prm(..), PrimeNat(..))-import qualified Math.NumberTheory.GaussianIntegers as G+import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E+import qualified Math.NumberTheory.Quadratic.GaussianIntegers as G import Math.NumberTheory.Utils.FromIntegral  import Numeric.Natural@@ -43,8 +40,10 @@ class UniqueFactorisation a where   unPrime   :: Prime a -> a   factorise :: a -> [(Prime a, Word)]-   isPrime   :: a -> Maybe (Prime a)++  default isPrime :: (Eq a, Num a) => a -> Maybe (Prime a)+  isPrime 0 = Nothing   isPrime n = case factorise n of     [(p, 1)] -> Just p     _        -> Nothing@@ -53,34 +52,21 @@  instance UniqueFactorisation Int where   unPrime   = coerce wordToInt-  factorise m' = if m <= 1-                then []-                else map (coerce integerToWord *** intToWord) . F.factorise' . intToInteger $ m-                  where-                    m = abs m'-  isPrime n = if T.isPrime (toInteger n) then Just (coerce $ intToWord $ abs n) else Nothing+  factorise = map (coerce integerToWord *** intToWord) . F.factorise . intToInteger  instance UniqueFactorisation Word where-  unPrime     = coerce-  factorise m = if m <= 1-                  then []-                  else map (coerce integerToWord *** intToWord) . F.factorise' . wordToInteger $ m+  unPrime   = coerce+  factorise = map (coerce integerToWord *** intToWord) . F.factorise . wordToInteger   isPrime n = if T.isPrime (toInteger n) then Just (coerce n) else Nothing  instance UniqueFactorisation Integer where-  unPrime      = coerce naturalToInteger-  factorise m' = if m <= 1-                then []-                else map (coerce integerToNatural *** intToWord) . F.factorise' $ m-                  where-                    m = abs m'+  unPrime   = coerce naturalToInteger+  factorise = map (coerce integerToNatural *** intToWord) . F.factorise   isPrime n = if T.isPrime n then Just (coerce $ integerToNatural $ abs n) else Nothing  instance UniqueFactorisation Natural where   unPrime   = coerce-  factorise m = if m <= 1-                  then []-                  else map (coerce integerToNatural *** intToWord) . F.factorise' . naturalToInteger $ m+  factorise = map (coerce integerToNatural *** intToWord) . F.factorise . naturalToInteger   isPrime n = if T.isPrime (toInteger n) then Just (coerce n) else Nothing  newtype GaussianPrime = GaussianPrime { _unGaussianPrime :: G.GaussianInteger }@@ -90,4 +76,15 @@   unPrime = coerce    factorise 0 = []-  factorise g = map (coerce *** intToWord) $ filter (\(h, _) -> abs h /= 1) $ G.factorise g+  factorise g = map (coerce *** intToWord) $ G.factorise g++newtype EisensteinPrime = EisensteinPrime { _unEisensteinPrime :: E.EisensteinInteger }+  deriving (Eq, Show)++type instance Prime E.EisensteinInteger = EisensteinPrime++instance UniqueFactorisation E.EisensteinInteger where+  unPrime = coerce++  factorise 0 = []+  factorise e = map (coerce *** intToWord) $ E.factorise e

@@ -6,7 +6,7 @@ -- Stability:   Provisional -- Portability: Non-portable (GHC extensions) ----- Some utilities for bit twiddling.+-- Some utilities, mostly for bit twiddling. -- {-# LANGUAGE CPP, MagicHash, UnboxedTuples, BangPatterns #-} {-# OPTIONS_HADDOCK hide #-}@@ -21,6 +21,10 @@     , uncheckedShiftR     , splitOff     , splitOff#++    , mergeBy++    , recipMod     ) where  #include "MachDeps.h"@@ -29,23 +33,10 @@  import GHC.Integer import GHC.Integer.GMP.Internals+import GHC.Natural  import Data.Bits -#if WORD_SIZE_IN_BITS == 64-#define m5 0x5555555555555555-#define m3 0x3333333333333333-#define mf 0x0F0F0F0F0F0F0F0F-#define m1 0x0101010101010101-#define sd 56-#else-#define m5 0x55555555-#define m3 0x33333333-#define mf 0x0F0F0F0F-#define m1 0x01010101-#define sd 24-#endif- uncheckedShiftR :: Word -> Int -> Word uncheckedShiftR (W# w#) (I# i#) = W# (uncheckedShiftRL# w# i#) @@ -56,6 +47,7 @@ "shiftToOddCount/Int"       shiftToOddCount = shiftOCInt "shiftToOddCount/Word"      shiftToOddCount = shiftOCWord "shiftToOddCount/Integer"   shiftToOddCount = shiftOCInteger+"shiftToOddCount/Natural"   shiftToOddCount = shiftOCNatural   #-} {-# INLINE [1] shiftToOddCount #-} shiftToOddCount :: Integral a => a -> (Int, a)@@ -82,25 +74,25 @@       (# z#, w# #)         | isTrue# (z# ==# 0#) -> (0, n)         | otherwise -> (I# z#, S# (word2Int# w#))-#if __GLASGOW_HASKELL__ < 709-shiftOCInteger n@(J# _ ba#) = case count 0# 0# of-#else shiftOCInteger n@(Jp# bn#) = case bigNatZeroCount bn# of                                  0#  -> (0, n)                                  z#  -> (I# z#, n `shiftRInteger` z#) shiftOCInteger n@(Jn# bn#) = case bigNatZeroCount bn# of-#endif                                  0#  -> (0, n)                                  z#  -> (I# z#, n `shiftRInteger` z#)-#if __GLASGOW_HASKELL__ < 709-  where-    count a# i# =-          case indexWordArray# ba# i# of-             0## -> count (a# +# WORD_SIZE_IN_BITS#) (i# +# 1#)-             w#  -> a# +# trailZeros# w#-#endif -#if __GLASGOW_HASKELL__ >= 709+-- | Specialised version for @'Natural'@.+--   Precondition: argument nonzero (not checked).+shiftOCNatural :: Natural -> (Int, Natural)+shiftOCNatural n@(NatS# i#) =+    case shiftToOddCount# i# of+      (# z#, w# #)+        | isTrue# (z# ==# 0#) -> (0, n)+        | otherwise -> (I# z#, NatS# w#)+shiftOCNatural n@(NatJ# bn#) = case bigNatZeroCount bn# of+                                 0#  -> (0, n)+                                 z#  -> (I# z#, NatJ# (bn# `shiftRBigNat` z#))+ -- | Count trailing zeros in a @'BigNat'@. --   Precondition: argument nonzero (not checked, Integer invariant). bigNatZeroCount :: BigNat -> Int#@@ -109,8 +101,7 @@     count a# i# =           case indexBigNat# bn# i# of             0## -> count (a# +# WORD_SIZE_IN_BITS#) (i# +# 1#)-            w#  -> a# +# trailZeros# w#-#endif+            w#  -> a# +# word2Int# (ctz# w#)  -- | Remove factors of @2@. If @n = 2^k*m@ with @m@ odd, the result is @m@. --   Precondition: argument not @0@ (not checked).@@ -137,33 +128,21 @@ --   Precondition: argument nonzero (not checked). shiftOInteger :: Integer -> Integer shiftOInteger (S# i#) = S# (word2Int# (shiftToOdd# (int2Word# i#)))-#if __GLASGOW_HASKELL__ < 709-shiftOInteger n@(J# _ ba#) = case count 0# 0# of-#else shiftOInteger n@(Jn# bn#) = case bigNatZeroCount bn# of                                  0#  -> n                                  z#  -> n `shiftRInteger` z# shiftOInteger n@(Jp# bn#) = case bigNatZeroCount bn# of-#endif                                  0#  -> n                                  z#  -> n `shiftRInteger` z#-#if __GLASGOW_HASKELL__ < 709-  where-    count a# i# =-          case indexWordArray# ba# i# of-            0## -> count (a# +# WORD_SIZE_IN_BITS#) (i# +# 1#)-            w#  -> a# +# trailZeros# w#-#endif  -- | Shift argument right until the result is odd. --   Precondition: argument not @0@, not checked. shiftToOdd# :: Word# -> Word#-shiftToOdd# w# = case trailZeros# w# of-                   k# -> uncheckedShiftRL# w# k#+shiftToOdd# w# = uncheckedShiftRL# w# (word2Int# (ctz# w#))  -- | Like @'shiftToOdd#'@, but count the number of places to shift too. shiftToOddCount# :: Word# -> (# Int#, Word# #)-shiftToOddCount# w# = case trailZeros# w# of+shiftToOddCount# w# = case word2Int# (ctz# w#) of                         k# -> (# k#, uncheckedShiftRL# w# k# #)  -- | Number of 1-bits in a @'Word#'@.@@ -179,20 +158,7 @@ bitCountInt :: Int -> Int bitCountInt = popCount --- | Number of trailing zeros in a @'Word#'@, wrong for @0@.-{-# INLINE trailZeros# #-}-trailZeros# :: Word# -> Int#-trailZeros# w =-    case xor# w (w `minusWord#` 1##) `uncheckedShiftRL#` 1# of-      v0 ->-        case v0 `minusWord#` (uncheckedShiftRL# v0 1# `and#` m5##) of-          v1 ->-            case (v1 `and#` m3##) `plusWord#` (uncheckedShiftRL# v1 2# `and#` m3##) of-              v2 ->-                case (v2 `plusWord#` uncheckedShiftRL# v2 4#) `and#` mf## of-                  v3 -> word2Int# (uncheckedShiftRL# (v3 `timesWord#` m1##) sd#)--splitOff :: Integer -> Integer -> (Int, Integer)+splitOff :: Integral a => a -> a -> (Int, a) splitOff _ 0 = (0, 0) -- prevent infinite loop splitOff p n = go 0 n   where@@ -211,3 +177,21 @@       (# q, 0## #) -> go (k +# 1#) q       _            -> (# k, m #) {-# INLINABLE splitOff# #-}++-- | Merges two ordered lists into an ordered list. Checks for neither its+-- precondition or postcondition.+mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]+mergeBy cmp = loop+  where+    loop [] ys  = ys+    loop xs []  = xs+    loop (x:xs) (y:ys)+      = case cmp x y of+         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

@@ -22,9 +22,6 @@   ) where  import Numeric.Natural-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif  wordToInt :: Word -> Int wordToInt = fromIntegral

@@ -1,115 +1,21 @@ -- | -- Module:      Math.NumberTheory.Zeta--- Copyright:   (c) 2016 Andrew Lelechenko+-- Copyright:   (c) 2018 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com> -- Stability:   Provisional -- Portability: Non-portable (GHC extensions) ----- Riemann zeta-function.+-- Interface to work with Riemann zeta-function and Dirichlet beta-function.  {-# LANGUAGE ScopedTypeVariables #-}  module Math.NumberTheory.Zeta-  ( zetas-  , zetasEven-  , approximateValue+  ( module Math.NumberTheory.Zeta.Dirichlet+  , module Math.NumberTheory.Zeta.Riemann+  , module Math.NumberTheory.Zeta.Utils   ) where -import Data.ExactPi-import Data.Ratio--import Math.NumberTheory.Recurrencies.Bilinear (bernoulli)-import Math.NumberTheory.Recurrencies.Linear (factorial)---- | Infinite sequence of exact values of Riemann zeta-function at even arguments, starting with @ζ(0)@.--- Note that due to numerical errors convertation to 'Double' may return values below 1:------ > > approximateValue (zetasEven !! 25) :: Double--- > 0.9999999999999996------ Use your favorite type for long-precision arithmetic. For instance, 'Data.Number.Fixed.Fixed' works fine:------ > > approximateValue (zetasEven !! 25) :: Fixed Prec50--- > 1.00000000000000088817842111574532859293035196051773----zetasEven :: [ExactPi]-zetasEven = zipWith Exact [0, 2 ..] $ zipWith (*) (skipOdds bernoulli) cs-  where-    cs = (- 1 % 2) : zipWith (\i f -> i * (-4) / fromInteger (2 * f * (2 * f - 1))) cs [1..]--skipOdds :: [a] -> [a]-skipOdds (x : _ : xs) = x : skipOdds xs-skipOdds xs = xs--zetasEven' :: Floating a => [a]-zetasEven' = map approximateValue zetasEven--zetasOdd :: forall a. (Floating a, Ord a) => a -> [a]-zetasOdd eps = (1 / 0) : zets-  where-    zets :: [a] -- [zeta(3), zeta(5), zeta(7)...]-    zets = zipWith (*) zs (tail (iterate (* (- pi * pi)) 1))--    zs :: [a] -- [zeta(3) / (-pi^2), zeta(5) / pi^4, zeta(7) / (-pi^6)...]-    zs = zipWith (\w f -> negate (w / (1 + f))) ws fourth--    ys :: [a] -- [(1 - 1/4) * zeta(3) / (-pi^2), (1 - 1/4^2) * zeta(5) / pi^4...]-    ys = zipWith (*) zs fourth-    yss :: [[a]] -- [[], [ys !! 0], [ys !! 1, ys !! 0], [ys !! 2, ys !! 1, ys !! 0]...]-    yss = scanl (flip (:)) [] ys--    xs :: [a] -- first summand of RHS in (57) for m=[1..]-    xs = map (sum . zipWith (flip (/)) factorial2) yss--    ws :: [a] -- RHS in (57) for m=[1..]-    ws = zipWith (+) xs cs--    rs :: [a] -- [1, 1/2, 1/3, 1/4...]-    rs = map (\n -> recip (fromInteger n)) [1..]-    rss :: [[a]] -- [[1, 1/2, 1/3...], [1/2, 1/3, 1/4...], [1/3, 1/4...]]-    rss = iterate tail rs--    factorial2 :: [a] -- [2!, 4!, 6!..]-    factorial2 = map fromInteger $ tail $ skipOdds factorial--    fourth :: [a] -- [1 - 1/4, 1 - 1/4^2, 1 - 1/4^3...]-    fourth = tail $ map (1 -) $ iterate (/ 4) 1--    as :: [a] -- [zeta(0), zeta(2)/4, zeta(2*2)/4^2, zeta(2*3)/4^3...]-    as = zipWith (/) zetasEven' (iterate (* 4) 1)--    bs :: [a] -- map (+ log 2) [b(1), b(2), b(3)...],-              -- where b(m) = \sum_{n=0}^\infty zeta(2n) / 4^n / (n + m)-    bs = map ((+ log 2) . suminf eps . zipWith (*) as) rss--    cs :: [a] -- second summand of RHS in (57) for m = [1..]-    cs = zipWith (\b f -> b / f) bs factorial2--suminf :: (Floating a, Ord a) => a -> [a] -> a-suminf eps = sum . takeWhile ((>= eps / 111) . abs)---- | Infinite sequence of approximate (up to given precision)--- values of Riemann zeta-function at integer arguments, starting with @ζ(0)@.--- Computations for odd arguments are 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).------ > > take 5 (zetas 1e-14) :: [Double]--- > [-0.5,Infinity,1.6449340668482262,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)-  where-    e : es = zetasEven'-    o : os = zetasOdd eps--    intertwine (x : xs) (y : ys) = x : y : intertwine xs ys-    intertwine      xs       ys  = xs ++ ys--    -- Cap-and-floor to improve numerical stability:-    -- 0 < zeta(n + 1) - 1 < (zeta(n) - 1) / 2-    f x y = 1 `max` (y `min` (1 + (x - 1) / 2))+import Math.NumberTheory.Zeta.Dirichlet+import Math.NumberTheory.Zeta.Riemann+import Math.NumberTheory.Zeta.Utils

@@ -0,0 +1,171 @@+-- |+-- Module:      Math.NumberTheory.Zeta.Dirichlet+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- Dirichlet beta-function.++{-# LANGUAGE ScopedTypeVariables #-}++module Math.NumberTheory.Zeta.Dirichlet+  ( betas+  , betasEven+  , betasOdd+  ) where++import Data.ExactPi                     (ExactPi (..), approximateValue)+import Data.List                        (zipWith4)+import Data.Ratio                       ((%))++import Math.NumberTheory.Recurrencies   (euler, eulerPolyAt1, factorial)+import Math.NumberTheory.Zeta.Riemann   (zetasOdd)+import Math.NumberTheory.Zeta.Utils     (intertwine, skipEvens, skipOdds,+                                         suminf)++-- | Infinite sequence of exact values of Dirichlet beta-function at odd arguments, starting with @β(1)@.+--+-- > > approximateValue (betasOdd !! 25) :: Double+-- > 0.9999999999999987+--+-- Using 'Data.Number.Fixed.Fixed':+--+-- > > approximateValue (betasOdd !! 25) :: Fixed Prec50+-- > 0.99999999999999999999999960726927497384196726751694z+--+betasOdd :: [ExactPi]+betasOdd = zipWith Exact [1, 3 ..] $ zipWith4+                                     (\sgn denom eul twos -> sgn * (eul % (twos * denom)))+                                     (cycle [1, -1])+                                     (skipOdds factorial)+                                     (skipOdds euler)+                                     (iterate (4 *) 4)++-- | @betasOdd@, but with @forall a . Floating a => a@ instead of @ExactPi@s.+-- Used in @betasEven@.+betasOdd' :: Floating a => [a]+betasOdd' = map approximateValue betasOdd++-- | 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) : bets+  where+    bets :: [a]+    bets = zipWith3 (\r1 r2 r3 -> (r1 + (negate r2) + r3)) rhs1 rhs2 rhs3++    -- [1!, 3!, 5!..]+    factorial1AsInteger :: [Integer]+    factorial1AsInteger = skipEvens factorial++    -- [1!, 3!, 5!..]+    factorial1 :: [a]+    factorial1 = map fromInteger factorial1AsInteger++    -- [2^1 * 1!, 2^3 * 3!, 2^5 * 5!, 2^7 * 7! ..]+    denoms :: [a]+    denoms = zipWith+             (\pow fac -> fromInteger $ pow * fac)+             factorial1AsInteger+             (iterate (4 *) 2)++    -- First term of the right hand side of (12).+    rhs1 = zipWith+           (\sgn piFrac -> sgn * piFrac * log 2)+           (cycle [1, -1])+           (zipWith (\p f -> p / f) (iterate ((pi * pi) *) pi) denoms)++    -- [1 - (1 / (2^2)), 1 - (1 / (2^4)), 1 - (1 / (2^6)), ..]+    second :: [a]+    second = map (1 -) $ (iterate (/ 4) (1/4))++    -- [- (1 - (1 / (2^2))) * zeta(3), (1 - (1 / (2^4))) * zeta(5), - (1 - (1 / (2^6))) * zeta(7), ..]+    zets :: [a]+    zets = zipWith3+           (\sgn twosFrac z -> sgn * twosFrac * z)+           (cycle [-1, 1])+           second+           (tail $ zetasOdd eps)++    -- [pi / (2^1 * 1!), pi^3 / (2^3 * 3!), pi^5 / (2^5 * 5!), ..]+    pisAndFacs :: [a]+    pisAndFacs = zipWith3+                 (\p pow fac -> p / (pow * fac))+                 (iterate ((pi * pi) *) pi)+                 (iterate (4 *) 2)+                 factorial1++    -- [[], [pisAndFacs !! 0], [pisAndFacs !! 1, pisAndFacs !! 0], [pisAndFacs !! 2, pisAndFacs !! 1, pisAndFacs !! 0]...]+    pisAndFacs' :: [[a]]+    pisAndFacs' = scanl (flip (:)) [] pisAndFacs++    -- Second summand of RHS in (12) for k = [1 ..]+    rhs2 :: [a]+    rhs2 = zipWith (*) (cycle [-1, 1]) $ map (sum . zipWith (*) zets) pisAndFacs'++    -- [pi^3 / (2^4), pi^5 / (2^6), pi^7 / (2^8) ..]+    -- Second factor of third addend in RHS of (12).+    pis :: [a]+    pis = zipWith+          (\p f -> p / f)+          (iterate ((pi * pi) *) (pi ^^ (3 :: Integer)))+          (iterate (4 *) 16)++    -- [[3!, 5!, 7! ..], [5!, 7! ..] ..]+    oddFacs :: [[a]]+    oddFacs = iterate tail (tail factorial1)++    -- [1, 4, 16 ..]+    fours :: [a]+    fours = iterate (4 *) 1++    -- [[3! * 2^0, 5! * 2^2, 7! * 2^4 ..], [5! * 2^0, 7! * 2^2, 9! * 2^4 ..] ..]+    infSumDenoms :: [[a]]+    infSumDenoms = map (zipWith (*) fours) oddFacs++    -- [pi^0, pi^2, pi^4, pi^6 ..]+    pis2 :: [a]+    pis2 = iterate ((pi * pi) *) 1++    -- [pi^0 * E_1(1), - pi^2 * E_3(1), pi^4 * E_5(1) ..]+    infSumNum :: [a]+    infSumNum = zipWith3+                (\sgn p eulerP -> sgn * p * eulerP)+                (cycle [1, -1])+                pis2+                (map fromRational . skipEvens $ eulerPolyAt1)++    -- [     [ pi^0 * E_1(1)  (-1) * pi^2 * E_3(1)   ]      [ (-1) * pi^2 * E_3(1)  pi^4 * E_5(1)    ]      [ pi^4 * E_5(1)  (-1) * pi^6 * E_7(1)    ]  ]+    -- | sum | -------------, -------------------- ..|, sum | --------------------, ------------- .. |, sum | -------------, -------------------- .. |..|+    -- [     [       3!                 5!           ]      [          5!                 7!         ]      [       7!                9!             ]  ]+    infSum :: [a]+    infSum = map (suminf eps . zipWith (/) infSumNum) infSumDenoms++    -- Third summand of the right hand side of (12).+    rhs3 :: [a]+    rhs3 = zipWith3+           (\sgn p inf -> sgn * p * inf)+           (cycle [-1, 1])+           pis+           infSum++-- | Infinite sequence of approximate (up to given precision)+-- values of Dirichlet beta-function at integer arguments, starting with @β(0)@.+-- The algorithm 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).+--+-- > > take 5 (betas 1e-14) :: [Double]+-- > [0.5,0.7853981633974483,0.9159655941772191,0.9689461462593693,0.988944551741105]+betas :: (Floating a, Ord a) => a -> [a]+betas eps = e : o : scanl1 f (intertwine es os)+  where+    e : es = betasEven eps+    o : os = betasOdd'++    -- Cap-and-floor to improve numerical stability:+    -- 1 > beta(n + 1) - 1 > (beta(n) - 1) / 2+    -- A similar method is used in @Math.NumberTheory.Zeta.Riemann.zetas@.+    f x y = 1 `min` (y `max` (1 + (x - 1) / 2))

@@ -0,0 +1,106 @@+-- |+-- Module:      Math.NumberTheory.Zeta.Riemann+-- Copyright:   (c) 2016 Andrew Lelechenko+-- Licence:     MIT+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- Riemann zeta-function.++{-# LANGUAGE ScopedTypeVariables #-}++module Math.NumberTheory.Zeta.Riemann+  ( zetas+  , zetasEven+  , zetasOdd+  ) where++import Data.ExactPi                     (ExactPi (..), approximateValue)+import Data.Ratio                       ((%))++import Math.NumberTheory.Recurrencies   (bernoulli, factorial)+import Math.NumberTheory.Zeta.Utils     (intertwine, skipOdds, suminf)++-- | 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:+--+-- >>> approximateValue (zetasEven !! 25) :: Double+-- 0.9999999999999996+--+-- Use your favorite type for long-precision arithmetic. For instance, 'Data.Number.Fixed.Fixed' works fine:+--+-- >>> import Data.Number.Fixed+-- >>> approximateValue (zetasEven !! 25) :: Fixed Prec50+-- 1.00000000000000088817842111574532859293035196051773+--+zetasEven :: [ExactPi]+zetasEven = zipWith Exact [0, 2 ..] $ zipWith (*) (skipOdds bernoulli) cs+  where+    cs = (- 1 % 2) : zipWith (\i f -> i * (-4) / fromInteger (2 * f * (2 * f - 1))) cs [1..]++zetasEven' :: Floating a => [a]+zetasEven' = map approximateValue zetasEven++zetasOdd :: forall a. (Floating a, Ord a) => a -> [a]+zetasOdd eps = (1 / 0) : zets+  where+    zets :: [a] -- [zeta(3), zeta(5), zeta(7)...]+    zets = zipWith (*) zs (tail (iterate (* (- pi * pi)) 1))++    zs :: [a] -- [zeta(3) / (-pi^2), zeta(5) / pi^4, zeta(7) / (-pi^6)...]+    zs = zipWith (\w f -> negate (w / (1 + f))) ws fourth++    ys :: [a] -- [(1 - 1/4) * zeta(3) / (-pi^2), (1 - 1/4^2) * zeta(5) / pi^4...]+    ys = zipWith (*) zs fourth+    yss :: [[a]] -- [[], [ys !! 0], [ys !! 1, ys !! 0], [ys !! 2, ys !! 1, ys !! 0]...]+    yss = scanl (flip (:)) [] ys++    xs :: [a] -- first summand of RHS in (57) for m=[1..]+    xs = map (sum . zipWith (flip (/)) factorial2) yss++    ws :: [a] -- RHS in (57) for m=[1..]+    ws = zipWith (+) xs cs++    rs :: [a] -- [1, 1/2, 1/3, 1/4...]+    rs = map (\n -> recip (fromInteger n)) [1..]+    rss :: [[a]] -- [[1, 1/2, 1/3...], [1/2, 1/3, 1/4...], [1/3, 1/4...]]+    rss = iterate tail rs++    factorial2 :: [a] -- [2!, 4!, 6!..]+    factorial2 = map fromInteger $ tail $ skipOdds factorial++    fourth :: [a] -- [1 - 1/4, 1 - 1/4^2, 1 - 1/4^3...]+    fourth = tail $ map (1 -) $ iterate (/ 4) 1++    as :: [a] -- [zeta(0), zeta(2)/4, zeta(2*2)/4^2, zeta(2*3)/4^3...]+    as = zipWith (/) zetasEven' (iterate (* 4) 1)++    bs :: [a] -- map (+ log 2) [b(1), b(2), b(3)...],+              -- where b(m) = \sum_{n=0}^\infty (zeta(2n) / 4^n) / (n + m)+    bs = map ((+ log 2) . suminf eps . zipWith (*) as) rss++    cs :: [a] -- second summand of RHS in (57) for m = [1..]+    cs = zipWith (\b f -> b / f) bs factorial2++-- | Infinite sequence of approximate (up to given precision)+-- values of Riemann zeta-function at integer arguments, starting with @ζ(0)@.+-- Computations for odd arguments are 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).+--+-- >>> take 5 (zetas 1e-14) :: [Double]+-- > [-0.5,Infinity,1.6449340668482262,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)+  where+    e : es = zetasEven'+    o : os = zetasOdd eps++    -- Cap-and-floor to improve numerical stability:+    -- 0 < zeta(n + 1) - 1 < (zeta(n) - 1) / 2+    f x y = 1 `max` (y `min` (1 + (x - 1) / 2))

@@ -0,0 +1,51 @@+-- |+-- Module:      Math.NumberTheory.Zeta.Utils+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+-- Stability:   Provisional+-- Portability: Non-portable (GHC extensions)+--+-- Shared utilities used by functions from @Math.NumberTheory.Zeta@.++module Math.NumberTheory.Zeta.Utils+  ( intertwine+  , skipEvens+  , skipOdds+  , suminf+  ) 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 ++-- | 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++-- | 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++-- | Sums every element of an infinite list up to a certain precision.+-- I.e. once an element falls below the given threshold it stops traversing+-- the list.+--+-- >>> suminf 1e-14 (iterate (/ 10) 1)+-- 1.1111111111111112+suminf :: (Floating a, Ord a) => a -> [a] -> a+suminf eps = sum . takeWhile ((>= eps / 111) . abs)

@@ -1,200 +1,217 @@-name                : arithmoi-version             : 0.7.0.0-cabal-version       : >= 1.10-author              : Daniel Fischer-copyright           : (c) 2011 Daniel Fischer, 2016-2018 Andrew Lelechenko, Carter Schonwald-license             : MIT-license-file        : LICENSE-maintainer          : Carter Schonwald  carter at wellposed dot com,-                      Andrew Lelechenko andrew dot lelechenko at gmail dot com-build-type          : Simple-stability           : Provisional-homepage            : https://github.com/cartazio/arithmoi-bug-reports         : https://github.com/cartazio/arithmoi/issues--synopsis            : Efficient basic number-theoretic functions.-description         : A library of basic functionality needed for-                      number-theoretic calculations. The aim of this library-                      is to provide efficient implementations of the functions.--                      Primes and related things (totients, factorisation),-                      powers (integer roots and tests, modular exponentiation).--category            : Math, Algorithms, Number Theory--tested-with         : GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2--extra-source-files  : Changes--flag check-bounds-    description         : Replace unsafe array operations with safe ones-    default             : False-    manual              : True--library-    default-language: Haskell2010-    build-depends       : base >= 4.7 && < 5-                        , array >= 0.5 && < 0.6-                        , ghc-prim < 0.6-                        , integer-gmp < 1.1-                        , containers >= 0.5 && < 0.6-                        , random >= 1.0 && < 1.2-                        , mtl >= 2.0 && < 2.3-                        , exact-pi >= 0.4.1.1-                        , integer-logarithms >= 1.0-                        , vector >= 0.12-    if impl(ghc < 7.10)-      build-depends     : nats >= 1 && <1.2-    if impl(ghc < 8.0)-      build-depends     : semigroups >= 0.8--    exposed-modules     : Math.NumberTheory.ArithmeticFunctions-                          Math.NumberTheory.ArithmeticFunctions.Class-                          Math.NumberTheory.ArithmeticFunctions.Mertens-                          Math.NumberTheory.ArithmeticFunctions.Moebius-                          Math.NumberTheory.ArithmeticFunctions.SieveBlock-                          Math.NumberTheory.ArithmeticFunctions.Standard-                          Math.NumberTheory.Curves.Montgomery-                          Math.NumberTheory.Moduli-                          Math.NumberTheory.Moduli.Chinese-                          Math.NumberTheory.Moduli.Class-                          Math.NumberTheory.Moduli.Jacobi-                          Math.NumberTheory.Moduli.PrimitiveRoot-                          Math.NumberTheory.Moduli.Sqrt-                          Math.NumberTheory.MoebiusInversion-                          Math.NumberTheory.MoebiusInversion.Int-                          Math.NumberTheory.Recurrencies.Bilinear-                          Math.NumberTheory.Recurrencies.Linear-                          Math.NumberTheory.GaussianIntegers-                          Math.NumberTheory.GCD-                          Math.NumberTheory.GCD.LowLevel-                          Math.NumberTheory.Powers-                          Math.NumberTheory.Powers.Squares-                          Math.NumberTheory.Powers.Squares.Internal-                          Math.NumberTheory.Powers.Cubes-                          Math.NumberTheory.Powers.Fourth-                          Math.NumberTheory.Powers.General-                          Math.NumberTheory.Powers.Modular-                          Math.NumberTheory.Primes-                          Math.NumberTheory.Primes.Sieve-                          Math.NumberTheory.Primes.Factorisation-                          Math.NumberTheory.Primes.Factorisation.Certified-                          Math.NumberTheory.Primes.Counting-                          Math.NumberTheory.Primes.Testing-                          Math.NumberTheory.Primes.Testing.Certificates-                          Math.NumberTheory.Primes.Heap-                          Math.NumberTheory.UniqueFactorisation-                          Math.NumberTheory.Zeta-                          Math.NumberTheory.Prefactored-                          GHC.TypeNats.Compat-                          Math.NumberTheory.SmoothNumbers--    other-modules       : Math.NumberTheory.ArithmeticFunctions.SieveBlock.Unboxed-                          Math.NumberTheory.Utils-                          Math.NumberTheory.Utils.FromIntegral-                          Math.NumberTheory.Utils.Hyperbola-                          Math.NumberTheory.Unsafe-                          Math.NumberTheory.Primes.Counting.Impl-                          Math.NumberTheory.Primes.Counting.Approximate-                          Math.NumberTheory.Primes.Factorisation.Montgomery-                          Math.NumberTheory.Primes.Factorisation.TrialDivision-                          Math.NumberTheory.Primes.Sieve.Eratosthenes-                          Math.NumberTheory.Primes.Sieve.Indexing-                          Math.NumberTheory.Primes.Sieve.Misc-                          Math.NumberTheory.Primes.Testing.Probabilistic-                          Math.NumberTheory.Primes.Testing.Certified-                          Math.NumberTheory.Primes.Testing.Certificates.Internal-                          Math.NumberTheory.Primes.Types-    other-extensions    : BangPatterns--    ghc-options         : -O2 -Wall-    ghc-prof-options    : -O2 -auto-    if flag(check-bounds)-        cpp-options     : -DCheckBounds+name:          arithmoi+version:       0.8.0.0+cabal-version: >=1.10+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+synopsis:      Efficient basic number-theoretic functions.+description:+  A library of basic functionality needed for+  number-theoretic calculations. The aim of this library+  is to provide efficient implementations of the functions.+  Primes and related things (totients, factorisation),+  powers (integer roots and tests, modular exponentiation).+category:      Math, Algorithms, Number Theory+author:        Daniel Fischer+tested-with:   GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3+extra-source-files:+  Changes  source-repository head-  type:     git+  type: git   location: https://github.com/cartazio/arithmoi +flag check-bounds+  description:+    Replace unsafe array operations with safe ones+  default: False+  manual: True -benchmark criterion-  build-depends:    base-                    , arithmoi-                    , gauge-                    , containers-                    , random-                    , integer-logarithms-                    , vector-  if impl(ghc < 7.10)-    build-depends     : nats >= 1 && <1.2-  if impl(ghc < 8.0)-    build-depends     : semigroups >= 0.8-  other-modules:    Math.NumberTheory.ArithmeticFunctionsBench-                  , Math.NumberTheory.GCDBench-                  , Math.NumberTheory.MertensBench-                  , Math.NumberTheory.PowersBench-                  , Math.NumberTheory.PrimesBench-                  , Math.NumberTheory.RecurrenciesBench-                  , Math.NumberTheory.SieveBlockBench-  hs-source-dirs:   benchmark-  main-is:          Bench.hs-  type:             exitcode-stdio-1.0+library+  build-depends:+    base >=4.7 && <5,+    array >=0.5 && <0.6,+    containers >=0.5 && <0.7,+    deepseq,+    exact-pi >=0.4.1.1,+    ghc-prim <0.6,+    integer-gmp <1.1,+    integer-logarithms >=1.0,+    random >=1.0 && <1.2,+    transformers >=0.4 && <0.6,+    vector >= 0.12+  if impl(ghc <8.0)+    build-depends:+      semigroups >=0.8+  exposed-modules:+    GHC.TypeNats.Compat+    Math.NumberTheory.ArithmeticFunctions+    Math.NumberTheory.ArithmeticFunctions.Mertens+    Math.NumberTheory.ArithmeticFunctions.Moebius+    Math.NumberTheory.ArithmeticFunctions.SieveBlock+    Math.NumberTheory.Curves.Montgomery+    Math.NumberTheory.Euclidean+    Math.NumberTheory.Euclidean.Coprimes+    Math.NumberTheory.GaussianIntegers+    Math.NumberTheory.GCD+    Math.NumberTheory.GCD.LowLevel+    Math.NumberTheory.Moduli+    Math.NumberTheory.Moduli.Chinese+    Math.NumberTheory.Moduli.Class+    Math.NumberTheory.Moduli.DiscreteLogarithm+    Math.NumberTheory.Moduli.Equations+    Math.NumberTheory.Moduli.Jacobi+    Math.NumberTheory.Moduli.PrimitiveRoot+    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.Testing+    Math.NumberTheory.Primes.Testing.Certificates+    Math.NumberTheory.Quadratic.GaussianIntegers+    Math.NumberTheory.Quadratic.EisensteinIntegers+    Math.NumberTheory.Recurrencies+    Math.NumberTheory.Recurrencies.Bilinear+    Math.NumberTheory.Recurrencies.Linear+    Math.NumberTheory.SmoothNumbers+    Math.NumberTheory.UniqueFactorisation+    Math.NumberTheory.Zeta+    Math.NumberTheory.Zeta.Dirichlet+    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.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.Testing.Certified+    Math.NumberTheory.Primes.Testing.Probabilistic+    Math.NumberTheory.Primes.Types+    Math.NumberTheory.Recurrencies.Pentagonal+    Math.NumberTheory.Unsafe+    Math.NumberTheory.Utils+    Math.NumberTheory.Utils.FromIntegral+    Math.NumberTheory.Utils.Hyperbola+    Math.NumberTheory.Zeta.Utils   default-language: Haskell2010+  ghc-options: -O2 -Wall+  if flag(check-bounds)+    cpp-options: -DCheckBounds  test-suite spec-  type:                 exitcode-stdio-1.0-  hs-source-dirs:       test-suite-  ghc-options:          -Wall-  main-is:              Test.hs+  build-depends:+    base >=4.6 && <5,+    arithmoi,+    containers,+    exact-pi >=0.4.1.1,+    integer-gmp <1.1,+    QuickCheck >=2.10 && <2.13,+    smallcheck >=1.1.3 && <1.2,+    tasty >=0.10 && <1.2,+    tasty-hunit >=0.9 && <0.11,+    tasty-quickcheck >=0.9 && <0.11,+    tasty-smallcheck >=0.8 && <0.9,+    transformers >=0.5,+    vector+  if impl(ghc <8.0)+    build-depends:+      semigroups >=0.8+  other-modules:+    Math.NumberTheory.ArithmeticFunctionsTests+    Math.NumberTheory.ArithmeticFunctions.MertensTests+    Math.NumberTheory.ArithmeticFunctions.SieveBlockTests+    Math.NumberTheory.CurvesTests+    Math.NumberTheory.EisensteinIntegersTests+    Math.NumberTheory.GaussianIntegersTests+    Math.NumberTheory.GCDTests+    Math.NumberTheory.Moduli.ChineseTests+    Math.NumberTheory.Moduli.DiscreteLogarithmTests+    Math.NumberTheory.Moduli.ClassTests+    Math.NumberTheory.Moduli.EquationsTests+    Math.NumberTheory.Moduli.JacobiTests+    Math.NumberTheory.Moduli.PrimitiveRootTests+    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.SieveTests+    Math.NumberTheory.Primes.TestingTests+    Math.NumberTheory.PrimesTests+    Math.NumberTheory.Recurrencies.PentagonalTests+    Math.NumberTheory.Recurrencies.BilinearTests+    Math.NumberTheory.Recurrencies.LinearTests+    Math.NumberTheory.SmoothNumbersTests+    Math.NumberTheory.TestUtils+    Math.NumberTheory.TestUtils.MyCompose+    Math.NumberTheory.TestUtils.Wrappers+    Math.NumberTheory.UniqueFactorisationTests+    Math.NumberTheory.Zeta.DirichletTests+    Math.NumberTheory.Zeta.RiemannTests+  type: exitcode-stdio-1.0+  main-is: Test.hs   default-language: Haskell2010-  build-depends:        arithmoi-                      , base >= 4.6 && < 5-                      , containers >= 0.5 && < 0.6-                      , tasty >= 0.10 && < 1.1-                      , tasty-smallcheck >= 0.8 && < 0.9-                      , tasty-quickcheck >= 0.9 && < 0.11-                      , tasty-hunit >= 0.9 && < 0.11-                      , QuickCheck >= 2.10 && < 2.12-                      , transformers >= 0.5-                      , integer-gmp < 1.1-                      , vector-  if impl(ghc < 7.10)-    build-depends     : smallcheck >= 1.1 && < 1.1.3,-                        nats >= 1 && <1.2-  else-    build-depends     : smallcheck >= 1.1.3 && < 1.2-  if impl(ghc < 8.0)-    build-depends     : semigroups >= 0.8+  hs-source-dirs: test-suite+  ghc-options: -Wall -  other-modules :   Math.NumberTheory.ArithmeticFunctionsTests-                  , Math.NumberTheory.ArithmeticFunctions.MertensTests-                  , Math.NumberTheory.ArithmeticFunctions.SieveBlockTests-                  , Math.NumberTheory.CurvesTests-                  , Math.NumberTheory.GaussianIntegersTests-                  , Math.NumberTheory.GCDTests-                  , Math.NumberTheory.GCD.LowLevelTests-                  , Math.NumberTheory.Recurrencies.LinearTests-                  , Math.NumberTheory.Recurrencies.BilinearTests-                  , Math.NumberTheory.Moduli.ChineseTests-                  , Math.NumberTheory.Moduli.ClassTests-                  , Math.NumberTheory.Moduli.JacobiTests-                  , Math.NumberTheory.Moduli.PrimitiveRootTests-                  , Math.NumberTheory.Moduli.SqrtTests-                  , Math.NumberTheory.Powers.CubesTests-                  , Math.NumberTheory.MoebiusInversionTests-                  , Math.NumberTheory.MoebiusInversion.IntTests-                  , Math.NumberTheory.Powers.FourthTests-                  , Math.NumberTheory.Powers.GeneralTests-                  , Math.NumberTheory.Powers.ModularTests-                  , Math.NumberTheory.Powers.SquaresTests-                  , Math.NumberTheory.PrefactoredTests-                  , Math.NumberTheory.PrimesTests-                  , Math.NumberTheory.Primes.CountingTests-                  , Math.NumberTheory.Primes.FactorisationTests-                  , Math.NumberTheory.Primes.SieveTests-                  , Math.NumberTheory.Primes.TestingTests-                  , Math.NumberTheory.TestUtils-                  , Math.NumberTheory.TestUtils.Wrappers-                  , Math.NumberTheory.TestUtils.MyCompose-                  , Math.NumberTheory.UniqueFactorisationTests-                  , Math.NumberTheory.ZetaTests+benchmark criterion+  build-depends:+    base,+    arithmoi,+    containers,+    deepseq,+    gauge,+    integer-logarithms,+    random,+    vector+  if impl(ghc <8.0)+    build-depends:+      semigroups >=0.8+  other-modules:+    Math.NumberTheory.ArithmeticFunctionsBench+    Math.NumberTheory.DiscreteLogarithmBench+    Math.NumberTheory.EisensteinIntegersBench+    Math.NumberTheory.GaussianIntegersBench+    Math.NumberTheory.GCDBench+    Math.NumberTheory.JacobiBench+    Math.NumberTheory.MertensBench+    Math.NumberTheory.PowersBench+    Math.NumberTheory.PrimesBench+    Math.NumberTheory.PrimitiveRootsBench+    Math.NumberTheory.RecurrenciesBench+    Math.NumberTheory.SieveBlockBench+    Math.NumberTheory.SmoothNumbersBench+  type: exitcode-stdio-1.0+  main-is: Bench.hs+  default-language: Haskell2010+  hs-source-dirs: benchmark

@@ -3,19 +3,32 @@ import Gauge.Main  import Math.NumberTheory.ArithmeticFunctionsBench as ArithmeticFunctions+import Math.NumberTheory.DiscreteLogarithmBench as DiscreteLogarithm+import Math.NumberTheory.EisensteinIntegersBench as Eisenstein+import Math.NumberTheory.GaussianIntegersBench as Gaussian import Math.NumberTheory.GCDBench as GCD+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.RecurrenciesBench as Recurrencies import Math.NumberTheory.SieveBlockBench as SieveBlock+import Math.NumberTheory.SmoothNumbersBench as SmoothNumbers +main :: IO () main = defaultMain   [ ArithmeticFunctions.benchSuite+  , DiscreteLogarithm.benchSuite+  , Eisenstein.benchSuite+  , Gaussian.benchSuite   , GCD.benchSuite+  , Jacobi.benchSuite   , Mertens.benchSuite   , Powers.benchSuite   , Primes.benchSuite+  , PrimitiveRoots.benchSuite   , Recurrencies.benchSuite   , SieveBlock.benchSuite+  , SmoothNumbers.benchSuite   ]

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+ module Math.NumberTheory.ArithmeticFunctionsBench   ( benchSuite   ) where@@ -7,20 +9,23 @@  import Math.NumberTheory.ArithmeticFunctions as A -compareFunctions :: String -> (Integer -> Integer) -> Benchmark-compareFunctions name new = bench name $ nf (map new) [1..100000]+compareFunctions :: String -> (Integer -> Integer) -> [Integer] -> Benchmark+compareFunctions name new range = bench name $ nf (map new) range  compareSetFunctions :: String -> (Integer -> Set Integer) -> Benchmark compareSetFunctions name new = bench name $ nf (map new) [1..100000]  benchSuite :: Benchmark benchSuite = bgroup "ArithmeticFunctions"-  [ compareSetFunctions "divisors" A.divisors-  , bench "divisors/int" $ nf (map A.divisorsSmall) [1 :: Int .. 100000]-  , compareFunctions "totient" A.totient-  , compareFunctions "carmichael" A.carmichael-  , compareFunctions "moebius" (A.runMoebius . A.moebius)-  , compareFunctions "tau" A.tau-  , compareFunctions "sigma 1" (A.sigma 1)-  , compareFunctions "sigma 2" (A.sigma 2)+  [ compareSetFunctions "divisors" A.divisors +  , bench "divisors/int" $ nf (map A.divisorsSmall)              [1 :: Int .. 100000]+  , compareFunctions "totient" A.totient                         [1..100000]+  , compareFunctions "carmichael" A.carmichael                   [1..100000]+  , compareFunctions "moebius" (A.runMoebius . A.moebius)        [1..100000]+  , compareFunctions "tau" A.tau                                 [1..100000]+  , compareFunctions "sigma 1" (A.sigma 1)                       [1..100000]+  , compareFunctions "sigma 2" (A.sigma 2)                       [1..100000]+  , compareFunctions "ramanujan range" ramanujan                 [1..2000]+  , compareFunctions "ramanujan large prime" ramanujan           [100003]+  , compareFunctions "ramanujan prime power" ramanujan           [2^3000]   ]

@@ -0,0 +1,66 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Math.NumberTheory.DiscreteLogarithmBench+  ( benchSuite+  , rangeCases+  , discreteLogarithm'+  ) where++import Gauge.Main+import Data.Maybe+import GHC.TypeNats.Compat+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)++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]+    where a' = multElement $ unPrimitiveRoot a+          b' = getVal $ 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+        where a' = fromInteger a :: Mod m+              b' = fromInteger b++cases :: [Case]+cases = mapMaybe makeCase [ (5,  8,  10^9 + 7,  "10^9 + 7")+                          , (2,  7,    3^1000,    "3^1000")+                          , (2,  3, 10^11 + 3, "10^11 + 3")+                          , (3, 17,     5^700,     "5^700")+                          ]++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)++discreteLogarithm' :: Case -> Natural+discreteLogarithm' (Case a b _) = discreteLogarithm a b++benchSuite :: Benchmark+benchSuite = bgroup "Discrete logarithm"+  [ bgroup "individual case"+          [ bench (show c) $ nf discreteLogarithm' c | c <- cases]+  , bgroup "range"+          [ bench (show num ++ " cases near " ++ show n) $ nf (map discreteLogarithm') $ rangeCases n num+            | (n, num) <- [(10000, 100), (1000000, 100), (100000000, 100), (10000000000, 100)]+          ]+  ]

@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -fno-warn-orphans       #-}++module Math.NumberTheory.EisensteinIntegersBench+  ( benchSuite+  ) where++import Control.DeepSeq+import Gauge.Main++import Math.NumberTheory.ArithmeticFunctions (tau)+import Math.NumberTheory.Quadratic.EisensteinIntegers++instance NFData EisensteinInteger++benchFindPrime :: Integer -> Benchmark+benchFindPrime n = bench (show n) $ nf findPrime n++benchTau :: Integer -> Benchmark+benchTau n = bench (show n) $ nf (\m -> sum [tau (x :+ y) | x <- [1..m], y <- [0..m]] :: Word) n++benchSuite :: Benchmark+benchSuite = bgroup "Eisenstein"+  [ bgroup "findPrime" $ map benchFindPrime [1000003, 10000141, 100000039, 1000000021, 10000000033, 100000000003, 1000000000039, 10000000000051]+  , bgroup "tau" $ map benchTau [10, 20, 40, 80]+  ]

@@ -1,3 +1,6 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -fno-warn-deprecations  #-}+ module Math.NumberTheory.GCDBench   ( benchSuite   ) where@@ -6,16 +9,29 @@  import Math.NumberTheory.GCD as A import Prelude as P+import Numeric.Natural +averageGCD :: Integral a => (a -> a -> a) -> a -> a+averageGCD gcdF lim = sum [ gcdF x y | x <- [lim .. 2 * lim], y <- [lim .. x] ]++benchSuite :: Benchmark benchSuite = bgroup "GCD"   [ subSuite "large coprimes" 1073741823 100003   , subSuite "powers of 2" (2^12) (2^19)   , subSuite "power of 23" (23^3) (23^7)+  , bench "average prelude  Int"     $ nf (averageGCD P.gcd)       (2000 :: Int)+  , bench "average arithmoi Int"     $ nf (averageGCD A.binaryGCD) (2000 :: Int)+  , bench "average prelude  Word"    $ nf (averageGCD P.gcd)       (2000 :: Word)+  , bench "average arithmoi Word"    $ nf (averageGCD A.binaryGCD) (2000 :: Word)+  , bench "average prelude  Integer" $ nf (averageGCD P.gcd)       (2000 :: Integer)+  , bench "average arithmoi Integer" $ nf (averageGCD A.binaryGCD) (2000 :: Integer)+  , bench "average prelude  Natural" $ nf (averageGCD P.gcd)       (2000 :: Natural)+  , bench "average arithmoi Natural" $ nf (averageGCD A.binaryGCD) (2000 :: Natural)   ]   where subSuite :: String -> Int -> Int -> Benchmark         subSuite name m n = bgroup name           [ bench "Prelude.gcd" $ nf (P.gcd m) n           , bench "binaryGCD" $ nf (A.binaryGCD m) n-          , bench "Prelude.coprime" $ nf (\n -> 1 == P.gcd m n) n+          , bench "Prelude.coprime" $ nf (\t -> 1 == P.gcd m t) n           , bench "coprime" $ nf (A.coprime m) n           ]

@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Math.NumberTheory.GaussianIntegersBench+  ( benchSuite+  ) where++import Gauge.Main++import Math.NumberTheory.ArithmeticFunctions (tau)+import Math.NumberTheory.Quadratic.GaussianIntegers++benchFindPrime :: Integer -> Benchmark+benchFindPrime n = bench (show n) $ nf findPrime n++benchTau :: Integer -> Benchmark+benchTau n = bench (show n) $ nf (\m -> sum [tau (x :+ y) | x <- [1..m], y <- [0..m]] :: Word) n++benchSuite :: Benchmark+benchSuite = bgroup "Gaussian"+  [ bgroup "findPrime" $ map benchFindPrime [1000033, 10000121, 100000037, 1000000009, 10000000033, 100000000057, 1000000000061, 10000000000037]+  , bgroup "tau" $ map benchTau [10, 20, 40, 80]+  ]

@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Math.NumberTheory.JacobiBench+  ( benchSuite+  ) where++import Gauge.Main+import Numeric.Natural++import Math.NumberTheory.Moduli.Jacobi++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 ]++benchSuite :: Benchmark+benchSuite = bgroup "Jacobi"+  [ bench "jacobi/Int"      $ nf (doBench jacobi  :: Int -> Int)         2000+  , bench "jacobi/Word"     $ nf (doBench jacobi  :: Word -> Word)       2000+  , bench "jacobi/Integer"  $ nf (doBench jacobi  :: Integer -> Integer) 2000+  , bench "jacobi/Natural"  $ nf (doBench jacobi  :: Natural -> Natural) 2000+  ]

@@ -8,9 +8,6 @@   ) where  import Gauge.Main-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif  import Math.NumberTheory.ArithmeticFunctions.Mertens 

@@ -0,0 +1,40 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Math.NumberTheory.PrimitiveRootsBench+  ( benchSuite+  ) where++import Gauge.Main+import Data.Maybe++import Math.NumberTheory.Moduli.PrimitiveRoot+import Math.NumberTheory.UniqueFactorisation++primRootWrap :: Integer -> Word -> Integer -> Bool+primRootWrap p k g = isPrimitiveRoot' (CGOddPrimePower p' k) 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++cyclicWrap :: Integer -> Maybe (CyclicGroup Integer)+cyclicWrap = cyclicGroupFromModulo++benchSuite :: Benchmark+benchSuite = bgroup "PrimRoot"+  [ bgroup "groupFromModulo"+    [ bench "3^20000"             $ nf cyclicWrap (3^20000)             -- prime to large power+    , 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+    ]+  , bgroup "check prim roots"+    [ bench "3^20000"             $ nf (primRootWrap  3              20000) 2 -- prime to large power+    , bench "10000000000000061"   $ nf (primRootWrap  (10^16 + 61)   1)     3 -- large prime+    , bench "10000000000000061^2" $ nf (primRootWrap  (10^16 + 61)   2)     3 -- large prime squared+    , bench "2*3^20000"           $ nf (primRootWrap2 3              20000) 5 -- twice prime to large power+    , bench "10000000000000046"   $ nf (primRootWrap2 (5*10^15 + 23) 1)     5 -- twice large prime+    ]+  ]

@@ -6,7 +6,8 @@  import Gauge.Main -import Math.NumberTheory.Recurrencies.Bilinear+import Math.NumberTheory.Recurrencies (binomial, eulerian1, eulerian2,+                                       stirling1, stirling2, partition)  benchTriangle :: String -> (forall a. (Integral a) => [[a]]) -> Int -> Benchmark benchTriangle name triangle n = bgroup name@@ -19,11 +20,29 @@     benchAt i j = bench ("!! " ++ show i ++ " !! " ++ show j)                 $ nf (\(x, y) -> triangle !! x !! y :: Integer) (i, j) +benchPartition :: Int -> 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+ benchSuite :: Benchmark-benchSuite = bgroup "Bilinear"-  [ benchTriangle "binomial"  binomial 1000-  , benchTriangle "stirling1" stirling1 100-  , benchTriangle "stirling2" stirling2 100-  , benchTriangle "eulerian1" eulerian1 100-  , benchTriangle "eulerian2" eulerian2 100+benchSuite = bgroup "Recurrencies"+  [+    bgroup "Bilinear"+    [ benchTriangle "binomial"  binomial 1000+    , benchTriangle "stirling1" stirling1 100+    , benchTriangle "stirling2" stirling2 100+    , benchTriangle "eulerian1" eulerian1 100+    , benchTriangle "eulerian2" eulerian2 100+    ]+    ,+    bgroup "Pentagonal"+    [ bgroup "Partition function"+      [ benchPartition 1000+      ]+    ]   ]

@@ -14,16 +14,12 @@ #endif import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif  import Math.NumberTheory.ArithmeticFunctions.Moebius import Math.NumberTheory.ArithmeticFunctions.SieveBlock-import Math.NumberTheory.Primes.Factorisation (totientSieve, sieveTotient, carmichaelSieve, sieveCarmichael)  blockLen :: Word-blockLen = 10^6+blockLen = 1000000  totientHelper :: Word -> Word -> Word totientHelper p 1 = p - 1@@ -37,12 +33,6 @@   , sbcFunctionOnPrimePower = totientHelper   } -sumOldTotientSieve :: Word -> Word-sumOldTotientSieve len' = sum $ map (fromInteger . sieveTotient sieve) [1 .. len]-  where-    len = toInteger len'-    sieve = totientSieve len- carmichaelHelper :: Word -> Word -> Word carmichaelHelper 2 1 = 1 carmichaelHelper 2 2 = 2@@ -59,12 +49,6 @@   , sbcFunctionOnPrimePower = carmichaelHelper   } -sumOldCarmichaelSieve :: Word -> Word-sumOldCarmichaelSieve len' = sum $ map (fromInteger . sieveCarmichael sieve) [1 .. len]-  where-    len = toInteger len'-    sieve = carmichaelSieve len- moebiusConfig :: SieveBlockConfig Moebius moebiusConfig = SieveBlockConfig   { sbcEmpty                = MoebiusP@@ -78,13 +62,11 @@ benchSuite :: Benchmark benchSuite = bgroup "SieveBlock"   [ bgroup "totient"-    [ bench "old"     $ nf sumOldTotientSieve blockLen-    , bench "boxed"   $ nf (V.sum . sieveBlock        totientBlockConfig 1) blockLen+    [ bench "boxed"   $ nf (V.sum . sieveBlock        totientBlockConfig 1) blockLen     , bench "unboxed" $ nf (U.sum . sieveBlockUnboxed totientBlockConfig 1) blockLen     ]   , bgroup "carmichael"-    [ bench "old"     $ nf sumOldCarmichaelSieve blockLen-    , bench "boxed"   $ nf (V.sum . sieveBlock        carmichaelBlockConfig 1) blockLen+    [ bench "boxed"   $ nf (V.sum . sieveBlock        carmichaelBlockConfig 1) blockLen     , bench "unboxed" $ nf (U.sum . sieveBlockUnboxed carmichaelBlockConfig 1) blockLen     ]   , bgroup "moebius"

@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Math.NumberTheory.SmoothNumbersBench+  ( benchSuite+  ) where++import Data.List (genericTake)+import Data.Maybe+import Gauge.Main++import Math.NumberTheory.SmoothNumbers++doBench :: Integral a => a -> a+doBench lim = sum $ genericTake lim $ smoothOver $ fromJust $ fromSmoothUpperBound lim++benchSuite :: Benchmark+benchSuite = bgroup "SmoothNumbers"+  [ bench "100"      $ nf doBench    (100 :: Int)+  , bench "1000"     $ nf doBench   (1000 :: Int)+  , bench "10000"    $ nf doBench  (10000 :: Int)+  ]

@@ -24,9 +24,6 @@ #endif import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif  import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.ArithmeticFunctions.Mertens

@@ -25,9 +25,6 @@ #endif import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U-#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif  import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.ArithmeticFunctions.SieveBlock

@@ -20,18 +20,11 @@ import Test.Tasty import Test.Tasty.HUnit -#if MIN_VERSION_base(4,8,0)-#else-import Prelude hiding (sum, all, elem)-import Data.Foldable-#endif- import Data.List (sort) import qualified Data.Set as S import qualified Data.IntSet as IS  import Math.NumberTheory.ArithmeticFunctions-import Math.NumberTheory.Primes.Factorisation import Math.NumberTheory.TestUtils  import Numeric.Natural@@ -39,25 +32,28 @@ oeisAssertion :: (Eq a, Show a) => String -> ArithmeticFunction Natural a -> [a] -> Assertion oeisAssertion name f baseline = assertEqual name baseline (map (runFunction f) [1 .. fromIntegral (length baseline)]) +wolframAlphaAssertion :: (Eq a, Show a) => String -> ArithmeticFunction Integer a -> [Integer] -> [a] -> Assertion+wolframAlphaAssertion name f domain baseline = assertEqual name baseline (map (runFunction f) domain)+ -- | tau(n) equals to a number of divisors.-divisorsProperty1 :: Natural -> Bool-divisorsProperty1 n = S.size (runFunction divisorsA n) == runFunction tauA n+divisorsProperty1 :: NonZero Natural -> Bool+divisorsProperty1 (NonZero n) = S.size (runFunction divisorsA n) == runFunction tauA n  -- | sigma(n) equals to a number of divisors.-divisorsProperty2 :: Natural -> Bool-divisorsProperty2 n = sum (runFunction divisorsA n) == runFunction (sigmaA 1) n+divisorsProperty2 :: NonZero Natural -> Bool+divisorsProperty2 (NonZero n) = sum (runFunction divisorsA n) == runFunction (sigmaA 1) n  -- | All divisors of n truly divides n.-divisorsProperty3 :: Natural -> Bool-divisorsProperty3 n = all (\d -> n `mod` d == 0) (runFunction divisorsA n)+divisorsProperty3 :: NonZero Natural -> Bool+divisorsProperty3 (NonZero n) = all (\d -> n `mod` d == 0) (runFunction divisorsA n)  -- | 'divisorsA' matches 'divisorsSmallA'-divisorsProperty4 :: Int -> Bool-divisorsProperty4 n = S.toAscList (runFunction divisorsA n) == IS.toAscList (runFunction divisorsSmallA n)+divisorsProperty4 :: NonZero Int -> Bool+divisorsProperty4 (NonZero n) = S.toAscList (runFunction divisorsA n) == IS.toAscList (runFunction divisorsSmallA n)  -- | 'divisorsA' matches 'divisorsListA'-divisorsProperty5 :: Int -> Bool-divisorsProperty5 n = S.toAscList (runFunction divisorsA n) == sort (runFunction divisorsListA n)+divisorsProperty5 :: NonZero Int -> Bool+divisorsProperty5 (NonZero n) = S.toAscList (runFunction divisorsA n) == sort (runFunction divisorsListA n)  -- | tau matches baseline from OEIS. tauOeis :: Assertion@@ -70,12 +66,12 @@   ]  -- | sigma_0 coincides with tau by definition-sigmaProperty1 :: Natural -> Bool-sigmaProperty1 n = runFunction tauA n == runFunction (sigmaA 0) n+sigmaProperty1 :: NonZero Natural -> Bool+sigmaProperty1 (NonZero n) = runFunction tauA n == runFunction (sigmaA 0) n  -- | value of totient is bigger than argument-sigmaProperty2 :: Natural -> Bool-sigmaProperty2 n = n <= 1 || runFunction (sigmaA 1) n > n+sigmaProperty2 :: NonZero Natural -> Bool+sigmaProperty2 (NonZero n) = n <= 1 || runFunction (sigmaA 1) n > n  -- | sigma_1 matches baseline from OEIS. sigma1Oeis :: Assertion@@ -96,21 +92,12 @@   ]  -- | value of totient if even, except totient(1) and totient(2)-totientProperty1 :: Natural -> Bool-totientProperty1 n = n <= 2 || even (runFunction totientA n)+totientProperty1 :: NonZero Natural -> Bool+totientProperty1 (NonZero n) = n <= 2 || even (runFunction totientA n)  -- | value of totient is smaller than argument-totientProperty2 :: Natural -> Bool-totientProperty2 n = n <= 1 || runFunction totientA n < n--totientSieve100 :: TotientSieve-totientSieve100 = totientSieve 100---- | totient matches sieveTotient-totientProperty3 :: Natural -> Bool-totientProperty3 n = n < 1-  || fromIntegral (runFunction totientA n)-    == sieveTotient totientSieve100 (fromIntegral n)+totientProperty2 :: NonZero Natural -> Bool+totientProperty2 (NonZero n) = n <= 1 || runFunction totientA n < n  -- | totient matches baseline from OEIS. totientOeis :: Assertion@@ -122,12 +109,12 @@   ]  -- | jordan_0 is zero for argument > 1-jordanProperty1 :: Natural -> Bool-jordanProperty1 n = n <= 1 || runFunction (jordanA 0) n == 0+jordanProperty1 :: NonZero Natural -> Bool+jordanProperty1 (NonZero n) = n <= 1 || runFunction (jordanA 0) n == 0  -- | jordan_1 coincides with totient by definition-jordanProperty2 :: Natural -> Bool-jordanProperty2 n = runFunction totientA n == runFunction (jordanA 1) n+jordanProperty2 :: NonZero Natural -> Bool+jordanProperty2 (NonZero n) = runFunction totientA n == runFunction (jordanA 1) n  -- | jordan_2 matches baseline from OEIS. jordan2Oeis :: Assertion@@ -138,6 +125,72 @@   , 1728, 1584, 2208, 1536   ] +-- | 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+  | otherwise = True+  where k = n `mod` 8+        n' = fromIntegral n :: Integer++-- | 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+  where m = ramanujan n' - n' * sigma 9 n'+        n' = fromIntegral n :: Integer++-- | ramanujan matches baseline from wolframAlpha: https://www.wolframalpha.com/input/?i=RamanujanTau%5BRange%5B100%5D%5D+ramanujanRange :: Assertion+ramanujanRange = wolframAlphaAssertion "A000594" ramanujanA [1..100]+  [ 1, -24, 252, -1472, 4830, -6048, -16744, 84480, -113643, -115920+  , 534612, -370944, -577738, 401856, 1217160, 987136, -6905934, 2727432+  , 10661420, -7109760, -4219488, -12830688, 18643272, 21288960, -25499225+  , 13865712, -73279080, 24647168, 128406630, -29211840, -52843168+  , -196706304, 134722224, 165742416, -80873520, 167282496, -182213314+  , -255874080, -145589976, 408038400, 308120442, 101267712, -17125708+  , -786948864, -548895690, -447438528, 2687348496, 248758272, -1696965207+  , 611981400, -1740295368, 850430336, -1596055698, 1758697920, 2582175960+  , -1414533120, 2686677840, -3081759120, -5189203740, -1791659520, 6956478662+  , 1268236032, 1902838392, 2699296768, -2790474540, -3233333376, -15481826884+  , 10165534848, 4698104544, 1940964480, 9791485272, -9600560640, 1463791322+  , 4373119536, -6425804700, -15693610240, -8951543328, 3494159424, 38116845680+  , 4767866880, 1665188361, -7394890608, -29335099668, 6211086336, -33355661220+  , 411016992, 32358470760, 45164021760, -24992917110, 13173496560, 9673645072+  , -27442896384, -13316478336, -64496363904, 51494658600, -49569988608+  , 75013568546, 40727164968, -60754911516, 37534859200+  ]++-- | ramanujan matches baseline from wolframAlpha: https://www.wolframalpha.com/input/?i=RamanujanTau%5B2%5ERange%5B20%5D%5D+ramanujanPowers2 :: Assertion+ramanujanPowers2 = wolframAlphaAssertion "wolframAlpha2^n" ramanujanA [2^n | n <- [1..20]]+  [ -24, -1472, 84480, 987136, -196706304, 2699296768, 338071388160+  , -13641873096704, -364965248630784, 36697722069188608, -133296500464680960+  , -71957818786545926144, 1999978883828768833536, 99370119662955604738048+  , -6480839625992253084794880, -47969854045919004468445184+  , 14424036051134190424902598656, -247934604141178449046286630912+  , -23589995333334539213089642905600, 1073929957281162404760946449842176+  ]++-- | ramanujan matches baseline from wolframAlpha: https://www.wolframalpha.com/input/?i=RamanujanTau%5B3%5ERange%5B20%5D%5D+ramanujanPowers3 :: Assertion+ramanujanPowers3 = wolframAlphaAssertion "wolframAlpha3^n" ramanujanA [3^n | n <- [1..20]]+  [ 252, -113643, -73279080, 1665188361, 13400796651732, 3082017633650397+  , -1597242480784468560, -948475282905952954479, 43930942451226107469612+  , 179090148438649827109433637, 37348482744132405171657919560+  , -22313464873940134819697044764519, -12239164820907737153507340756954108+  , 868493827155123300221022518147812077, 2386991774972433985188062567645398013280+  , 447670851294004737003138291024309833342241+  , -310035377434952569449318870332553243856267428+  , -157432463407787104647123294163886831498857358283+  , 15248856227707192449163419793501327951694151780600+  , 31731400364681474724113131979212395183355010696469801+  ]+ -- | moebius does not require full factorisation moebiusLazy :: Assertion moebiusLazy = assertEqual "moebius" MoebiusZ (runFunction moebiusA (2^2 * (2^100000-1) :: Natural))@@ -152,12 +205,12 @@   ]  -- | liouville values are [-1, 1]-liouvilleProperty1 :: Natural -> Bool-liouvilleProperty1 n = runFunction liouvilleA n `elem` [-1, 1]+liouvilleProperty1 :: NonZero Natural -> Bool+liouvilleProperty1 (NonZero n) = runFunction liouvilleA n `elem` [-1, 1]  -- | moebius is zero or equal to liouville-liouvilleProperty2 :: Natural -> Bool-liouvilleProperty2 n = m == MoebiusZ || l == runMoebius m+liouvilleProperty2 :: NonZero Natural -> Bool+liouvilleProperty2 (NonZero n) = m == MoebiusZ || l == runMoebius m   where     l = runFunction liouvilleA n     m = runFunction moebiusA   n@@ -173,17 +226,8 @@   ]  -- | carmichaeil divides totient-carmichaelProperty1 :: Natural -> Bool-carmichaelProperty1 n = runFunction totientA n `mod` runFunction carmichaelA n == 0--carmichaelSieve100 :: CarmichaelSieve-carmichaelSieve100 = carmichaelSieve 100---- | carmichael matches sieveCarmichael-carmichaelProperty2 :: Natural -> Bool-carmichaelProperty2 n = n < 1-  || fromIntegral (runFunction carmichaelA n)-    == sieveCarmichael carmichaelSieve100 (fromIntegral n)+carmichaelProperty1 :: NonZero Natural -> Bool+carmichaelProperty1 (NonZero n) = runFunction totientA n `mod` runFunction carmichaelA n == 0  -- | carmichael matches baseline from OEIS. carmichaelOeis :: Assertion@@ -195,8 +239,8 @@   ]  -- | smallOmega is smaller than bigOmega-omegaProperty1 :: Natural -> Bool-omegaProperty1 n = runFunction smallOmegaA n <= runFunction bigOmegaA n+omegaProperty1 :: NonZero Natural -> Bool+omegaProperty1 (NonZero n) = runFunction smallOmegaA n <= runFunction bigOmegaA n  -- | smallOmega matches baseline from OEIS. smallOmegaOeis :: Assertion@@ -248,7 +292,6 @@   , testGroup "Totient"     [ testSmallAndQuick "totient is even"      totientProperty1     , testSmallAndQuick "totient n < n"        totientProperty2-    , testSmallAndQuick "matches sieveTotient" totientProperty3     , testCase          "OEIS"                 totientOeis     ]   , testGroup "Jordan"@@ -256,6 +299,13 @@     , testSmallAndQuick "jordan_1 = totient" jordanProperty2     , testCase          "OEIS jordan_2"      jordan2Oeis     ]+  , testGroup "Ramanujan"+    [ testSmallAndQuick "ramanujan mod 8 congruences" ramanujanCongruence1+    , testSmallAndQuick "ramanujan mod 7 congruences" ramanujanCongruence2+    , testCase          "baseline ramanujan range"    ramanujanRange+    , testCase          "baseline ramanujan powers2"  ramanujanPowers2+    , testCase          "baseline ramanujan powers3"  ramanujanPowers3+    ]   , testGroup "Moebius"     [ testCase          "OEIS"           moebiusOeis     , testCase          "Lazy"           moebiusLazy@@ -267,7 +317,6 @@     ]   , testGroup "Carmichael"     [ testSmallAndQuick "carmichael divides totient" carmichaelProperty1-    , testSmallAndQuick "matches sieveCarmichael"    carmichaelProperty2     , testCase          "OEIS"                       carmichaelOeis     ]   , testGroup "Omegas"

@@ -22,10 +22,6 @@ import Math.NumberTheory.Curves.Montgomery import Math.NumberTheory.TestUtils -#if __GLASGOW_HASKELL__ < 709-import Data.Word-#endif- (==>?) :: Maybe a -> (a -> Property) -> Property x ==>? f = case x of   Nothing -> discard

@@ -0,0 +1,208 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- |+-- Module:      Math.NumberTheory.EisensteinIntegersTests+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.+-- Stability:   Provisional+--+-- Tests for Math.NumberTheory.EisensteinIntegers+--++module Math.NumberTheory.EisensteinIntegersTests+  ( testSuite+  ) where++import qualified Math.NumberTheory.Euclidean    as ED+import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E+import Math.NumberTheory.Primes                       (primes)+import Test.Tasty                                     (TestTree, testGroup)+import Test.Tasty.HUnit                               (Assertion, assertEqual,+                                                      testCase)++import Math.NumberTheory.TestUtils                    (Positive (..),+                                                       testSmallAndQuick)++-- | Check that @signum@ and @abs@ satisfy @z == signum z * abs z@, where @z@ is+-- an @EisensteinInteger@.+signumAbsProperty :: E.EisensteinInteger -> Bool+signumAbsProperty z = z == signum z * abs z++-- | Check that @abs@ maps an @EisensteinInteger@ to its associate in first+-- sextant.+absProperty :: E.EisensteinInteger -> Bool+absProperty z = isOrigin || (inFirstSextant && isAssociate)+  where+    z'@(x' E.:+ y') = abs z+    isOrigin = z' == 0 && z == 0+    -- The First sextant includes the positive real axis, but not the origin+    -- or the line defined by the linear equation @y = (sqrt 3) * x@ in the+    -- Cartesian plane.+    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+-- 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)++-- | 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++-- | 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++-- | 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+  where+    z = ED.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+  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)++findPrimesProperty1 :: Positive Int -> Bool+findPrimesProperty1 (Positive index) =+    let -- Only retain primes that are of the form @6k + 1@, for some nonzero natural @k@.+        prop prime = prime `mod` 6 == 1+        p = (!! index) $ filter prop $ drop 3 primes+    in E.isPrime $ E.findPrime p++-- | Checks that the @norm@ of the Euclidean domain of Eisenstein integers+-- is multiplicative i.e.+-- @forall e1 e2 in Z[ω] . norm(e1 * e2) == norm(e1) * norm(e2)@.+euclideanDomainProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool+euclideanDomainProperty1 e1 e2 = E.norm (e1 * e2) == E.norm e1 * E.norm e2++-- | Checks that the numbers produced by @primes@ are actually Eisenstein+-- primes.+primesProperty1 :: Positive Int -> Bool+primesProperty1 (Positive index) = all E.isPrime $ 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 :: [E.EisensteinInteger] -> Bool+        isOrdered xs = all (\(x,y) -> E.norm x <= E.norm y) . zip xs $ tail xs+    in isOrdered $ 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 e == e) $ 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+-- respective exponents.+factoriseProperty1 :: E.EisensteinInteger -> Bool+factoriseProperty1 g = g == 0 || abs g == abs g'+  where+    factors = E.factorise g+    g' = product $ map (uncurry (^)) factors++-- | Check that there are no factors with exponent @0@ in the factorisation.+factoriseProperty2 :: E.EisensteinInteger -> Bool+factoriseProperty2 z = z == 0 || all ((> 0) . snd) (E.factorise z)++-- | Check that no factor produced by @factorise@ is a unit.+factoriseProperty3 :: E.EisensteinInteger -> Bool+factoriseProperty3 z = z == 0 || all ((> 1) . E.norm . fst) (E.factorise z)++-- | Check that every prime factor in the factorisation is primary, excluding+-- @1 - ω@, if it is a factor.+factoriseProperty4 :: E.EisensteinInteger -> Bool+factoriseProperty4 z =+    z == 0 ||+    (all (\e -> e `ED.mod` 3 == 2) $+     filter (\e -> not $ elem e $ E.associates $ 1 E.:+ (-1)) $+     map fst $ E.factorise z)++factoriseSpecialCase1 :: Assertion+factoriseSpecialCase1 = assertEqual "should be equal"+  [(2 E.:+ 1, 3), (2 E.:+ 3, 1)]+  (E.factorise (15 E.:+ 12))++testSuite :: TestTree+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+  , 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 "quotE and remE work properly" quotRemProperty1+    , testSmallAndQuick "quotRemE works properly" quotRemProperty2+    ]++  , 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"+                        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"+                        findPrimesProperty1+    , testSmallAndQuick "Eisenstein primes generated by `primes` are actually\+                        \ primes"+                        primesProperty1+    , testSmallAndQuick "The infinite list of Eisenstein primes produced by\+                        \ `primes` is ordered. "+                        primesProperty2+    , testSmallAndQuick "All generated primes are in the first sextant"+                        primesProperty3+    ]++    , testGroup "Factorisation"+      [ testSmallAndQuick "factorise produces correct results"+                          factoriseProperty1+      , testSmallAndQuick "factorise produces no factors with exponent 0"+                          factoriseProperty2+      , testSmallAndQuick "factorise produces no unit factors"+                          factoriseProperty3+      , testSmallAndQuick "factorise only produces primary primes"+                          factoriseProperty4+      , testCase          "factorise 15:+12" factoriseSpecialCase1+      ]+  ]