arithmoi 0.8.0.0 → 0.9.0.0

raw patch · 133 files changed

+4505/−3000 lines, 133 filesdep +hmatrix-gsldep +semiringsdep −semigroupsdep ~arraydep ~basedep ~containersnew-component:exe:sequence-modelPVP ok

version bump matches the API change (PVP)

Dependencies added: hmatrix-gsl, semirings

Dependencies removed: semigroups

Dependency ranges changed: array, base, containers, exact-pi

API changes (from Hackage documentation)

Files

• Changes +57/−0
• GHC/TypeNats/Compat.hs +2/−5
• Math/NumberTheory/ArithmeticFunctions.hs +0/−2
• Math/NumberTheory/ArithmeticFunctions/Class.hs +10/−8
• Math/NumberTheory/ArithmeticFunctions/Inverse.hs +370/−0
• Math/NumberTheory/ArithmeticFunctions/Mertens.hs +0/−2
• Math/NumberTheory/ArithmeticFunctions/Moebius.hs +5/−6
• Math/NumberTheory/ArithmeticFunctions/NFreedom.hs +160/−0
• Math/NumberTheory/ArithmeticFunctions/SieveBlock.hs +8/−9
• Math/NumberTheory/ArithmeticFunctions/SieveBlock/Unboxed.hs +11/−12
• Math/NumberTheory/ArithmeticFunctions/Standard.hs +62/−35
• Math/NumberTheory/Curves/Montgomery.hs +2/−2
• Math/NumberTheory/Euclidean.hs +3/−4
• Math/NumberTheory/GCD.hs +0/−261
• Math/NumberTheory/GCD/LowLevel.hs +0/−104
• Math/NumberTheory/GaussianIntegers.hs +0/−18
• Math/NumberTheory/Moduli.hs +0/−2
• Math/NumberTheory/Moduli/Chinese.hs +151/−12
• Math/NumberTheory/Moduli/Class.hs +36/−15
• Math/NumberTheory/Moduli/DiscreteLogarithm.hs +12/−10
• Math/NumberTheory/Moduli/Equations.hs +2/−4
• Math/NumberTheory/Moduli/Jacobi.hs +0/−4
• Math/NumberTheory/Moduli/PrimitiveRoot.hs +15/−25
• Math/NumberTheory/Moduli/Sqrt.hs +24/−24
• Math/NumberTheory/Moduli/SqrtOld.hs +9/−11
• Math/NumberTheory/MoebiusInversion.hs +69/−60
• Math/NumberTheory/MoebiusInversion/Int.hs +69/−61
• Math/NumberTheory/Powers.hs +0/−2
• Math/NumberTheory/Powers/Cubes.hs +43/−38
• Math/NumberTheory/Powers/Fourth.hs +40/−34
• Math/NumberTheory/Powers/General.hs +34/−28
• Math/NumberTheory/Powers/Modular.hs +1/−3
• Math/NumberTheory/Powers/Squares.hs +46/−40
• Math/NumberTheory/Powers/Squares/Internal.hs +0/−2
• Math/NumberTheory/Prefactored.hs +24/−37
• Math/NumberTheory/Primes.hs +252/−12
• Math/NumberTheory/Primes/Counting.hs +0/−2
• Math/NumberTheory/Primes/Counting/Approximate.hs +0/−2
• Math/NumberTheory/Primes/Counting/Impl.hs +6/−7
• Math/NumberTheory/Primes/Factorisation.hs +0/−2
• Math/NumberTheory/Primes/Factorisation/Certified.hs +7/−9
• Math/NumberTheory/Primes/Factorisation/Montgomery.hs +27/−22
• Math/NumberTheory/Primes/Factorisation/TrialDivision.hs +7/−8
• Math/NumberTheory/Primes/Sieve.hs +0/−2
• Math/NumberTheory/Primes/Sieve/Eratosthenes.hs +23/−19
• Math/NumberTheory/Primes/Sieve/Indexing.hs +0/−2
• Math/NumberTheory/Primes/Testing.hs +0/−2
• Math/NumberTheory/Primes/Testing/Certificates.hs +0/−2
• Math/NumberTheory/Primes/Testing/Certificates/Internal.hs +8/−8
• Math/NumberTheory/Primes/Testing/Certified.hs +0/−2
• Math/NumberTheory/Primes/Testing/Probabilistic.hs +0/−2
• Math/NumberTheory/Primes/Types.hs +50/−31
• Math/NumberTheory/Quadratic/EisensteinIntegers.hs +120/−109
• Math/NumberTheory/Quadratic/GaussianIntegers.hs +47/−76
• Math/NumberTheory/Recurrences.hs +16/−0
• Math/NumberTheory/Recurrences/Bilinear.hs +270/−0
• Math/NumberTheory/Recurrences/Linear.hs +136/−0
• Math/NumberTheory/Recurrences/Pentagonal.hs +95/−0
• Math/NumberTheory/Recurrencies.hs +8/−9
• Math/NumberTheory/Recurrencies/Bilinear.hs +5/−222
• Math/NumberTheory/Recurrencies/Linear.hs +5/−129
• Math/NumberTheory/Recurrencies/Pentagonal.hs +0/−96
• Math/NumberTheory/SmoothNumbers.hs +77/−48
• Math/NumberTheory/UniqueFactorisation.hs +7/−84
• Math/NumberTheory/Unsafe.hs +0/−1
• Math/NumberTheory/Utils.hs +60/−40
• Math/NumberTheory/Utils/DirichletSeries.hs +86/−0
• Math/NumberTheory/Utils/FromIntegral.hs +5/−2
• Math/NumberTheory/Utils/Hyperbola.hs +0/−2
• Math/NumberTheory/Zeta.hs +2/−2
• Math/NumberTheory/Zeta/Dirichlet.hs +27/−126
• Math/NumberTheory/Zeta/Hurwitz.hs +125/−0
• Math/NumberTheory/Zeta/Riemann.hs +15/−53
• Math/NumberTheory/Zeta/Utils.hs +5/−17
• app/SequenceModel.hs +83/−0
• arithmoi.cabal +40/−26
• benchmark/Bench.hs +10/−4
• benchmark/Math/NumberTheory/EisensteinIntegersBench.hs +3/−4
• benchmark/Math/NumberTheory/EuclideanBench.hs +19/−0
• benchmark/Math/NumberTheory/GCDBench.hs +0/−37
• benchmark/Math/NumberTheory/GaussianIntegersBench.hs +3/−1
• benchmark/Math/NumberTheory/InverseBench.hs +58/−0
• benchmark/Math/NumberTheory/PrimesBench.hs +2/−1
• benchmark/Math/NumberTheory/PrimitiveRootsBench.hs +1/−1
• benchmark/Math/NumberTheory/RecurrencesBench.hs +48/−0
• benchmark/Math/NumberTheory/RecurrenciesBench.hs +0/−48
• benchmark/Math/NumberTheory/SequenceBench.hs +71/−0
• benchmark/Math/NumberTheory/SieveBlockBench.hs +3/−2
• benchmark/Math/NumberTheory/SmoothNumbersBench.hs +2/−1
• benchmark/Math/NumberTheory/ZetaBench.hs +15/−0
• test-suite/Math/NumberTheory/ArithmeticFunctions/InverseTests.hs +262/−0
• test-suite/Math/NumberTheory/ArithmeticFunctions/MertensTests.hs +0/−1
• test-suite/Math/NumberTheory/ArithmeticFunctions/SieveBlockTests.hs +3/−3
• test-suite/Math/NumberTheory/ArithmeticFunctionsTests.hs +50/−1
• test-suite/Math/NumberTheory/CurvesTests.hs +0/−1
• test-suite/Math/NumberTheory/EisensteinIntegersTests.hs +19/−27
• test-suite/Math/NumberTheory/EuclideanTests.hs +148/−0
• test-suite/Math/NumberTheory/GCDTests.hs +0/−147
• test-suite/Math/NumberTheory/GaussianIntegersTests.hs +29/−24
• test-suite/Math/NumberTheory/Moduli/ChineseTests.hs +24/−1
• test-suite/Math/NumberTheory/Moduli/ClassTests.hs +27/−1
• test-suite/Math/NumberTheory/Moduli/EquationsTests.hs +0/−2
• test-suite/Math/NumberTheory/Moduli/JacobiTests.hs +9/−41
• test-suite/Math/NumberTheory/Moduli/PrimitiveRootTests.hs +1/−2
• test-suite/Math/NumberTheory/Moduli/SqrtTests.hs +29/−33
• test-suite/Math/NumberTheory/MoebiusInversion/IntTests.hs +0/−1
• test-suite/Math/NumberTheory/MoebiusInversionTests.hs +0/−1
• test-suite/Math/NumberTheory/Powers/CubesTests.hs +7/−8
• test-suite/Math/NumberTheory/Powers/FourthTests.hs +4/−5
• test-suite/Math/NumberTheory/Powers/GeneralTests.hs +1/−2
• test-suite/Math/NumberTheory/Powers/ModularTests.hs +0/−1
• test-suite/Math/NumberTheory/Powers/SquaresTests.hs +5/−6
• test-suite/Math/NumberTheory/PrefactoredTests.hs +0/−1
• test-suite/Math/NumberTheory/Primes/CountingTests.hs +6/−6
• test-suite/Math/NumberTheory/Primes/FactorisationTests.hs +4/−5
• test-suite/Math/NumberTheory/Primes/SequenceTests.hs +146/−0
• test-suite/Math/NumberTheory/Primes/SieveTests.hs +8/−8
• test-suite/Math/NumberTheory/Primes/TestingTests.hs +0/−1
• test-suite/Math/NumberTheory/PrimesTests.hs +4/−4
• test-suite/Math/NumberTheory/Recurrences/BilinearTests.hs +233/−0
• test-suite/Math/NumberTheory/Recurrences/LinearTests.hs +103/−0
• test-suite/Math/NumberTheory/Recurrences/PentagonalTests.hs +103/−0
• test-suite/Math/NumberTheory/Recurrencies/BilinearTests.hs +0/−234
• test-suite/Math/NumberTheory/Recurrencies/LinearTests.hs +0/−104
• test-suite/Math/NumberTheory/Recurrencies/PentagonalTests.hs +0/−105
• test-suite/Math/NumberTheory/SmoothNumbersTests.hs +48/−3
• test-suite/Math/NumberTheory/TestUtils.hs +74/−17
• test-suite/Math/NumberTheory/TestUtils/MyCompose.hs +0/−2
• test-suite/Math/NumberTheory/TestUtils/Wrappers.hs +20/−26
• test-suite/Math/NumberTheory/UniqueFactorisationTests.hs +5/−4
• test-suite/Math/NumberTheory/Zeta/DirichletTests.hs +3/−4
• test-suite/Math/NumberTheory/Zeta/RiemannTests.hs +3/−4
• test-suite/Test.hs +13/−9

@@ -1,3 +1,60 @@+0.9.0.0+    This release supports GHC 8.0, 8.2, 8.4 and 8.6.++    Breaking changes:++        Remove 'Prime' type family and introduce 'Prime' newtype. This newtype+        is now used extensively in public API:++        primes :: Integral a => [Prime a]+        primeList :: Integral a => PrimeSieve -> [Prime a]+        sieveFrom :: Integer -> [Prime Integer]+        nthPrime :: Integer -> Prime Integer++        'sbcFunctionOnPrimePower' now accepts 'Prime Word' instead of 'Word'.++        'Math.NumberTheory.Primes.{Factorisation,Testing,Counting,Sieve}'+        are no longer re-exported from 'Math.NumberTheory.Primes'.+        Merge 'Math.NumberTheory.UniqueFactorisation' into+        'Math.NumberTheory.Primes' (#135, #153).++        From now on 'Math.NumberTheory.Primes.Factorisation.factorise'+        and similar functions return [(Integer, Word)] instead of [(Integer, Int)].++        Remove deprecated 'Math.NumberTheory.GCD' and 'Math.NumberTheory.GCD.LowLevel'.++        Deprecate 'Math.NumberTheory.Recurrencies.*'.+        Use 'Math.NumberTheory.Recurrences.*' instead (#146).++    New features:++        New functions 'nextPrime' and 'precPrime'. Implement an instance of 'Enum' for primes (#153):++        > [nextPrime 101 .. precPrime 130]+        [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127]++        Support Gaussian and Eisenstein integers in smooth numbers (#138).++        Add the Hurwitz zeta function on non-negative integer arguments (#126).++        Implement efficient tests of n-freeness: pointwise and in interval. See 'isNFree' and 'nFreesBlock' (#145).++        Generate preimages of the totient and the sum-of-divisors functions (#142):++        > inverseTotient 120 :: [Integer]+        [155,310,183,366,225,450,175,350,231,462,143,286,244,372,396,308,248]++        Generate coefficients of Faulhaber polynomials 'faulhaberPoly' (#70).++    Improvements:++        Better precision for exact values of Riemann zeta and Dirichlet beta+        functions (#123).++        Speed up certain cases of modular multiplication (#160).++        Extend Chinese theorem to non-coprime moduli (#71).+ 0.8.0.0     This release supports GHC 7.10, 8.0, 8.2, 8.4 and 8.6. 

@@ -14,15 +14,12 @@ #else  module GHC.TypeNats.Compat-  ( Nat-  , KnownNat-  , SomeNat(..)+  ( module GHC.TypeLits   , natVal   , someNatVal-  , sameNat   ) where -import GHC.TypeLits (Nat, KnownNat, SomeNat(..), sameNat)+import GHC.TypeLits hiding (natVal, someNatVal) import qualified GHC.TypeLits as TL import Numeric.Natural 

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2016 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- This module provides an interface for defining and manipulating -- arithmetic functions. It also defines several most widespreaded

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2016 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Generic type for arithmetic functions over arbitrary unique -- factorisation domains.@@ -18,6 +16,7 @@ module Math.NumberTheory.ArithmeticFunctions.Class   ( ArithmeticFunction(..)   , runFunction+  , runFunctionOnFactors   ) where  import Control.Applicative@@ -25,7 +24,7 @@ import Data.Semigroup #endif -import Math.NumberTheory.UniqueFactorisation+import Math.NumberTheory.Primes  -- | A typical arithmetic function operates on the canonical factorisation of -- a number into prime's powers and consists of two rules. The first one@@ -34,8 +33,8 @@ -- -- In the following definition the first argument is the function on prime's -- powers, the monoid instance determines a rule of combination (typically--- 'Product' or 'Sum'), and the second argument is convenient for unwrapping--- (typically, 'getProduct' or 'getSum').+-- 'Data.Semigroup.Product' or 'Data.Semigroup.Sum'), and the second argument is convenient for unwrapping+-- (typically, 'Data.Semigroup.getProduct' or 'Data.Semigroup.getSum'). data ArithmeticFunction n a where   ArithmeticFunction     :: Monoid m@@ -43,13 +42,16 @@     -> (m -> a)     -> ArithmeticFunction n a --- | Convert to function. The value on 0 is undefined.+-- | Convert to a function. The value on 0 is undefined. runFunction :: UniqueFactorisation n => ArithmeticFunction n a -> n -> a-runFunction (ArithmeticFunction f g)+runFunction f = runFunctionOnFactors f . factorise++-- | Convert to a function on prime factorisation.+runFunctionOnFactors :: ArithmeticFunction n a -> [(Prime n, Word)] -> a+runFunctionOnFactors (ArithmeticFunction f g)   = g   . mconcat   . map (uncurry f)-  . factorise  instance Functor (ArithmeticFunction n) where   fmap f (ArithmeticFunction g h) = ArithmeticFunction g (f . h)

@@ -0,0 +1,370 @@+-- |+-- Module:      Math.NumberTheory.ArithmeticFunctions.Inverse+-- Copyright:   (c) 2018 Andrew Lelechenko+-- Licence:     MIT+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Computing inverses of multiplicative functions.+-- The implementation is based on+-- <https://www.emis.de/journals/JIS/VOL19/Alekseyev/alek5.pdf Computing the Inverses, their Power Sums, and Extrema for Euler’s Totient and Other Multiplicative Functions>+-- by M. A. Alekseyev.++{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Math.NumberTheory.ArithmeticFunctions.Inverse+  ( inverseTotient+  , inverseSigma+  , -- * Wrappers+    MinWord(..)+  , MaxWord(..)+  , MinNatural(..)+  , MaxNatural(..)+  , -- * Utils+    asSetOfPreimages+  ) where++import Prelude hiding (rem, quot)+import Data.List+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe+import Data.Ord (Down(..))+import Data.Semigroup+import Data.Semiring (Semiring(..))+import Data.Set (Set)+import qualified Data.Set as S+import Numeric.Natural++import Math.NumberTheory.ArithmeticFunctions+import Math.NumberTheory.Euclidean+import Math.NumberTheory.Logarithms+import Math.NumberTheory.Powers+import Math.NumberTheory.Primes+import Math.NumberTheory.Primes.Sieve (primes)+import Math.NumberTheory.Utils.DirichletSeries (DirichletSeries)+import qualified Math.NumberTheory.Utils.DirichletSeries as DS+import Math.NumberTheory.Utils.FromIntegral++data PrimePowers a = PrimePowers+  { _ppPrime  :: Prime a+  , _ppPowers :: [Word] -- sorted list+  }++instance Show a => Show (PrimePowers a) where+  show (PrimePowers p xs) = "PP " ++ show (unPrime p) ++ " " ++ show xs++-- | Convert a list of powers of a prime into an atomic Dirichlet series+-- (Section 4, Step 2).+atomicSeries+  :: Num a+  => (a -> b)               -- ^ How to inject a number into a semiring+  -> ArithmeticFunction a c -- ^ Arithmetic function, which we aim to inverse+  -> PrimePowers a          -- ^ List of powers of a prime+  -> DirichletSeries c b    -- ^ Atomic Dirichlet series+atomicSeries point (ArithmeticFunction f g) (PrimePowers p ks) =+  DS.fromDistinctAscList (map (\k -> (g (f p k), point (unPrime p ^ k))) ks)++-- | See section 5.1 of the paper.+invTotient+  :: forall a. (UniqueFactorisation a, Eq a)+  => [(Prime a, Word)]+  -- ^ Factorisation of a value of the totient function+  -> [PrimePowers a]+  -- ^ Possible prime factors of an argument of the totient function+invTotient fs = map (\p -> PrimePowers p (doPrime p)) ps+  where+    divs :: [a]+    divs = runFunctionOnFactors divisorsListA fs++    ps :: [Prime a]+    ps = mapMaybe (isPrime . (+ 1)) divs++    doPrime :: Prime a -> [Word]+    doPrime p = case lookup p fs of+      Nothing -> [1]+      Just k  -> [1 .. k+1]++-- | See section 5.2 of the paper.+invSigma+  :: forall a. (Euclidean a, Integral a, UniqueFactorisation a)+  => [(Prime a, Word)]+  -- ^ Factorisation of a value of the sum-of-divisors function+  -> [PrimePowers a]+  -- ^ Possible prime factors of an argument of the sum-of-divisors function+invSigma fs+  = map (\(x, ys) -> PrimePowers x (S.toList ys))+  $ M.assocs+  $ M.unionWith (<>) pksSmall pksLarge+  where+    numDivs :: a+    numDivs = runFunctionOnFactors tauA fs++    divs :: [a]+    divs = runFunctionOnFactors divisorsListA fs++    n :: a+    n = product $ map (\(p, k) -> unPrime p ^ k) fs++    -- There are two possible strategies to find possible prime factors+    -- of an argument of the sum-of-divisors function.+    -- 1. Take each prime p and each power e such that p^e <= n,+    -- compute sigma(p^e) and check whether it is a divisor of n.+    -- (corresponds to 'pksSmall' below)+    -- 2. Take each divisor d of n and each power e such that e <= log_2 d,+    -- compute p = floor(e-th root of (d - 1)) and check whether sigma(p^e) = d+    -- and p is actually prime (correposnds to 'pksLarge' below).+    --+    -- Asymptotically the second strategy is beneficial, but computing+    -- exact e-th roots of huge integers (especially when they exceed MAX_DOUBLE)+    -- is very costly. That is why we employ the first strategy for primes+    -- below limit 'lim' and the second one for larger ones. This allows us+    -- to loop over e <= log_lim d which is much smaller than log_2 d.+    --+    -- The value of 'lim' below was chosen heuristically;+    -- it may be tuned in future in accordance with new experimental data.+    lim :: a+    lim = numDivs `max` 2++    pksSmall :: Map (Prime a) (Set Word)+    pksSmall = M.fromDistinctAscList+      [ (p, pows)+      | p <- takeWhile ((< lim) . unPrime) primes+      , let pows = doPrime p+      , not (null pows)+      ]++    doPrime :: Prime a -> Set Word+    doPrime p' = let p = unPrime p' in S.fromDistinctAscList+      [ e+      | e <- [1 .. intToWord (integerLogBase (toInteger p) (toInteger n))]+      , n `rem` ((p ^ (e + 1) - 1) `quot` (p - 1)) == 0+      ]++    pksLarge :: Map (Prime a) (Set Word)+    pksLarge = M.unionsWith (<>)+      [ maybe mempty (flip M.singleton (S.singleton e)) (isPrime p)+      | d <- divs+      , e <- [1 .. intToWord (integerLogBase (toInteger lim) (toInteger d))]+      , let p = integerRoot e (d - 1)+      , p ^ (e + 1) - 1 == d * (p - 1)+      ]++-- | Instead of multiplying all atomic series and filtering out everything,+-- which is not divisible by @n@, we'd rather split all atomic series into+-- a couple of batches, each of which corresponds to a prime factor of @n@.+-- This allows us to crop resulting Dirichlet series (see 'filter' calls+-- in 'invertFunction' below) at the end of each batch, saving time and memory.+strategy+  :: forall a c. (Euclidean c, Ord c)+  => ArithmeticFunction a c+  -- ^ Arithmetic function, which we aim to inverse+  -> [(Prime c, Word)]+  -- ^ Factorisation of a value of the arithmetic function+  -> [PrimePowers a]+  -- ^ Possible prime factors of an argument of the arithmetic function+  -> [(Maybe (Prime c, Word), [PrimePowers a])]+  -- ^ Batches, corresponding to each element of the factorisation of a value+strategy (ArithmeticFunction f g) factors args = (Nothing, ret) : rets+  where+    (ret, rets)+      = mapAccumL go args+      $ sortOn (Down . fst) factors++    go+      :: [PrimePowers a]+      -> (Prime c, Word)+      -> ([PrimePowers a], (Maybe (Prime c, Word), [PrimePowers a]))+    go ts (p, k) = (rs, (Just (p, k), qs))+      where+        predicate (PrimePowers q ls) = any (\l -> g (f q l) `rem` unPrime p == 0) ls+        (qs, rs) = partition predicate ts++-- | Main workhorse.+invertFunction+  :: forall a b c.+     (Num a, Semiring b, Euclidean c, UniqueFactorisation c, Ord c)+  => (a -> b)+  -- ^ How to inject a number into a semiring+  -> ArithmeticFunction a c+  -- ^ Arithmetic function, which we aim to inverse+  -> ([(Prime c, Word)] -> [PrimePowers a])+  -- ^ How to find possible prime factors of the argument+  -> c+  -- ^ Value of the arithmetic function, which we aim to inverse+  -> b+  -- ^ Semiring element, representing preimages+invertFunction point f invF n+  = DS.lookup n+  $ foldl' (\ds b -> uncurry processBatch b ds) (DS.fromDistinctAscList []) batches+  where+    factors = factorise n+    batches = strategy f factors $ invF factors++    processBatch+      :: Maybe (Prime c, Word)+      -> [PrimePowers a]+      -> DirichletSeries c b+      -> DirichletSeries c b+    processBatch Nothing xs acc+      = foldl' (DS.timesAndCrop n) acc+      $ map (atomicSeries point f) xs++    -- This is equivalent to the next, general case, but is faster,+    -- since it avoids construction of many intermediate series.+    processBatch (Just (p, 1)) xs acc+      = DS.filter (\a -> a `rem` unPrime p == 0)+      $ foldl' (DS.timesAndCrop n) acc'+      $ map (atomicSeries point f) xs2+      where+        (xs1, xs2) = partition (\(PrimePowers _ ts) -> length ts == 1) xs+        vs = DS.unions $ map (atomicSeries point f) xs1+        (ys, zs) = DS.partition (\a -> a `rem` unPrime p == 0) acc+        acc' = ys `DS.union` DS.timesAndCrop n zs vs++    processBatch (Just pk) xs acc+      = (\(p, k) -> DS.filter (\a -> a `rem` (unPrime p ^ k) == 0)) pk+      $ foldl' (DS.timesAndCrop n) acc+      $ map (atomicSeries point f) xs++{-# SPECIALISE invertFunction :: Semiring b => (Int -> b) -> ArithmeticFunction Int Int -> ([(Prime Int, Word)] -> [PrimePowers Int]) -> Int -> b #-}+{-# SPECIALISE invertFunction :: Semiring b => (Word -> b) -> ArithmeticFunction Word Word -> ([(Prime Word, Word)] -> [PrimePowers Word]) -> Word -> b #-}+{-# SPECIALISE invertFunction :: Semiring b => (Integer -> b) -> ArithmeticFunction Integer Integer -> ([(Prime Integer, Word)] -> [PrimePowers Integer]) -> Integer -> b #-}+{-# SPECIALISE invertFunction :: Semiring b => (Natural -> b) -> ArithmeticFunction Natural Natural -> ([(Prime Natural, Word)] -> [PrimePowers Natural]) -> Natural -> b #-}++-- | The inverse for 'totient' function.+--+-- The return value is parameterized by a 'Semiring', which allows+-- various applications by providing different (multiplicative) embeddings.+-- E. g., list all preimages (see a helper 'asSetOfPreimages'):+--+-- >>> import qualified Data.Set as S+-- >>> import Data.Semigroup+-- >>> S.mapMonotonic getProduct (inverseTotient (S.singleton . Product) 120)+-- fromList [143,155,175,183,225,231,244,248,286,308,310,350,366,372,396,450,462]+--+-- Count preimages:+--+-- >>> inverseTotient (const 1) 120+-- 17+--+-- Sum preimages:+--+-- >>> inverseTotient id 120+-- 4904+--+-- Find minimal and maximal preimages:+--+-- >>> unMinWord (inverseTotient MinWord 120)+-- 143+-- >>> unMaxWord (inverseTotient MaxWord 120)+-- 462+inverseTotient+  :: (Semiring b, Euclidean a, UniqueFactorisation a, Ord a)+  => (a -> b)+  -> a+  -> b+inverseTotient point = invertFunction point totientA invTotient+{-# SPECIALISE inverseTotient :: Semiring b => (Int -> b) -> Int -> b #-}+{-# SPECIALISE inverseTotient :: Semiring b => (Word -> b) -> Word -> b #-}+{-# SPECIALISE inverseTotient :: Semiring b => (Integer -> b) -> Integer -> b #-}+{-# SPECIALISE inverseTotient :: Semiring b => (Natural -> b) -> Natural -> b #-}++-- | The inverse for 'sigma' 1 function.+--+-- The return value is parameterized by a 'Semiring', which allows+-- various applications by providing different (multiplicative) embeddings.+-- E. g., list all preimages (see a helper 'asSetOfPreimages'):+--+-- >>> import qualified Data.Set as S+-- >>> import Data.Semigroup+-- >>> S.mapMonotonic getProduct (inverseSigma (S.singleton . Product) 120)+-- fromList [54,56,87,95]+--+-- Count preimages:+--+-- >>> inverseSigma (const 1) 120+-- 4+--+-- Sum preimages:+--+-- >>> inverseSigma id 120+-- 292+--+-- Find minimal and maximal preimages:+--+-- >>> unMinWord (inverseSigma MinWord 120)+-- 54+-- >>> unMaxWord (inverseSigma MaxWord 120)+-- 95+inverseSigma+  :: (Semiring b, Euclidean a, UniqueFactorisation a, Integral a)+  => (a -> b)+  -> a+  -> b+inverseSigma point = invertFunction point (sigmaA 1) invSigma+{-# SPECIALISE inverseSigma :: Semiring b => (Int -> b) -> Int -> b #-}+{-# SPECIALISE inverseSigma :: Semiring b => (Word -> b) -> Word -> b #-}+{-# SPECIALISE inverseSigma :: Semiring b => (Integer -> b) -> Integer -> b #-}+{-# SPECIALISE inverseSigma :: Semiring b => (Natural -> b) -> Natural -> b #-}++--------------------------------------------------------------------------------+-- Wrappers++-- | Wrapper to use in conjunction with 'inverseTotient' and 'inverseSigma'.+-- Extracts the maximal preimage of function.+newtype MaxWord = MaxWord { unMaxWord :: Word }+  deriving (Eq, Ord, Show)++instance Semiring MaxWord where+  zero = MaxWord minBound+  one  = MaxWord 1+  plus  (MaxWord a) (MaxWord b) = MaxWord (a `max` b)+  times (MaxWord a) (MaxWord b) = MaxWord (a * b)++-- | Wrapper to use in conjunction with 'inverseTotient' and 'inverseSigma'.+-- Extracts the minimal preimage of function.+newtype MinWord = MinWord { unMinWord :: Word }+  deriving (Eq, Ord, Show)++instance Semiring MinWord where+  zero = MinWord maxBound+  one  = MinWord 1+  plus  (MinWord a) (MinWord b) = MinWord (a `min` b)+  times (MinWord a) (MinWord b) = MinWord (a * b)++-- | Wrapper to use in conjunction with 'inverseTotient' and 'inverseSigma'.+-- Extracts the maximal preimage of function.+newtype MaxNatural = MaxNatural { unMaxNatural :: Natural }+  deriving (Eq, Ord, Show)++instance Semiring MaxNatural where+  zero = MaxNatural 0+  one  = MaxNatural 1+  plus  (MaxNatural a) (MaxNatural b) = MaxNatural (a `max` b)+  times (MaxNatural a) (MaxNatural b) = MaxNatural (a * b)++-- | Wrapper to use in conjunction with 'inverseTotient' and 'inverseSigma'.+-- Extracts the minimal preimage of function.+data MinNatural+  = MinNatural { unMinNatural :: !Natural }+  | Infinity+  deriving (Eq, Ord, Show)++instance Semiring MinNatural where+  zero = Infinity+  one  = MinNatural 1++  plus a b = a `min` b++  times Infinity _ = Infinity+  times _ Infinity = Infinity+  times (MinNatural a) (MinNatural b) = MinNatural (a * b)++-- | Helper to extract a set of preimages for 'inverseTotient' or 'inverseSigma'.+asSetOfPreimages+  :: (Euclidean a, Integral a)+  => (forall b. Semiring b => (a -> b) -> a -> b)+  -> a+  -> S.Set a+asSetOfPreimages f = S.mapMonotonic getProduct . f (S.singleton . Product)

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2018 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Values of <https://en.wikipedia.org/wiki/Mertens_function Mertens function>. --

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2018 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Values of <https://en.wikipedia.org/wiki/Möbius_function Möbius function>. --@@ -38,15 +36,16 @@ import GHC.Integer.GMP.Internals import Unsafe.Coerce -import Math.NumberTheory.Primes (primes) import Math.NumberTheory.Powers.Squares (integerSquareRoot)+import Math.NumberTheory.Primes (unPrime)+import Math.NumberTheory.Primes.Sieve (primes) import Math.NumberTheory.Utils.FromIntegral (wordToInt)  import Math.NumberTheory.Logarithms  -- | Represents three possible values of <https://en.wikipedia.org/wiki/Möbius_function Möbius function>. data Moebius-  = MoebiusN -- ^ −1+  = MoebiusN -- ^ -1   | MoebiusZ -- ^  0   | MoebiusP -- ^  1   deriving (Eq, Ord, Show)@@ -127,7 +126,7 @@ -- 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]+-- [MoebiusP,MoebiusN,MoebiusN,MoebiusZ,MoebiusN,MoebiusP,MoebiusN,MoebiusZ,MoebiusZ,MoebiusP] sieveBlockMoebius   :: Word   -> Word@@ -162,7 +161,7 @@     -- Bit fiddling in 'mapper' is correct only     -- if all sufficiently small (<= 191) primes has been sieved out.     ps :: [Int]-    ps = takeWhile (<= (191 `max` integerSquareRoot highIndex)) $ map fromInteger primes+    ps = takeWhile (<= (191 `max` integerSquareRoot highIndex)) $ map unPrime primes      mapper :: Int -> Word8 -> Word8     mapper ix val

@@ -0,0 +1,160 @@+-- |+-- Module:      Math.NumberTheory.ArithmeticFunctions.NFreedom+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+--+-- N-free number generation.+--++{-# LANGUAGE ScopedTypeVariables #-}++module Math.NumberTheory.ArithmeticFunctions.NFreedom+  ( nFrees+  , nFreesBlock+  , sieveBlockNFree+  ) where++import Control.Monad                         (forM_)+import Control.Monad.ST                      (runST)+import Data.List                             (scanl')+import qualified Data.Vector.Unboxed         as U+import qualified Data.Vector.Unboxed.Mutable as MU++import Math.NumberTheory.Powers.Squares      (integerSquareRoot)+import Math.NumberTheory.Primes              (unPrime)+import Math.NumberTheory.Primes.Sieve        (primes)+import Math.NumberTheory.Utils.FromIntegral  (wordToInt)++-- | Evaluate the `Math.NumberTheory.ArithmeticFunctions.isNFree` function over a block.+-- Value at @0@, if zero falls into block, is undefined.+--+-- This function should __**not**__ be used with a negative lower bound.+-- If it is, the result is undefined.+-- Furthermore, do not:+--+-- * use a block length greater than @maxBound :: Int@.+-- * use a power that is either of @0, 1@.+--+-- None of these preconditions are checked, and if any occurs, the result is+-- undefined, __if__ the function terminates.+--+-- >>> sieveBlockNFree 2 1 10+-- [True,True,True,False,True,True,True,False,False,True]+sieveBlockNFree+  :: forall a . Integral a+  => Word+  -- ^ Power whose @n@-freedom will be checked.+  -> a+  -- ^ Lower index of the block.+  -> Word+  -- ^ Length of the block.+  -> U.Vector Bool+  -- ^ Vector of flags, where @True@ at index @i@ means the @i@-th element of+  -- the block is @n@-free.+sieveBlockNFree _ _ 0 = U.empty+sieveBlockNFree n lowIndex len'+  = runST $ do+    as <- MU.replicate (wordToInt len') True+    forM_ ps $ \p -> do+      let pPow :: a+          pPow = p ^ n+          offset :: a+          offset = negate lowIndex `mod` pPow+          -- The second argument in @Data.Vector.Unboxed.Mutable.write@ is an+          -- @Int@, so to avoid segmentation faults or out-of-bounds errors,+          -- the enumeration's higher bound must always be less than+          -- @maxBound :: Int@.+          -- As mentioned above, this is not checked when using this function+          -- by itself, but is carefully managed when this function is called+          -- by @nFrees@, see the comments in it.+          indices :: [a]+          indices = [offset, offset + pPow .. len - 1]+      forM_ indices $ \ix -> do+          MU.write as (fromIntegral ix) False+    U.freeze as++  where+    len :: a+    len = fromIntegral len'++    highIndex :: a+    highIndex = lowIndex + len - 1++    ps :: [a]+    ps = takeWhile (<= integerSquareRoot highIndex) $ map unPrime primes++-- | For a given nonnegative integer power @n@, generate all @n@-free+-- numbers in ascending order, starting at @1@.+--+-- When @n@ is @0@ or @1@, the resulting list is @[1]@.+nFrees+    :: forall a. Integral a+    => Word+    -- ^ Power @n@ to be used to generate @n@-free numbers.+    -> [a]+    -- ^ Generated infinite list of @n@-free numbers.+nFrees 0 = [1]+nFrees 1 = [1]+nFrees n = concatMap (\(lo, len) -> nFreesBlock n lo len) $ zip bounds strides+  where+    -- The 56th element of @iterate (2 *) 256@ is @2^64 :: Word == 0@, so to+    -- avoid overflow only the first 55 elements of this list are used.+    -- After those, since @maxBound :: Int@ is the largest a vector can be,+    -- this value is just repeated. This means after a few dozen iterations,+    -- the sieve will stop increasing in size.+    strides :: [Word]+    strides = take 55 (iterate (2 *) 256) ++ repeat (fromIntegral (maxBound :: Int))++    -- Infinite list of lower bounds at which @sieveBlockNFree@ will be+    -- applied. This has type @Integral a => a@ instead of @Word@ because+    -- unlike the sizes of the sieve that eventually stop increasing (see+    -- above comment), the lower bound at which @sieveBlockNFree@ is called does not.+    bounds :: [a]+    bounds = scanl' (+) 1 $ map fromIntegral strides++-- | Generate @n@-free numbers in a block starting at a certain value.+-- The length of the list is determined by the value passed in as the third+-- argument. It will be lesser than or equal to this value.+--+-- This function should not be used with a negative lower bound. If it is,+-- the result is undefined.+--+-- The block length cannot exceed @maxBound :: Int@, this precondition is not+-- checked.+--+-- As with @nFrees@, passing @n = 0, 1@ results in an empty list.+nFreesBlock+    :: forall a . Integral a+    => Word+    -- ^ Power @n@ to be used to generate @n@-free numbers.+    -> a+    -- ^ Starting number in the block.+    -> Word+    -- ^ Maximum length of the block to be generated.+    -> [a]+    -- ^ Generated list of @n@-free numbers.+nFreesBlock 0 lo _ = help lo+nFreesBlock 1 lo _ = help lo+nFreesBlock n lowIndex len =+    let -- When indexing the array of flags @bs@, the index has to be an+        -- @Int@. As such, it's necessary to cast @strd@ twice.+        -- * Once, immediately below, to create the range of values whose+        -- @n@-freedom will be tested. Since @nFrees@ has return type+        -- @[a]@, this cannot be avoided as @strides@ has type @[Word]@.+        len' :: Int+        len' = wordToInt len+        -- * Twice, immediately below, to create the range of indices with+        -- which to query @bs@.+        len'' :: a+        len'' = fromIntegral len+        bs  = sieveBlockNFree n lowIndex len+    in map snd .+       filter ((bs U.!) . fst) .+       zip [0 .. len' - 1] $ [lowIndex .. lowIndex + len'']+{-# INLINE nFreesBlock #-}++help :: Integral a => a -> [a]+help 1 = [1]+help _ = []+{-# INLINE help #-}

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Bulk evaluation of arithmetic functions over continuous intervals -- without factorisation.@@ -37,7 +35,7 @@ import Math.NumberTheory.ArithmeticFunctions.Moebius (sieveBlockMoebius) import Math.NumberTheory.ArithmeticFunctions.SieveBlock.Unboxed import Math.NumberTheory.Logarithms (integerLogBase')-import Math.NumberTheory.Primes (primes)+import Math.NumberTheory.Primes.Sieve (primes) import Math.NumberTheory.Primes.Types import Math.NumberTheory.Powers.Squares (integerSquareRoot) import Math.NumberTheory.Utils (splitOff#)@@ -55,6 +53,7 @@ -- -- This is a thin wrapper over 'sieveBlock', read more details there. --+-- >>> import Math.NumberTheory.ArithmeticFunctions -- >>> runFunctionOverBlock carmichaelA 1 10 -- [1,1,2,2,4,2,6,2,6,4] runFunctionOverBlock@@ -79,12 +78,12 @@ -- -- For example, following code lists smallest prime factors: ----- >>> sieveBlock (SieveBlockConfig maxBound (\p _ -> p) min) 2 10+-- >>> sieveBlock (SieveBlockConfig maxBound (\p _ -> unPrime 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+-- >>> sieveBlock (SieveBlockConfig [] (\p k -> [(unPrime 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@@ -107,7 +106,7 @@         highIndex = lowIndex + len - 1          ps :: [Int]-        ps = takeWhile (<= integerSquareRoot highIndex) $ map fromInteger primes+        ps = takeWhile (<= integerSquareRoot highIndex) $ map unPrime primes      forM_ ps $ \p -> do @@ -116,7 +115,7 @@            fs = V.generate             (integerLogBase' (toInteger p) (toInteger highIndex))-            (\k -> f p' (intToWord k + 1))+            (\k -> f (Prime p') (intToWord k + 1))            offset :: Int           offset = negate lowIndex `mod` p@@ -125,10 +124,10 @@         W# a# <- MV.unsafeRead as ix         let !(# pow#, a'# #) = splitOff# p# (a# `quotWord#` p#)         MV.unsafeWrite as ix (W# a'#)-        MV.unsafeModify bs (\y -> y `append` V.unsafeIndex fs (I# pow#)) ix+        MV.unsafeModify bs (\y -> y `append` V.unsafeIndex fs (I# (word2Int# pow#))) ix      forM_ [0 .. len - 1] $ \k -> do       a <- MV.unsafeRead as k-      MV.unsafeModify bs (\b -> if a /= 1 then b `append` f a 1 else b) k+      MV.unsafeModify bs (\b -> if a /= 1 then b `append` f (Prime a) 1 else b) k      V.unsafeFreeze bs

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Bulk evaluation of arithmetic functions without factorisation -- of arguments.@@ -30,7 +28,8 @@  import Math.NumberTheory.ArithmeticFunctions.Moebius (Moebius) import Math.NumberTheory.Logarithms (integerLogBase')-import Math.NumberTheory.Primes (primes)+import Math.NumberTheory.Primes.Sieve (primes)+import Math.NumberTheory.Primes.Types (Prime(..)) import Math.NumberTheory.Powers.Squares (integerSquareRoot) import Math.NumberTheory.Utils (splitOff#) import Math.NumberTheory.Utils.FromIntegral (wordToInt, intToWord)@@ -41,20 +40,20 @@ -- -- > SieveBlockConfig -- >   { sbcEmpty                = 1--- >   , sbcFunctionOnPrimePower = (\p a -> (p - 1) * p ^ (a - 1)+-- >   , sbcFunctionOnPrimePower = \p a -> (unPrime p - 1) * unPrime p ^ (a - 1) -- >   , sbcAppend               = (*) -- >   } data SieveBlockConfig a = SieveBlockConfig   { sbcEmpty                :: a     -- ^ value of a function on 1-  , sbcFunctionOnPrimePower :: Word -> Word -> a+  , sbcFunctionOnPrimePower :: Prime Word -> Word -> a     -- ^ how to evaluate a function on prime powers   , sbcAppend               :: a -> a -> a     -- ^ how to combine values of a function on coprime arguments   }  -- | Create a config for a multiplicative function from its definition on prime powers.-multiplicativeSieveBlockConfig :: Num a => (Word -> Word -> a) -> SieveBlockConfig a+multiplicativeSieveBlockConfig :: Num a => (Prime Word -> Word -> a) -> SieveBlockConfig a multiplicativeSieveBlockConfig f = SieveBlockConfig   { sbcEmpty                = 1   , sbcFunctionOnPrimePower = f@@ -62,7 +61,7 @@   }  -- | Create a config for an additive function from its definition on prime powers.-additiveSieveBlockConfig :: Num a => (Word -> Word -> a) -> SieveBlockConfig a+additiveSieveBlockConfig :: Num a => (Prime Word -> Word -> a) -> SieveBlockConfig a additiveSieveBlockConfig f = SieveBlockConfig   { sbcEmpty                = 0   , sbcFunctionOnPrimePower = f@@ -74,7 +73,7 @@ -- -- Based on Algorithm M of <https://arxiv.org/pdf/1305.1639.pdf Parity of the number of primes in a given interval and algorithms of the sublinear summation> by A. V. Lelechenko. See Lemma 2 on p. 5 on its algorithmic complexity. For the majority of use-cases its time complexity is O(x^(1+ε)). ----- For example, here is an analogue of divisor function 'tau':+-- For example, here is an analogue of divisor function 'Math.NumberTheory.ArithmeticFunctions.tau': -- -- >>> sieveBlockUnboxed (SieveBlockConfig 1 (\_ a -> a + 1) (*)) 1 10 -- [1,2,2,3,2,4,2,4,3,4]@@ -100,7 +99,7 @@         highIndex = lowIndex + len - 1          ps :: [Int]-        ps = takeWhile (<= integerSquareRoot highIndex) $ map fromInteger primes+        ps = takeWhile (<= integerSquareRoot highIndex) $ map unPrime primes      forM_ ps $ \p -> do @@ -109,7 +108,7 @@            fs = V.generate             (integerLogBase' (toInteger p) (toInteger highIndex))-            (\k -> f p' (intToWord k + 1))+            (\k -> f (Prime p') (intToWord k + 1))            offset :: Int           offset = negate lowIndex `mod` p@@ -118,11 +117,11 @@         W# a# <- MV.unsafeRead as ix         let !(# pow#, a'# #) = splitOff# p# (a# `quotWord#` p#)         MV.unsafeWrite as ix (W# a'#)-        MV.unsafeModify bs (\y -> y `append` V.unsafeIndex fs (I# pow#)) ix+        MV.unsafeModify bs (\y -> y `append` V.unsafeIndex fs (I# (word2Int# pow#))) ix      forM_ [0 .. len - 1] $ \k -> do       a <- MV.unsafeRead as k-      MV.unsafeModify bs (\b -> if a /= 1 then b `append` f a 1 else b) k+      MV.unsafeModify bs (\b -> if a /= 1 then b `append` f (Prime a) 1 else b) k      V.unsafeFreeze bs 

@@ -3,26 +3,19 @@ -- Copyright:   (c) 2016 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Textbook arithmetic functions. -- -{-# LANGUAGE CPP                 #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE ViewPatterns        #-} -{-# OPTIONS_HADDOCK hide #-}- module Math.NumberTheory.ArithmeticFunctions.Standard   ( -- * Multiplicative functions     multiplicative   , divisors, divisorsA   , divisorsList, divisorsListA   , divisorsSmall, divisorsSmallA-  , tau, tauA+  , divisorCount, tau, tauA   , sigma, sigmaA   , totient, totientA   , jordan, jordanA@@ -36,6 +29,7 @@     -- * Misc   , carmichael, carmichaelA   , expMangoldt, expMangoldtA+  , isNFree, isNFreeA, nFrees, nFreesBlock   ) where  import Data.Coerce@@ -47,7 +41,8 @@  import Math.NumberTheory.ArithmeticFunctions.Class import Math.NumberTheory.ArithmeticFunctions.Moebius-import Math.NumberTheory.UniqueFactorisation+import Math.NumberTheory.ArithmeticFunctions.NFreedom (nFrees, nFreesBlock)+import Math.NumberTheory.Primes import Math.NumberTheory.Utils.FromIntegral  import Numeric.Natural@@ -56,14 +51,15 @@ multiplicative :: Num a => (Prime n -> Word -> a) -> ArithmeticFunction n a multiplicative f = ArithmeticFunction ((Product .) . f) getProduct -divisors :: (UniqueFactorisation n, Num n, Ord n) => n -> Set n+-- | See 'divisorsA'.+divisors :: (UniqueFactorisation n, Ord n) => n -> Set n divisors = runFunction divisorsA {-# SPECIALIZE divisors :: Natural -> Set Natural #-} {-# SPECIALIZE divisors :: Integer -> Set Integer #-}  -- | The set of all (positive) divisors of an argument.-divisorsA :: forall n. (UniqueFactorisation n, Num n, Ord n) => ArithmeticFunction n (Set n)-divisorsA = ArithmeticFunction (\((unPrime :: Prime n -> n) -> p) k -> SetProduct $ divisorsHelper p k) (S.insert 1 . getSetProduct)+divisorsA :: (UniqueFactorisation n, Ord n) => ArithmeticFunction n (Set n)+divisorsA = ArithmeticFunction (\p -> SetProduct . divisorsHelper (unPrime p)) (S.insert 1 . getSetProduct)  divisorsHelper :: Num n => n -> Word -> Set n divisorsHelper _ 0 = S.empty@@ -71,12 +67,13 @@ divisorsHelper p a = S.fromDistinctAscList $ p : p * p : map (p ^) [3 .. wordToInt a] {-# INLINE divisorsHelper #-} -divisorsList :: (UniqueFactorisation n, Num n) => n -> [n]+-- | See 'divisorsListA'.+divisorsList :: UniqueFactorisation n => n -> [n] divisorsList = runFunction divisorsListA  -- | The unsorted list of all (positive) divisors of an argument, produced in lazy fashion.-divisorsListA :: forall n. (UniqueFactorisation n, Num n) => ArithmeticFunction n [n]-divisorsListA = ArithmeticFunction (\((unPrime :: Prime n -> n) -> p) k -> ListProduct $ divisorsListHelper p k) ((1 :) . getListProduct)+divisorsListA :: UniqueFactorisation n => ArithmeticFunction n [n]+divisorsListA = ArithmeticFunction (\p -> ListProduct . divisorsListHelper (unPrime p)) ((1 :) . getListProduct)  divisorsListHelper :: Num n => n -> Word -> [n] divisorsListHelper _ 0 = []@@ -84,12 +81,13 @@ divisorsListHelper p a = p : p * p : map (p ^) [3 .. wordToInt a] {-# INLINE divisorsListHelper #-} -divisorsSmall :: (UniqueFactorisation n, Prime n ~ Prime Int) => n -> IntSet+-- | See 'divisorsSmallA'.+divisorsSmall :: Int -> IntSet divisorsSmall = runFunction divisorsSmallA  -- | Same as 'divisors', but with better performance on cost of type restriction.-divisorsSmallA :: forall n. (Prime n ~ Prime Int) => ArithmeticFunction n IntSet-divisorsSmallA = ArithmeticFunction (\p k -> IntSetProduct $ divisorsHelperSmall (unPrime p) k) (IS.insert 1 . getIntSetProduct)+divisorsSmallA :: ArithmeticFunction Int IntSet+divisorsSmallA = ArithmeticFunction (\p -> IntSetProduct . divisorsHelperSmall (unPrime p)) (IS.insert 1 . getIntSetProduct)  divisorsHelperSmall :: Int -> Word -> IntSet divisorsHelperSmall _ 0 = IS.empty@@ -97,6 +95,14 @@ divisorsHelperSmall p a = IS.fromDistinctAscList $ p : p * p : map (p ^) [3 .. wordToInt a] {-# INLINE divisorsHelperSmall #-} +-- | Synonym for 'tau'.+--+-- >>> map divisorCount [1..10]+-- [1,2,2,3,2,4,2,4,3,4]+divisorCount :: (UniqueFactorisation n, Num a) => n -> a+divisorCount = tau++-- | See 'tauA'. tau :: (UniqueFactorisation n, Num a) => n -> a tau = runFunction tauA @@ -106,6 +112,7 @@ tauA :: Num a => ArithmeticFunction n a tauA = multiplicative $ const (fromIntegral . succ) +-- | See 'sigmaA'. sigma :: (UniqueFactorisation n, Integral n) => Word -> n -> n sigma = runFunction . sigmaA @@ -113,10 +120,10 @@ -- -- > sigmaA = multiplicative (\p k -> sum $ map (p ^) [0..k]) -- > sigmaA 0 = tauA-sigmaA :: forall n. (UniqueFactorisation n, Integral n) => Word -> ArithmeticFunction n n+sigmaA :: (UniqueFactorisation n, Integral n) => Word -> ArithmeticFunction n n sigmaA 0 = tauA-sigmaA 1 = multiplicative $ \((unPrime :: Prime n -> n) -> p) -> sigmaHelper p-sigmaA a = multiplicative $ \((unPrime :: Prime n -> n) -> p) -> sigmaHelper (p ^ wordToInt a)+sigmaA 1 = multiplicative $ sigmaHelper . unPrime+sigmaA a = multiplicative $ sigmaHelper . (^ wordToInt a) . unPrime  sigmaHelper :: Integral n => n -> Word -> n sigmaHelper pa 1 = pa + 1@@ -124,25 +131,27 @@ sigmaHelper pa k = (pa ^ wordToInt (k + 1) - 1) `quot` (pa - 1) {-# INLINE sigmaHelper #-} -totient :: (UniqueFactorisation n, Num n) => n -> n+-- | See 'totientA'.+totient :: UniqueFactorisation n => n -> n totient = runFunction totientA  -- | Calculates the totient of a positive number @n@, i.e. --   the number of @k@ with @1 <= k <= n@ and @'gcd' n k == 1@, --   in other words, the order of the group of units in @&#8484;/(n)@.-totientA :: forall n. (UniqueFactorisation n, Num n) => ArithmeticFunction n n-totientA = multiplicative $ \((unPrime :: Prime n -> n) -> p) -> jordanHelper p+totientA :: UniqueFactorisation n => ArithmeticFunction n n+totientA = multiplicative $ jordanHelper . unPrime -jordan :: (UniqueFactorisation n, Num n) => Word -> n -> n+-- | See 'jordanA'.+jordan :: UniqueFactorisation n => Word -> n -> n jordan = runFunction . jordanA  -- | Calculates the k-th Jordan function of an argument. -- -- > jordanA 1 = totientA-jordanA :: forall n. (UniqueFactorisation n, Num n) => Word -> ArithmeticFunction n n+jordanA :: UniqueFactorisation n => Word -> ArithmeticFunction n n jordanA 0 = multiplicative $ \_ _ -> 0 jordanA 1 = totientA-jordanA a = multiplicative $ \((unPrime :: Prime n -> n) -> p) -> jordanHelper (p ^ wordToInt a)+jordanA a = multiplicative $ jordanHelper . (^ wordToInt a) . unPrime  jordanHelper :: Num n => n -> Word -> n jordanHelper pa 1 = pa - 1@@ -150,13 +159,14 @@ jordanHelper pa k = (pa - 1) * pa ^ wordToInt (k - 1) {-# INLINE jordanHelper #-} +-- | See 'ramanujanA'. 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+ramanujanA = multiplicative $ ramanujanHelper . unPrime  ramanujanHelper :: Integer -> Word -> Integer ramanujanHelper _ 0 = 1@@ -171,6 +181,7 @@         tpPowers = reverse $ take (length binomials) $ iterate (* tp^(2::Int)) (if even k then 1 else tp) {-# INLINE ramanujanHelper #-} +-- | See 'moebiusA'. moebius :: UniqueFactorisation n => n -> Moebius moebius = runFunction moebiusA @@ -182,6 +193,7 @@     f 0 = MoebiusP     f _ = MoebiusZ +-- | See 'liouvilleA'. liouville :: (UniqueFactorisation n, Num a) => n -> a liouville = runFunction liouvilleA @@ -189,16 +201,18 @@ liouvilleA :: Num a => ArithmeticFunction n a liouvilleA = ArithmeticFunction (const $ Xor . odd) runXor +-- | See 'carmichaelA'. carmichael :: (UniqueFactorisation n, Integral n) => n -> n carmichael = runFunction carmichaelA-{- The specializations reflects available specializations of lcm. -}-{-# SPECIALIZE carmichael :: Int -> Int #-}+{-# SPECIALIZE carmichael :: Int     -> Int #-}+{-# SPECIALIZE carmichael :: Word    -> Word #-} {-# SPECIALIZE carmichael :: Integer -> Integer #-}+{-# SPECIALIZE carmichael :: Natural -> Natural #-}  -- | Calculates the Carmichael function for a positive integer, that is, --   the (smallest) exponent of the group of units in @&#8484;/(n)@.-carmichaelA :: forall n. (UniqueFactorisation n, Integral n) => ArithmeticFunction n n-carmichaelA = ArithmeticFunction (\((unPrime :: Prime n -> n) -> p) k -> LCM $ f p k) getLCM+carmichaelA :: (UniqueFactorisation n, Integral n) => ArithmeticFunction n n+carmichaelA = ArithmeticFunction (\p -> LCM . f (unPrime p)) getLCM   where     f 2 1 = 1     f 2 2 = 2@@ -211,6 +225,7 @@ additive :: Num a => (Prime n -> Word -> a) -> ArithmeticFunction n a additive f = ArithmeticFunction ((Sum .) . f) getSum +-- | See 'smallOmegaA'. smallOmega :: (UniqueFactorisation n, Num a) => n -> a smallOmega = runFunction smallOmegaA @@ -220,6 +235,7 @@ smallOmegaA :: Num a => ArithmeticFunction n a smallOmegaA = additive (\_ _ -> 1) +-- | See 'bigOmegaA'. bigOmega :: UniqueFactorisation n => n -> Word bigOmega = runFunction bigOmegaA @@ -229,12 +245,13 @@ bigOmegaA :: ArithmeticFunction n Word bigOmegaA = additive $ const id -expMangoldt :: (UniqueFactorisation n, Num n) => n -> n+-- | See 'expMangoldtA'.+expMangoldt :: UniqueFactorisation n => n -> n expMangoldt = runFunction expMangoldtA  -- | The exponent of von Mangoldt function. Use @log expMangoldtA@ to recover von Mangoldt function itself.-expMangoldtA :: forall n. (UniqueFactorisation n, Num n) => ArithmeticFunction n n-expMangoldtA = ArithmeticFunction (\((unPrime :: Prime n -> n) -> p) _ -> MangoldtOne p) runMangoldt+expMangoldtA :: UniqueFactorisation n => ArithmeticFunction n n+expMangoldtA = ArithmeticFunction (const . MangoldtOne . unPrime) runMangoldt  data Mangoldt a   = MangoldtZero@@ -255,6 +272,16 @@ instance Monoid (Mangoldt a) where   mempty  = MangoldtZero   mappend = (<>)++-- | See 'isNFreeA'.+isNFree :: UniqueFactorisation n => Word -> n -> Bool+isNFree n = runFunction (isNFreeA n)++-- | Check if an integer is @n@-free. An integer @x@ is @n@-free if in its+-- factorisation into prime factors, no factor has an exponent larger than or+-- equal to @n@.+isNFreeA :: Word -> ArithmeticFunction n Bool+isNFreeA n = ArithmeticFunction (\_ pow -> All $ pow < n) getAll  newtype LCM a = LCM { getLCM :: a } 

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Arithmetic on Montgomery elliptic curve. --@@ -56,9 +54,11 @@   , pointZ :: !Integer -- ^ Extract z-coordinate.   } +-- | Extract (a + 2) \/ 4, where a is a coefficient in curve's equation. pointA24 :: forall a24 n. KnownNat a24 => Point a24 n -> Integer pointA24 _ = toInteger $ natVal (Proxy :: Proxy a24) +-- | Extract modulo of the curve. pointN :: forall a24 n. KnownNat n => Point a24 n -> Integer pointN _ = toInteger $ natVal (Proxy :: Proxy n) 

@@ -3,8 +3,6 @@ -- 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. --@@ -63,7 +61,7 @@   lcm 0 _ =  0   lcm x y =  abs ((x `quot` (gcd x y)) * y) -  -- | Test whether two numbers are coprime .+  -- | Test whether two numbers are coprime.   coprime :: a -> a -> Bool   coprime x y = gcd x y == 1 @@ -102,7 +100,7 @@ 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.+-- | Wrapper around 'Integral', which has an 'Euclidean' instance. newtype WrappedIntegral a = WrappedIntegral { unWrappedIntegral :: a }   deriving (Eq, Ord, Show, Num, Integral, Real, Enum) @@ -153,6 +151,7 @@   -- https://ghc.haskell.org/trac/ghc/ticket/15350   -- extendedGCD = gcdExtInteger +-- | Beware that 'extendedGCD' does not make any sense for 'Natural'. instance Euclidean Natural where   quotRem = P.quotRem   divMod  = P.divMod

@@ -1,261 +0,0 @@--- |--- Module:      Math.NumberTheory.GCD--- Copyright:   (c) 2011 Daniel Fischer--- Licence:     MIT--- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions)------ This module exports GCD and coprimality test using the binary gcd algorithm--- and GCD with the extended Euclidean algorithm.------ Efficiently counting the number of trailing zeros, the binary gcd algorithm--- can perform considerably faster than the Euclidean algorithm on average.--- For 'Int', GHC has a rewrite rule to use GMP's fast gcd, depending on--- hardware and\/or GMP version, that can be faster or slower than the binary--- algorithm (on my 32-bit box, binary is faster, on my 64-bit box, GMP).--- For 'Word' and the sized @IntN\/WordN@ types, there is no rewrite rule (yet)--- in GHC, and the binary algorithm performs consistently (so far as my tests go)--- much better (if this module's rewrite rules fire).------ 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           #-}--{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_GHC -fno-warn-deprecations   #-}--module Math.NumberTheory.GCD-    ( binaryGCD-    , extendedGCD-    , coprime-    ) where--import Data.Bits-import Data.Semigroup--import GHC.Word-import GHC.Int--import Math.NumberTheory.GCD.LowLevel-import Math.NumberTheory.Utils--#include "MachDeps.h"--{-# RULES-"binaryGCD/Int"     binaryGCD = gcdInt-"binaryGCD/Word"    binaryGCD = gcdWord-"binaryGCD/Int8"    binaryGCD = gi8-"binaryGCD/Int16"   binaryGCD = gi16-"binaryGCD/Int32"   binaryGCD = gi32-"binaryGCD/Word8"   binaryGCD = gw8-"binaryGCD/Word16"  binaryGCD = gw16-"binaryGCD/Word32"  binaryGCD = gw32-  #-}-#if WORD_SIZE_IN_BITS == 64-gi64 :: Int64 -> Int64 -> Int64-gi64 (I64# x#) (I64# y#) = I64# (gcdInt# x# y#)--gw64 :: Word64 -> Word64 -> Word64-gw64 (W64# x#) (W64# y#) = W64# (gcdWord# x# y#)--{-# RULES-"binaryGCD/Int64"   binaryGCD = gi64-"binaryGCD/Word64"  binaryGCD = gw64-  #-}-#endif-{-# INLINE [1] binaryGCD #-}--- | Calculate the greatest common divisor using the binary gcd algorithm.---   Depending on type and hardware, that can be considerably faster than---   @'Prelude.gcd'@ but it may also be significantly slower.------   There are specialised functions for @'Int'@ and @'Word'@ and rewrite rules---   for those and @IntN@ and @WordN@, @N <= WORD_SIZE_IN_BITS@, to use the---   specialised variants. These types are worth benchmarking, others probably not.------   It is very slow for 'Integer' (and probably every type except the abovementioned),---   I recommend not using it for those.------   Relies on twos complement or sign and magnitude representaion for signed types.-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 #-}-#endif-{-# SPECIALISE binaryGCDImpl :: Integer -> Integer -> Integer #-}-binaryGCDImpl :: (Integral a, Bits a) => a -> a -> a-binaryGCDImpl a 0 = abs a-binaryGCDImpl 0 b = abs b-binaryGCDImpl a b =-    case shiftToOddCount a' of-      (!za, !oa) ->-        case shiftToOddCount b' of-          (!zb, !ob) -> gcdOdd (abs oa) (abs ob) `shiftL` min za zb-    where-      a' = abs a-      b' = abs b--{-# SPECIALISE extendedGCD :: Int -> Int -> (Int, Int, Int),-                              Word -> Word -> (Word, Word, Word),-                              Integer -> Integer -> (Integer, Integer, Integer)-  #-}--- | 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 :: Integral a => a -> a -> (a, a, a)-extendedGCD a b = (d, u, v)-  where-    (d, x, y) = eGCD 0 1 1 0 (abs a) (abs b)-    u | a < 0     = negate x-      | otherwise = x-    v | b < 0     = negate y-      | otherwise = y-    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-{-# DEPRECATED extendedGCD "Use 'Math.NumberTheory.Euclidean.extendedGCD'" #-}--{-# RULES-"coprime/Int"       coprime = coprimeInt-"coprime/Word"      coprime = coprimeWord-"coprime/Int8"      coprime = ci8-"coprime/Int16"     coprime = ci16-"coprime/Int32"     coprime = ci32-"coprime/Word8"     coprime = cw8-"coprime/Word16"    coprime = cw16-"coprime/Word32"    coprime = cw32-  #-}-#if WORD_SIZE_IN_BITS == 64-ci64 :: Int64 -> Int64 -> Bool-ci64 (I64# x#) (I64# y#) = coprimeInt# x# y#--cw64 :: Word64 -> Word64 -> Bool-cw64 (W64# x#) (W64# y#) = coprimeWord# x# y#--{-# RULES-"coprime/Int64"     coprime = ci64-"coprime/Word64"    coprime = cw64-  #-}-#endif-{-# INLINE [1] coprime #-}--- | Test whether two numbers are coprime using an abbreviated binary gcd algorithm.---   A little bit faster than checking @binaryGCD a b == 1@ if one of the arguments---   is even, much faster if both are even.------   The remarks about performance at 'binaryGCD' apply here too, use this function---   only at the types with rewrite rules.------   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-#if WORD_SIZE_IN_BITS < 64-{-# SPECIALISE coprimeImpl :: Word64 -> Word64 -> Bool,-                              Int64 -> Int64 -> Bool #-}-#endif-{-# SPECIALISE coprimeImpl :: Integer -> Integer -> Bool #-}-coprimeImpl :: (Integral a, Bits a) => a -> a -> Bool-coprimeImpl a b =-  (a' == 1 || b' == 1)-  || (a' /= 0 && b' /= 0 && ((a .|. b) .&. 1) == 1-      && gcdOdd (abs (shiftToOdd a')) (abs (shiftToOdd b')) == 1)-    where-      a' = abs a-      b' = abs b---- Auxiliaries---- gcd of two odd numbers-{-# INLINE gcdOdd #-}-gcdOdd :: (Integral a, Bits a) => a -> a -> a-gcdOdd a b-  | a == 1 || b == 1    = 1-  | a < b               = oddGCD b a-  | a > b               = oddGCD a b-  | otherwise           = a--{-# SPECIALISE oddGCD :: Integer -> Integer -> Integer #-}-#if WORD_SIZE_IN_BITS < 64-{-# SPECIALISE oddGCD :: Int64 -> Int64 -> Int64,-                         Word64 -> Word64 -> Word64-  #-}-#endif-oddGCD :: (Integral a, Bits a) => a -> a -> a-oddGCD a b =-    case shiftToOdd (a-b) of-      1 -> 1-      c | c < b     -> oddGCD b c-        | c > b     -> oddGCD c b-        | otherwise -> c------------------------------------------------------------------------------------                Blech! Getting the rules to fire isn't easy.               ------------------------------------------------------------------------------------gi8 :: Int8 -> Int8 -> Int8-gi8 (I8# x#) (I8# y#) = I8# (gcdInt# x# y#)--gi16 :: Int16 -> Int16 -> Int16-gi16 (I16# x#) (I16# y#) = I16# (gcdInt# x# y#)--gi32 :: Int32 -> Int32 -> Int32-gi32 (I32# x#) (I32# y#) = I32# (gcdInt# x# y#)--gw8 :: Word8 -> Word8 -> Word8-gw8 (W8# x#) (W8# y#) = W8# (gcdWord# x# y#)--gw16 :: Word16 -> Word16 -> Word16-gw16 (W16# x#) (W16# y#) = W16# (gcdWord# x# y#)--gw32 :: Word32 -> Word32 -> Word32-gw32 (W32# x#) (W32# y#) = W32# (gcdWord# x# y#)--ci8 :: Int8 -> Int8 -> Bool-ci8 (I8# x#) (I8# y#) = coprimeInt# x# y#--ci16 :: Int16 -> Int16 -> Bool-ci16 (I16# x#) (I16# y#) = coprimeInt# x# y#--ci32 :: Int32 -> Int32 -> Bool-ci32 (I32# x#) (I32# y#) = coprimeInt# x# y#--cw8 :: Word8 -> Word8 -> Bool-cw8 (W8# x#) (W8# y#) = coprimeWord# x# y#--cw16 :: Word16 -> Word16 -> Bool-cw16 (W16# x#) (W16# y#) = coprimeWord# x# y#--cw32 :: Word32 -> Word32 -> Bool-cw32 (W32# x#) (W32# y#) = coprimeWord# x# y#

@@ -1,104 +0,0 @@--- |--- Module:      Math.NumberTheory.GCD.LowLevel--- Copyright:   (c) 2011 Daniel Fischer--- Licence:     MIT--- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions)------ Low level gcd and coprimality functions using the binary gcd algorithm.--- Normally, accessing these via the higher level interface of "Math.NumberTheory.GCD"--- should be sufficient.----{-# LANGUAGE MagicHash     #-}-{-# LANGUAGE UnboxedTuples #-}-module Math.NumberTheory.GCD.LowLevel-  ( -- * Specialised GCDs-    gcdInt-  , gcdWord-    -- ** GCDs for unboxed types-  , gcdInt#-  , gcdWord#-    -- * Specialised tests for coprimality-  , coprimeInt-  , coprimeWord-    -- ** Coprimality tests for unboxed types-  , coprimeInt#-  , coprimeWord#-  ) where--import GHC.Base--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#)---- | Test whether two 'Int's are coprime, using an abbreviated binary gcd algorithm.-coprimeInt :: Int -> Int -> Bool-coprimeInt (I# a#) (I# b#) = coprimeInt# a# b#---- | Greatest common divisor of two 'Word's, calculated with the binary gcd algorithm.-gcdWord :: Word -> Word -> Word-gcdWord (W# a#) (W# b#) = W# (gcdWord# a# b#)---- | Test whether two 'Word's are coprime, using an abbreviated binary gcd algorithm.-coprimeWord :: Word -> Word -> Bool-coprimeWord (W# a#) (W# b#) = coprimeWord# a# b#---- | Greatest common divisor of two 'Int#'s, calculated with the binary gcd algorithm.-gcdInt# :: Int# -> Int# -> Int#-gcdInt# a# b# = word2Int# (gcdWord# (int2Word# (absInt# a#)) (int2Word# (absInt# b#)))----- | Test whether two 'Int#'s are coprime.-coprimeInt# :: Int# -> Int# -> Bool-coprimeInt# a# b# = coprimeWord# (int2Word# (absInt# a#)) (int2Word# (absInt# b#))---- | Greatest common divisor of two 'Word#'s, calculated with the binary gcd algorithm.-gcdWord# :: Word# -> Word# -> Word#-gcdWord# a# 0## = a#-gcdWord# 0## b# = b#-gcdWord# a# b#  =-    case shiftToOddCount# a# of-      (# za#, oa# #) ->-        case shiftToOddCount# b# of-          (# zb#, ob# #) -> gcdWordOdd# oa# ob# `uncheckedShiftL#` (if isTrue# (za# <# zb#) then za# else zb#)---- | Test whether two 'Word#'s are coprime.-coprimeWord# :: Word# -> Word# -> Bool-coprimeWord# a# b# =-  (isTrue# (a# `eqWord#` 1##) || isTrue# (b# `eqWord#` 1##))-  || (isTrue# (((a# `or#` b#) `and#` 1##) `eqWord#` 1##) -- not both even-      && ((isTrue# (a# `neWord#` 0##) && isTrue# (b# `neWord#` 0##)) -- neither is zero-      && isTrue# (gcdWordOdd# (shiftToOdd# a#) (shiftToOdd# b#) `eqWord#` 1##)))---- Various auxiliary functions---- calculate the gcd of two odd numbers-{-# INLINE gcdWordOdd# #-}-gcdWordOdd# :: Word# -> Word# -> Word#-gcdWordOdd# a# b#-  | isTrue# (a# `eqWord#` 1##) || isTrue# (b# `eqWord#` 1##)    = 1##-  | isTrue# (a# `eqWord#` b#)                                   = a#-  | isTrue# (a# `ltWord#` b#)                                   = oddGCD# b# a#-  | otherwise                                                   = oddGCD# a# b#---- calculate the gcd of two odd numbers using the binary gcd algorithm--- Precondition: first argument strictly larger than second (which should be greater than 1)-oddGCD# :: Word# -> Word# -> Word#-oddGCD# a# b# =-    case shiftToOdd# (a# `minusWord#` b#) of-      1## -> 1##-      c#  | isTrue# (c# `ltWord#` b#)   -> oddGCD# b# c#-          | isTrue# (c# `gtWord#` b#)   -> oddGCD# c# b#-          | otherwise                   -> c#--absInt# :: Int# -> Int#-absInt# i#-  | isTrue# (i# <# 0#)  = negateInt# i#-  | otherwise           = i#

@@ -1,18 +0,0 @@--- |--- 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.-----module Math.NumberTheory.GaussianIntegers-  {-# DEPRECATED "Use Math.NumberTheory.Quadratic.GaussianIntegers instead" #-}-  ( module Math.NumberTheory.Quadratic.GaussianIntegers-  ) where--import Math.NumberTheory.Quadratic.GaussianIntegers

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Miscellaneous functions related to modular arithmetic. --

@@ -1,26 +1,165 @@ -- | -- Module:      Math.NumberTheory.Moduli.Chinese--- Copyright:   (c) 2011 Daniel Fischer+-- Copyright:   (c) 2011 Daniel Fischer, 2018 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Chinese remainder theorem -- -{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}+{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE TypeOperators       #-} +#if __GLASGOW_HASKELL__ > 805+{-# LANGUAGE NoStarIsType #-}+#endif+ module Math.NumberTheory.Moduli.Chinese-  ( chineseRemainder+  ( -- * Safe interface+    chinese+  , chineseCoprime+  , chineseSomeMod+  , chineseCoprimeSomeMod++  , -- * Unsafe interface+    chineseRemainder   , chineseRemainder2   ) where +import Prelude hiding (mod, quot, gcd, lcm)+ import Control.Monad (foldM)+import Data.Foldable+import Data.Ratio+import GHC.TypeNats.Compat+import Numeric.Natural -import Math.NumberTheory.Euclidean (extendedGCD)-import Math.NumberTheory.Utils (recipMod)+import Math.NumberTheory.Moduli.Class+import Math.NumberTheory.Euclidean+import Math.NumberTheory.Euclidean.Coprimes+import Math.NumberTheory.Utils (recipMod, splitOff) +-- | 'chineseCoprime' @(n1, m1)@ @(n2, m2)@ returns @n@ such that+-- @n \`mod\` m1 == n1@ and @n \`mod\` m2 == n2@.+-- Moduli @m1@ and @m2@ must be coprime, otherwise 'Nothing' is returned.+--+-- This function is slightly faster than 'chinese', but more restricted.+--+-- >>> chineseCoprime (1, 2) (2, 3)+-- Just 5+-- >>> chineseCoprime (3, 4) (5, 6)+-- Nothing -- moduli must be coprime+chineseCoprime :: Euclidean a => (a, a) -> (a, a) -> Maybe a+chineseCoprime (n1, m1) (n2, m2) = case d of+  1 -> Just $ ((1 - u * m1) * n1 + (1 - v * m2) * n2) `mod` (m1 * m2)+  _ -> Nothing+  where+    (d, u, v) = extendedGCD m1 m2++{-# SPECIALISE chineseCoprime :: (Int, Int) -> (Int, Int) -> Maybe Int #-}+{-# SPECIALISE chineseCoprime :: (Word, Word) -> (Word, Word) -> Maybe Word #-}+{-# SPECIALISE chineseCoprime :: (Integer, Integer) -> (Integer, Integer) -> Maybe Integer #-}+{-# SPECIALISE chineseCoprime :: (Natural, Natural) -> (Natural, Natural) -> Maybe Natural #-}++-- | 'chinese' @(n1, m1)@ @(n2, m2)@ returns @n@ such that+-- @n \`mod\` m1 == n1@ and @n \`mod\` m2 == n2@, if exists.+-- Moduli @m1@ and @m2@ are allowed to have common factors.+--+-- >>> chinese (1, 2) (2, 3)+-- Just 5+-- >>> chinese (3, 4) (5, 6)+-- Just 11+-- >>> chinese (3, 4) (2, 6)+-- Nothing+chinese :: forall a. Euclidean a => (a, a) -> (a, a) -> Maybe a+chinese (n1, m1) (n2, m2)+  | n1 `mod` g == n2 `mod` g+  = chineseCoprime (n1 `mod` m1', m1') (n2 `mod` m2', m2')+  | otherwise+  = Nothing+  where+    g :: a+    g = gcd m1 m2++    ms :: [(a, Word)]+    ms = unCoprimes $ splitIntoCoprimes [(m1, 1), (m2 `quot` g, 1)]++    m1', m2' :: a+    (m1', m2') = foldl' go (1, 1) $ map fst ms++    go :: (a, a) -> a -> (a, a)+    go (t1, t2) p+      | k1 <= k2+      = (t1, t2 * p ^ k2)+      | otherwise+      = (t1 * p ^ k1, t2)+      where+        (k1, _) = splitOff p m1+        (k2, _) = splitOff p m2++{-# SPECIALISE chinese :: (Int, Int) -> (Int, Int) -> Maybe Int #-}+{-# SPECIALISE chinese :: (Word, Word) -> (Word, Word) -> Maybe Word #-}+{-# SPECIALISE chinese :: (Integer, Integer) -> (Integer, Integer) -> Maybe Integer #-}+{-# SPECIALISE chinese :: (Natural, Natural) -> (Natural, Natural) -> Maybe Natural #-}++isCompatible :: KnownNat m => Mod m -> Rational -> Bool+isCompatible n r = case invertMod (fromInteger (denominator r)) of+  Nothing -> False+  Just r' -> r' * fromInteger (numerator r) == n++chineseWrap+  :: (Integer -> Integer -> Integer)+  -> ((Integer, Integer) -> (Integer, Integer) -> Maybe Integer)+  -> SomeMod+  -> SomeMod+  -> Maybe SomeMod+chineseWrap f g (SomeMod n1) (SomeMod n2)+  = fmap (`modulo` fromInteger (f m1 m2)) (g (getVal n1, m1) (getVal n2, m2))+  where+    m1 = getMod n1+    m2 = getMod n2+chineseWrap _ _ (SomeMod n) (InfMod r)+  | isCompatible n r = Just $ InfMod r+  | otherwise        = Nothing+chineseWrap _ _ (InfMod r) (SomeMod n)+  | isCompatible n r = Just $ InfMod r+  | otherwise        = Nothing+chineseWrap _ _ (InfMod r1) (InfMod r2)+  | r1 == r2  = Just $ InfMod r1+  | otherwise = Nothing++-- | Same as 'chineseCoprime', but operates on residues.+--+-- >>> :set -XDataKinds+-- >>> import Math.NumberTheory.Moduli.Class+-- >>> (1 `modulo` 2) `chineseCoprimeSomeMod` (2 `modulo` 3)+-- Just (5 `modulo` 6)+-- >>> (3 `modulo` 4) `chineseCoprimeSomeMod` (5 `modulo` 6)+-- Nothing+chineseCoprimeSomeMod :: SomeMod -> SomeMod -> Maybe SomeMod+chineseCoprimeSomeMod = chineseWrap (*) chineseCoprime++-- | Same as 'chinese', but operates on residues.+--+-- >>> :set -XDataKinds+-- >>> import Math.NumberTheory.Moduli.Class+-- >>> (1 `modulo` 2) `chineseSomeMod` (2 `modulo` 3)+-- Just (5 `modulo` 6)+-- >>> (3 `modulo` 4) `chineseSomeMod` (5 `modulo` 6)+-- Just (11 `modulo` 12)+-- >>> (3 `modulo` 4) `chineseSomeMod` (2 `modulo` 6)+-- Nothing+chineseSomeMod :: SomeMod -> SomeMod -> Maybe SomeMod+chineseSomeMod = chineseWrap lcm chinese++-------------------------------------------------------------------------------+-- Unsafe interface+ -- | Given a list @[(r_1,m_1), ..., (r_n,m_n)]@ of @(residue,modulus)@ --   pairs, @chineseRemainder@ calculates the solution to the simultaneous --   congruences@@ -32,7 +171,7 @@ --   if all moduli are positive and pairwise coprime. Otherwise --   the result is @Nothing@ regardless of whether --   a solution exists.-chineseRemainder :: [(Integer,Integer)] -> Maybe Integer+chineseRemainder :: [(Integer, Integer)] -> Maybe Integer chineseRemainder remainders = foldM addRem 0 remainders   where     !modulus = product (map snd remainders)@@ -48,7 +187,7 @@ -- > r ≡ r_k (mod m_k) -- --   if @m_1@ and @m_2@ are coprime.-chineseRemainder2 :: (Integer,Integer) -> (Integer,Integer) -> Integer-chineseRemainder2 (r1, md1) (r2,md2)-    = case extendedGCD md1 md2 of-        (_,u,v) -> ((1 - u*md1)*r1 + (1 - v*md2)*r2) `mod` (md1*md2)+chineseRemainder2 :: (Integer, Integer) -> (Integer, Integer) -> Integer+chineseRemainder2 (n1, m1) (n2, m2) = ((1 - u * m1) * n1 + (1 - v * m2) * n2) `mod` (m1 * m2)+  where+    (_, u, v) = extendedGCD m1 m2

@@ -3,20 +3,21 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Safe modular arithmetic with modulo on type level. -- +{-# LANGUAGE BangPatterns               #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures             #-} {-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MagicHash                  #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE UnboxedTuples              #-}  module Math.NumberTheory.Moduli.Class   ( -- * Known modulo@@ -46,11 +47,11 @@ import Data.Ratio import Data.Semigroup import Data.Type.Equality+import GHC.Exts import GHC.Integer.GMP.Internals+import GHC.Natural (Natural(..), powModNatural) import GHC.TypeNats.Compat -import GHC.Natural (Natural, powModNatural)- -- | Wrapper for residues modulo @m@. -- -- @Mod 3 :: Mod 10@ stands for the class of integers, congruent to 3 modulo 10 (…−17, −7, 3, 13, 23…).@@ -89,9 +90,25 @@   negate mx@(Mod x) =     Mod $ if x == 0 then 0 else getNatMod mx - x   {-# INLINE negate #-}-  mx@(Mod x) * Mod y =-    Mod $ x * y `rem` getNatMod mx -- `rem` is slightly faster than `mod`++  -- If modulo is small and fits into one machine word,+  -- there is no need to use long arithmetic at all+  -- and we can save some allocations.+  mx@(Mod (NatS# x#)) * (Mod (NatS# y#)) = case getNatMod mx of+    NatS# m# -> let !(# z1#, z2# #) = timesWord2# x# y# in+                let !(# _, r# #) = quotRemWord2# z1# z2# m# in+                Mod (NatS# r#)+    NatJ# b# -> let !(# z1#, z2# #) = timesWord2# x# y# in+                let r# = wordToBigNat2 z1# z2# `remBigNat` b# in+                Mod $ if isTrue# (sizeofBigNat# r# ==# 1#)+                  then NatS# (bigNatToWord r#)+                  else NatJ# r#++  mx@(Mod !x) * (Mod !y) =+    Mod $ x * y `rem` getNatMod mx+    -- `rem` is slightly faster than `mod`   {-# INLINE (*) #-}+   abs = id   {-# INLINE abs #-}   signum = const $ Mod 1@@ -152,11 +169,11 @@     y = recipModInteger (getVal mx) (getMod mx) {-# INLINABLE invertMod #-} --- | Drop-in replacement for '^', with much better performance.+-- | Drop-in replacement for 'Prelude.^', with much better performance. -- -- >>> :set -XDataKinds -- >>> powMod (3 :: Mod 10) 4--- > (1 `modulo` 10)+-- (1 `modulo` 10) powMod :: (KnownNat m, Integral a) => Mod m -> a -> Mod m powMod mx a   | a < 0     = error $ "^{Mod}: negative exponent"@@ -173,7 +190,10 @@ "powMod/2/Integer"     forall x. powMod x (2 :: Integer) = let u = x in u*u "powMod/3/Integer"     forall x. powMod x (3 :: Integer) = let u = x in u*u*u "powMod/2/Int"         forall x. powMod x (2 :: Int)     = let u = x in u*u-"powMod/3/Int"         forall x. powMod x (3 :: Int)     = let u = x in u*u*u #-}+"powMod/3/Int"         forall x. powMod x (3 :: Int)     = let u = x in u*u*u+"powMod/2/Word"        forall x. powMod x (2 :: Word)    = let u = x in u*u+"powMod/3/Word"        forall x. powMod x (3 :: Word)    = let u = x in u*u*u+#-}  -- | Infix synonym of 'powMod'. (^%) :: (KnownNat m, Integral a) => Mod m -> a -> Mod m@@ -188,8 +208,9 @@  -- | 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)+newtype MultMod m = MultMod {+  multElement :: Mod m -- ^ Unwrap a residue.+  } deriving (Eq, Ord, Show)  instance KnownNat m => Semigroup (MultMod m) where   MultMod a <> MultMod b = MultMod (a * b)@@ -225,7 +246,7 @@ -- -- >>> 2 `modulo` 10 + 4 `modulo` 15 -- (1 `modulo` 5)--- >>> 2 `modulo` 10 * 4 `modulo` 15+-- >>> (2 `modulo` 10) * (4 `modulo` 15) -- (3 `modulo` 5) -- >>> 2 `modulo` 10 + fromRational (3 % 7) -- (1 `modulo` 10)@@ -322,7 +343,7 @@ -- -- >>> invertSomeMod (3 `modulo` 10) -- Just (7 `modulo` 10) -- because 3 * 7 = 1 :: Mod 10--- >>> invertMod (4 `modulo` 10)+-- >>> invertSomeMod (4 `modulo` 10) -- Nothing -- >>> invertSomeMod (fromRational (2 % 5)) -- Just 5 % 2@@ -338,8 +359,8 @@   SomeMod -> Int     -> SomeMod,   SomeMod -> Word    -> SomeMod #-} --- | Drop-in replacement for '^', with much better performance.--- When -O is enabled, there is a rewrite rule, which specialises '^' to 'powSomeMod'.+-- | Drop-in replacement for 'Prelude.^', with much better performance.+-- When -O is enabled, there is a rewrite rule, which specialises 'Prelude.^' to 'powSomeMod'. -- -- >>> powSomeMod (3 `modulo` 10) 4 -- (1 `modulo` 10)

@@ -3,8 +3,6 @@ -- Copyright:    (c) 2018 Bhavik Mehta -- License:      MIT -- Maintainer:   Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:    Provisional--- Portability:  Non-portable --  {-# LANGUAGE BangPatterns        #-}@@ -27,7 +25,7 @@ import Math.NumberTheory.Moduli.Equations     (solveLinear) import Math.NumberTheory.Moduli.PrimitiveRoot (PrimitiveRoot(..), CyclicGroup(..)) import Math.NumberTheory.Powers.Squares       (integerSquareRoot)-import Math.NumberTheory.UniqueFactorisation  (unPrime)+import Math.NumberTheory.Primes  (unPrime)  -- | Computes the discrete logarithm. Currently uses a combination of the baby-step -- giant-step method and Pollard's rho algorithm, with Bach reduction.@@ -42,13 +40,17 @@   -> 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)*+    CG2+      -> 0+      -- the only valid input was a=1, b=1+    CG4+      -> if b == 1 then 0 else 1+      -- the only possible input here is a=3 with b = 1 or 3+    CGOddPrimePower       (toInteger . unPrime -> p) k+      -> discreteLogarithmPP p k (getVal a) (getVal b)+    CGDoubleOddPrimePower (toInteger . unPrime -> p) k+      -> discreteLogarithmPP p k (getVal a `rem` p^k) (getVal b `rem` p^k)+      -- we have the isomorphism t -> t `rem` p^k from (Z/2p^kZ)* -> (Z/p^kZ)*  -- Implementation of Bach reduction (https://www2.eecs.berkeley.edu/Pubs/TechRpts/1984/CSD-84-186.pdf) {-# INLINE discreteLogarithmPP #-}

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2018 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Polynomial modular equations. --@@ -22,7 +20,7 @@ import Math.NumberTheory.Moduli.Chinese import Math.NumberTheory.Moduli.Class import Math.NumberTheory.Moduli.Sqrt-import Math.NumberTheory.UniqueFactorisation+import Math.NumberTheory.Primes import Math.NumberTheory.Utils (recipMod)  -------------------------------------------------------------------------------@@ -65,7 +63,7 @@   => Mod m   -- ^ a   -> Mod m   -- ^ b   -> Mod m   -- ^ c-  -> [Mod m] -- ^ list of c+  -> [Mod m] -- ^ list of x solveQuadratic a b c   = map fromInteger   $ fst

@@ -3,8 +3,6 @@ -- 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) -- -- <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol> -- is a generalization of the Legendre symbol, useful for primality@@ -20,7 +18,6 @@ module Math.NumberTheory.Moduli.Jacobi   ( JacobiSymbol(..)   , jacobi-  , jacobi'   ) where  import Data.Bits@@ -91,7 +88,6 @@                                 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 jacPS :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Primitive roots and cyclic groups. --@@ -42,8 +40,7 @@ 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 Math.NumberTheory.Primes  import Control.DeepSeq import Control.Monad (guard)@@ -62,12 +59,9 @@   -- ^ 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 (Eq, Show, Generic) -deriving instance Eq   (Prime a) => Eq   (CyclicGroup a)-deriving instance Show (Prime a) => Show (CyclicGroup a)+instance NFData a => NFData (CyclicGroup a)  -- | Check whether a multiplicative group of residues, -- characterized by its modulo, is cyclic and, if yes, return its form.@@ -75,7 +69,7 @@ -- >>> cyclicGroupFromModulo 4 -- Just CG4 -- >>> cyclicGroupFromModulo (2 * 13 ^ 3)--- Just (CGDoubleOddPrimePower (PrimeNat 13) 3)+-- Just (CGDoubleOddPrimePower (Prime 13) 3) -- >>> cyclicGroupFromModulo (4 * 13) -- Nothing cyclicGroupFromModulo@@ -97,7 +91,7 @@   :: (Integral a, UniqueFactorisation a)   => a   -> Maybe (Prime a, Word)-isPrimePower n = (, intToWord k) <$> isPrime m+isPrimePower n = (, k) <$> isPrime m   where     (m, k) = highestPower n @@ -105,13 +99,13 @@ -- a cyclic multiplicative group of residues. -- -- >>> cyclicGroupToModulo CG4--- Prefactored {prefValue = 4, prefFactors = Coprimes {unCoprimes = fromList [(2,2)]}}+-- Prefactored {prefValue = 4, prefFactors = Coprimes {unCoprimes = [(2,2)]}} ----- >>> :set -XTypeFamilies--- >>> cyclicGroupToModulo (CGDoubleOddPrimePower (PrimeNat 13) 3)--- Prefactored {prefValue = 4394, prefFactors = Coprimes {unCoprimes = fromList [(2,1),(13,3)]}}+-- >>> import Data.Maybe+-- >>> cyclicGroupToModulo (CGDoubleOddPrimePower (fromJust (isPrime 13)) 3)+-- Prefactored {prefValue = 4394, prefFactors = Coprimes {unCoprimes = [(13,3),(2,1)]}} cyclicGroupToModulo-  :: (E.Euclidean a, Ord a, UniqueFactorisation a)+  :: E.Euclidean a   => CyclicGroup a   -> Prefactored a cyclicGroupToModulo = fromFactors . \case@@ -121,7 +115,8 @@   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.+-- | 'PrimitiveRoot' m is a type which is only inhabited+-- by <https://en.wikipedia.org/wiki/Primitive_root_modulo_n primitive roots> of m. data PrimitiveRoot m = PrimitiveRoot   { unPrimitiveRoot :: MultMod m -- ^ Extract primitive root value.   , getGroup        :: CyclicGroup Natural -- ^ Get cyclic group structure.@@ -163,14 +158,9 @@ -- -- >>> :set -XDataKinds -- >>> isPrimitiveRoot (1 :: Mod 13)--- False+-- Nothing -- >>> isPrimitiveRoot (2 :: Mod 13)--- True------ Here is how to list all primitive roots:------ >>> mapMaybe isPrimitiveRoot [minBound .. maxBound] :: [Mod 13]--- [(2 `modulo` 13), (6 `modulo` 13), (7 `modulo` 13), (11 `modulo` 13)]+-- Just (PrimitiveRoot {unPrimitiveRoot = MultMod {multElement = (2 `modulo` 13)}, getGroup = CGOddPrimePower (Prime 13) 1}) -- -- This function is a convenient wrapper around 'isPrimitiveRoot''. The latter -- provides better control and performance, if you need them.@@ -185,5 +175,5 @@   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 :: (E.Euclidean a, UniqueFactorisation a) => CyclicGroup a -> Prefactored a groupSize = totient . cyclicGroupToModulo

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Modular square roots. --@@ -30,7 +28,6 @@   , Old.sqrtModFList   ) where -import Control.Arrow hiding (loop) import Control.Monad (liftM2) import Data.Bits @@ -38,9 +35,9 @@ 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.Primes (Prime, factorise) import Math.NumberTheory.Utils (shiftToOddCount, splitOff, recipMod) import Math.NumberTheory.Utils.FromIntegral @@ -50,13 +47,12 @@ -- -- >>> :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)]+-- [(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 --- | List all square roots modulo a number, which factorisation is passed as a second argument.+-- | List all square roots modulo a number, the factorisation of which is+-- passed as a second argument. -- -- >>> sqrtsModFactorisation 1 (factorise 60) -- [1,49,41,29,31,19,11,59]@@ -65,7 +61,7 @@ sqrtsModFactorisation n pps = map fst $ foldl1 (liftM2 comb) cs   where     ms :: [Integer]-    ms = map (\(PrimeNat p, pow) -> toInteger p ^ pow) pps+    ms = map (\(Prime p, pow) -> p ^ pow) pps      rs :: [[Integer]]     rs = map (\(p, pow) -> sqrtsModPrimePower n p pow) pps@@ -75,15 +71,17 @@      comb t1@(_, m1) t2@(_, m2) = (chineseRemainder2 t1 t2, m1 * m2) --- | List all square roots modulo power of a prime.+-- | List all square roots modulo the power of a prime. --+-- >>> import Data.Maybe+-- >>> import Math.NumberTheory.Primes -- >>> 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+sqrtsModPrimePower nn (Prime 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)@@ -95,7 +93,7 @@           then go rr os           else go rr os ++ go (primeExpo - rr) os       where-        k = intToWord kk `quot` 2+        k = 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]@@ -108,6 +106,8 @@  -- | List all square roots by prime modulo. --+-- >>> import Data.Maybe+-- >>> import Math.NumberTheory.Primes -- >>> sqrtsModPrime 1 (fromJust (isPrime 5)) -- [1,4] -- >>> sqrtsModPrime 0 (fromJust (isPrime 5))@@ -115,8 +115,8 @@ -- >>> 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+sqrtsModPrime n (Prime 2) = [n `mod` 2]+sqrtsModPrime n (Prime prime) = case jacobi n prime of   MinusOne -> []   Zero     -> [0]   One      -> let r = sqrtModP' (n `mod` prime) prime in [r, prime - r]@@ -135,7 +135,7 @@                     = sqrtOfMinusOne prime     | otherwise     = tonelliShanks square prime --- | p must be of form 4k + 1+-- | @p@ must be of form @4k + 1@ sqrtOfMinusOne :: Integer -> Integer sqrtOfMinusOne p   = head@@ -152,7 +152,7 @@ tonelliShanks :: Integer -> Integer -> Integer tonelliShanks square prime = loop rc t1 generator log2   where-    (log2,q) = shiftToOddCount (prime-1)+    (wordToInt -> log2,q) = shiftToOddCount (prime-1)     nonSquare = findNonSquare prime     generator = powMod nonSquare q prime     rc = powMod square ((q+1) `quot` 2) prime@@ -176,7 +176,7 @@  -- | 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+sqrtModPP' n prime expo = case sqrtsModPrime n (Prime prime) of                             []    -> Nothing                             r : _ -> fixup r   where@@ -184,12 +184,12 @@               in if diff' == 0                    then Just r                    else case splitOff prime diff' of-                          (e,q) | expo <= intToWord e -> Just r+                          (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 <= intToWord ex    = root'+        | expo <= ex    = root'         | otherwise     = hoist inv root' (nelim `mod` prime) (prime^ex)           where             root' = (root + (inv*(prime-elim))*pp) `mod` (prime*pp)@@ -198,13 +198,13 @@  -- dirty, dirty sqM2P :: Integer -> Word -> Maybe Integer-sqM2P n (wordToInt -> e)+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+    | otherwise = fmap ((`mod` mdl) . (`shiftL` wordToInt k2)) $ solve s e2       where-        mdl = 1 `shiftL` e+        mdl = 1 `shiftL` wordToInt e         n' = n `mod` mdl         (k, s) = shiftToOddCount n'         k2 = k `quot` 2@@ -220,7 +220,7 @@                     | pw >= e2  = Just x                     | otherwise = fixup x' pw'                       where-                        x' = x + (1 `shiftL` (pw-1))+                        x' = x + (1 `shiftL` (wordToInt pw - 1))                         d = x'*x' - r                         pw' = if d == 0 then e2 else fst (shiftToOddCount d) @@ -239,7 +239,7 @@     | 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+                        ++ map unPrime (sieveFrom (68 + n `rem` 4)) -- prevent sharing         search (p:ps) = case jacobi p n of           MinusOne -> p           _        -> search ps

@@ -3,14 +3,13 @@ -- 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          #-}+{-# LANGUAGE ViewPatterns #-}  module Math.NumberTheory.Moduli.SqrtOld   ( sqrtModP@@ -26,15 +25,14 @@ 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.Primes.Types (unPrime) import Math.NumberTheory.Utils (shiftToOddCount, splitOff)+import Math.NumberTheory.Utils.FromIntegral  {-# DEPRECATED sqrtModP, sqrtModP', sqrtModPList, tonelliShanks "Use 'Math.NumberTheory.Moduli.Sqrt.sqrtsModPrime' instead" #-} {-# DEPRECATED sqrtModPP, sqrtModPPList "Use 'Math.NumberTheory.Moduli.Sqrt.sqrtsModPrimePower' instead" #-}@@ -119,12 +117,12 @@               in if diff' == 0                    then Just r                    else case splitOff prime diff' of-                          (e,q) | expo <= e -> Just r+                          (wordToInt -> e,q) | expo <= e -> Just r                                 | otherwise -> fmap (\inv -> hoist inv r (q `mod` prime) (prime^e)) (recipMod (2*r) prime)      hoist inv root elim pp         | diff' == 0    = root'-        | expo <= ex    = root'+        | expo <= wordToInt ex    = root'         | otherwise     = hoist inv root' (nelim `mod` prime) (prime^ex)           where             root' = (root + (inv*(prime-elim))*pp) `mod` (prime*pp)@@ -141,7 +139,7 @@       where         mdl = 1 `shiftL` e         n' = n `mod` mdl-        (k,s) = shiftToOddCount n'+        (wordToInt -> k,s) = shiftToOddCount n'         k2 = k `quot` 2         e2 = e-k         solve _ 1 = Just 1@@ -149,7 +147,7 @@         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))+            | otherwise     = fixup r (wordToInt $ fst $ shiftToOddCount (r-1))               where                 fixup x pw                     | pw >= e2  = Just x@@ -157,7 +155,7 @@                       where                         x' = x + (1 `shiftL` (pw-1))                         d = x'*x' - r-                        pw' = if d == 0 then e2 else fst (shiftToOddCount d)+                        pw' = if d == 0 then e2 else wordToInt (fst (shiftToOddCount d))  -- | @sqrtModF n primePowers@ calculates a square root of @n@ modulo --   @product [p^k | (p,k) <- primePowers]@ if one exists and all primes@@ -222,7 +220,7 @@     | 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+                        ++ map unPrime (sieveFrom (68 + n `rem` 4)) -- prevent sharing         search (p:ps) = case jacobi p n of           MinusOne -> p           _        -> search ps

@@ -3,23 +3,23 @@ -- Copyright:   (c) 2012 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Generalised Möbius inversion----{-# LANGUAGE BangPatterns, FlexibleContexts #-}++{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Math.NumberTheory.MoebiusInversion     ( generalInversion     , totientSum     ) where -import Data.Array.ST import Control.Monad import Control.Monad.ST+import qualified Data.Vector.Mutable as MV  import Math.NumberTheory.Powers.Squares-import Math.NumberTheory.Unsafe  -- | @totientSum n@ is, for @n > 0@, the sum of @[totient k | k <- [1 .. n]]@, --   computed via generalised Möbius inversion.@@ -85,58 +85,67 @@     | otherwise = fastInvert fun n  fastInvert :: (Int -> Integer) -> Int -> Integer-fastInvert fun n = big `unsafeAt` 0-  where-    !k0 = integerSquareRoot (n `quot` 2)-    !mk0 = n `quot` (2*k0+1)-    kmax a m = (a `quot` m - 1) `quot` 2-    big = runSTArray $ do-        small <- newArray_ (0,mk0) :: ST s (STArray s Int Integer)-        unsafeWrite small 0 0-        unsafeWrite small 1 $! (fun 1)-        when (mk0 >= 2) $-            unsafeWrite small 2 $! (fun 2 - fun 1)-        let calcit switch change i-                | mk0 < i   = return (switch,change)-                | i == change = calcit (switch+1) (change + 4*switch+6) i-                | otherwise = do-                    let mloop !acc k !m-                            | k < switch    = kloop acc k-                            | otherwise     = do-                                val <- unsafeRead small m-                                let nxtk = kmax i (m+1)-                                mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1)-                        kloop !acc k-                            | k == 0    = do-                                unsafeWrite small i $! acc-                                calcit switch change (i+1)-                            | otherwise = do-                                val <- unsafeRead small (i `quot` (2*k+1))-                                kloop (acc-val) (k-1)-                    mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1-        (sw, ch) <- calcit 1 8 3-        large <- newArray_ (0,k0-1)-        let calcbig switch change j-                | j == 0    = return large-                | (2*j-1)*change <= n   = calcbig (switch+1) (change + 4*switch+6) j-                | otherwise = do-                    let i = n `quot` (2*j-1)-                        mloop !acc k m-                            | k < switch    = kloop acc k-                            | otherwise     = do-                                val <- unsafeRead small m-                                let nxtk = kmax i (m+1)-                                mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1)-                        kloop !acc k-                            | k == 0    = do-                                unsafeWrite large (j-1) $! acc-                                calcbig switch change (j-1)-                            | otherwise = do-                                let m = i `quot` (2*k+1)-                                val <- if m <= mk0-                                         then unsafeRead small m-                                         else unsafeRead large (k*(2*j-1)+j-1)-                                kloop (acc-val) (k-1)-                    mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1-        calcbig sw ch k0+fastInvert fun n = runST (fastInvertST fun n)++fastInvertST :: forall s. (Int -> Integer) -> Int -> ST s Integer+fastInvertST fun n = do+    let !k0 = integerSquareRoot (n `quot` 2)+        !mk0 = n `quot` (2*k0+1)+        kmax a m = (a `quot` m - 1) `quot` 2++    small <- MV.unsafeNew (mk0 + 1) :: ST s (MV.MVector s Integer)+    MV.unsafeWrite small 0 0+    MV.unsafeWrite small 1 $! (fun 1)+    when (mk0 >= 2) $+        MV.unsafeWrite small 2 $! (fun 2 - fun 1)++    let calcit :: Int -> Int -> Int -> ST s (Int, Int)+        calcit switch change i+            | mk0 < i   = return (switch,change)+            | i == change = calcit (switch+1) (change + 4*switch+6) i+            | otherwise = do+                let mloop !acc k !m+                        | k < switch    = kloop acc k+                        | otherwise     = do+                            val <- MV.unsafeRead small m+                            let nxtk = kmax i (m+1)+                            mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1)+                    kloop !acc k+                        | k == 0    = do+                            MV.unsafeWrite small i $! acc+                            calcit switch change (i+1)+                        | otherwise = do+                            val <- MV.unsafeRead small (i `quot` (2*k+1))+                            kloop (acc-val) (k-1)+                mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1++    (sw, ch) <- calcit 1 8 3+    large <- MV.unsafeNew k0 :: ST s (MV.MVector s Integer)++    let calcbig :: Int -> Int -> Int -> ST s (MV.MVector s Integer)+        calcbig switch change j+            | j == 0    = return large+            | (2*j-1)*change <= n   = calcbig (switch+1) (change + 4*switch+6) j+            | otherwise = do+                let i = n `quot` (2*j-1)+                    mloop !acc k m+                        | k < switch    = kloop acc k+                        | otherwise     = do+                            val <- MV.unsafeRead small m+                            let nxtk = kmax i (m+1)+                            mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1)+                    kloop !acc k+                        | k == 0    = do+                            MV.unsafeWrite large (j-1) $! acc+                            calcbig switch change (j-1)+                        | otherwise = do+                            let m = i `quot` (2*k+1)+                            val <- if m <= mk0+                                     then MV.unsafeRead small m+                                     else MV.unsafeRead large (k*(2*j-1)+j-1)+                            kloop (acc-val) (k-1)+                mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1++    mvec <- calcbig sw ch k0+    MV.unsafeRead mvec 0 

@@ -3,24 +3,23 @@ -- Copyright:   (c) 2012 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Generalised Möbius inversion for 'Int' valued functions.----{-# LANGUAGE BangPatterns, FlexibleContexts #-}-{-# OPTIONS_GHC -fspec-constr-count=8 #-}++{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Math.NumberTheory.MoebiusInversion.Int     ( generalInversion     , totientSum     ) where -import Data.Array.ST import Control.Monad import Control.Monad.ST+import qualified Data.Vector.Unboxed.Mutable as MV  import Math.NumberTheory.Powers.Squares-import Math.NumberTheory.Unsafe  -- | @totientSum n@ is, for @n > 0@, the sum of @[totient k | k <- [1 .. n]]@, --   computed via generalised Möbius inversion.@@ -86,57 +85,66 @@     | otherwise = fastInvert fun n  fastInvert :: (Int -> Int) -> Int -> Int-fastInvert fun n = big `unsafeAt` 0-  where-    !k0 = integerSquareRoot (n `quot` 2)-    !mk0 = n `quot` (2*k0+1)-    kmax a m = (a `quot` m - 1) `quot` 2-    big = runSTUArray $ do-        small <- newArray_ (0,mk0) :: ST s (STUArray s Int Int)-        unsafeWrite small 0 0-        unsafeWrite small 1 (fun 1)-        when (mk0 >= 2) $-            unsafeWrite small 2 (fun 2 - fun 1)-        let calcit switch change i-                | mk0 < i   = return (switch,change)-                | i == change = calcit (switch+1) (change + 4*switch+6) i-                | otherwise = do-                    let mloop !acc k !m-                            | k < switch    = kloop acc k-                            | otherwise     = do-                                val <- unsafeRead small m-                                let nxtk = kmax i (m+1)-                                mloop (acc - (k-nxtk)*val) nxtk (m+1)-                        kloop !acc k-                            | k == 0    = do-                                unsafeWrite small i acc-                                calcit switch change (i+1)-                            | otherwise = do-                                val <- unsafeRead small (i `quot` (2*k+1))-                                kloop (acc-val) (k-1)-                    mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1-        (sw, ch) <- calcit 1 8 3-        large <- newArray_ (0,k0-1)-        let calcbig switch change j-                | j == 0    = return large-                | (2*j-1)*change <= n   = calcbig (switch+1) (change + 4*switch+6) j-                | otherwise = do-                    let i = n `quot` (2*j-1)-                        mloop !acc k m-                            | k < switch    = kloop acc k-                            | otherwise     = do-                                val <- unsafeRead small m-                                let nxtk = kmax i (m+1)-                                mloop (acc - (k-nxtk)*val) nxtk (m+1)-                        kloop !acc k-                            | k == 0    = do-                                unsafeWrite large (j-1) acc-                                calcbig switch change (j-1)-                            | otherwise = do-                                let m = i `quot` (2*k+1)-                                val <- if m <= mk0-                                         then unsafeRead small m-                                         else unsafeRead large (k*(2*j-1)+j-1)-                                kloop (acc-val) (k-1)-                    mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1-        calcbig sw ch k0+fastInvert fun n = runST (fastInvertST fun n)++fastInvertST :: forall s. (Int -> Int) -> Int -> ST s Int+fastInvertST fun n = do+    let !k0 = integerSquareRoot (n `quot` 2)+        !mk0 = n `quot` (2*k0+1)+        kmax a m = (a `quot` m - 1) `quot` 2++    small <- MV.unsafeNew (mk0 + 1) :: ST s (MV.MVector s Int)+    MV.unsafeWrite small 0 0+    MV.unsafeWrite small 1 $! (fun 1)+    when (mk0 >= 2) $+        MV.unsafeWrite small 2 $! (fun 2 - fun 1)++    let calcit :: Int -> Int -> Int -> ST s (Int, Int)+        calcit switch change i+            | mk0 < i   = return (switch,change)+            | i == change = calcit (switch+1) (change + 4*switch+6) i+            | otherwise = do+                let mloop !acc k !m+                        | k < switch    = kloop acc k+                        | otherwise     = do+                            val <- MV.unsafeRead small m+                            let nxtk = kmax i (m+1)+                            mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1)+                    kloop !acc k+                        | k == 0    = do+                            MV.unsafeWrite small i $! acc+                            calcit switch change (i+1)+                        | otherwise = do+                            val <- MV.unsafeRead small (i `quot` (2*k+1))+                            kloop (acc-val) (k-1)+                mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1++    (sw, ch) <- calcit 1 8 3+    large <- MV.unsafeNew k0 :: ST s (MV.MVector s Int)++    let calcbig :: Int -> Int -> Int -> ST s (MV.MVector s Int)+        calcbig switch change j+            | j == 0    = return large+            | (2*j-1)*change <= n   = calcbig (switch+1) (change + 4*switch+6) j+            | otherwise = do+                let i = n `quot` (2*j-1)+                    mloop !acc k m+                        | k < switch    = kloop acc k+                        | otherwise     = do+                            val <- MV.unsafeRead small m+                            let nxtk = kmax i (m+1)+                            mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1)+                    kloop !acc k+                        | k == 0    = do+                            MV.unsafeWrite large (j-1) $! acc+                            calcbig switch change (j-1)+                        | otherwise = do+                            let m = i `quot` (2*k+1)+                            val <- if m <= mk0+                                     then MV.unsafeRead small m+                                     else MV.unsafeRead large (k*(2*j-1)+j-1)+                            kloop (acc-val) (k-1)+                mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1++    mvec <- calcbig sw ch k0+    MV.unsafeRead mvec 0

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Calculating integer roots, modular powers and related things. -- This module reexports the most needed functions from the implementation

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Functions dealing with cubes. Moderately efficient calculation of integer -- cube roots and testing for cubeness.@@ -20,25 +18,26 @@  #include "MachDeps.h" -import Data.Array.Unboxed-import Data.Array.ST-+import Control.Monad.ST import Data.Bits+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as MV  import GHC.Base import GHC.Integer import GHC.Integer.GMP.Internals import GHC.Integer.Logarithms (integerLog2#) -import Math.NumberTheory.Unsafe+import Numeric.Natural  -- | Calculate the integer cube root of an integer @n@, --   that is the largest integer @r@ such that @r^3 <= n@. --   Note that this is not symmetric about @0@, for example --   @integerCubeRoot (-2) = (-2)@ while @integerCubeRoot 2 = 1@. {-# SPECIALISE integerCubeRoot :: Int -> Int,+                                  Word -> Word,                                   Integer -> Integer,-                                  Word -> Word+                                  Natural -> Natural   #-} integerCubeRoot :: Integral a => a -> a integerCubeRoot 0 = 0@@ -68,7 +67,8 @@ --   @Just r@ if @n == r^3@. {-# SPECIALISE exactCubeRoot :: Int -> Maybe Int,                                 Word -> Maybe Word,-                                Integer -> Maybe Integer+                                Integer -> Maybe Integer,+                                Natural -> Maybe Natural   #-} exactCubeRoot :: Integral a => a -> Maybe a exactCubeRoot 0 = Just 0@@ -85,8 +85,9 @@  -- | Test whether an integer is a cube. {-# SPECIALISE isCube :: Int -> Bool,+                         Word -> Bool,                          Integer -> Bool,-                         Word -> Bool+                         Natural -> Bool   #-} isCube :: Integral a => a -> Bool isCube 0 = True@@ -104,8 +105,9 @@ --   this is much faster than @let r = cubeRoot n in r*r*r == n@. --   The condition @n >= 0@ is /not/ checked. {-# SPECIALISE isCube' :: Int -> Bool,+                          Word -> Bool,                           Integer -> Bool,-                          Word -> Bool+                          Natural -> Bool   #-} isCube' :: Integral a => a -> Bool isCube' !n = isPossibleCube n@@ -117,15 +119,16 @@ --   Only about 0.08% of all numbers pass this test. --   The precondition @n >= 0@ is /not/ checked. {-# SPECIALISE isPossibleCube :: Int -> Bool,+                                 Word -> Bool,                                  Integer -> Bool,-                                 Word -> Bool+                                 Natural -> Bool   #-} isPossibleCube :: Integral a => a -> Bool-isPossibleCube !n =-    unsafeAt cr512 (fromIntegral n .&. 511)-    && unsafeAt cubeRes837 (fromIntegral (n `rem` 837))-    && unsafeAt cubeRes637 (fromIntegral (n `rem` 637))-    && unsafeAt cubeRes703 (fromIntegral (n `rem` 703))+isPossibleCube !n+    =  V.unsafeIndex cr512 (fromIntegral n .&. 511)+    && V.unsafeIndex cubeRes837 (fromIntegral (n `rem` 837))+    && V.unsafeIndex cubeRes637 (fromIntegral (n `rem` 637))+    && V.unsafeIndex cubeRes703 (fromIntegral (n `rem` 703))  ---------------------------------------------------------------------- --                         Utility Functions                        --@@ -168,7 +171,6 @@ cubeRootIgr 0 = 0 cubeRootIgr n = newton3 n (approxCuRt n) -{-# SPECIALISE newton3 :: Int -> Int -> Int #-} {-# SPECIALISE newton3 :: Integer -> Integer -> Integer #-} newton3 :: Integral a => a -> a -> a newton3 n a = go (step a)@@ -210,40 +212,43 @@ appCuRt _ = error "integerCubeRoot': negative argument"  -- not very discriminating, but cheap, so it's an overall gain-cr512 :: UArray Int Bool-cr512 = runSTUArray $ do-    ar <- newArray (0,511) True+cr512 :: V.Vector Bool+cr512 = runST $ do+    ar <- MV.replicate 512 True     let note s i-            | i < 512   = unsafeWrite ar i False >> note s (i+s)+            | i < 512   = MV.unsafeWrite ar i False >> note s (i+s)             | otherwise = return ()     note 4 2     note 8 4     note 32 16     note 64 32     note 256 128-    unsafeWrite ar 256 False-    return ar+    MV.unsafeWrite ar 256 False+    V.unsafeFreeze ar  -- Remainders modulo @3^3 * 31@-cubeRes837 :: UArray Int Bool-cubeRes837 = runSTUArray $ do-    ar <- newArray (0,836) False-    let note 837 = return ar-        note k = unsafeWrite ar ((k*k*k) `rem` 837) True >> note (k+1)+cubeRes837 :: V.Vector Bool+cubeRes837 = runST $ do+    ar <- MV.replicate 837 False+    let note 837 = return ()+        note k = MV.unsafeWrite ar ((k*k*k) `rem` 837) True >> note (k+1)     note 0+    V.unsafeFreeze ar  -- Remainders modulo @7^2 * 13@-cubeRes637 :: UArray Int Bool-cubeRes637 = runSTUArray $ do-    ar <- newArray (0,636) False-    let note 637 = return ar-        note k = unsafeWrite ar ((k*k*k) `rem` 637) True >> note (k+1)+cubeRes637 :: V.Vector Bool+cubeRes637 = runST $ do+    ar <- MV.replicate 637 False+    let note 637 = return ()+        note k = MV.unsafeWrite ar ((k*k*k) `rem` 637) True >> note (k+1)     note 0+    V.unsafeFreeze ar  -- Remainders modulo @19 * 37@-cubeRes703 :: UArray Int Bool-cubeRes703 = runSTUArray $ do-    ar <- newArray (0,702) False-    let note 703 = return ar-        note k = unsafeWrite ar ((k*k*k) `rem` 703) True >> note (k+1)+cubeRes703 :: V.Vector Bool+cubeRes703 = runST $ do+    ar <- MV.replicate 703 False+    let note 703 = return ()+        note k = MV.unsafeWrite ar ((k*k*k) `rem` 703) True >> note (k+1)     note 0+    V.unsafeFreeze ar

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Functions dealing with fourth powers. Efficient calculation of integer fourth -- roots and efficient testing for being a square's square.@@ -20,24 +18,25 @@  #include "MachDeps.h" +import Control.Monad.ST+import Data.Bits+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as MV+ import GHC.Base import GHC.Integer import GHC.Integer.GMP.Internals import GHC.Integer.Logarithms (integerLog2#) -import Data.Array.Unboxed-import Data.Array.ST--import Data.Bits--import Math.NumberTheory.Unsafe+import Numeric.Natural  -- | Calculate the integer fourth root of a nonnegative number, --   that is, the largest integer @r@ with @r^4 <= n@. --   Throws an error on negaitve input. {-# SPECIALISE integerFourthRoot :: Int -> Int,+                                    Word -> Word,                                     Integer -> Integer,-                                    Word -> Word+                                    Natural -> Natural   #-} integerFourthRoot :: Integral a => a -> a integerFourthRoot n@@ -60,8 +59,9 @@ -- | Returns @Nothing@ if @n@ is not a fourth power, --   @Just r@ if @n == r^4@ and @r >= 0@. {-# SPECIALISE exactFourthRoot :: Int -> Maybe Int,+                                  Word -> Maybe Word,                                   Integer -> Maybe Integer,-                                  Word -> Maybe Word+                                  Natural -> Maybe Natural   #-} exactFourthRoot :: Integral a => a -> Maybe a exactFourthRoot 0 = Just 0@@ -77,8 +77,9 @@ --   First nonnegativity is checked, then the unchecked --   test is called. {-# SPECIALISE isFourthPower :: Int -> Bool,+                                Word -> Bool,                                 Integer -> Bool,-                                Word -> Bool+                                Natural -> Bool   #-} isFourthPower :: Integral a => a -> Bool isFourthPower 0 = True@@ -89,8 +90,9 @@ --   'isPossibleFourthPower' test, its integer fourth root --   is calculated. {-# SPECIALISE isFourthPower' :: Int -> Bool,+                                 Word -> Bool,                                  Integer -> Bool,-                                 Word -> Bool+                                 Natural -> Bool   #-} isFourthPower' :: Integral a => a -> Bool isFourthPower' n = isPossibleFourthPower n && r2*r2 == n@@ -102,14 +104,15 @@ --   The condition is /not/ checked. --   This eliminates about 99.958% of numbers. {-# SPECIALISE isPossibleFourthPower :: Int -> Bool,+                                        Word -> Bool,                                         Integer -> Bool,-                                        Word -> Bool+                                        Natural -> Bool   #-} isPossibleFourthPower :: Integral a => a -> Bool-isPossibleFourthPower n =-        biSqRes256 `unsafeAt` (fromIntegral n .&. 255)-      && biSqRes425 `unsafeAt` (fromIntegral (n `rem` 425))-      && biSqRes377 `unsafeAt` (fromIntegral (n `rem` 377))+isPossibleFourthPower n+  =  V.unsafeIndex biSqRes256 (fromIntegral n .&. 255)+  && V.unsafeIndex biSqRes425 (fromIntegral (n `rem` 425))+  && V.unsafeIndex biSqRes377 (fromIntegral (n `rem` 377))  {-# SPECIALISE newton4 :: Integer -> Integer -> Integer #-} newton4 :: Integral a => a -> a -> a@@ -151,28 +154,31 @@ appBiSqrt _ = error "integerFourthRoot': negative argument"  -biSqRes256 :: UArray Int Bool-biSqRes256 = runSTUArray $ do-    ar <- newArray (0,255) False-    let note 257 = return ar-        note i = unsafeWrite ar i True >> note (i+16)-    unsafeWrite ar 0 True-    unsafeWrite ar 16 True+biSqRes256 :: V.Vector Bool+biSqRes256 = runST $ do+    ar <- MV.replicate 256 False+    let note 257 = return ()+        note i = MV.unsafeWrite ar i True >> note (i+16)+    MV.unsafeWrite ar 0 True+    MV.unsafeWrite ar 16 True     note 1+    V.unsafeFreeze ar -biSqRes425 :: UArray Int Bool-biSqRes425 = runSTUArray $ do-    ar <- newArray (0,424) False-    let note 154 = return ar-        note i = unsafeWrite ar ((i*i*i*i) `rem` 425) True >> note (i+1)+biSqRes425 :: V.Vector Bool+biSqRes425 = runST $ do+    ar <- MV.replicate 425 False+    let note 154 = return ()+        note i = MV.unsafeWrite ar ((i*i*i*i) `rem` 425) True >> note (i+1)     note 0+    V.unsafeFreeze ar -biSqRes377 :: UArray Int Bool-biSqRes377 = runSTUArray $ do-    ar <- newArray (0,376) False-    let note 144 = return ar-        note i = unsafeWrite ar ((i*i*i*i) `rem` 377) True >> note (i+1)+biSqRes377 :: V.Vector Bool+biSqRes377 = runST $ do+    ar <- MV.replicate 377 False+    let note 144 = return ()+        note i = MV.unsafeWrite ar ((i*i*i*i) `rem` 377) True >> note (i+1)     note 0+    V.unsafeFreeze ar  biSqrtInt :: Int -> Int biSqrtInt 0 = 0

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Calculating integer roots and determining perfect powers. -- The algorithms are moderately efficient.@@ -31,6 +29,8 @@ import Data.List (foldl') import qualified Data.Set as Set +import Numeric.Natural+ import Math.NumberTheory.Logarithms (integerLogBase') import Math.NumberTheory.Utils  (shiftToOddCount                                 , splitOff@@ -38,6 +38,7 @@ import qualified Math.NumberTheory.Powers.Squares as P2 import qualified Math.NumberTheory.Powers.Cubes as P3 import qualified Math.NumberTheory.Powers.Fourth as P4+import Math.NumberTheory.Utils.FromIntegral (intToWord, wordToInt)  -- | Calculate an integer root, @'integerRoot' k n@ computes the (floor of) the @k@-th --   root of @n@, where @k@ must be positive.@@ -50,10 +51,13 @@ {-# SPECIALISE integerRoot :: Int -> Int -> Int,                               Int -> Word -> Word,                               Int -> Integer -> Integer,+                              Int -> Natural -> Natural,                               Word -> Int -> Int,                               Word -> Word -> Word,                               Word -> Integer -> Integer,-                              Integer -> Integer -> Integer+                              Word -> Natural -> Natural,+                              Integer -> Integer -> Integer,+                              Natural -> Natural -> Natural   #-} integerRoot :: (Integral a, Integral b) => b -> a -> a integerRoot 1 n         = n@@ -155,7 +159,7 @@ --   remaining factor is examined by trying the divisors of the @gcd@ --   of the prime exponents if some have been found, otherwise by trying --   prime exponents recursively.-highestPower :: Integral a => a -> (a, Int)+highestPower :: Integral a => a -> (a, Word) highestPower n'   | abs n <= 1  = (n', 3)   | n < 0       = case integerHighPower (negate n) of@@ -167,7 +171,7 @@       n :: Integer       n = toInteger n' -      sqr :: Int -> Integer -> Integer+      sqr :: Word -> Integer -> Integer       sqr 0 m = m       sqr k m = sqr (k-1) (m*m) @@ -180,18 +184,19 @@ --   and primality testing, it is not expected to be generally useful. --   The assumptions are not checked, if they are not satisfied, wrong --   results and wasted work may be the consequence.-largePFPower :: Integer -> Integer -> (Integer, Int)+largePFPower :: Integer -> Integer -> (Integer, Word) largePFPower bd n = rawPower ln n   where-    ln = integerLogBase' (bd+1) n+    ln = intToWord (integerLogBase' (bd+1) n)  ------------------------------------------------------------------------------------------ --                                  Auxiliary functions                                 -- ------------------------------------------------------------------------------------------  {-# SPECIALISE newtonK :: Int -> Int -> Int -> Int,+                          Word -> Word -> Word -> Word,                           Integer -> Integer -> Integer -> Integer,-                          Word -> Word -> Word -> Word+                          Natural -> Natural -> Natural -> Natural   #-} newtonK :: Integral a => a -> a -> a -> a newtonK k n a = go (step a)@@ -204,9 +209,10 @@         where           l = step m -{-# SPECIALISE approxKthRoot :: Int -> Integer -> Integer,-                                Int -> Int -> Int,-                                Int -> Word -> Word+{-# SPECIALISE approxKthRoot :: Int -> Int -> Int,+                                Int -> Word -> Word,+                                Int -> Integer -> Integer,+                                Int -> Natural -> Natural   #-} approxKthRoot :: Integral a => Int -> a -> a approxKthRoot k = fromInteger . appKthRoot k . fromIntegral@@ -230,7 +236,7 @@                           `shiftLInteger` (h# -# 401#)  -- assumption: argument is > 1-integerHighPower :: Integer -> (Integer, Int)+integerHighPower :: Integer -> (Integer, Word) integerHighPower n   | n < 4       = (n,1)   | otherwise   = case shiftToOddCount n of@@ -239,7 +245,7 @@                              where                                r = P2.integerSquareRoot m -findHighPower :: Int -> [(Integer,Int)] -> Integer -> Integer -> [Integer] -> (Integer, Int)+findHighPower :: Word -> [(Integer, Word)] -> Integer -> Integer -> [Integer] -> (Integer, Word) findHighPower 1 pws m _ _ = (foldl' (*) m [p^e | (p,e) <- pws], 1) findHighPower e pws 1 _ _ = (foldl' (*) 1 [p^(ex `quot` e) | (p,ex) <- pws], e) findHighPower e pws m s (p:ps)@@ -250,7 +256,7 @@       (k,r) -> findHighPower (gcd k e) ((p,k):pws) r (P2.integerSquareRoot r) ps findHighPower e pws m _ [] = finishPower e pws m -spBEx :: Int+spBEx :: Word spBEx = 14  spBound :: Integer@@ -266,20 +272,20 @@         go []     = True  -- n large, has no prime divisors < spBound-finishPower :: Int -> [(Integer, Int)] -> Integer -> (Integer, Int)+finishPower :: Word -> [(Integer, Word)] -> Integer -> (Integer, Word) finishPower e pws n-  | n < (1 `shiftL` (2*spBEx))  = (foldl' (*) n [p^ex | (p,ex) <- pws], 1)    -- n is prime+  | n < (1 `shiftL` wordToInt (2*spBEx))  = (foldl' (*) n [p^ex | (p,ex) <- pws], 1)    -- n is prime   | e == 0  = rawPower maxExp n   | otherwise = go divs     where-      maxExp = (I# (integerLog2# n)) `quot` spBEx+      maxExp = (W# (int2Word# (integerLog2# n))) `quot` spBEx       divs = divisorsTo maxExp e       go [] = (foldl' (*) n [p^ex | (p,ex) <- pws], 1)       go (d:ds) = case exactRoot d n of                     Just r -> (foldl' (*) r [p^(ex `quot` d) | (p,ex) <- pws], d)                     Nothing -> go ds -rawPower :: Int -> Integer -> (Integer, Int)+rawPower :: Word -> Integer -> (Integer, Word) rawPower mx n   | mx < 2      = (n,1)   | mx == 2     = case P2.exactSquareRoot n of@@ -293,7 +299,7 @@                                            (m,e) -> (m, 2*e)                                Nothing -> rawOddPower mx n -rawOddPower :: Int -> Integer -> (Integer, Int)+rawOddPower :: Word -> Integer -> (Integer, Word) rawOddPower mx n   | mx < 3       = (n,1) rawOddPower mx n = case P3.exactCubeRoot n of@@ -301,7 +307,7 @@                                  (m,e) -> (m, 3*e)                      Nothing -> badPower mx n -badPower :: Int -> Integer -> (Integer, Int)+badPower :: Word -> Integer -> (Integer, Word) badPower mx n   | mx < 5      = (n,1)   | otherwise   = go 1 mx n (takeWhile (<= mx) $ scanl (+) 5 $ cycle [2,4])@@ -313,25 +319,25 @@                         Nothing -> go e b m ks       go e _ m []   = (m,e) -divisorsTo :: Int -> Int -> [Int]+divisorsTo :: Word -> Word -> [Word] divisorsTo mx n = case shiftToOddCount n of                     (k,o) | k == 0 -> go (Set.singleton 1) n iops-                          | otherwise -> go (Set.fromDistinctAscList $ takeWhile (<= mx) $ take (k+1) (iterate (*2) 1)) o iops+                          | otherwise -> go (Set.fromDistinctAscList $ takeWhile (<= mx) $ take (wordToInt k + 1) (iterate (*2) 1)) o iops   where     mset k st = fst (Set.split (mx+1) (Set.mapMonotonic (*k) st))     -- unP p m = (k, m / p ^ k), where k is as large as possible such that p ^ k still divides m-    unP :: Int -> Int -> (Int,Int)+    unP :: Word -> Word -> (Word, Word)     unP p m = goP 0 m       where-        goP :: Int -> Int -> (Int,Int)+        goP :: Word -> Word -> (Word, Word)         goP !i j = case j `quotRem` p of                      (q,r) | r == 0 -> goP (i+1) q                            | otherwise -> (i,j)-    iops :: [Int]+    iops :: [Word]     iops = 3:5:prs-    prs :: [Int]+    prs :: [Word]     prs = 7:filter prm (scanl (+) 11 $ cycle [2,4,2,4,6,2,6,4])-    prm :: Int -> Bool+    prm :: Word -> Bool     prm k = td prs       where         td (p:ps) = (p*p > k) || (k `rem` p /= 0 && td ps)@@ -343,5 +349,5 @@         case unP p m of           (0,_) -> go st m ps           -- iterate f x = [x, f x, f (f x)...]-          (k,r) -> go (Set.unions (take (k + 1) (iterate (mset p) st))) r ps+          (k,r) -> go (Set.unions (take (wordToInt k + 1) (iterate (mset p) st))) r ps     go st m [] = go st m [m+1]

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Modular powers (a. k. a. modular exponentiation). --@@ -44,7 +42,7 @@ -- -- >>> powMod 3 101 (2^60-1 :: Integer) -- 1018105167100379328 -- correct--- >>> powMod 3 101 (2^60-1 :: Int64)+-- >>> powMod 3 101 (2^60-1 :: Int) -- 1115647832265427613 -- incorrect due to overflow -- >>> powModInt 3 101 (2^60-1 :: Int) -- 1018105167100379328 -- correct

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Functions dealing with squares. Efficient calculation of integer square roots -- and efficient testing for squareness.@@ -25,12 +23,12 @@  #include "MachDeps.h" -import Data.Array.Unboxed-import Data.Array.ST-+import Control.Monad.ST import Data.Bits+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as MV -import Math.NumberTheory.Unsafe+import Numeric.Natural  import Math.NumberTheory.Powers.Squares.Internal @@ -39,7 +37,8 @@ --   Throws an error on negative input. {-# SPECIALISE integerSquareRoot :: Int -> Int,                                     Word -> Word,-                                    Integer -> Integer+                                    Integer -> Integer,+                                    Natural -> Natural   #-} integerSquareRoot :: Integral a => a -> a integerSquareRoot n@@ -64,7 +63,8 @@ {-# SPECIALISE integerSquareRootRem ::         Int -> (Int, Int),         Word -> (Word, Word),-        Integer -> (Integer, Integer)+        Integer -> (Integer, Integer),+        Natural -> (Natural, Natural)   #-} integerSquareRootRem :: Integral a => a -> (a, a) integerSquareRootRem n@@ -92,7 +92,8 @@ --   Checks for negativity and 'isPossibleSquare'. {-# SPECIALISE exactSquareRoot :: Int -> Maybe Int,                                   Word -> Maybe Word,-                                  Integer -> Maybe Integer+                                  Integer -> Maybe Integer,+                                  Natural -> Maybe Natural   #-} exactSquareRoot :: Integral a => a -> Maybe a exactSquareRoot n@@ -106,7 +107,8 @@ --   is checked, if it is, the integer square root is calculated. {-# SPECIALISE isSquare :: Int -> Bool,                            Word -> Bool,-                           Integer -> Bool+                           Integer -> Bool,+                           Natural -> Bool   #-} isSquare :: Integral a => a -> Bool isSquare n = n >= 0 && isSquare' n@@ -119,7 +121,8 @@ --   arguments may cause any kind of havoc. {-# SPECIALISE isSquare' :: Int -> Bool,                             Word -> Bool,-                            Integer -> Bool+                            Integer -> Bool,+                            Natural -> Bool   #-} isSquare' :: Integral a => a -> Bool isSquare' n@@ -137,17 +140,18 @@ --   to eliminate altogether about 99.436% of all numbers. -- --   This is the test used by 'exactSquareRoot'. For large numbers,---   the slower but more discriminating test 'isPossibleSqure2' is+--   the slower but more discriminating test 'isPossibleSquare2' is --   faster. {-# SPECIALISE isPossibleSquare :: Int -> Bool,+                                   Word -> Bool,                                    Integer -> Bool,-                                   Word -> Bool+                                   Natural -> Bool   #-} isPossibleSquare :: Integral a => a -> Bool-isPossibleSquare n =-  unsafeAt sr256 ((fromIntegral n) .&. 255)-  && unsafeAt sr693 (fromIntegral (n `rem` 693))-  && unsafeAt sr325 (fromIntegral (n `rem` 325))+isPossibleSquare n+  =  V.unsafeIndex sr256 ((fromIntegral n) .&. 255)+  && V.unsafeIndex sr693 (fromIntegral (n `rem` 693))+  && V.unsafeIndex sr325 (fromIntegral (n `rem` 325))  -- | Test whether a non-negative number may be a square. --   Non-negativity is not checked, passing negative arguments may@@ -163,55 +167,57 @@ --   numbers, where calculating the square root becomes more expensive, --   it is much faster (if the vast majority of tested numbers aren't squares). {-# SPECIALISE isPossibleSquare2 :: Int -> Bool,+                                    Word -> Bool,                                     Integer -> Bool,-                                    Word -> Bool+                                    Natural -> Bool   #-} isPossibleSquare2 :: Integral a => a -> Bool-isPossibleSquare2 n =-  unsafeAt sr256 ((fromIntegral n) .&. 255)-  && unsafeAt sr819  (fromIntegral (n `rem` 819))-  && unsafeAt sr1025 (fromIntegral (n `rem` 1025))-  && unsafeAt sr2047 (fromIntegral (n `rem` 2047))-  && unsafeAt sr4097 (fromIntegral (n `rem` 4097))-  && unsafeAt sr341  (fromIntegral (n `rem` 341))+isPossibleSquare2 n+  =  V.unsafeIndex sr256  ((fromIntegral n) .&. 255)+  && V.unsafeIndex sr819  (fromIntegral (n `rem` 819))+  && V.unsafeIndex sr1025 (fromIntegral (n `rem` 1025))+  && V.unsafeIndex sr2047 (fromIntegral (n `rem` 2047))+  && V.unsafeIndex sr4097 (fromIntegral (n `rem` 4097))+  && V.unsafeIndex sr341  (fromIntegral (n `rem` 341))  ----------------------------------------------------------------------------- --  Auxiliary Stuff  -- Make an array indicating whether a remainder is a square remainder.-sqRemArray :: Int -> UArray Int Bool-sqRemArray md = runSTUArray $ do-  arr <- newArray (0,md-1) False+sqRemArray :: Int -> V.Vector Bool+sqRemArray md = runST $ do+  ar <- MV.replicate md False   let !stop = (md `quot` 2) + 1       fill k-        | k < stop  = unsafeWrite arr ((k*k) `rem` md) True >> fill (k+1)-        | otherwise = return arr-  unsafeWrite arr 0 True-  unsafeWrite arr 1 True+        | k < stop  = MV.unsafeWrite ar ((k*k) `rem` md) True >> fill (k+1)+        | otherwise = return ()+  MV.unsafeWrite ar 0 True+  MV.unsafeWrite ar 1 True   fill 2+  V.unsafeFreeze ar -sr256 :: UArray Int Bool+sr256 :: V.Vector Bool sr256 = sqRemArray 256 -sr819 :: UArray Int Bool+sr819 :: V.Vector Bool sr819 = sqRemArray 819 -sr4097 :: UArray Int Bool+sr4097 :: V.Vector Bool sr4097 = sqRemArray 4097 -sr341 :: UArray Int Bool+sr341 :: V.Vector Bool sr341 = sqRemArray 341 -sr1025 :: UArray Int Bool+sr1025 :: V.Vector Bool sr1025 = sqRemArray 1025 -sr2047 :: UArray Int Bool+sr2047 :: V.Vector Bool sr2047 = sqRemArray 2047 -sr693 :: UArray Int Bool+sr693 :: V.Vector Bool sr693 = sqRemArray 693 -sr325 :: UArray Int Bool+sr325 :: V.Vector Bool sr325 = sqRemArray 325  -- Specialisations for Int, Word, and Integer

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2016 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Internal functions dealing with square roots. End-users should not import this module. 

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Type for numbers, accompanied by their factorisation. --@@ -26,7 +24,8 @@  import Math.NumberTheory.Euclidean import Math.NumberTheory.Euclidean.Coprimes-import Math.NumberTheory.UniqueFactorisation+import Math.NumberTheory.Primes+import Math.NumberTheory.Primes.Types  -- | A container for a number and its pairwise coprime (but not neccessarily prime) -- factorisation.@@ -36,29 +35,23 @@ -- -- For instance, let @p@ and @q@ be big primes: ----- >>> let p, q :: Integer--- >>>     p = 1000000000000000000000000000057--- >>>     q = 2000000000000000000000000000071+-- >>> let p = 1000000000000000000000000000057 :: Integer+-- >>> let q = 2000000000000000000000000000071 :: Integer ----- It would be  difficult to compute prime factorisation of their product--- as is:--- 'factorise' would take ages. Things become different if we simply+-- It would be difficult to compute the totient function+-- of their product as is, because once we multiplied them+-- the information of factors is lost and+-- 'Math.NumberTheory.ArithmeticFunctions.totient' (@p@ * @q@)+-- 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------ 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)]+-- >>> let p = 1000000000000000000000000000057 :: Prefactored Integer+-- >>> let q = 2000000000000000000000000000071 :: Prefactored Integer ----- Moreover, we can instantly compute 'totient' and its iterations.--- It works fine, because output of 'totient' is also prefactored.+-- Now the 'Math.NumberTheory.ArithmeticFunctions.totient' function+-- can be computed instantly: --+-- >>> import Math.NumberTheory.ArithmeticFunctions -- >>> prefValue $ totient (p^2 * q^3) -- 8000000000000000000000000001752000000000000000000000000151322000000000000000000000006445392000000000000000000000135513014000000000000000000001126361040 -- >>> prefValue $ totient $ totient (p^2 * q^3)@@ -66,14 +59,11 @@ -- -- Let us look under the hood: --+-- >>> import Math.NumberTheory.ArithmeticFunctions -- >>> prefFactors $ totient (p^2 * q^3)--- Coprimes {unCoprimes = fromList [(2,4),(3,3),---   (41666666666666666666666666669,1),(111111111111111111111111111115,1),---   (1000000000000000000000000000057,1),(2000000000000000000000000000071,2)]}+-- Coprimes {unCoprimes = [(1000000000000000000000000000057,1),(41666666666666666666666666669,1),(2000000000000000000000000000071,2),(111111111111111111111111111115,1),(2,4),(3,3)]} -- >>> 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)]}+-- Coprimes {unCoprimes = [(39521,1),(6046667,1),(22222222222222222222222222223,1),(2000000000000000000000000000071,1),(361696272343,1),(85331809838489,1),(227098769,1),(199937,1),(5,3),(41666666666666666666666666669,1),(2,22),(3,8)]} -- -- Pairwise coprimality of factors is crucial, because it allows -- us to process them independently, possibly even@@ -93,7 +83,7 @@ -- | Create 'Prefactored' from a given number. -- -- >>> fromValue 123--- Prefactored {prefValue = 123, prefFactors = Coprimes {unCoprimes = fromList [(123,1)]}}+-- Prefactored {prefValue = 123, prefFactors = Coprimes {unCoprimes = [(123,1)]}} fromValue :: (Eq a, Num a) => a -> Prefactored a fromValue a = Prefactored a (singleton a 1) @@ -101,13 +91,13 @@ -- (but not neccesarily prime) factors with multiplicities. -- -- >>> fromFactors (splitIntoCoprimes [(140, 1), (165, 1)])--- Prefactored {prefValue = 23100, prefFactors = Coprimes {unCoprimes = fromList [(5,2),(28,1),(33,1)]}}+-- Prefactored {prefValue = 23100, prefFactors = Coprimes {unCoprimes = [(28,1),(33,1),(5,2)]}} -- >>> fromFactors (splitIntoCoprimes [(140, 2), (165, 3)])--- Prefactored {prefValue = 88045650000, prefFactors = Coprimes {unCoprimes = fromList [(5,5),(28,2),(33,3)]}}+-- Prefactored {prefValue = 88045650000, prefFactors = Coprimes {unCoprimes = [(28,2),(33,3),(5,5)]}} fromFactors :: Num a => Coprimes a Word -> Prefactored a fromFactors as = Prefactored (product (map (uncurry (^)) (unCoprimes as))) as -instance (Euclidean a, Ord a) => Num (Prefactored a) where+instance Euclidean a => Num (Prefactored a) where   Prefactored v1 _ + Prefactored v2 _     = fromValue (v1 + v2)   Prefactored v1 _ - Prefactored v2 _@@ -119,12 +109,9 @@   signum (Prefactored v _) = Prefactored (signum v) mempty   fromInteger n = fromValue (fromInteger n) -type instance Prime (Prefactored a) = Prime a--instance (Eq a, Num a, UniqueFactorisation a) => UniqueFactorisation (Prefactored a) where-  unPrime p = fromValue (unPrime p)+instance (Euclidean a, UniqueFactorisation a) => UniqueFactorisation (Prefactored a) where   factorise (Prefactored _ f)-    = concatMap (\(x, xm) -> map (second (* xm)) (factorise x)) (unCoprimes f)+    = concatMap (\(x, xm) -> map (\(p, k) -> (Prime $ fromValue $ unPrime p, k * xm)) (factorise x)) (unCoprimes f)   isPrime (Prefactored _ f) = case unCoprimes f of-    [(n, 1)] -> isPrime n+    [(n, 1)] -> Prime . fromValue . unPrime <$> isPrime n     _        -> Nothing

@@ -1,19 +1,259 @@ -- | -- Module:      Math.NumberTheory.Primes--- Copyright:   (c) 2011 Daniel Fischer+-- Copyright:   (c) 2016-2018 Andrew.Lelechenko -- Licence:     MIT--- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions)+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com> --++{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase        #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Math.NumberTheory.Primes-    ( module Math.NumberTheory.Primes.Sieve-    , module Math.NumberTheory.Primes.Counting-    , module Math.NumberTheory.Primes.Testing-    , module Math.NumberTheory.Primes.Factorisation+    ( Prime+    , unPrime+    , nextPrime+    , precPrime+    , UniqueFactorisation(..)+    , -- * Old interface+      primes     ) where -import Math.NumberTheory.Primes.Sieve-import Math.NumberTheory.Primes.Counting-import Math.NumberTheory.Primes.Testing-import Math.NumberTheory.Primes.Factorisation+import Control.Arrow+import Data.Bits+import Data.Coerce+import Data.Maybe++import Math.NumberTheory.Primes.Counting (nthPrime, primeCount)+import qualified Math.NumberTheory.Primes.Factorisation as F (factorise)+import qualified Math.NumberTheory.Primes.Testing.Probabilistic as T (isPrime)+import Math.NumberTheory.Primes.Sieve.Eratosthenes (primes, sieveRange, primeList, psieveFrom, primeSieve)+import Math.NumberTheory.Primes.Types+import Math.NumberTheory.Utils (toWheel30, fromWheel30)+import Math.NumberTheory.Utils.FromIntegral++import Numeric.Natural++-- | A class for unique factorisation domains.+class Num a => UniqueFactorisation a where+  -- | Factorise a number into a product of prime powers.+  -- Factorisation of 0 is an undefined behaviour. Otherwise+  -- following invariants hold:+  --+  -- > abs n == abs (product (map (\(p, k) -> unPrime p ^ k) (factorise n)))+  -- > all ((> 0) . snd) (factorise n)+  --+  -- >>> factorise (1 :: Integer)+  -- []+  -- >>> factorise (-1 :: Integer)+  -- []+  -- >>> factorise (6 :: Integer)+  -- [(Prime 2,1),(Prime 3,1)]+  -- >>> factorise (-108 :: Integer)+  -- [(Prime 2,2),(Prime 3,3)]+  --+  -- This function is a replacement+  -- for 'Math.NumberTheory.Primes.Factorisation.factorise'.+  -- If you were looking for the latter, please import+  -- "Math.NumberTheory.Primes.Factorisation" instead of this module.+  --+  -- __Warning:__ there are no guarantees of any particular+  -- order of prime factors, do not expect them to be ascending. E. g.,+  --+  -- >>> factorise 10251562501+  -- [(Prime 101701,1),(Prime 100801,1)]+  factorise :: a -> [(Prime a, Word)]+  -- | Check whether an argument is prime.+  -- If it is then return an associated prime.+  --+  -- >>> isPrime (3 :: Integer)+  -- Just (Prime 3)+  -- >>> isPrime (4 :: Integer)+  -- Nothing+  -- >>> isPrime (-5 :: Integer)+  -- Just (Prime 5)+  --+  -- This function is a replacement+  -- for 'Math.NumberTheory.Primes.Testing.isPrime'.+  -- If you were looking for the latter, please import+  -- "Math.NumberTheory.Primes.Testing" instead of this module.+  isPrime   :: a -> Maybe (Prime a)++instance UniqueFactorisation Int where+  factorise = map (Prime . integerToInt *** id) . F.factorise . intToInteger+  isPrime n = if T.isPrime (toInteger n) then Just (Prime $ abs n) else Nothing++instance UniqueFactorisation Word where+  factorise = map (coerce integerToWord *** id) . F.factorise . wordToInteger+  isPrime n = if T.isPrime (toInteger n) then Just (Prime n) else Nothing++instance UniqueFactorisation Integer where+  factorise = coerce . F.factorise+  isPrime n = if T.isPrime n then Just (Prime $ abs n) else Nothing++instance UniqueFactorisation Natural where+  factorise = map (coerce integerToNatural *** id) . F.factorise . naturalToInteger+  isPrime n = if T.isPrime (toInteger n) then Just (Prime n) else Nothing++-- | Smallest prime, greater or equal to argument.+--+-- > nextPrime (-100) ==    2+-- > nextPrime  1000  == 1009+-- > nextPrime  1009  == 1009+nextPrime :: (Bits a, Integral a, UniqueFactorisation a) => a -> Prime a+nextPrime n+  | n <= 2    = Prime 2+  | n <= 3    = Prime 3+  | n <= 5    = Prime 5+  | otherwise = head $ mapMaybe isPrime $+                  dropWhile (< n) $ map fromWheel30 [toWheel30 n ..]+                  -- dropWhile is important, because fromWheel30 (toWheel30 n) may appear to be < n.+                  -- E. g., fromWheel30 (toWheel30 94) == 97++-- | Largest prime, less or equal to argument. Undefined, when argument < 2.+--+-- > precPrime 100 == 97+-- > precPrime  97 == 97+precPrime :: (Bits a, Integral a, UniqueFactorisation a) => a -> Prime a+precPrime n+  | n < 2     = error $ "precPrime: tried to take `precPrime` of an argument less than 2"+  | n < 3     = Prime 2+  | n < 5     = Prime 3+  | n < 7     = Prime 5+  | otherwise = head $ mapMaybe isPrime $+                  dropWhile (> n) $ map fromWheel30 [toWheel30 n, toWheel30 n - 1 ..]+                  -- dropWhile is important, because fromWheel30 (toWheel30 n) may appear to be > n.+                  -- E. g., fromWheel30 (toWheel30 100) == 101++-------------------------------------------------------------------------------+-- Prime sequences++data Algorithm = IsPrime | Sieve++chooseAlgorithm :: Integral a => a -> a -> Algorithm+chooseAlgorithm from to+  | to <= fromIntegral sieveRange+  && to < from + truncate (sqrt (fromIntegral from) :: Double)+  = IsPrime+  | to > fromIntegral sieveRange+  && to < from + truncate (0.036 * sqrt (fromIntegral from) + 40000 :: Double)+  = IsPrime+  | otherwise+  = Sieve++succGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a+succGeneric = \case+  Prime 2 -> Prime 3+  Prime 3 -> Prime 5+  Prime 5 -> Prime 7+  Prime p -> head $ mapMaybe isPrime $ map fromWheel30 [toWheel30 p + 1 ..]++succGenericBounded+  :: (Bits a, Integral a, UniqueFactorisation a, Bounded a)+  => Prime a+  -> Prime a+succGenericBounded = \case+  Prime 2 -> Prime 3+  Prime 3 -> Prime 5+  Prime 5 -> Prime 7+  Prime p -> case mapMaybe isPrime $ map fromWheel30 [toWheel30 p + 1 .. toWheel30 maxBound] of+    []    -> error "Enum.succ{Prime}: tried to take `succ' near `maxBound'"+    q : _ -> q++predGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a+predGeneric = \case+  Prime 2 -> error "Enum.pred{Prime}: tried to take `pred' of 2"+  Prime 3 -> Prime 2+  Prime 5 -> Prime 3+  Prime 7 -> Prime 5+  Prime p -> head $ mapMaybe isPrime $ map fromWheel30 [toWheel30 p - 1, toWheel30 p - 2 ..]++-- 'dropWhile' is important, because 'psieveFrom' can actually contain primes less than p.+enumFromGeneric :: Integral a => Prime a -> [Prime a]+enumFromGeneric p@(Prime p')+  = coerce+  $ dropWhile (< p)+  $ concat+  $ takeWhile (not . null)+  $ map primeList+  $ psieveFrom+  $ toInteger p'++enumFromToGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> [Prime a]+enumFromToGeneric p@(Prime p') q@(Prime q') = takeWhile (<= q) $ dropWhile (< p) $+  case chooseAlgorithm p' q' of+    IsPrime -> Prime 2 : Prime 3 : Prime 5 : mapMaybe isPrime (map fromWheel30 [toWheel30 p' .. toWheel30 q'])+    Sieve   ->+      if q' < fromIntegral sieveRange+      then           primeList $ primeSieve $ toInteger q'+      else concatMap primeList $ psieveFrom $ toInteger p'++enumFromThenGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> [Prime a]+enumFromThenGeneric p@(Prime p') (Prime q') = case p' `compare` q' of+  LT -> filter (\(Prime r') -> (r' - p') `mod` delta == 0) $ enumFromGeneric p+    where+      delta = q' - p'+  EQ -> repeat p+  GT -> filter (\(Prime r') -> (p' - r') `mod` delta == 0) $ reverse $ enumFromToGeneric (Prime 2) p+    where+      delta = p' - q'++enumFromThenToGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> Prime a -> [Prime a]+enumFromThenToGeneric p@(Prime p') (Prime q') r@(Prime r') = case p' `compare` q' of+  LT -> filter (\(Prime t') -> (t' - p') `mod` delta == 0) $ enumFromToGeneric p r+    where+      delta = q' - p'+  EQ -> if p' <= r' then repeat p else []+  GT -> filter (\(Prime t') -> (p' - t') `mod` delta == 0) $ reverse $ enumFromToGeneric r p+    where+      delta = p' - q'++instance Enum (Prime Integer) where+  toEnum = nthPrime . intToInteger+  fromEnum = integerToInt . primeCount . unPrime+  succ = succGeneric+  pred = predGeneric+  enumFrom = enumFromGeneric+  enumFromTo = enumFromToGeneric+  enumFromThen = enumFromThenGeneric+  enumFromThenTo = enumFromThenToGeneric++instance Enum (Prime Natural) where+  toEnum = Prime . integerToNatural . unPrime . nthPrime . intToInteger+  fromEnum = integerToInt . primeCount . naturalToInteger . unPrime+  succ = succGeneric+  pred = predGeneric+  enumFrom = enumFromGeneric+  enumFromTo = enumFromToGeneric+  enumFromThen = enumFromThenGeneric+  enumFromThenTo = enumFromThenToGeneric++instance Enum (Prime Int) where+  toEnum n = if p > intToInteger maxBound+    then error $ "Enum.toEnum{Prime}: " ++ show n ++ "th prime = " ++ show p ++ " is out of bounds of Int"+    else Prime (integerToInt p)+    where+      Prime p = nthPrime (intToInteger n)+  fromEnum = integerToInt . primeCount . intToInteger . unPrime+  succ = succGenericBounded+  pred = predGeneric+  enumFrom = enumFromGeneric+  enumFromTo = enumFromToGeneric+  enumFromThen = enumFromThenGeneric+  enumFromThenTo = enumFromThenToGeneric++instance Enum (Prime Word) where+  toEnum n = if p > wordToInteger maxBound+    then error $ "Enum.toEnum{Prime}: " ++ show n ++ "th prime = " ++ show p ++ " is out of bounds of Word"+    else Prime (integerToWord p)+    where+      Prime p = nthPrime (intToInteger n)+  fromEnum = integerToInt . primeCount . wordToInteger . unPrime+  succ = succGenericBounded+  pred = predGeneric+  enumFrom = enumFromGeneric+  enumFromTo = enumFromToGeneric+  enumFromThen = enumFromThenGeneric+  enumFromThenTo = enumFromThenToGeneric

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: non-portable -- -- Number of primes not exceeding @n@, @&#960;(n)@, and @n@-th prime; also fast, but -- reasonably accurate approximations to these.

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: portable -- -- Approximations to the number of primes below a limit and the -- n-th prime.

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: non-portable -- -- Number of primes not exceeding @n@, @&#960;(n)@, and @n@-th prime. --@@ -27,6 +25,7 @@ import Math.NumberTheory.Primes.Sieve.Eratosthenes import Math.NumberTheory.Primes.Sieve.Indexing import Math.NumberTheory.Primes.Counting.Approximate+import Math.NumberTheory.Primes.Types import Math.NumberTheory.Powers.Squares import Math.NumberTheory.Powers.Cubes import Math.NumberTheory.Logarithms@@ -61,7 +60,7 @@ primeCount n     | n > primeCountMaxArg = error $ "primeCount: can't handle bound " ++ show n     | n < 2     = 0-    | n < 1000  = fromIntegral . length . takeWhile (<= n) . primeList . primeSieve $ max 242 n+    | n < 1000  = fromIntegral . length . takeWhile (<= n) . map unPrime . primeList . primeSieve $ max 242 n     | n < 30000 = runST $ do         ba <- sieveTo n         (s,e) <- getBounds ba@@ -86,13 +85,13 @@ -- --   Requires @/O/((n*log n)^0.5)@ space, the time complexity is roughly @/O/((n*log n)^0.7@. --   The argument must be strictly positive, and must not exceed 'nthPrimeMaxArg'.-nthPrime :: Integer -> Integer+nthPrime :: Integer -> Prime Integer nthPrime n     | n < 1         = error "Prime indexing starts at 1"     | n > nthPrimeMaxArg = error $ "nthPrime: can't handle index " ++ show n-    | n < 200000    = nthPrimeCt n-    | ct0 < n       = tooLow n p0 (n-ct0) approxGap-    | otherwise     = tooHigh n p0 (ct0-n) approxGap+    | n < 200000    = Prime $ nthPrimeCt n+    | ct0 < n       = Prime $ tooLow n p0 (n-ct0) approxGap+    | otherwise     = Prime $ tooHigh n p0 (ct0-n) approxGap       where         p0 = nthPrimeApprox n         approxGap = (7 * fromIntegral (integerLog2' p0)) `quot` 10

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Various functions related to prime factorisation. -- Many of these functions use the prime factorisation of an 'Integer'.

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Factorisation proving the primality of the found factors. --@@ -30,12 +28,12 @@  -- | @'certifiedFactorisation' n@ produces the prime factorisation --   of @n@, proving the primality of the factors, but doesn't report the proofs.-certifiedFactorisation :: Integer -> [(Integer,Int)]+certifiedFactorisation :: Integer -> [(Integer, Word)] certifiedFactorisation = map fst . certificateFactorisation  -- | @'certificateFactorisation' n@ produces a 'provenFactorisation' --   with a default bound of @100000@.-certificateFactorisation :: Integer -> [((Integer,Int),PrimalityProof)]+certificateFactorisation :: Integer -> [((Integer, Word),PrimalityProof)] certificateFactorisation n = provenFactorisation 100000 n  -- | @'provenFactorisation' bound n@ constructs a the prime factorisation of @n@@@ -47,7 +45,7 @@ --   Construction of primality proofs can take a /very/ long time, so this --   will usually be slow (but should be faster than using 'factorise' and --   proving the primality of the factors from scratch).-provenFactorisation :: Integer -> Integer -> [((Integer,Int),PrimalityProof)]+provenFactorisation :: Integer -> Integer -> [((Integer, Word),PrimalityProof)] provenFactorisation _ 1 = [] provenFactorisation bd n     | n < 2     = error "provenFactorisation: argument not positive"@@ -61,7 +59,7 @@                                                 (mkStdGen $ fromIntegral n `xor` 0xdeadbeef) Nothing k  -- | verify that we indeed have a correct primality proof-test :: [((Integer,Int),PrimalityProof)] -> [((Integer,Int),PrimalityProof)]+test :: [((Integer, Word),PrimalityProof)] -> [((Integer, Word),PrimalityProof)] test (t@((p,_),prf):more)     | p == cprime prf && checkPrimalityProof prf    = t : test more     | otherwise = error (invalid p prf)@@ -89,7 +87,7 @@                    -> g                             -- ^ Initial PRNG state                    -> Maybe Int                     -- ^ Estimated number of digits of the smallest prime factor                    -> Integer                       -- ^ The number to factorise-                   -> [((Integer,Int),PrimalityProof)]+                   -> [((Integer, Word),PrimalityProof)]                                                     -- ^ List of prime factors, exponents and primality proofs certiFactorisation primeBound primeTest prng seed mbdigs n     = case ptest n of@@ -147,7 +145,7 @@                             return  (mergeAll [dp,cp,gp], dc ++ cc ++ gc)  -- | merge two lists of factors, so that the result is strictly increasing (wrt the primes)-merge :: [((Integer,Int),PrimalityProof)] -> [((Integer,Int),PrimalityProof)] -> [((Integer,Int),PrimalityProof)]+merge :: [((Integer, Word), PrimalityProof)] -> [((Integer, Word), PrimalityProof)] -> [((Integer, Word), PrimalityProof)] merge xxs@(x@((p,e),c):xs) yys@(y@((q,d),_):ys)     = case compare p q of         LT -> x : merge xs yys@@ -157,7 +155,7 @@ merge xs _  = xs  -- | merge a list of lists of factors so that the result is strictly increasing (wrt the primes)-mergeAll :: [[((Integer,Int),PrimalityProof)]] -> [((Integer,Int),PrimalityProof)]+mergeAll :: [[((Integer, Word), PrimalityProof)]] -> [((Integer, Word), PrimalityProof)] mergeAll [] = [] mergeAll [xs] = xs mergeAll (xs:ys:zss) = merge (merge xs ys) (mergeAll zss)

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Factorisation of 'Integer's by the elliptic curve algorithm after Montgomery. -- The algorithm is explained at@@ -72,13 +70,20 @@ import Math.NumberTheory.Primes.Sieve.Eratosthenes import Math.NumberTheory.Primes.Sieve.Indexing import Math.NumberTheory.Primes.Testing.Probabilistic+import Math.NumberTheory.Primes.Types (unPrime) import Math.NumberTheory.Unsafe import Math.NumberTheory.Utils  -- | @'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)]+--+-- __Warning:__ there are no guarantees of any particular+-- order of prime factors, do not expect them to be ascending. E. g.,+--+-- >>> factorise 10251562501+-- [(101701,1),(100801,1)]+factorise :: Integer -> [(Integer, Word)] factorise n     | abs n == 1 = []     | n < 0      = factorise (-n)@@ -86,14 +91,14 @@     | otherwise  = factorise' n  -- | Like 'factorise', but without input checking, hence @n > 1@ is required.-factorise' :: Integer -> [(Integer,Int)]+factorise' :: Integer -> [(Integer, Word)] factorise' n = defaultStdGenFactorisation' (mkStdGen $ fromInteger n `xor` 0xdeadbeef) n  -- | @'stepFactorisation'@ is like 'factorise'', except that it doesn't use a --   pseudo random generator but steps through the curves in order. --   This strategy turns out to be surprisingly fast, on average it doesn't --   seem to be slower than the 'StdGen' based variant.-stepFactorisation :: Integer -> [(Integer,Int)]+stepFactorisation :: Integer -> [(Integer, Word)] stepFactorisation n     = let (sfs,mb) = smallFactors 100000 n       in sfs ++ case mb of@@ -106,7 +111,7 @@ --   For negative numbers, a factor of @-1@ is included, the factorisation of @1@ --   is empty. Since @0@ has no prime factorisation, a zero argument causes --   an error.-defaultStdGenFactorisation :: StdGen -> Integer -> [(Integer,Int)]+defaultStdGenFactorisation :: StdGen -> Integer -> [(Integer, Word)] defaultStdGenFactorisation sg n     | n == 0    = error "0 has no prime factorisation"     | n < 0     = (-1,1) : defaultStdGenFactorisation sg (-n)@@ -115,7 +120,7 @@  -- | Like 'defaultStdGenFactorisation', but without input checking, so --   @n@ must be larger than @1@.-defaultStdGenFactorisation' :: StdGen -> Integer -> [(Integer,Int)]+defaultStdGenFactorisation' :: StdGen -> Integer -> [(Integer, Word)] defaultStdGenFactorisation' sg n     = let (sfs,mb) = smallFactors 100000 n       in sfs ++ case mb of@@ -130,11 +135,11 @@ --   The primality test is 'bailliePSW', the @prng@ function - naturally - --   'randomR'. This function also requires small prime factors to have been --   stripped before.-stdGenFactorisation :: Maybe Integer    -- ^ Lower bound for composite divisors-                    -> StdGen           -- ^ Standard PRNG-                    -> Maybe Int        -- ^ Estimated number of digits of smallest prime factor-                    -> Integer          -- ^ The number to factorise-                    -> [(Integer,Int)]  -- ^ List of prime factors and exponents+stdGenFactorisation :: Maybe Integer     -- ^ Lower bound for composite divisors+                    -> StdGen            -- ^ Standard PRNG+                    -> Maybe Int         -- ^ Estimated number of digits of smallest prime factor+                    -> Integer           -- ^ The number to factorise+                    -> [(Integer, Word)] -- ^ List of prime factors and exponents stdGenFactorisation primeBound sg digits n     = curveFactorisation primeBound bailliePSW (\m -> randomR (6,m-2)) sg digits n @@ -164,7 +169,7 @@   -> g                              -- ^ Initial PRNG state   -> Maybe Int                      -- ^ Estimated number of digits of the smallest prime factor   -> Integer                        -- ^ The number to factorise-  -> [(Integer, Int)]               -- ^ List of prime factors and exponents+  -> [(Integer, Word)]              -- ^ List of prime factors and exponents curveFactorisation primeBound primeTest prng seed mbdigs n     | n == 1    = []     | ptest n   = [(n, 1)]@@ -179,10 +184,10 @@         rndR :: Integer -> State g Integer         rndR k = state (prng k) -        perfPw :: Integer -> (Integer, Int)+        perfPw :: Integer -> (Integer, Word)         perfPw = maybe highestPower (largePFPower . integerSquareRoot') primeBound -        fact :: Integer -> Int -> State g [(Integer, Int)]+        fact :: Integer -> Int -> State g [(Integer, Word)]         fact 1 _ = return mempty         fact m digs = do           let (b1, b2, ct) = findParms digs@@ -227,14 +232,14 @@                               else repFact x b1 b2 (count - 1)  data Factors = Factors-  { _primeFactors     :: [(Integer, Int)]-  , _compositeFactors :: [(Integer, Int)]+  { _primeFactors     :: [(Integer, Word)]+  , _compositeFactors :: [(Integer, Word)]   } -singlePrimeFactor :: Integer -> Int -> Factors+singlePrimeFactor :: Integer -> Word -> Factors singlePrimeFactor a b = Factors [(a, b)] [] -singleCompositeFactor :: Integer -> Int -> Factors+singleCompositeFactor :: Integer -> Word -> Factors singleCompositeFactor a b = Factors [] [(a, b)]  instance Semigroup Factors where@@ -245,7 +250,7 @@   mempty = Factors [] []   mappend = (<>) -modifyPowers :: (Int -> Int) -> Factors -> Factors+modifyPowers :: (Word -> Word) -> Factors -> Factors modifyPowers f (Factors pfs cfs)   = Factors (map (second f) pfs) (map (second f) cfs) @@ -343,12 +348,12 @@  -- | @'smallFactors' bound n@ finds all prime divisors of @n > 1@ up to @bound@ by trial division and returns the --   list of these together with their multiplicities, and a possible remaining factor which may be composite.-smallFactors :: Integer -> Integer -> ([(Integer,Int)], Maybe Integer)+smallFactors :: Integer -> Integer -> ([(Integer, Word)], Maybe Integer) smallFactors bd n = case shiftToOddCount n of                       (0,m) -> go m prms                       (k,m) -> (2,k) <: if m == 1 then ([],Nothing) else go m prms   where-    prms = tail (primeStore >>= primeList)+    prms = map unPrime $ tail (primeStore >>= primeList)     x <: ~(l,b) = (x:l,b)     go m (p:ps)         | m < p*p   = ([(m,1)], Nothing)

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Factorisation and primality testing using trial division. --@@ -21,12 +19,13 @@  import Math.NumberTheory.Primes.Sieve.Eratosthenes import Math.NumberTheory.Powers.Squares+import Math.NumberTheory.Primes.Types import Math.NumberTheory.Utils  -- | Factorise an 'Integer' using a given list of numbers considered prime. --   If the list is not a list of primes containing all relevant primes, the --   result could be surprising.-trialDivisionWith :: [Integer] -> Integer -> [(Integer,Int)]+trialDivisionWith :: [Integer] -> Integer -> [(Integer, Word)] trialDivisionWith prs n     | n < 0     = trialDivisionWith prs (-n)     | n == 0    = error "trialDivision of 0"@@ -47,11 +46,11 @@ --   primes @<= bound@. If @n@ has prime divisors @> bound@, the last entry --   in the list is the product of all these. If @n <= bound^2@, this is a --   full factorisation, but very slow if @n@ has large prime divisors.-trialDivisionTo :: Integer -> Integer -> [(Integer,Int)]+trialDivisionTo :: Integer -> Integer -> [(Integer, Word)] trialDivisionTo bd     | bd < 100      = trialDivisionTo 100-    | bd < 10000000 = trialDivisionWith (primeList $ primeSieve bd)-    | otherwise     = trialDivisionWith (takeWhile (<= bd) $ (psieveList >>= primeList))+    | bd < 10000000 = trialDivisionWith (map unPrime $ primeList $ primeSieve bd)+    | otherwise     = trialDivisionWith (takeWhile (<= bd) $ map unPrime $ (psieveList >>= primeList))  -- | Check whether a number is coprime to all of the numbers in the list --   (assuming that list contains only numbers > 1 and is ascending).@@ -69,5 +68,5 @@ trialDivisionPrimeTo :: Integer -> Integer -> Bool trialDivisionPrimeTo bd     | bd < 100      = trialDivisionPrimeTo 100-    | bd < 10000000 = trialDivisionPrimeWith (primeList $ primeSieve bd)-    | otherwise     = trialDivisionPrimeWith (takeWhile (<= bd) $ (psieveList >>= primeList))+    | bd < 10000000 = trialDivisionPrimeWith (map unPrime $ primeList $ primeSieve bd)+    | otherwise     = trialDivisionPrimeWith (takeWhile (<= bd) $ map unPrime $ (psieveList >>= primeList))

@@ -3,8 +3,6 @@ -- 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 sieve. -- Currently, an enhanced sieve of Eratosthenes is used, switching to an

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Sieve --@@ -38,6 +36,7 @@ import Control.Monad.ST import Data.Array.ST import Data.Array.Unboxed+import Data.Coerce import Data.Proxy import Control.Monad (when) import Data.Bits@@ -51,6 +50,7 @@ import Math.NumberTheory.Utils.FromIntegral import Math.NumberTheory.Primes.Counting.Approximate import Math.NumberTheory.Primes.Sieve.Indexing+import Math.NumberTheory.Primes.Types  #define IX_MASK     0xFFFFF #define IX_BITS     20@@ -112,12 +112,14 @@  -- | Generate a list of primes for consumption from a --   'PrimeSieve'.-primeList :: forall a. Integral a => PrimeSieve -> [a]+primeList :: forall a. Integral a => PrimeSieve -> [Prime 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+  | v == 0    = (coerce :: [a] -> [Prime a])+              $ takeWhileIncreasing $ 2 : 3 : 5 : primeListInternal ps+  | otherwise = (coerce :: [a] -> [Prime a])+              $ takeWhileIncreasing $ primeListInternal ps  primeListInternal :: Num a => PrimeSieve -> [a] primeListInternal (PS v0 bs)@@ -143,30 +145,32 @@ -- | Ascending list of primes. -- -- >>> take 10 primes--- [2, 3, 5, 7, 11, 13, 17, 19, 23, 29]+-- [Prime 2,Prime 3,Prime 5,Prime 7,Prime 11,Prime 13,Prime 17,Prime 19,Prime 23,Prime 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+-- >>> primes !! 1000000 :: Prime Int+-- Prime 15485867 -- (5.32 secs, 6,945,267,496 bytes)--- >>> primes !! 1000000 :: Int--- 15485867+-- >>> primes !! 1000000 :: Prime Int+-- Prime 15485867 -- (5.19 secs, 6,945,267,496 bytes) -- -- against ----- >>> let primes' = primes :: [Int]--- >>> primes' !! 1000000 :: Int--- 15485867+-- >>> let primes' = primes :: [Prime Int]+-- >>> primes' !! 1000000 :: Prime Int+-- Prime 15485867 -- (5.29 secs, 6,945,269,856 bytes)--- >>> primes' !! 1000000 :: Int--- 15485867+-- >>> primes' !! 1000000 :: Prime Int+-- Prime 15485867 -- (0.02 secs, 336,232 bytes)-primes :: (Ord a, Num a) => [a]-primes = takeWhileIncreasing $ 2 : 3 : 5 : concatMap primeListInternal psieveList+primes :: Integral a => [Prime a]+primes+  = (coerce :: [a] -> [Prime a])+  $ 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'@@@ -366,9 +370,9 @@           return (bitCountWord (w1 `shiftL` (RMASK - ei + si)))  -- | @'sieveFrom' n@ creates the list of primes not less than @n@.-sieveFrom :: Integer -> [Integer]+sieveFrom :: Integer -> [Prime Integer] sieveFrom n = case psieveFrom n of-                        ps -> dropWhile (< n) (ps >>= primeList)+                        ps -> dropWhile ((< n) . unPrime) (ps >>= primeList)  -- | @'psieveFrom' n@ creates the list of 'PrimeSieve's starting roughly --   at @n@. Due to the organisation of the sieve, the list may contain

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Auxiliary stuff, conversion between number and index, -- remainders modulo 30 and related things.

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Primality tests. 

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Certificates for primality or compositeness. module Math.NumberTheory.Primes.Testing.Certificates

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Certificates for primality or compositeness. {-# LANGUAGE CPP #-}@@ -40,6 +38,7 @@ import Math.NumberTheory.Primes.Factorisation.Montgomery import Math.NumberTheory.Primes.Testing.Probabilistic import Math.NumberTheory.Primes.Sieve.Eratosthenes+import Math.NumberTheory.Primes.Types (unPrime) import Math.NumberTheory.Powers.Squares  -- | A certificate of either compositeness or primality of an@@ -63,7 +62,7 @@       deriving Show  -- | An argument for compositeness of a number (which must be @> 1@).---   'CompositenessProof's translate directly to 'CompositenessArguments',+--   'CompositenessProof's translate directly to 'CompositenessArgument's, --   correct arguments can be transformed into proofs. This type allows the --   manipulation of proofs while maintaining their correctness. --   The only way to access components of a 'CompositenessProof' except@@ -81,7 +80,7 @@ data PrimalityProof     = Pocklington { cprime :: !Integer          -- ^ The number whose primality is proved.                   , factorisedPart, cofactor :: !Integer-                  , knownFactors :: ![(Integer,Int,Integer,PrimalityProof)]+                  , knownFactors :: ![(Integer, Word, Integer, PrimalityProof)]                   }     | TrialDivision { cprime :: !Integer        -- ^ The number whose primality is proved.                     , tdLimit :: !Integer }@@ -90,7 +89,7 @@       deriving Show  -- | An argument for primality of a number (which must be @> 1@).---   'PrimalityProof's translate directly to 'PrimalityArguments',+--   'PrimalityProof's translate directly to 'PrimalityArgument's, --   correct arguments can be transformed into proofs. This type allows the --   manipulation of proofs while maintaining their correctness. --   The only way to access components of a 'PrimalityProof' except@@ -98,13 +97,14 @@ data PrimalityArgument     = Pock { aprime :: Integer            , largeFactor, smallFactor :: Integer-           , factorList :: [(Integer,Int,Integer,PrimalityArgument)]+           , factorList :: [(Integer, Word, Integer, PrimalityArgument)]            }                                 -- ^ A suggested Pocklington certificate     | Division { aprime, alimit :: Integer } -- ^ Primality should be provable by trial division to @alimit@     | Obvious { aprime :: Integer }          -- ^ @aprime@ is said to be obviously prime, that holds for primes @< 30@     | Assumption { aprime :: Integer }       -- ^ Primality assumed       deriving (Show, Read, Eq, Ord) +-- | Eliminate 'Certificate'. argueCertificate :: Certificate -> Either CompositenessArgument PrimalityArgument argueCertificate (Composite proof) = Left (argueCompositeness proof) argueCertificate (Prime proof) = Right (arguePrimality proof)@@ -294,12 +294,12 @@  -- | Find a decomposition of p-1 for the pocklington certificate. --   Usually bloody slow if p-1 has two (or more) /large/ prime divisors.-findDecomposition :: Integer -> (Integer, [(Integer,Int,Bool)], Integer)+findDecomposition :: Integer -> (Integer, [(Integer, Word, Bool)], Integer) findDecomposition n = go 1 n [] prms   where     sr = integerSquareRoot' n     pbd = min 1000000 (sr+20)-    prms = primeList (primeSieve $ pbd)+    prms = map unPrime $ primeList (primeSieve $ pbd)     go a b afs (p:ps)         | a > b     = (a,afs,b)         | otherwise = case splitOff p b of

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Deterministic primality testing. module Math.NumberTheory.Primes.Testing.Certified (isCertifiedPrime) where

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer, 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Probabilistic primality tests, Miller-Rabin and Baillie-PSW. {-# LANGUAGE CPP, MagicHash, BangPatterns #-}

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- This is an internal module, defining types for primes. -- Should not be exposed to users.@@ -15,41 +13,62 @@ {-# LANGUAGE DeriveGeneric #-}  module Math.NumberTheory.Primes.Types-  ( Prime-  , Prm(..)-  , PrimeNat(..)+  ( Prime(..)   ) where -import Numeric.Natural import GHC.Generics import Control.DeepSeq -newtype Prm = Prm { unPrm :: Word }-  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 }+-- | Wrapper for prime elements of @a@. It is supposed to be constructed+-- by 'Math.NumberTheory.Primes.nextPrime' / 'Math.NumberTheory.Primes.precPrime'.+-- and eliminated by 'unPrime'.+--+-- One can leverage 'Enum' instance to generate lists of primes.+-- Here are some examples.+--+-- *  Generate primes from the given interval:+--+--    >>> [nextPrime 101 .. precPrime 130]+--    [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127]+--+-- *  Generate an infinite list of primes:+--+--    >>> [nextPrime 101 ..]+--    [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127...+--+-- *  Generate primes from the given interval of form p = 6k+5:+--+--    >>> [nextPrime 101, nextPrime 107 .. precPrime 150]+--    [Prime 101,Prime 107,Prime 113,Prime 131,Prime 137,Prime 149]+--+-- *  Get next prime:+--+--    >>> succ (nextPrime 101)+--    Prime 103+--+-- *  Get previous prime:+--+--    >>> prec (nextPrime 101)+--    Prime 97+--+-- *  Count primes less than a given number (cf. 'Math.NumberTheory.Primes.Counting.approxPrimeCount'):+--+--    >>> fromEnum (precPrime 100)+--    25+--+-- *  Get 25-th prime number (cf. 'Math.NumberTheory.Primes.Counting.nthPrimeApprox'):+--+--    >>> toEnum 25 :: Prime Int+--    Prime 97+--+newtype Prime a = Prime+  { unPrime :: a -- ^ Unwrap prime element.+  }   deriving (Eq, Ord, Generic) -instance NFData PrimeNat+instance NFData a => NFData (Prime a) -instance Show PrimeNat where-  showsPrec d (PrimeNat p) r = (if d > 10 then "(" ++ s ++ ")" else s) ++ r+instance Show a => Show (Prime a) where+  showsPrec d (Prime p) r = (if d > 10 then "(" ++ s ++ ")" else s) ++ r     where-      s = "PrimeNat " ++ show p---- | Type of primes of a given unique factorisation domain.------ @abs (unPrime n) == unPrime n@ must hold for all @n@ of type @Prime t@-type family Prime (f :: *) :: *--type instance Prime Int     = Prm-type instance Prime Word    = Prm-type instance Prime Integer = PrimeNat-type instance Prime Natural = PrimeNat+      s = "Prime " ++ show p

@@ -3,8 +3,6 @@ -- 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.@@ -13,6 +11,7 @@ {-# LANGUAGE BangPatterns   #-} {-# LANGUAGE DeriveGeneric  #-} {-# LANGUAGE RankNTypes     #-}+{-# LANGUAGE TypeFamilies   #-}  module Math.NumberTheory.Quadratic.EisensteinIntegers   ( EisensteinInteger(..)@@ -22,15 +21,13 @@   , associates   , ids -  , divideByThree-   -- * Primality functions-  , factorise   , findPrime-  , isPrime   , primes   ) where +import Control.DeepSeq+import Data.Coerce import Data.List                                       (mapAccumL, partition) import Data.Maybe                                      (fromMaybe) import Data.Ord                                        (comparing)@@ -38,23 +35,25 @@  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.Primes.Types+import qualified Math.NumberTheory.Primes  as U import Math.NumberTheory.Utils                          (mergeBy)-import Math.NumberTheory.Utils.FromIntegral             (integerToNatural)+import Math.NumberTheory.Utils.FromIntegral  infix 6 :+ --- | An Eisenstein integer is a + bω, where a and b are both integers.+-- | An Eisenstein integer is @a + bω@, where @a@ and @b@ are both integers. data EisensteinInteger = (:+) { real :: !Integer, imag :: !Integer }     deriving (Eq, Ord, Generic) +instance NFData EisensteinInteger+ -- | The imaginary unit for Eisenstein integers, where -- -- > ω == (-1/2) + ((sqrt 3)/2)ι == exp(2*pi*ι/3)--- and ι is the usual imaginary unit with ι² == -1.+-- and @ι@ is the usual imaginary unit with @ι² == -1@. ω :: EisensteinInteger ω = 0 :+ 1 @@ -97,13 +96,6 @@ 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@@ -149,12 +141,12 @@  -- | Remove @1 - ω@ factors from an @EisensteinInteger@, and calculate that -- prime's multiplicity in the number's factorisation.-divideByThree :: EisensteinInteger -> (Int, EisensteinInteger)+divideByThree :: EisensteinInteger -> (Word, EisensteinInteger) divideByThree = go 0   where-    go :: Int -> EisensteinInteger -> (Int, EisensteinInteger)+    go :: Word -> EisensteinInteger -> (Word, EisensteinInteger)     go !n z@(a :+ b) | r1 == 0 && r2 == 0 = go (n + 1) (q1 :+ q2)-                      | otherwise          = (n, abs z)+                     | 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))@.@@ -167,138 +159,146 @@ -- -- 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@+--     * Each prime of the form @3n + 1@ is actually of the form @6k + 1@.+--     * One has @(z + 3k)^2 ≡ z^2 + 6kz + 9k^2 ≡ z^2 + (6k + 1)z - z + 9k^2 ≡ z^2 - z + 9k^2 (mod 6k + 1)@. ----- * 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+-- The goal is to solve @z^2 - z + 1 ≡ 0 (mod 6k + 1)@. One has:+--+--     1. @z^2 - z + 1 ≡ 0 (mod 6k + 1)@+--     2. @z^2 - z ≡ -1 (mod 6k + 1)@+--     3. @z^2 - z + 9k^2 ≡ 9k^2 - 1 (mod 6k + 1)@+--     4. @(z + 3k)^2 ≡ 9k^2 - 1 (mod 6k + 1)@+--     5. @z + 3k = sqrtsModPrime(9k^2 - 1) (mod 6k + 1)@+--     6. @z = (sqrtsModPrime(9k^2 - 1) (mod 6k + 1)) - 3k@+--+-- For example, let @p = 7@, then @k = 1@.+-- Square root of @9*1^2-1 ≡ 1 (mod 7)@, and @z = 1 - 3*1 = -2 ≡ 5 (mod 7)@.+--+-- Truly, @norm (5 :+ 1) = 25 - 5 + 1 = 21 ≡ 0 (mod 7)@.+findPrime :: Prime Integer -> U.Prime EisensteinInteger+findPrime p = case sqrtsModPrime (9*k*k - 1) p of     []    -> error "findPrime: argument must be prime p = 6k + 1"-    z : _ -> ED.gcd (p :+ 0) ((z - 3 * k) :+ 1)+    z : _ -> Prime $ ED.gcd (unPrime p :+ 0) ((z - 3 * k) :+ 1)     where         k :: Integer-        k = p `div` 6+        k = unPrime p `div` 6 --- | An infinite list of Eisenstein primes. Uses primes in Z to exhaustively--- generate all Eisenstein primes in order of ascending magnitude.+-- | An infinite list of Eisenstein primes. Uses primes in @Z@ to exhaustively+-- generate all Eisenstein primes in order of ascending norm.+-- -- * 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)]]+-- applying 'associates' to each prime in this list.+primes :: [Prime EisensteinInteger]+primes = coerce $ (2 :+ 1) : mergeBy (comparing norm) l r+  where+    leftPrimes, rightPrimes :: [Prime Integer]+    (leftPrimes, rightPrimes) = partition (\p -> unPrime p `mod` 3 == 2) Sieve.primes+    rightPrimes' = filter (\prime -> unPrime prime `mod` 3 == 1) $ tail rightPrimes+    l = [unPrime p :+ 0 | p <- leftPrimes]+    r = [g | p <- rightPrimes', let x :+ y = unPrime (findPrime p), g <- [x :+ y, x :+ (x - y)]] --- | 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@.+-- | [Implementation notes for factorise function] ----- * 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@.+-- Compute the prime factorisation of a Eisenstein integer. ----- * 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@.+--     1. 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@.+--     2. 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@.+--     3. 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 Eisenstein primes. ----- * 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 the equation from Theorem 8.4: ----- * 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]]@+-- 1. @norm μ = norm ( (-1)^a * ω^b * (1 - ω)^c * product [ π_i^a_i | i <- [1..N]] ) ==@+-- 2. @norm μ = norm ((-1)^a) * norm (ω^b) * norm ((1 - ω)^c) * norm (product [ π_i^a_i | i <- [1..N]]) ==@+-- 3. @norm μ = (norm (-1))^a * (norm ω)^b * (norm (1 - ω))^c * product [ norm (π_i^a_i) | i <- [1..N]] ==@+-- 4. @norm μ = (norm (-1))^a * (norm ω)^b * (norm (1 - ω))^c * product [ (norm π_i)^a_i) | i <- [1..N]] ==@+-- 5. @norm μ = 1^a * 1^b * 3^c * product [ (norm π_i)^a_i) | i <- [1..N]] ==@+-- 6. @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 remainder of the Eisenstein integer factorisation problem is about+-- finding appropriate Eisenstein primes @[e_i | i <- [1..M]]@ such that+-- @map norm [e_i | i <- [1..M]] == map norm [π_i | i <- [1..N]]@+-- where @ 1 < N <= M@ are integers and @==@ is equality on sets+-- (i.e.duplicates do not matter). ----- * 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)]+-- NB: The reason @M >= N@ is because the prime factors of an Eisenstein integer+-- may include a prime factor and its conjugate (both have the same norm),+-- meaning the number may have more Eisenstein prime factors than its norm has+-- integer prime factors.+factorise :: EisensteinInteger -> [(Prime EisensteinInteger, Word)] factorise g = concat $               snd $-              mapAccumL go (abs g) (Factorisation.factorise $ norm g)+              mapAccumL go (abs g) (U.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."+    go :: EisensteinInteger -> (Prime Integer, Word) -> (EisensteinInteger, [(Prime EisensteinInteger, Word)])+    go z (Prime 3, e)+      | e == n    = (q, [(Prime (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')])+    go z (p, e)+      | unPrime p `mod` 3 == 2+      = let e' = e `quot` 2 in (z `quotI` (unPrime p ^ e'), [(Prime (unPrime p :+ 0), e')]) -                -- The @`mod` 3 == 0@ case need not be verified because the-                -- 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')])+      -- 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 = findPrime p+        x :+ y = unPrime gp         -- @gp'@ is @gp@'s conjugate.-        gp'              = primary $ abs $ x :+ (x - y)-        (k, k', z') = divideByPrime gp gp' p e z+        gp' = Prime (x :+ (x - y))+        (k, k', z') = divideByPrime gp gp' (unPrime p) e z          quotI (a :+ b) n = (a `quot` n :+ b `quot` n)  -- | 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+    :: Prime EisensteinInteger -- ^ Eisenstein prime @p@+    -> Prime EisensteinInteger -- ^ Conjugate of @p@+    -> Integer                 -- ^ Precomputed norm of @p@, of form @4k + 1@+    -> Word                    -- ^ Expected number of factors (either @p@ or @conjugate p@)+                               --   in Eisenstein integer @z@+    -> EisensteinInteger       -- ^ Eisenstein integer @z@+    -> ( Word                  -- Multiplicity of factor @p@ in @z@+       , Word                  -- 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 :: Word -> Word -> EisensteinInteger -> (Word, Word, 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'+                z'' = head $ drop (wordToInt d2)+                    $ iterate (\g -> fromMaybe err $ (g * unPrime p) `quotEvenI` np) z' -        go1 :: Int -> Int -> EisensteinInteger -> (Int, EisensteinInteger)+        go1 :: Word -> Word -> EisensteinInteger -> (Word, EisensteinInteger)         go1 0 d z = (d, z)         go1 c d z-            | Just z' <- (z * p') `quotEvenI` np+            | Just z' <- (z * unPrime p') `quotEvenI` np             = go1 (c - 1) (d + 1) z'             | otherwise             = (d, z)@@ -313,3 +313,14 @@   where     (xq, xr) = x `quotRem` n     (yq, yr) = y `quotRem` n++-------------------------------------------------------------------------------++-- | See the source code and Haddock comments for the @factorise@ and @isPrime@+-- functions in this module (they are not exported) for implementation+-- details.+instance U.UniqueFactorisation EisensteinInteger where+  factorise 0 = []+  factorise e = coerce $ factorise e++  isPrime e = if isPrime e then Just (Prime e) else Nothing

@@ -3,32 +3,26 @@ -- 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 BangPatterns  #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies  #-}  module Math.NumberTheory.Quadratic.GaussianIntegers (     GaussianInteger(..),     ι,     conjugate,     norm,-    (.^),-    isPrime,     primes,-    gcdG,-    gcdG',     findPrime,-    findPrime',-    factorise, ) where  import Control.DeepSeq (NFData)+import Data.Coerce import Data.List (mapAccumL, partition) import Data.Maybe (fromMaybe) import Data.Ord (comparing)@@ -38,15 +32,14 @@ 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 Math.NumberTheory.Primes.Types import qualified Math.NumberTheory.Primes.Sieve as Sieve import qualified Math.NumberTheory.Primes.Testing as Testing+import qualified Math.NumberTheory.Primes  as U import Math.NumberTheory.Utils              (mergeBy)-import Math.NumberTheory.Utils.FromIntegral (integerToNatural)+import Math.NumberTheory.Utils.FromIntegral  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)@@ -119,77 +112,47 @@ -- |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]]+primes :: [U.Prime GaussianInteger]+primes = coerce $ (1 :+ 1) : mergeBy (comparing norm) l r+  where+    leftPrimes, rightPrimes :: [Prime Integer]+    (leftPrimes, rightPrimes) = partition (\p -> unPrime p `mod` 4 == 3) (tail Sieve.primes)+    l = [unPrime p :+ 0 | p <- leftPrimes]+    r = [g | p <- rightPrimes, let Prime (x :+ y) = findPrime p, g <- [x :+ y, y :+ x]]  --- | 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+findPrime :: Prime Integer -> U.Prime GaussianInteger+findPrime p = case sqrtsModPrime (-1) p of     []    -> error "findPrime: an argument must be prime p = 4k + 1"-    z : _ -> go p z -- Effectively we calculate gcdG' (p :+ 0) (z :+ 1)+    z : _ -> Prime $ go (unPrime p) z -- Effectively we calculate gcdG' (p :+ 0) (z :+ 1)     where         sqrtp :: Integer-        sqrtp = integerSquareRoot p+        sqrtp = integerSquareRoot (unPrime 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).+-- | 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)+factorise :: GaussianInteger -> [(Prime GaussianInteger, Word)]+factorise g = concat $ snd $ mapAccumL go g (U.factorise $ norm g)     where-        go :: GaussianInteger -> (Integer, Int) -> (GaussianInteger, [(GaussianInteger, Int)])-        go z (2, e) = (divideByTwo z, [(1 :+ 1, e)])+        go :: GaussianInteger -> (Prime Integer, Word) -> (GaussianInteger, [(Prime GaussianInteger, Word)])+        go z (Prime 2, e) = (divideByTwo z, [(Prime (1 :+ 1), e)])         go z (p, e)-            | p `mod` 4 == 3-            = let e' = e `quot` 2 in (z `quotI` (p ^ e'), [(p :+ 0, e')])+            | unPrime p `mod` 4 == 3+            = let e' = e `quot` 2 in (z `quotI` (unPrime p ^ e'), [(Prime (unPrime 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)+                    (k, k', z') = divideByPrime gp (unPrime p) e z+                    gp' = Prime (abs (conjugate (unPrime gp)))  -- | Remove all (1:+1) factors from the argument, -- avoiding complex division.@@ -205,18 +168,18 @@ -- | 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+    :: Prime GaussianInteger -- ^ Gaussian prime p+    -> Integer               -- ^ Precomputed norm of p, of form 4k + 1+    -> Word                  -- ^ Expected number of factors (either p or conj p)+                             --   in Gaussian integer z+    -> GaussianInteger       -- ^ Gaussian integer z+    -> ( Word                -- Multiplicity of factor p in z+       , Word                -- 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 :: Word -> Word -> GaussianInteger -> (Word, Word, GaussianInteger)         go 0 d z = (d, d, z)         go c d z             | c >= 2@@ -226,13 +189,13 @@             where                 (d1, z') = go1 c 0 z                 d2 = c - d1-                z'' = head $ drop d2-                    $ iterate (\g -> fromMaybe err $ (g * p) `quotEvenI` np) z'+                z'' = head $ drop (wordToInt d2)+                    $ iterate (\g -> fromMaybe err $ (g * unPrime p) `quotEvenI` np) z' -        go1 :: Int -> Int -> GaussianInteger -> (Int, GaussianInteger)+        go1 :: Word -> Word -> GaussianInteger -> (Word, GaussianInteger)         go1 0 d z = (d, z)         go1 c d z-            | Just z' <- (z * conjugate p) `quotEvenI` np+            | Just z' <- (z * conjugate (unPrime p)) `quotEvenI` np             = go1 (c - 1) (d + 1) z'             | otherwise             = (d, z)@@ -252,3 +215,11 @@     where         (xq, xr) = x `quotRem` n         (yq, yr) = y `quotRem` n++-------------------------------------------------------------------------------++instance U.UniqueFactorisation GaussianInteger where+  factorise 0 = []+  factorise g = coerce $ factorise g++  isPrime g = if isPrime g then Just (Prime g) else Nothing

@@ -0,0 +1,16 @@+-- |+-- Module:      Math.NumberTheory.Recurrences+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+--++module Math.NumberTheory.Recurrences+    ( module Math.NumberTheory.Recurrences.Linear+    , module Math.NumberTheory.Recurrences.Bilinear+    , module Math.NumberTheory.Recurrences.Pentagonal+    ) where++import Math.NumberTheory.Recurrences.Bilinear+import Math.NumberTheory.Recurrences.Linear+import Math.NumberTheory.Recurrences.Pentagonal (partition)

@@ -0,0 +1,270 @@+-- |+-- Module:      Math.NumberTheory.Recurrences.Bilinear+-- Copyright:   (c) 2016 Andrew Lelechenko+-- Licence:     MIT+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Bilinear recurrent sequences and Bernoulli numbers,+-- roughly covering Ch. 5-6 of /Concrete Mathematics/+-- by R. L. Graham, D. E. Knuth and O. Patashnik.+--+-- #memory# __Note on memory leaks and memoization.__+-- Top-level definitions in this module are polymorphic, so the results of computations are not retained in memory.+-- Make them monomorphic to take advantages of memoization. Compare+--+-- >>> :set +s+-- >>> binomial !! 1000 !! 1000 :: Integer+-- 1+-- (0.01 secs, 1,385,512 bytes)+-- >>> binomial !! 1000 !! 1000 :: Integer+-- 1+-- (0.01 secs, 1,381,616 bytes)+--+-- against+--+-- >>> let binomial' = binomial :: [[Integer]]+-- >>> binomial' !! 1000 !! 1000 :: Integer+-- 1+-- (0.01 secs, 1,381,696 bytes)+-- >>> binomial' !! 1000 !! 1000 :: Integer+-- 1+-- (0.01 secs, 391,152 bytes)++{-# LANGUAGE CPP                 #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Math.NumberTheory.Recurrences.Bilinear+  ( binomial+  , stirling1+  , stirling2+  , lah+  , eulerian1+  , eulerian2+  , bernoulli+  , euler+  , eulerPolyAt1+  , faulhaberPoly+  ) where++import Data.List+import Data.Ratio+import Numeric.Natural++import Math.NumberTheory.Recurrences.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]]+--+-- Complexity: @binomial !! n !! k@ is O(n) bits long, its computation+-- takes O(k n) time and forces thunks @binomial !! n !! i@ for @0 <= i <= k@.+-- Use the symmetry of Pascal triangle @binomial !! n !! k == binomial !! n !! (n - k)@ to speed up computations.+--+-- One could also consider 'Math.Combinat.Numbers.binomial' to compute stand-alone values.+binomial :: Integral a => [[a]]+binomial = map f [0..]+  where+    f n = scanl (\x k -> x * (n - k + 1) `div` k) 1 [1..n]+{-# SPECIALIZE binomial :: [[Int]]     #-}+{-# SPECIALIZE binomial :: [[Word]]    #-}+{-# SPECIALIZE binomial :: [[Integer]] #-}+{-# SPECIALIZE binomial :: [[Natural]] #-}++-- | 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]]+--+-- Complexity: @stirling1 !! n !! k@ is O(n ln n) bits long, its computation+-- takes O(k n^2 ln n) time and forces thunks @stirling1 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@.+--+-- One could also consider 'Math.Combinat.Numbers.unsignedStirling1st' to compute stand-alone values.+stirling1 :: (Num a, Enum a) => [[a]]+stirling1 = scanl f [1] [0..]+  where+    f xs n = 0 : zipIndexedListWithTail (\_ x y -> x + n * y) 1 xs 0+{-# SPECIALIZE stirling1 :: [[Int]]     #-}+{-# SPECIALIZE stirling1 :: [[Word]]    #-}+{-# SPECIALIZE stirling1 :: [[Integer]] #-}+{-# SPECIALIZE stirling1 :: [[Natural]] #-}++-- | 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]]+--+-- Complexity: @stirling2 !! n !! k@ is O(n ln n) bits long, its computation+-- takes O(k n^2 ln n) time and forces thunks @stirling2 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@.+--+-- One could also consider 'Math.Combinat.Numbers.stirling2nd' to compute stand-alone values.+stirling2 :: (Num a, Enum a) => [[a]]+stirling2 = iterate f [1]+  where+    f xs = 0 : zipIndexedListWithTail (\k x y -> x + k * y) 1 xs 0+{-# SPECIALIZE stirling2 :: [[Int]]     #-}+{-# SPECIALIZE stirling2 :: [[Word]]    #-}+{-# SPECIALIZE stirling2 :: [[Integer]] #-}+{-# SPECIALIZE stirling2 :: [[Natural]] #-}++-- | 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]]+--+-- Complexity: @lah !! n !! k@ is O(n ln n) bits long, its computation+-- takes O(k n ln n) time and forces thunks @lah !! n !! i@ for @0 <= i <= k@.+lah :: Integral a => [[a]]+-- Implementation was derived from code by https://github.com/grandpascorpion+lah = zipWith f (tail factorial) [1..]+  where+    f nf n = scanl (\x k -> x * (n - k) `div` (k * (k + 1))) nf [1..n-1]+{-# SPECIALIZE lah :: [[Int]]     #-}+{-# SPECIALIZE lah :: [[Word]]    #-}+{-# SPECIALIZE lah :: [[Integer]] #-}+{-# SPECIALIZE lah :: [[Natural]] #-}++-- | 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]]+--+-- Complexity: @eulerian1 !! n !! k@ is O(n ln n) bits long, its computation+-- takes O(k n^2 ln n) time and forces thunks @eulerian1 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@.+--+eulerian1 :: (Num a, Enum a) => [[a]]+eulerian1 = scanl f [] [1..]+  where+    f xs n = 1 : zipIndexedListWithTail (\k x y -> (n - k) * x + (k + 1) * y) 1 xs 0+{-# SPECIALIZE eulerian1 :: [[Int]]     #-}+{-# SPECIALIZE eulerian1 :: [[Word]]    #-}+{-# SPECIALIZE eulerian1 :: [[Integer]] #-}+{-# SPECIALIZE eulerian1 :: [[Natural]] #-}++-- | 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]]+--+-- Complexity: @eulerian2 !! n !! k@ is O(n ln n) bits long, its computation+-- takes O(k n^2 ln n) time and forces thunks @eulerian2 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@.+--+eulerian2 :: (Num a, Enum a) => [[a]]+eulerian2 = scanl f [] [1..]+  where+    f xs n = 1 : zipIndexedListWithTail (\k x y -> (2 * n - k - 1) * x + (k + 1) * y) 1 xs 0+{-# SPECIALIZE eulerian2 :: [[Int]]     #-}+{-# SPECIALIZE eulerian2 :: [[Word]]    #-}+{-# SPECIALIZE eulerian2 :: [[Integer]] #-}+{-# SPECIALIZE eulerian2 :: [[Natural]] #-}++-- | Infinite zero-based sequence of <https://en.wikipedia.org/wiki/Bernoulli_number Bernoulli numbers>,+-- computed via <https://en.wikipedia.org/wiki/Bernoulli_number#Connection_with_Stirling_numbers_of_the_second_kind connection>+-- with 'stirling2'.+--+-- >>> 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 = helperForB_E_EP id (map recip [1..])+{-# SPECIALIZE bernoulli :: [Ratio Int] #-}+{-# SPECIALIZE bernoulli :: [Rational] #-}++-- | <https://en.wikipedia.org/wiki/Faulhaber%27s_formula Faulhaber's formula>.+--+-- >>> sum (map (^ 10) [0..100])+-- 959924142434241924250+-- >>> sum $ zipWith (*) (faulhaberPoly 10) (iterate (* 100) 1)+-- 959924142434241924250 % 1+faulhaberPoly :: Integral a => Int -> [Ratio a]+-- Implementation by https://github.com/CarlEdman+faulhaberPoly p+  = zipWith (*) ((0:)+  $ reverse+  $ take (p+1) $ bernoulli)+  $ map (% (fromIntegral p+1))+  $ zipWith (*) (iterate negate (if odd p then 1 else -1))+  $ binomial !! (fromIntegral p+1)++-- | Infinite zero-based list of <https://en.wikipedia.org/wiki/Euler_number Euler numbers>.+-- The algorithm used was derived from <http://www.emis.ams.org/journals/JIS/VOL4/CHEN/AlgBE2.pdf Algorithms for Bernoulli numbers and Euler numbers>+-- 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++-- zipIndexedListWithTail f n as a == zipWith3 f [n..] as (tail as ++ [a])+-- but inlines much better and avoids checks for distinct sizes of lists.+zipIndexedListWithTail :: Enum b => (b -> a -> a -> b) -> b -> [a] -> a -> [b]+zipIndexedListWithTail f n as a = case as of+  []       -> []+  (x : xs) -> go n x xs+  where+    go m y ys = case ys of+      []       -> 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]     #-}

@@ -0,0 +1,136 @@+-- |+-- Module:      Math.NumberTheory.Recurrences.Linear+-- Copyright:   (c) 2011 Daniel Fischer+-- Licence:     MIT+-- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>+--+-- Efficient calculation of linear recurrent sequences, including Fibonacci and Lucas sequences.++{-# LANGUAGE CPP #-}+module Math.NumberTheory.Recurrences.Linear+  ( factorial+  , fibonacci+  , fibonacciPair+  , lucas+  , lucasPair+  , generalLucas+  ) where++#include "MachDeps.h"++import Data.Bits+import Numeric.Natural++-- | Infinite zero-based table of factorials.+--+-- >>> take 5 factorial+-- [1,1,2,6,24]+--+-- The time-and-space behaviour of 'factorial' is similar to described in+-- "Math.NumberTheory.Recurrences.Bilinear#memory".+factorial :: (Num a, Enum a) => [a]+factorial = scanl (*) 1 [1..]+{-# SPECIALIZE factorial :: [Int]     #-}+{-# SPECIALIZE factorial :: [Word]    #-}+{-# SPECIALIZE factorial :: [Integer] #-}+{-# SPECIALIZE factorial :: [Natural] #-}++-- | @'fibonacci' k@ calculates the @k@-th Fibonacci number in+--   /O/(@log (abs k)@) steps. The index may be negative. This+--   is efficient for calculating single Fibonacci numbers (with+--   large index), but for computing many Fibonacci numbers in+--   close proximity, it is better to use the simple addition+--   formula starting from an appropriate pair of successive+--   Fibonacci numbers.+fibonacci :: Num a => Int -> a+fibonacci = fst . fibonacciPair+{-# SPECIALIZE fibonacci :: Int -> Int     #-}+{-# SPECIALIZE fibonacci :: Int -> Word    #-}+{-# SPECIALIZE fibonacci :: Int -> Integer #-}+{-# SPECIALIZE fibonacci :: Int -> Natural #-}++-- | @'fibonacciPair' k@ returns the pair @(F(k), F(k+1))@ of the @k@-th+--   Fibonacci number and its successor, thus it can be used to calculate+--   the Fibonacci numbers from some index on without needing to compute+--   the previous. The pair is efficiently calculated+--   in /O/(@log (abs k)@) steps. The index may be negative.+fibonacciPair :: Num a => Int -> (a, a)+fibonacciPair n+  | n < 0     = let (f,g) = fibonacciPair (-(n+1)) in if testBit n 0 then (g, -f) else (-g, f)+  | n == 0    = (0, 1)+  | otherwise = look (WORD_SIZE_IN_BITS - 2)+    where+      look k+        | testBit n k = go (k-1) 0 1+        | otherwise   = look (k-1)+      go k g f+        | k < 0       = (f, f+g)+        | testBit n k = go (k-1) (f*(f+shiftL1 g)) ((f+g)*shiftL1 f + g*g)+        | otherwise   = go (k-1) (f*f+g*g) (f*(f+shiftL1 g))+{-# SPECIALIZE fibonacciPair :: Int -> (Int, Int)         #-}+{-# SPECIALIZE fibonacciPair :: Int -> (Word, Word)       #-}+{-# SPECIALIZE fibonacciPair :: Int -> (Integer, Integer) #-}+{-# SPECIALIZE fibonacciPair :: Int -> (Natural, Natural) #-}++-- | @'lucas' k@ computes the @k@-th Lucas number. Very similar+--   to @'fibonacci'@.+lucas :: Num a => Int -> a+lucas = fst . lucasPair+{-# SPECIALIZE lucas :: Int -> Int     #-}+{-# SPECIALIZE lucas :: Int -> Word    #-}+{-# SPECIALIZE lucas :: Int -> Integer #-}+{-# SPECIALIZE lucas :: Int -> Natural #-}++-- | @'lucasPair' k@ computes the pair @(L(k), L(k+1))@ of the @k@-th+--   Lucas number and its successor. Very similar to @'fibonacciPair'@.+lucasPair :: Num a => Int -> (a, a)+lucasPair n+  | n < 0     = let (f,g) = lucasPair (-(n+1)) in if testBit n 0 then (-g, f) else (g, -f)+  | n == 0    = (2, 1)+  | otherwise = look (WORD_SIZE_IN_BITS - 2)+    where+      look k+        | testBit n k = go (k-1) 0 1+        | otherwise   = look (k-1)+      go k g f+        | k < 0       = (shiftL1 g + f,g+3*f)+        | otherwise   = go (k-1) g' f'+          where+            (f',g')+              | testBit n k = (shiftL1 (f*(f+g)) + g*g,f*(shiftL1 g + f))+              | otherwise   = (f*(shiftL1 g + f),f*f+g*g)+{-# SPECIALIZE lucasPair :: Int -> (Int, Int)         #-}+{-# SPECIALIZE lucasPair :: Int -> (Word, Word)       #-}+{-# SPECIALIZE lucasPair :: Int -> (Integer, Integer) #-}+{-# SPECIALIZE lucasPair :: Int -> (Natural, Natural) #-}++-- | @'generalLucas' p q k@ calculates the quadruple @(U(k), U(k+1), V(k), V(k+1))@+--   where @U(i)@ is the Lucas sequence of the first kind and @V(i)@ the Lucas+--   sequence of the second kind for the parameters @p@ and @q@, where @p^2-4q /= 0@.+--   Both sequences satisfy the recurrence relation @A(j+2) = p*A(j+1) - q*A(j)@,+--   the starting values are @U(0) = 0, U(1) = 1@ and @V(0) = 2, V(1) = p@.+--   The Fibonacci numbers form the Lucas sequence of the first kind for the+--   parameters @p = 1, q = -1@ and the Lucas numbers form the Lucas sequence of+--   the second kind for these parameters.+--   Here, the index must be non-negative, since the terms of the sequence for+--   negative indices are in general not integers.+generalLucas :: Num a => a -> a -> Int -> (a, a, a, a)+generalLucas p q k+  | k < 0       = error "generalLucas: negative index"+  | k == 0      = (0,1,2,p)+  | otherwise   = look (WORD_SIZE_IN_BITS - 2)+    where+      look i+        | testBit k i   = go (i-1) 1 p p q+        | otherwise     = look (i-1)+      go i un un1 vn qn+        | i < 0         = (un, un1, vn, p*un1 - shiftL1 (q*un))+        | testBit k i   = go (i-1) (un1*vn-qn) ((p*un1-q*un)*vn - p*qn) ((p*un1 - (2*q)*un)*vn - p*qn) (qn*qn*q)+        | otherwise     = go (i-1) (un*vn) (un1*vn-qn) (vn*vn - 2*qn) (qn*qn)+{-# SPECIALIZE generalLucas :: Int     -> Int     -> Int -> (Int, Int, Int, Int)                 #-}+{-# SPECIALIZE generalLucas :: Word    -> Word    -> Int -> (Word, Word, Word, Word)             #-}+{-# SPECIALIZE generalLucas :: Integer -> Integer -> Int -> (Integer, Integer, Integer, Integer) #-}+{-# SPECIALIZE generalLucas :: Natural -> Natural -> Int -> (Natural, Natural, Natural, Natural) #-}++shiftL1 :: Num a => a -> a+shiftL1 n = n + n

@@ -0,0 +1,95 @@+-- |+-- Module:      Math.NumberTheory.Recurrences.Pentagonal+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+--+-- Values of <https://en.wikipedia.org/wiki/Partition_(number_theory)#Partition_function partition function>.+--++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes   #-}++module Math.NumberTheory.Recurrences.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+-- >>> import Math.NumberTheory.Moduli.Class+-- >>> 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] #-}

@@ -1,18 +1,17 @@ -- | -- Module:      Math.NumberTheory.Recurrencies+-- Description: Deprecated -- 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+module Math.NumberTheory.Recurrencies {-# DEPRECATED "Use `Math.NumberTheory.Recurrences` instead." #-}+    ( module Math.NumberTheory.Recurrences.Linear+    , module Math.NumberTheory.Recurrences.Bilinear+    , module Math.NumberTheory.Recurrences.Pentagonal     ) where -import Math.NumberTheory.Recurrencies.Bilinear-import Math.NumberTheory.Recurrencies.Linear-import Math.NumberTheory.Recurrencies.Pentagonal (partition)+import Math.NumberTheory.Recurrences.Bilinear+import Math.NumberTheory.Recurrences.Linear+import Math.NumberTheory.Recurrences.Pentagonal (partition)

@@ -1,10 +1,9 @@ -- | -- Module:      Math.NumberTheory.Recurrencies.Bilinear+-- Description: Deprecated -- Copyright:   (c) 2016 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Bilinear recurrent sequences and Bernoulli numbers, -- roughly covering Ch. 5-6 of /Concrete Mathematics/@@ -32,224 +31,8 @@ -- 1 -- (0.01 secs, 391,152 bytes) -{-# LANGUAGE CPP                 #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Math.NumberTheory.Recurrencies.Bilinear-  ( binomial-  , stirling1-  , stirling2-  , lah-  , eulerian1-  , eulerian2-  , bernoulli-  , euler-  , eulerPolyAt1-  ) where--import Data.List-import Data.Ratio-import Numeric.Natural--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]]------ Complexity: @binomial !! n !! k@ is O(n) bits long, its computation--- takes O(k n) time and forces thunks @binomial !! n !! i@ for @0 <= i <= k@.--- Use the symmetry of Pascal triangle @binomial !! n !! k == binomial !! n !! (n - k)@ to speed up computations.------ One could also consider 'Math.Combinat.Numbers.binomial' to compute stand-alone values.-binomial :: Integral a => [[a]]-binomial = map f [0..]-  where-    f n = scanl (\x k -> x * (n - k + 1) `div` k) 1 [1..n]-{-# SPECIALIZE binomial :: [[Int]]     #-}-{-# SPECIALIZE binomial :: [[Word]]    #-}-{-# SPECIALIZE binomial :: [[Integer]] #-}-{-# SPECIALIZE binomial :: [[Natural]] #-}---- | 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]]------ Complexity: @stirling1 !! n !! k@ is O(n ln n) bits long, its computation--- takes O(k n^2 ln n) time and forces thunks @stirling1 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@.------ One could also consider 'Math.Combinat.Numbers.unsignedStirling1st' to compute stand-alone values.-stirling1 :: (Num a, Enum a) => [[a]]-stirling1 = scanl f [1] [0..]-  where-    f xs n = 0 : zipIndexedListWithTail (\_ x y -> x + n * y) 1 xs 0-{-# SPECIALIZE stirling1 :: [[Int]]     #-}-{-# SPECIALIZE stirling1 :: [[Word]]    #-}-{-# SPECIALIZE stirling1 :: [[Integer]] #-}-{-# SPECIALIZE stirling1 :: [[Natural]] #-}---- | 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]]------ Complexity: @stirling2 !! n !! k@ is O(n ln n) bits long, its computation--- takes O(k n^2 ln n) time and forces thunks @stirling2 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@.------ One could also consider 'Math.Combinat.Numbers.stirling2nd' to compute stand-alone values.-stirling2 :: (Num a, Enum a) => [[a]]-stirling2 = iterate f [1]-  where-    f xs = 0 : zipIndexedListWithTail (\k x y -> x + k * y) 1 xs 0-{-# SPECIALIZE stirling2 :: [[Int]]     #-}-{-# SPECIALIZE stirling2 :: [[Word]]    #-}-{-# SPECIALIZE stirling2 :: [[Integer]] #-}-{-# SPECIALIZE stirling2 :: [[Natural]] #-}---- | 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]]------ Complexity: @lah !! n !! k@ is O(n ln n) bits long, its computation--- takes O(k n ln n) time and forces thunks @lah !! n !! i@ for @0 <= i <= k@.-lah :: Integral a => [[a]]--- Implementation was derived from code by https://github.com/grandpascorpion-lah = zipWith f (tail factorial) [1..]-  where-    f nf n = scanl (\x k -> x * (n - k) `div` (k * (k + 1))) nf [1..n-1]-{-# SPECIALIZE lah :: [[Int]]     #-}-{-# SPECIALIZE lah :: [[Word]]    #-}-{-# SPECIALIZE lah :: [[Integer]] #-}-{-# SPECIALIZE lah :: [[Natural]] #-}---- | 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]]------ Complexity: @eulerian1 !! n !! k@ is O(n ln n) bits long, its computation--- takes O(k n^2 ln n) time and forces thunks @eulerian1 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@.----eulerian1 :: (Num a, Enum a) => [[a]]-eulerian1 = scanl f [] [1..]-  where-    f xs n = 1 : zipIndexedListWithTail (\k x y -> (n - k) * x + (k + 1) * y) 1 xs 0-{-# SPECIALIZE eulerian1 :: [[Int]]     #-}-{-# SPECIALIZE eulerian1 :: [[Word]]    #-}-{-# SPECIALIZE eulerian1 :: [[Integer]] #-}-{-# SPECIALIZE eulerian1 :: [[Natural]] #-}---- | 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]]------ Complexity: @eulerian2 !! n !! k@ is O(n ln n) bits long, its computation--- takes O(k n^2 ln n) time and forces thunks @eulerian2 !! i !! j@ for @0 <= i <= n@ and @max(0, k - n + i) <= j <= k@.----eulerian2 :: (Num a, Enum a) => [[a]]-eulerian2 = scanl f [] [1..]-  where-    f xs n = 1 : zipIndexedListWithTail (\k x y -> (2 * n - k - 1) * x + (k + 1) * y) 1 xs 0-{-# SPECIALIZE eulerian2 :: [[Int]]     #-}-{-# SPECIALIZE eulerian2 :: [[Word]]    #-}-{-# SPECIALIZE eulerian2 :: [[Integer]] #-}-{-# SPECIALIZE eulerian2 :: [[Natural]] #-}---- | Infinite zero-based sequence of <https://en.wikipedia.org/wiki/Bernoulli_number Bernoulli numbers>,--- computed via <https://en.wikipedia.org/wiki/Bernoulli_number#Connection_with_Stirling_numbers_of_the_second_kind connection>--- with 'stirling2'.------ >>> 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 = 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---- zipIndexedListWithTail f n as a == zipWith3 f [n..] as (tail as ++ [a])--- but inlines much better and avoids checks for distinct sizes of lists.-zipIndexedListWithTail :: Enum b => (b -> a -> a -> b) -> b -> [a] -> a -> [b]-zipIndexedListWithTail f n as a = case as of-  []       -> []-  (x : xs) -> go n x xs-  where-    go m y ys = case ys of-      []       -> 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 #-}+module Math.NumberTheory.Recurrencies.Bilinear {-# DEPRECATED "Use `Math.NumberTheory.Recurrences.Bilinear` instead." #-}+    ( module Math.NumberTheory.Recurrences.Bilinear+    ) where --- | 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]     #-}+import Math.NumberTheory.Recurrences.Bilinear

@@ -1,138 +1,14 @@ -- | -- Module:      Math.NumberTheory.Recurrencies.Linear+-- Description: Deprecated -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Efficient calculation of linear recurrent sequences, including Fibonacci and Lucas sequences. -{-# LANGUAGE CPP #-}-module Math.NumberTheory.Recurrencies.Linear-  ( factorial-  , fibonacci-  , fibonacciPair-  , lucas-  , lucasPair-  , generalLucas-  ) where--#include "MachDeps.h"--import Data.Bits-import Numeric.Natural---- | Infinite zero-based table of factorials.------ >>> 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".-factorial :: (Num a, Enum a) => [a]-factorial = scanl (*) 1 [1..]-{-# SPECIALIZE factorial :: [Int]     #-}-{-# SPECIALIZE factorial :: [Word]    #-}-{-# SPECIALIZE factorial :: [Integer] #-}-{-# SPECIALIZE factorial :: [Natural] #-}---- | @'fibonacci' k@ calculates the @k@-th Fibonacci number in---   /O/(@log (abs k)@) steps. The index may be negative. This---   is efficient for calculating single Fibonacci numbers (with---   large index), but for computing many Fibonacci numbers in---   close proximity, it is better to use the simple addition---   formula starting from an appropriate pair of successive---   Fibonacci numbers.-fibonacci :: Num a => Int -> a-fibonacci = fst . fibonacciPair-{-# SPECIALIZE fibonacci :: Int -> Int     #-}-{-# SPECIALIZE fibonacci :: Int -> Word    #-}-{-# SPECIALIZE fibonacci :: Int -> Integer #-}-{-# SPECIALIZE fibonacci :: Int -> Natural #-}---- | @'fibonacciPair' k@ returns the pair @(F(k), F(k+1))@ of the @k@-th---   Fibonacci number and its successor, thus it can be used to calculate---   the Fibonacci numbers from some index on without needing to compute---   the previous. The pair is efficiently calculated---   in /O/(@log (abs k)@) steps. The index may be negative.-fibonacciPair :: Num a => Int -> (a, a)-fibonacciPair n-  | n < 0     = let (f,g) = fibonacciPair (-(n+1)) in if testBit n 0 then (g, -f) else (-g, f)-  | n == 0    = (0, 1)-  | otherwise = look (WORD_SIZE_IN_BITS - 2)-    where-      look k-        | testBit n k = go (k-1) 0 1-        | otherwise   = look (k-1)-      go k g f-        | k < 0       = (f, f+g)-        | testBit n k = go (k-1) (f*(f+shiftL1 g)) ((f+g)*shiftL1 f + g*g)-        | otherwise   = go (k-1) (f*f+g*g) (f*(f+shiftL1 g))-{-# SPECIALIZE fibonacciPair :: Int -> (Int, Int)         #-}-{-# SPECIALIZE fibonacciPair :: Int -> (Word, Word)       #-}-{-# SPECIALIZE fibonacciPair :: Int -> (Integer, Integer) #-}-{-# SPECIALIZE fibonacciPair :: Int -> (Natural, Natural) #-}---- | @'lucas' k@ computes the @k@-th Lucas number. Very similar---   to @'fibonacci'@.-lucas :: Num a => Int -> a-lucas = fst . lucasPair-{-# SPECIALIZE lucas :: Int -> Int     #-}-{-# SPECIALIZE lucas :: Int -> Word    #-}-{-# SPECIALIZE lucas :: Int -> Integer #-}-{-# SPECIALIZE lucas :: Int -> Natural #-}---- | @'lucasPair' k@ computes the pair @(L(k), L(k+1))@ of the @k@-th---   Lucas number and its successor. Very similar to @'fibonacciPair'@.-lucasPair :: Num a => Int -> (a, a)-lucasPair n-  | n < 0     = let (f,g) = lucasPair (-(n+1)) in if testBit n 0 then (-g, f) else (g, -f)-  | n == 0    = (2, 1)-  | otherwise = look (WORD_SIZE_IN_BITS - 2)-    where-      look k-        | testBit n k = go (k-1) 0 1-        | otherwise   = look (k-1)-      go k g f-        | k < 0       = (shiftL1 g + f,g+3*f)-        | otherwise   = go (k-1) g' f'-          where-            (f',g')-              | testBit n k = (shiftL1 (f*(f+g)) + g*g,f*(shiftL1 g + f))-              | otherwise   = (f*(shiftL1 g + f),f*f+g*g)-{-# SPECIALIZE lucasPair :: Int -> (Int, Int)         #-}-{-# SPECIALIZE lucasPair :: Int -> (Word, Word)       #-}-{-# SPECIALIZE lucasPair :: Int -> (Integer, Integer) #-}-{-# SPECIALIZE lucasPair :: Int -> (Natural, Natural) #-}---- | @'generalLucas' p q k@ calculates the quadruple @(U(k), U(k+1), V(k), V(k+1))@---   where @U(i)@ is the Lucas sequence of the first kind and @V(i)@ the Lucas---   sequence of the second kind for the parameters @p@ and @q@, where @p^2-4q /= 0@.---   Both sequences satisfy the recurrence relation @A(j+2) = p*A(j+1) - q*A(j)@,---   the starting values are @U(0) = 0, U(1) = 1@ and @V(0) = 2, V(1) = p@.---   The Fibonacci numbers form the Lucas sequence of the first kind for the---   parameters @p = 1, q = -1@ and the Lucas numbers form the Lucas sequence of---   the second kind for these parameters.---   Here, the index must be non-negative, since the terms of the sequence for---   negative indices are in general not integers.-generalLucas :: Num a => a -> a -> Int -> (a, a, a, a)-generalLucas p q k-  | k < 0       = error "generalLucas: negative index"-  | k == 0      = (0,1,2,p)-  | otherwise   = look (WORD_SIZE_IN_BITS - 2)-    where-      look i-        | testBit k i   = go (i-1) 1 p p q-        | otherwise     = look (i-1)-      go i un un1 vn qn-        | i < 0         = (un, un1, vn, p*un1 - shiftL1 (q*un))-        | testBit k i   = go (i-1) (un1*vn-qn) ((p*un1-q*un)*vn - p*qn) ((p*un1 - (2*q)*un)*vn - p*qn) (qn*qn*q)-        | otherwise     = go (i-1) (un*vn) (un1*vn-qn) (vn*vn - 2*qn) (qn*qn)-{-# SPECIALIZE generalLucas :: Int     -> Int     -> Int -> (Int, Int, Int, Int)                 #-}-{-# SPECIALIZE generalLucas :: Word    -> Word    -> Int -> (Word, Word, Word, Word)             #-}-{-# SPECIALIZE generalLucas :: Integer -> Integer -> Int -> (Integer, Integer, Integer, Integer) #-}-{-# SPECIALIZE generalLucas :: Natural -> Natural -> Int -> (Natural, Natural, Natural, Natural) #-}+module Math.NumberTheory.Recurrencies.Linear {-# DEPRECATED "Use `Math.NumberTheory.Recurrences.Linear` instead." #-}+    ( module Math.NumberTheory.Recurrences.Linear+    ) where -shiftL1 :: Num a => a -> a-shiftL1 n = n + n+import Math.NumberTheory.Recurrences.Linear

@@ -1,96 +0,0 @@--- |--- 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] #-}

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2018 Frederick Schneider -- Licence:     MIT -- Maintainer:  Frederick Schneider <frederick.schneider2011@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- A <https://en.wikipedia.org/wiki/Smooth_number smooth number> -- is an integer, which can be represented as a product of powers of elements@@ -22,44 +20,49 @@   , fromSmoothUpperBound     -- * Generate smooth numbers   , smoothOver+  , smoothOver'   , smoothOverInRange   , smoothOverInRangeBF++  -- * Verify if a number is smooth+  , isSmooth   ) where  import Prelude hiding (div, mod, gcd) import Data.Coerce import Data.List (nub) import qualified Data.Set as S-import Math.NumberTheory.Euclidean+import qualified Math.NumberTheory.Euclidean as E+import Math.NumberTheory.Primes (unPrime) import Math.NumberTheory.Primes.Sieve (primes)  -- | An abstract representation of a smooth basis.--- It consists of a set of coprime numbers ≥2.+-- It consists of a set of numbers ≥2. newtype SmoothBasis a = SmoothBasis { unSmoothBasis :: [a] } deriving (Eq, Show) --- | Build a 'SmoothBasis' from a set of coprime numbers ≥2.+-- | Build a 'SmoothBasis' from a set of numbers ≥2. -- -- >>> import qualified Data.Set as Set -- >>> fromSet (Set.fromList [2, 3])--- Just (SmoothBasis [2, 3])--- >>> fromSet (Set.fromList [2, 4]) -- should be coprime--- Nothing+-- Just (SmoothBasis {unSmoothBasis = [2,3]})+-- >>> fromSet (Set.fromList [2, 4])+-- Just (SmoothBasis {unSmoothBasis = [2,4]}) -- >>> fromSet (Set.fromList [1, 3]) -- should be >= 2 -- Nothing-fromSet :: Euclidean a => S.Set a -> Maybe (SmoothBasis a)+fromSet :: E.Euclidean a => S.Set a -> Maybe (SmoothBasis a) fromSet s = if isValid l then Just (SmoothBasis l) else Nothing where l = S.elems s --- | Build a 'SmoothBasis' from a list of coprime numbers ≥2.+-- | Build a 'SmoothBasis' from a list of numbers ≥2. -- -- >>> fromList [2, 3]--- Just (SmoothBasis [2, 3])+-- Just (SmoothBasis {unSmoothBasis = [2,3]}) -- >>> fromList [2, 2]--- Just (SmoothBasis [2])--- >>> fromList [2, 4] -- should be coprime--- Nothing+-- Just (SmoothBasis {unSmoothBasis = [2]})+-- >>> fromList [2, 4]+-- Just (SmoothBasis {unSmoothBasis = [2,4]}) -- >>> fromList [1, 3] -- should be >= 2 -- Nothing-fromList :: Euclidean a => [a] -> Maybe (SmoothBasis a)+fromList :: E.Euclidean a => [a] -> Maybe (SmoothBasis a) fromList l = if isValid l' then Just (SmoothBasis l') else Nothing   where     l' = nub l@@ -67,36 +70,53 @@ -- | Build a 'SmoothBasis' from a list of primes below given bound. -- -- >>> fromSmoothUpperBound 10--- Just (SmoothBasis [2, 3, 5, 7])+-- Just (SmoothBasis {unSmoothBasis = [2,3,5,7]}) -- >>> fromSmoothUpperBound 1 -- Nothing fromSmoothUpperBound :: Integral a => a -> Maybe (SmoothBasis a) fromSmoothUpperBound n = if (n < 2)                          then Nothing-                         else Just $ SmoothBasis $ takeWhile (<= n) primes+                         else Just $ SmoothBasis $ takeWhile (<= n) $ map unPrime primes +-- | Helper used by @smoothOver@ (@Integral@ constraint) and @smoothOver'@+-- (@Euclidean@ constraint) Since the typeclass constraint is just+-- @Num@, it receives a @norm@ comparison function for the generated smooth+-- numbers.+-- This function relies on the fact that for any element of a smooth basis @p@+-- and any @a@ it is true that @norm (a * p) > norm a@.+-- This condition is not checked.+smoothOver' :: forall a b . (Eq a, Num a, Ord b) => (a -> b) -> SmoothBasis a -> [a]+smoothOver' norm pl =+    foldr+    (\p l -> mergeListLists $ iterate (map $ abs . (p*)) l)+    [1]+    (nub $ unSmoothBasis pl)+  where+    {-# INLINE mergeListLists #-}+    mergeListLists :: [[a]] -> [a]+    mergeListLists = foldr go1 []+      where+        go1 :: [a] -> [a] -> [a]+        go1 []    b = b+        go1 (h:t) b = h:(go2 t b)++        go2 :: [a] -> [a] -> [a]+        go2 a [] = a+        go2 [] b = b+        go2 a@(ah:at) b@(bh:bt)+          | norm bh < norm ah   = bh : (go2 a bt)+          | ah == bh    = ah : (go2 at bt)+          | otherwise = ah : (go2 at b)+ -- | Generate an infinite ascending list of -- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers> -- over a given smooth basis. -- -- >>> import Data.Maybe -- >>> take 10 (smoothOver (fromJust (fromList [2, 5])))--- [1, 2, 4, 5, 8, 10, 16, 20, 25, 32]+-- [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 :: Ord a => [a] -> [a] -> [a]-        go1 (h:t) b = h:(go2 t b)-        go1 _     b = b--        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+smoothOver = smoothOver' abs  -- | Generate an ascending list of -- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers>@@ -108,13 +128,13 @@ -- -- >>> import Data.Maybe -- >>> smoothOverInRange (fromJust (fromList [2, 5])) 100 200--- [100, 125, 128, 160, 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))+  $ smoothOver (coerce s :: SmoothBasis (E.WrappedIntegral a))  -- | Generate an ascending list of -- <https://en.wikipedia.org/wiki/Smooth_number smooth numbers>@@ -128,25 +148,34 @@ -- -- >>> 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]+-- [100,125,128,160,200]+smoothOverInRangeBF+  :: forall a. (Enum a, E.Euclidean a)+  => SmoothBasis a+  -> a+  -> a+  -> [a] smoothOverInRangeBF prs lo hi   = coerce-  $ filter (mf prs')+  $ filter (isSmooth 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 :: Euclidean a => [a] -> Bool+isValid :: (Eq a, Num a) => [a] -> Bool isValid pl = length pl /= 0 && v' pl   where-    v' :: Euclidean a => [a] -> Bool+    v' :: (Eq a, Num a) => [a] -> Bool     v' []     = True-    v' (x:xs) = x /= 0 && abs x /= 1 && abs x == x && all (coprime x) xs && v' xs+    v' (x:xs) = x /= 0 && abs x /= 1 && abs x == x && v' xs++-- | @isSmooth@ checks if a given number is smooth under a certain @SmoothBasis@.+-- Does not check if the @SmoothBasis@ is valid.+isSmooth :: forall a . E.Euclidean a => SmoothBasis a -> a -> Bool+isSmooth prs x = mf (unSmoothBasis prs) x+  where+    mf :: [a] -> a -> Bool+    mf _         0 = False+    mf []        n = abs n == 1 -- mf means manually factor+    mf pl@(p:ps) n = if E.mod n p == 0+                     then mf pl (E.div n p)+                     else mf ps n

@@ -1,90 +1,13 @@ -- |--- Module:      Math.NumberTheory.UniqueFactorisation--- Copyright:   (c) 2016 Andrew Lelechenko+-- Module:      Math.NumberTheory.Recurrencies+-- Description: Deprecated+-- Copyright:   (c) 2019 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) ----- An abstract type class for unique factorisation domains.--- -{-# LANGUAGE CPP               #-}-{-# LANGUAGE TypeFamilies      #-}-{-# LANGUAGE DefaultSignatures #-}--module Math.NumberTheory.UniqueFactorisation-  ( Prime-  , UniqueFactorisation(..)-  ) where--import Control.Arrow-import Data.Coerce--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.Quadratic.EisensteinIntegers as E-import qualified Math.NumberTheory.Quadratic.GaussianIntegers as G-import Math.NumberTheory.Utils.FromIntegral--import Numeric.Natural--type instance Prime G.GaussianInteger = GaussianPrime---- | The following invariant must hold for @n /= 0@:------ > abs n == abs (product (map (\(p, k) -> unPrime p ^ k) (factorise n)))------ The result of 'factorise' should not contain zero powers and should not change after multiplication of the argument by domain's unit.-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--  {-# MINIMAL unPrime, factorise #-}--instance UniqueFactorisation Int where-  unPrime   = coerce wordToInt-  factorise = map (coerce integerToWord *** intToWord) . F.factorise . intToInteger--instance UniqueFactorisation Word where-  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 = 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 = 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 }-  deriving (Eq, Show)--instance UniqueFactorisation G.GaussianInteger where-  unPrime = coerce--  factorise 0 = []-  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+module Math.NumberTheory.UniqueFactorisation {-# DEPRECATED "Use `Math.NumberTheory.Primes` instead." #-}+    ( module Math.NumberTheory.Primes+    ) where -  factorise 0 = []-  factorise e = map (coerce *** intToWord) $ E.factorise e+import Math.NumberTheory.Primes

@@ -3,7 +3,6 @@ -- Copyright:   (c) 2016 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional -- -- Layer to switch between safe and unsafe arrays. --

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2011 Daniel Fischer -- Licence:     MIT -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Some utilities, mostly for bit twiddling. --@@ -25,17 +23,23 @@     , mergeBy      , recipMod++    , toWheel30+    , fromWheel30     ) where  #include "MachDeps.h" +import Prelude hiding (mod, quotRem)+import qualified Prelude as P+ import GHC.Base -import GHC.Integer import GHC.Integer.GMP.Internals import GHC.Natural  import Data.Bits+import Math.NumberTheory.Euclidean  uncheckedShiftR :: Word -> Int -> Word uncheckedShiftR (W# w#) (I# i#) = W# (uncheckedShiftRL# w# i#)@@ -50,58 +54,56 @@ "shiftToOddCount/Natural"   shiftToOddCount = shiftOCNatural   #-} {-# INLINE [1] shiftToOddCount #-}-shiftToOddCount :: Integral a => a -> (Int, a)+shiftToOddCount :: Integral a => a -> (Word, a) shiftToOddCount n = case shiftOCInteger (fromIntegral n) of                       (z, o) -> (z, fromInteger o)  -- | Specialised version for @'Word'@. --   Precondition: argument strictly positive (not checked).-shiftOCWord :: Word -> (Int, Word)+shiftOCWord :: Word -> (Word, Word) shiftOCWord (W# w#) = case shiftToOddCount# w# of-                        (# z# , u# #) -> (I# z#, W# u#)+                        (# z# , u# #) -> (W# z#, W# u#)  -- | Specialised version for @'Int'@. --   Precondition: argument nonzero (not checked).-shiftOCInt :: Int -> (Int, Int)+shiftOCInt :: Int -> (Word, Int) shiftOCInt (I# i#) = case shiftToOddCount# (int2Word# i#) of-                        (# z#, u# #) -> (I# z#, I# (word2Int# u#))+                        (# z#, u# #) -> (W# z#, I# (word2Int# u#))  -- | Specialised version for @'Integer'@. --   Precondition: argument nonzero (not checked).-shiftOCInteger :: Integer -> (Int, Integer)+shiftOCInteger :: Integer -> (Word, Integer) shiftOCInteger n@(S# i#) =     case shiftToOddCount# (int2Word# i#) of-      (# z#, w# #)-        | isTrue# (z# ==# 0#) -> (0, n)-        | otherwise -> (I# z#, S# (word2Int# w#))+      (# 0##, _ #) -> (0, n)+      (# z#, w# #) -> (W# z#, wordToInteger w#) shiftOCInteger n@(Jp# bn#) = case bigNatZeroCount bn# of-                                 0#  -> (0, n)-                                 z#  -> (I# z#, n `shiftRInteger` z#)+                                 0## -> (0, n)+                                 z#  -> (W# z#, bigNatToInteger (bn# `shiftRBigNat` (word2Int# z#))) shiftOCInteger n@(Jn# bn#) = case bigNatZeroCount bn# of-                                 0#  -> (0, n)-                                 z#  -> (I# z#, n `shiftRInteger` z#)+                                 0## -> (0, n)+                                 z#  -> (W# z#, bigNatToNegInteger (bn# `shiftRBigNat` (word2Int# z#)))  -- | Specialised version for @'Natural'@. --   Precondition: argument nonzero (not checked).-shiftOCNatural :: Natural -> (Int, Natural)+shiftOCNatural :: Natural -> (Word, Natural) shiftOCNatural n@(NatS# i#) =     case shiftToOddCount# i# of-      (# z#, w# #)-        | isTrue# (z# ==# 0#) -> (0, n)-        | otherwise -> (I# z#, NatS# w#)+      (# 0##, _ #) -> (0, n)+      (# z#, w# #) -> (W# z#, NatS# w#) shiftOCNatural n@(NatJ# bn#) = case bigNatZeroCount bn# of-                                 0#  -> (0, n)-                                 z#  -> (I# z#, NatJ# (bn# `shiftRBigNat` z#))+                                 0## -> (0, n)+                                 z#  -> (W# z#, bigNatToNatural (bn# `shiftRBigNat` (word2Int# z#)))  -- | Count trailing zeros in a @'BigNat'@. --   Precondition: argument nonzero (not checked, Integer invariant).-bigNatZeroCount :: BigNat -> Int#-bigNatZeroCount bn# = count 0# 0#+bigNatZeroCount :: BigNat -> Word#+bigNatZeroCount bn# = count 0## 0#   where     count a# i# =           case indexBigNat# bn# i# of-            0## -> count (a# +# WORD_SIZE_IN_BITS#) (i# +# 1#)-            w#  -> a# +# word2Int# (ctz# w#)+            0## -> count (a# `plusWord#` WORD_SIZE_IN_BITS##) (i# +# 1#)+            w#  -> a# `plusWord#` ctz# w#  -- | Remove factors of @2@. If @n = 2^k*m@ with @m@ odd, the result is @m@. --   Precondition: argument not @0@ (not checked).@@ -127,13 +129,13 @@ -- | Specialised version for @'Int'@. --   Precondition: argument nonzero (not checked). shiftOInteger :: Integer -> Integer-shiftOInteger (S# i#) = S# (word2Int# (shiftToOdd# (int2Word# i#)))-shiftOInteger n@(Jn# bn#) = case bigNatZeroCount bn# of-                                 0#  -> n-                                 z#  -> n `shiftRInteger` z#+shiftOInteger (S# i#) = wordToInteger (shiftToOdd# (int2Word# i#)) shiftOInteger n@(Jp# bn#) = case bigNatZeroCount bn# of-                                 0#  -> n-                                 z#  -> n `shiftRInteger` z#+                                 0## -> n+                                 z#  -> bigNatToInteger (bn# `shiftRBigNat` (word2Int# z#))+shiftOInteger n@(Jn# bn#) = case bigNatZeroCount bn# of+                                 0## -> n+                                 z#  -> bigNatToNegInteger (bn# `shiftRBigNat` (word2Int# z#))  -- | Shift argument right until the result is odd. --   Precondition: argument not @0@, not checked.@@ -141,9 +143,9 @@ 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 word2Int# (ctz# w#) of-                        k# -> (# k#, uncheckedShiftRL# w# k# #)+shiftToOddCount# :: Word# -> (# Word#, Word# #)+shiftToOddCount# w# = case ctz# w# of+                        k# -> (# k#, uncheckedShiftRL# w# (word2Int# k#) #)  -- | Number of 1-bits in a @'Word#'@. bitCountWord# :: Word# -> Int#@@ -158,7 +160,7 @@ bitCountInt :: Int -> Int bitCountInt = popCount -splitOff :: Integral a => a -> a -> (Int, a)+splitOff :: Euclidean a => a -> a -> (Word, a) splitOff _ 0 = (0, 0) -- prevent infinite loop splitOff p n = go 0 n   where@@ -169,12 +171,12 @@  -- | It is difficult to convince GHC to unbox output of 'splitOff' and 'splitOff.go', -- so we fallback to a specialized unboxed version to minimize allocations.-splitOff# :: Word# -> Word# -> (# Int#, Word# #)-splitOff# _ 0## = (# 0#, 0## #)-splitOff# p n = go 0# n+splitOff# :: Word# -> Word# -> (# Word#, Word# #)+splitOff# _ 0## = (# 0##, 0## #)+splitOff# p n = go 0## n   where     go k m = case m `quotRemWord#` p of-      (# q, 0## #) -> go (k +# 1#) q+      (# q, 0## #) -> go (k `plusWord#` 1##) q       _            -> (# k, m #) {-# INLINABLE splitOff# #-} @@ -195,3 +197,21 @@ recipMod x m = case recipModInteger (x `mod` m) m of   0 -> Nothing   y -> Just y++bigNatToNatural :: BigNat -> Natural+bigNatToNatural bn+  | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)+  | otherwise = NatJ# bn++-------------------------------------------------------------------------------+-- Helpers for mapping to rough numbers and back.+-- Copypasted from Data.BitStream.WheelMapping++toWheel30 :: (Integral a, Bits a) => a -> a+toWheel30 i = q `shiftL` 3 + (r + r `shiftR` 4) `shiftR` 2+  where+    (q, r) = i `P.quotRem` 30++fromWheel30 :: (Num a, Bits a) => a -> a+fromWheel30 i = ((i `shiftL` 2 - i `shiftR` 2) .|. 1)+              + ((i `shiftL` 1 - i `shiftR` 1) .&. 2)

@@ -0,0 +1,86 @@+-- |+-- Module:      Math.NumberTheory.Utils.DirichletSeries+-- Copyright:   (c) 2018 Andrew Lelechenko+-- Licence:     MIT+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- An abstract representation of a Dirichlet series over a semiring.+--++{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE ViewPatterns          #-}++module Math.NumberTheory.Utils.DirichletSeries+  ( DirichletSeries+  , fromDistinctAscList+  , lookup+  , filter+  , partition+  , unions+  , union+  , size+  , timesAndCrop+  ) where++import Prelude hiding (filter, last, rem, quot, snd, lookup)+import Data.Coerce+import Data.Map (Map)+import qualified Data.Map.Strict as M+import Data.Semiring (Semiring(..))+import Numeric.Natural++import Math.NumberTheory.Euclidean++-- Sparse Dirichlet series are represented by an ascending list of pairs.+-- For instance, [(a, b), (c, d)] stands for 1 + b/a^s + d/c^s.+-- Note that the representation still may include a term (1, b), so+-- [(1, b), (c, d)] means (1 + b) + d/c^s.+newtype DirichletSeries a b = DirichletSeries { _unDirichletSeries :: Map a b }+  deriving (Show)++fromDistinctAscList :: forall a b. [(a, b)] -> DirichletSeries a b+fromDistinctAscList = coerce (M.fromDistinctAscList @a @b)++lookup :: (Ord a, Num a, Semiring b) => a -> DirichletSeries a b -> b+lookup 1 (DirichletSeries m) = M.findWithDefault zero 1 m `plus` one+lookup a (DirichletSeries m) = M.findWithDefault zero a m++filter :: forall a b. (a -> Bool) -> DirichletSeries a b -> DirichletSeries a b+filter predicate = coerce (M.filterWithKey @a @b (\k _ -> predicate k))++partition :: forall a b. (a -> Bool) -> DirichletSeries a b -> (DirichletSeries a b, DirichletSeries a b)+partition predicate = coerce (M.partitionWithKey @a @b (\k _ -> predicate k))++unions :: forall a b. (Ord a, Semiring b) => [DirichletSeries a b] -> DirichletSeries a b+unions = coerce (M.unionsWith plus :: [Map a b] -> Map a b)++union :: forall a b. (Ord a, Semiring b) => DirichletSeries a b -> DirichletSeries a b -> DirichletSeries a b+union = coerce (M.unionWith @a @b plus)++size :: forall a b. DirichletSeries a b -> Int+size = coerce (M.size @a @b)++-- | Let as = sum_i k_i/a_i^s and bs = sum_i l_i/b_i^s be Dirichlet series,+-- and all a_i and b_i are divisors of n. Return Dirichlet series cs,+-- which contains all terms as * bs = sum_i m_i/c_i^s such that c_i divides n.+timesAndCrop+  :: (Euclidean a, Ord a, Semiring b)+  => a+  -> DirichletSeries a b+  -> DirichletSeries a b+  -> DirichletSeries a b+timesAndCrop n (DirichletSeries as) (DirichletSeries bs)+  = DirichletSeries+  $ M.unionWith plus (M.unionWith plus as bs)+  $ M.fromListWith plus+  [ (a * b, fa `times` fb)+  | (b, fb) <- M.assocs bs+  , let nb = n `quot` b+  , (a, fa) <- takeWhile ((<= nb) . fst) (M.assocs as)+  , nb `rem` a == 0+  ]+{-# SPECIALISE timesAndCrop :: Semiring b => Int -> DirichletSeries Int b -> DirichletSeries Int b -> DirichletSeries Int b #-}+{-# SPECIALISE timesAndCrop :: Semiring b => Word -> DirichletSeries Word b -> DirichletSeries Word b -> DirichletSeries Word b #-}+{-# SPECIALISE timesAndCrop :: Semiring b => Integer -> DirichletSeries Integer b -> DirichletSeries Integer b -> DirichletSeries Integer b #-}+{-# SPECIALISE timesAndCrop :: Semiring b => Natural -> DirichletSeries Natural b -> DirichletSeries Natural b -> DirichletSeries Natural b #-}

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2017 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Monomorphic `fromIntegral`. --@@ -19,6 +17,7 @@   , naturalToInteger   , integerToNatural   , integerToWord+  , integerToInt   ) where  import Numeric.Natural@@ -50,3 +49,7 @@ integerToWord :: Integer -> Word integerToWord = fromIntegral {-# INLINE integerToWord #-}++integerToInt :: Integer -> Int+integerToInt = fromIntegral+{-# INLINE integerToInt #-}

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2018 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Highest points under hyperbola. --

@@ -3,8 +3,6 @@ -- Copyright:   (c) 2018 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--- Stability:   Provisional--- Portability: Non-portable (GHC extensions) -- -- Interface to work with Riemann zeta-function and Dirichlet beta-function. @@ -12,10 +10,12 @@  module Math.NumberTheory.Zeta   ( module Math.NumberTheory.Zeta.Dirichlet+  , module Math.NumberTheory.Zeta.Hurwitz   , module Math.NumberTheory.Zeta.Riemann   , module Math.NumberTheory.Zeta.Utils   ) where  import Math.NumberTheory.Zeta.Dirichlet+import Math.NumberTheory.Zeta.Hurwitz import Math.NumberTheory.Zeta.Riemann import Math.NumberTheory.Zeta.Utils

@@ -3,8 +3,6 @@ -- 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. @@ -16,25 +14,21 @@   , betasOdd   ) where -import Data.ExactPi                     (ExactPi (..), approximateValue)-import Data.List                        (zipWith4)-import Data.Ratio                       ((%))+import Data.ExactPi+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)+import Math.NumberTheory.Recurrences  (euler, factorial)+import Math.NumberTheory.Zeta.Hurwitz (zetaHurwitz)+import Math.NumberTheory.Zeta.Utils   (intertwine, skipOdds)  -- | 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---+-- >>> approximateValue (betasOdd !! 25) :: Double+-- 0.9999999999999987+-- >>> import Data.Number.Fixed+-- >>> approximateValue (betasOdd !! 25) :: Fixed Prec50+-- 0.99999999999999999999999960726927497384196726751694 betasOdd :: [ExactPi] betasOdd = zipWith Exact [1, 3 ..] $ zipWith4                                      (\sgn denom eul twos -> sgn * (eul % (twos * denom)))@@ -43,127 +37,34 @@                                      (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+betasEven eps = (1 / 2) : hurwitz   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+    hurwitz :: [a]+    hurwitz =+        zipWith3 (\quarter threeQuarters four ->+            (quarter - threeQuarters) / four)+        (tail . skipOdds $ zetaHurwitz eps 0.25)+        (tail . skipOdds $ zetaHurwitz eps 0.75)+        (iterate (16 *) 16)  -- | 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]+-- The algorithm previously used to compute @β@ for even arguments was derived+-- from <https://arxiv.org/pdf/0910.5004.pdf An Euler-type formula for β(2n) and closed-form expressions for a class of zeta series>+-- by F. M. S. Lima, formula (12), but is now based on the+-- 'Math.NumberTheory.Zeta.Hurwitz.zetaHurwitz' recurrence.+--+-- >>> take 5 (betas 1e-14) :: [Double]+-- [0.5,0.7853981633974483,0.9159655941772189,0.9689461462593694,0.9889445517411051] betas :: (Floating a, Ord a) => a -> [a] betas eps = e : o : scanl1 f (intertwine es os)   where     e : es = betasEven eps-    o : os = betasOdd'+    o : os = map (getRationalLimit (\a b -> abs (a - b) < eps) . rationalApproximations) betasOdd      -- Cap-and-floor to improve numerical stability:     -- 1 > beta(n + 1) - 1 > (beta(n) - 1) / 2

@@ -0,0 +1,125 @@+-- |+-- Module:      Math.NumberTheory.Zeta.Hurwitz+-- Copyright:   (c) 2018 Alexandre Rodrigues Baldé+-- Licence:     MIT+-- Maintainer:  Alexandre Rodrigues Baldé <alexandrer_b@outlook.com>+--+-- Hurwitz zeta function.++{-# LANGUAGE ScopedTypeVariables #-}++module Math.NumberTheory.Zeta.Hurwitz+  ( zetaHurwitz+  ) where++import Math.NumberTheory.Recurrences (bernoulli, factorial)+import Math.NumberTheory.Zeta.Utils  (skipEvens, skipOdds)++-- | Values of Hurwitz zeta function evaluated at @ζ(s, a)@ with+-- @forall t1 . (Floating t1, Ord t1) => a ∈ t1@, and @s ∈ [0, 1 ..]@.+--+-- The algorithm used was based on the Euler-Maclaurin formula and was derived+-- from <http://fredrikj.net/thesis/thesis.pdf Fast and Rigorous Computation of Special Functions to High Precision>+-- by F. Johansson, chapter 4.8, formula 4.8.5.+--+-- The error for each value in this recurrence is given in formula 4.8.9 as an+--  indefinite integral, and in formula 4.8.12 as a closed form formula.+--+-- It is the __user's responsibility__ to provide an appropriate precision for+-- the type chosen.+--+-- For instance, when using @Double@s, it does not make sense+-- to provide a number @ε >= 1e-53@ as the desired precision. For @Float@s,+-- providing an @ε >= 1e-24@ also does not make sense.+-- Example of how to call the function:+--+-- >>> zetaHurwitz 1e-15 0.25 !! 5+-- 1024.3489745265808+zetaHurwitz :: forall a . (Floating a, Ord a) => a -> a -> [a]+zetaHurwitz eps a = zipWith3 (\s i t -> s + i + t) ss is ts+  where+    -- When given @1e-14@ as the @eps@ argument, this'll be+    -- @div (33 * (length . takeWhile (>= 1) . iterate (/ 10) . recip) 1e-14) 10 == div (33 * 14) 10@+    -- @div (33 * 14) 10 == 46.+    -- meaning @N,M@ in formula 4.8.5 will be @46@.+    -- Multiplying by 33 and dividing by 10 is because asking for @14@ digits+    -- of decimal precision equals asking for @(log 10 / log 2) * 14 ~ 3.3 * 14 ~ 46@+    -- bits of precision.+    digitsOfPrecision :: Integer+    digitsOfPrecision =+       let magnitude = toInteger . length . takeWhile (>= 1) . iterate (/ 10) . recip $ eps+       in  div (magnitude * 33) 10++    -- @a + n@+    aPlusN :: a+    aPlusN = a + fromIntegral digitsOfPrecision++    -- @[(a + n)^s | s <- [0, 1, 2 ..]]@+    powsOfAPlusN :: [a]+    powsOfAPlusN = iterate (aPlusN *) 1++    -- [                   [      1      ] |                   ]+    -- | \sum_{k=0}^\(n-1) | ----------- | | s <- [0, 1, 2 ..] |+    -- [                   [ (a + k) ^ s ] |                   ]+    -- @S@ value in 4.8.5 formula.+    ss :: [a]+    ss = let numbers = map ((a +) . fromInteger) [0..digitsOfPrecision-1]+             denoms  = replicate (fromInteger digitsOfPrecision) 1 :+                       iterate (zipWith (*) numbers) numbers+         in map (sum . map recip) denoms++    -- [ (a + n) ^ (1 - s)            a + n         |                   ]+    -- | ----------------- = ---------------------- | s <- [0, 1, 2 ..] |+    -- [       s - 1          (a + n) ^ s * (s - 1) |                   ]+    -- @I@ value in 4.8.5 formula.+    is :: [a]+    is = let denoms = zipWith+                      (\powOfA int -> powOfA * fromInteger int)+                      powsOfAPlusN+                      [-1, 0..]+         in zipWith (/) (repeat aPlusN) denoms++    -- [      1      |             ]+    -- [ ----------- | s <- [0 ..] ]+    -- [ (a + n) ^ s |             ]+    constants2 :: [a]+    constants2 = map recip powsOfAPlusN++    -- [ [(s)_(2*k - 1) | k <- [1 ..]], s <- [0 ..]], i.e. odd indices of+    -- infinite rising factorial sequences, each sequence starting at a+    -- positive integer.+    pochhammers :: [[Integer]]+    pochhammers = let -- [ [(s)_k | k <- [1 ..]], s <- [1 ..]]+                      pochhs :: [[Integer]]+                      pochhs = iterate (\(x : xs) -> map (`div` x) xs) (tail factorial)+                  in -- When @s@ is @0@, the infinite sequence of rising+                     -- factorials starting at @s@ is @[0,0,0,0..]@.+                     repeat 0 : map skipOdds pochhs++    -- [            B_2k           |             ]+    -- | ------------------------- | k <- [1 ..] |+    -- [ (2k)! (a + n) ^ (2*k - 1) |             ]+    second :: [a]+    second =+        take (fromInteger digitsOfPrecision) $+        zipWith3+        (\bern evenFac denom -> fromRational bern / (denom * fromInteger evenFac))+        (tail $ skipOdds bernoulli)+        (tail $ skipOdds factorial)+        -- Recall that @powsOfAPlusN = [(a + n) ^ s | s <- [0 ..]]@, so this+        -- is @[(a + n) ^ (2 * s - 1) | s <- [1 ..]]@+        (skipEvens powsOfAPlusN)++    fracs :: [a]+    fracs = zipWith+            (\sec pochh -> sum $ zipWith (\s p -> s * fromInteger p) sec pochh)+            (repeat second)+            pochhammers++    -- Infinite list of @T@ values in 4.8.5 formula, for every @s@ in+    -- @[0, 1, 2 ..]@.+    ts :: [a]+    ts = zipWith+         (\constant2 frac -> constant2 * (0.5 + frac))+         constants2+         fracs