arithmoi-0.12.1.0/0000755000000000000000000000000007346545000011736 5ustar0000000000000000arithmoi-0.12.1.0/LICENSE0000644000000000000000000000214507346545000012745 0ustar0000000000000000Copyright (c) 2011 Daniel Fischer, 2016-2017 Andrew Lelechenko, Carter Schonwald, Google Inc. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. arithmoi-0.12.1.0/Math/NumberTheory/0000755000000000000000000000000007346545000015252 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions.hs0000644000000000000000000000116207346545000021570 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- This module provides an interface for defining and manipulating -- arithmetic functions. It also defines several most widespreaded -- arithmetic functions. -- module Math.NumberTheory.ArithmeticFunctions ( module Math.NumberTheory.ArithmeticFunctions.Class , module Math.NumberTheory.ArithmeticFunctions.Standard ) where import Math.NumberTheory.ArithmeticFunctions.Class import Math.NumberTheory.ArithmeticFunctions.Standard arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions/0000755000000000000000000000000007346545000021234 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions/Class.hs0000644000000000000000000000630607346545000022642 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.Class -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Generic type for arithmetic functions over arbitrary unique -- factorisation domains. -- {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} module Math.NumberTheory.ArithmeticFunctions.Class ( ArithmeticFunction(..) , runFunction , runFunctionOnFactors ) where import Control.Applicative #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Prelude hiding (Applicative(..)) 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 -- determines the values of the function on the powers of primes. The second -- one determines how to combine these values into final result. -- -- In the following definition the first argument is the function on prime's -- powers, the monoid instance determines a rule of combination (typically -- '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 => (Prime n -> Word -> m) -> (m -> a) -> ArithmeticFunction n a -- | Convert to a function. The value on 0 is undefined. runFunction :: UniqueFactorisation n => ArithmeticFunction n a -> n -> a 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) instance Functor (ArithmeticFunction n) where fmap f (ArithmeticFunction g h) = ArithmeticFunction g (f . h) instance Applicative (ArithmeticFunction n) where pure x = ArithmeticFunction (\_ _ -> ()) (const x) (ArithmeticFunction f1 g1) <*> (ArithmeticFunction f2 g2) = ArithmeticFunction (\p k -> (f1 p k, f2 p k)) (\(a1, a2) -> g1 a1 (g2 a2)) instance Semigroup a => Semigroup (ArithmeticFunction n a) where (<>) = liftA2 (<>) instance Monoid a => Monoid (ArithmeticFunction n a) where mempty = pure mempty #if __GLASGOW_HASKELL__ < 803 mappend = liftA2 mappend #else mappend = (<>) #endif -- | Factorisation is expensive, so it is better to avoid doing it twice. -- Write 'runFunction (f + g) n' instead of 'runFunction f n + runFunction g n'. instance Num a => Num (ArithmeticFunction n a) where fromInteger = pure . fromInteger negate = fmap negate signum = fmap signum abs = fmap abs (+) = liftA2 (+) (-) = liftA2 (-) (*) = liftA2 (*) instance Fractional a => Fractional (ArithmeticFunction n a) where fromRational = pure . fromRational recip = fmap recip (/) = liftA2 (/) instance Floating a => Floating (ArithmeticFunction n a) where pi = pure pi exp = fmap exp log = fmap log sin = fmap sin cos = fmap cos asin = fmap asin acos = fmap acos atan = fmap atan sinh = fmap sinh cosh = fmap cosh asinh = fmap asinh acosh = fmap acosh atanh = fmap atanh arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions/Inverse.hs0000644000000000000000000004055707346545000023216 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.Inverse -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Computing inverses of multiplicative functions. -- The implementation is based on -- -- by M. A. Alekseyev. {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.ArithmeticFunctions.Inverse ( inverseTotient , inverseJordan , inverseSigma , inverseSigmaK , -- * Wrappers MinWord(..) , MaxWord(..) , MinNatural(..) , MaxNatural(..) , -- * Utils asSetOfPreimages ) where import Prelude hiding (rem, quot) import Data.Bits (Bits) import Data.Euclidean import Data.Foldable import Data.List (partition, sortOn) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe import Data.Ord (Down(..)) #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Data.Semiring (Semiring(..), Mul(..)) import Data.Set (Set) import qualified Data.Set as S import Data.Traversable import Numeric.Natural import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.Logarithms import Math.NumberTheory.Roots (exactRoot, integerRoot) import Math.NumberTheory.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. invJordan :: forall a. (Integral a, UniqueFactorisation a, Eq a) => Word -- ^ Value of k in 'jordan' k -> [(Prime a, Word)] -- ^ Factorisation of a value of the totient function -> [PrimePowers a] -- ^ Possible prime factors of an argument of the totient function invJordan k fs = map (\p -> PrimePowers p (doPrime p)) ps where divs :: [a] divs = runFunctionOnFactors divisorsListA fs ps :: [Prime a] ps = mapMaybe (\d -> exactRoot k (d + 1) >>= isPrime) divs doPrime :: Prime a -> [Word] doPrime p = case lookup p fs of Nothing -> [1] Just w -> [1 .. w+1] -- | See section 5.2 of the paper. invSigma :: forall a. (Euclidean a, Integral a, UniqueFactorisation a, Enum (Prime a), Bits a) => Word -- ^ Value of k in 'sigma' k -> [(Prime a, Word)] -- ^ Factorisation of a value of the sum-of-divisors function -> [PrimePowers a] -- ^ Possible prime factors of an argument of the sum-of-divisors function invSigma k 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 = factorBack 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 <- [nextPrime 2 .. precPrime lim] , 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 ^ k)) (toInteger n))] , n `rem` ((p ^ (k * (e + 1)) - 1) `quot` (p ^ k - 1)) == 0 ] pksLarge :: Map (Prime a) (Set Word) pksLarge = M.unionsWith (<>) [ maybe mempty (`M.singleton` S.singleton e) (isPrime p) | d <- divs , e <- [1 .. intToWord (quot (integerLogBase (toInteger lim) (toInteger d)) (wordToInt k)) ] , let p = integerRoot (e * k) (d - 1) , p ^ (k * (e + 1)) - 1 == d * (p ^ k - 1) ] -- | Instead of multiplying all atomic series and filtering out everything, -- which is not divisible by @n@, we'd rather split all atomic series into -- a couple of batches, each of which corresponds to a prime factor of @n@. -- This allows us to crop resulting Dirichlet series (see 'filter' calls -- in @invertFunction@ below) at the end of each batch, saving time and memory. strategy :: forall a c. (GcdDomain 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 -> isJust $ g (f q l) `divide` unPrime p) 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' (flip (uncurry processBatch)) (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, Integral a, Euclidean a, UniqueFactorisation a) => (a -> b) -> a -> b inverseTotient = inverseJordan 1 {-# SPECIALISE inverseTotient :: Semiring b => (Int -> b) -> Int -> b #-} {-# SPECIALISE inverseTotient :: Semiring b => (Word -> b) -> Word -> b #-} {-# SPECIALISE inverseTotient :: Semiring b => (Integer -> b) -> Integer -> b #-} {-# SPECIALISE inverseTotient :: Semiring b => (Natural -> b) -> Natural -> b #-} -- | The inverse for 'jordan' function. -- -- Generalizes the 'inverseTotient' function, which is 'inverseJordan' 1. -- -- The return value is parameterized by a 'Semiring', which allows -- various applications by providing different (multiplicative) embeddings. -- E. g., list all preimages (see a helper 'asSetOfPreimages'): -- -- >>> import qualified Data.Set as S -- >>> import Data.Semigroup -- >>> S.mapMonotonic getProduct (inverseJordan 2 (S.singleton . Product) 192) -- fromList [15,16] -- -- Similarly to 'inverseTotient', it is possible to count and sum preimages, or -- get the maximum/minimum preimage. -- -- Note: it is the __user's responsibility__ to use an appropriate type for -- 'inverseSigmaK'. Even low values of k with 'Int' or 'Word' will return -- invalid results due to over/underflow, or throw exceptions (i.e. division by -- zero). -- -- >>> asSetOfPreimages (inverseJordan 15) (jordan 15 19) :: S.Set Int -- fromList [] -- -- >>> asSetOfPreimages (inverseJordan 15) (jordan 15 19) :: S.Set Integer -- fromList [19] inverseJordan :: (Semiring b, Integral a, Euclidean a, UniqueFactorisation a) => Word -> (a -> b) -> a -> b inverseJordan k point = invertFunction point (jordanA k) (invJordan k) {-# SPECIALISE inverseJordan :: Semiring b => Word -> (Int -> b) -> Int -> b #-} {-# SPECIALISE inverseJordan :: Semiring b => Word -> (Word -> b) -> Word -> b #-} {-# SPECIALISE inverseJordan :: Semiring b => Word -> (Integer -> b) -> Integer -> b #-} {-# SPECIALISE inverseJordan :: Semiring b => Word -> (Natural -> b) -> Natural -> b #-} -- | The inverse for 'sigma' 1 function. -- -- The return value is parameterized by a 'Semiring', which allows -- various applications by providing different (multiplicative) embeddings. -- E. g., list all preimages (see a helper 'asSetOfPreimages'): -- -- >>> import qualified Data.Set as S -- >>> import Data.Semigroup -- >>> :set -XFlexibleContexts -- >>> S.mapMonotonic getProduct (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, Enum (Prime a), Bits a) => (a -> b) -> a -> b inverseSigma = inverseSigmaK 1 {-# SPECIALISE inverseSigma :: Semiring b => (Int -> b) -> Int -> b #-} {-# SPECIALISE inverseSigma :: Semiring b => (Word -> b) -> Word -> b #-} {-# SPECIALISE inverseSigma :: Semiring b => (Integer -> b) -> Integer -> b #-} {-# SPECIALISE inverseSigma :: Semiring b => (Natural -> b) -> Natural -> b #-} -- | The inverse for 'sigma' function. -- -- Generalizes the 'inverseSigma' function, which is 'inverseSigmaK' 1. -- -- The return value is parameterized by a 'Semiring', which allows -- various applications by providing different (multiplicative) embeddings. -- E. g., list all preimages (see a helper 'asSetOfPreimages'): -- -- >>> import qualified Data.Set as S -- >>> import Data.Semigroup -- >>> :set -XFlexibleContexts -- >>> S.mapMonotonic getProduct (inverseSigmaK 2 (S.singleton . Product) 850) -- fromList [24,26] -- -- Similarly to 'inverseSigma', it is possible to count and sum preimages, or -- get the maximum/minimum preimage. -- -- Note: it is the __user's responsibility__ to use an appropriate type for -- 'inverseSigmaK'. Even low values of k with 'Int' or 'Word' will return -- invalid results due to over/underflow, or throw exceptions (i.e. division by -- zero). -- -- >>> asSetOfPreimages (inverseSigmaK 17) (sigma 17 13) :: S.Set Int -- fromList *** Exception: divide by zero inverseSigmaK :: (Semiring b, Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a) => Word -> (a -> b) -> a -> b inverseSigmaK k point = invertFunction point (sigmaA k) (invSigma k) {-# SPECIALISE inverseSigmaK :: Semiring b => Word -> (Int -> b) -> Int -> b #-} {-# SPECIALISE inverseSigmaK :: Semiring b => Word -> (Word -> b) -> Word -> b #-} {-# SPECIALISE inverseSigmaK :: Semiring b => Word -> (Integer -> b) -> Integer -> b #-} {-# SPECIALISE inverseSigmaK :: Semiring b => Word -> (Natural -> b) -> Natural -> b #-} -------------------------------------------------------------------------------- -- Wrappers -- | 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 :: (Ord a, Semiring a) => (forall b. Semiring b => (a -> b) -> a -> b) -> a -> S.Set a asSetOfPreimages f = S.mapMonotonic getMul . f (S.singleton . Mul) arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions/Mertens.hs0000644000000000000000000000433707346545000023214 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.Mertens -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Values of . -- {-# LANGUAGE LambdaCase #-} module Math.NumberTheory.ArithmeticFunctions.Mertens ( mertens ) where import qualified Data.Vector.Unboxed as U import Math.NumberTheory.Roots import Math.NumberTheory.ArithmeticFunctions.Moebius import Math.NumberTheory.Utils.FromIntegral -- | Compute individual values of Mertens function in O(n^(2/3)) time and space. -- -- >>> map (mertens . (10 ^)) [0..9] -- [1,-1,1,2,-23,-48,212,1037,1928,-222] -- -- The implementation follows Theorem 3.1 from by G. Hurst, excluding segmentation of sieves. mertens :: Word -> Int mertens 0 = 0 mertens 1 = 1 mertens x = sumMultMoebius lookupMus (\n -> sfunc (x `quot` n)) [1 .. x `quot` u] where u = (integerSquareRoot x + 1) `max` (integerCubeRoot x ^ (2 :: Word) `quot` 2) sfunc :: Word -> Int sfunc y = 1 - sum [ U.unsafeIndex mes (wordToInt $ y `quot` n) | n <- [y `quot` u + 1 .. kappa] ] + wordToInt kappa * U.unsafeIndex mes (wordToInt nu) - sumMultMoebius lookupMus (\n -> wordToInt $ y `quot` n) [1 .. nu] where nu = integerSquareRoot y kappa = y `quot` (nu + 1) -- cacheSize ~ u cacheSize :: Word cacheSize = u `max` (x `quot` u) `max` integerSquareRoot x -- 1-based index mus :: U.Vector Moebius mus = sieveBlockMoebius 1 cacheSize lookupMus :: Word -> Moebius lookupMus i = U.unsafeIndex mus (wordToInt (i - 1)) -- 0-based index mes :: U.Vector Int mes = U.scanl' go 0 mus where go acc = \case MoebiusN -> acc - 1 MoebiusZ -> acc MoebiusP -> acc + 1 -- | Compute sum (map (\x -> runMoebius (mu x) * f x)) sumMultMoebius :: (Word -> Moebius) -> (Word -> Int) -> [Word] -> Int sumMultMoebius mu f = foldl go 0 where go acc i = case mu i of MoebiusN -> acc - f i MoebiusZ -> acc MoebiusP -> acc + f i arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions/Moebius.hs0000644000000000000000000001373407346545000023203 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.Moebius -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Values of . -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} module Math.NumberTheory.ArithmeticFunctions.Moebius ( Moebius(..) , runMoebius , sieveBlockMoebius ) where import Control.Monad (forM_) import Control.Monad.ST (runST) import Data.Bits import Data.Int import Data.Word #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU import GHC.Exts import GHC.Integer.GMP.Internals import Unsafe.Coerce import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.Primes import Math.NumberTheory.Utils.FromIntegral import Math.NumberTheory.Logarithms -- | Represents three possible values of . data Moebius = MoebiusN -- ^ -1 | MoebiusZ -- ^ 0 | MoebiusP -- ^ 1 deriving (Eq, Ord, Show) -- | Convert to any numeric type. runMoebius :: Num a => Moebius -> a runMoebius m = fromInteger (S# (dataToTag# m -# 1#)) fromMoebius :: Moebius -> Int8 fromMoebius m = intToInt8 $ I# (dataToTag# m) {-# INLINE fromMoebius #-} toMoebius :: Int8 -> Moebius toMoebius i = let !(I# i#) = int8ToInt i in tagToEnum# i# {-# INLINE toMoebius #-} newtype instance U.MVector s Moebius = MV_Moebius (P.MVector s Int8) newtype instance U.Vector Moebius = V_Moebius (P.Vector Int8) instance U.Unbox Moebius instance M.MVector U.MVector Moebius where {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicOverlaps #-} {-# INLINE basicUnsafeNew #-} {-# INLINE basicInitialize #-} {-# INLINE basicUnsafeReplicate #-} {-# INLINE basicUnsafeRead #-} {-# INLINE basicUnsafeWrite #-} {-# INLINE basicClear #-} {-# INLINE basicSet #-} {-# INLINE basicUnsafeCopy #-} {-# INLINE basicUnsafeGrow #-} basicLength (MV_Moebius v) = M.basicLength v basicUnsafeSlice i n (MV_Moebius v) = MV_Moebius $ M.basicUnsafeSlice i n v basicOverlaps (MV_Moebius v1) (MV_Moebius v2) = M.basicOverlaps v1 v2 basicUnsafeNew n = MV_Moebius <$> M.basicUnsafeNew n basicInitialize (MV_Moebius v) = M.basicInitialize v basicUnsafeReplicate n x = MV_Moebius <$> M.basicUnsafeReplicate n (fromMoebius x) basicUnsafeRead (MV_Moebius v) i = toMoebius <$> M.basicUnsafeRead v i basicUnsafeWrite (MV_Moebius v) i x = M.basicUnsafeWrite v i (fromMoebius x) basicClear (MV_Moebius v) = M.basicClear v basicSet (MV_Moebius v) x = M.basicSet v (fromMoebius x) basicUnsafeCopy (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeCopy v1 v2 basicUnsafeMove (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeMove v1 v2 basicUnsafeGrow (MV_Moebius v) n = MV_Moebius <$> M.basicUnsafeGrow v n instance G.Vector U.Vector Moebius where {-# INLINE basicUnsafeFreeze #-} {-# INLINE basicUnsafeThaw #-} {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicUnsafeIndexM #-} {-# INLINE elemseq #-} basicUnsafeFreeze (MV_Moebius v) = V_Moebius <$> G.basicUnsafeFreeze v basicUnsafeThaw (V_Moebius v) = MV_Moebius <$> G.basicUnsafeThaw v basicLength (V_Moebius v) = G.basicLength v basicUnsafeSlice i n (V_Moebius v) = V_Moebius $ G.basicUnsafeSlice i n v basicUnsafeIndexM (V_Moebius v) i = toMoebius <$> G.basicUnsafeIndexM v i basicUnsafeCopy (MV_Moebius mv) (V_Moebius v) = G.basicUnsafeCopy mv v elemseq _ = seq instance Semigroup Moebius where MoebiusZ <> _ = MoebiusZ _ <> MoebiusZ = MoebiusZ MoebiusP <> a = a a <> MoebiusP = a _ <> _ = MoebiusP instance Monoid Moebius where mempty = MoebiusP mappend = (<>) -- | Evaluate the Möbius function over a block. -- Value of @f@ at 0, if zero falls into block, is undefined. -- -- Based on the sieving algorithm from p. 3 of by G. Hurst. It is approximately 5x faster than 'Math.NumberTheory.ArithmeticFunctions.SieveBlock.sieveBlockUnboxed'. -- -- >>> sieveBlockMoebius 1 10 -- [MoebiusP,MoebiusN,MoebiusN,MoebiusZ,MoebiusN,MoebiusP,MoebiusN,MoebiusZ,MoebiusZ,MoebiusP] sieveBlockMoebius :: Word -> Word -> U.Vector Moebius sieveBlockMoebius _ 0 = U.empty sieveBlockMoebius lowIndex' len' = (unsafeCoerce :: U.Vector Word8 -> U.Vector Moebius) $ runST $ do as <- MU.replicate len (0x80 :: Word8) forM_ ps $ \p -> do let offset = negate lowIndex `mod` p offset2 = negate lowIndex `mod` (p * p) l :: Word8 l = intToWord8 $ intLog2 p .|. 1 forM_ [offset, offset + p .. len - 1] $ MU.unsafeModify as (+ l) forM_ [offset2, offset2 + p * p .. len - 1] $ \ix -> MU.unsafeWrite as ix 0 forM_ [0 .. len - 1] $ \ix -> MU.unsafeModify as (mapper ix) ix U.unsafeFreeze as where lowIndex :: Int lowIndex = wordToInt lowIndex' len :: Int len = wordToInt len' highIndex :: Int highIndex = lowIndex + len - 1 -- Bit fiddling in 'mapper' is correct only -- if all sufficiently small (<= 191) primes has been sieved out. ps :: [Int] ps = map unPrime [nextPrime 2 .. precPrime (191 `max` integerSquareRoot highIndex)] mapper :: Int -> Word8 -> Word8 mapper ix val | val .&. 0x80 == 0x00 = 1 | word8ToInt (val .&. 0x7F) < intLog2 (ix + lowIndex) - 5 - (if ix + lowIndex >= 0x100000 then 2 else 0) - (if ix + lowIndex >= 0x10000000 then 1 else 0) = (val .&. 1) `shiftL` 1 | otherwise = ((val .&. 1) `xor` 1) `shiftL` 1 arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions/NFreedom.hs0000644000000000000000000001350207346545000023270 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.NFreedom -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- -- N-free number generation. -- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.ArithmeticFunctions.NFreedom ( nFrees , nFreesBlock , sieveBlockNFree ) where import Control.Monad (forM_) import Control.Monad.ST (runST) import Data.Bits (Bits) import Data.List (scanl') import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU import Math.NumberTheory.Roots import Math.NumberTheory.Primes import Math.NumberTheory.Utils.FromIntegral -- | Evaluate the `Math.NumberTheory.ArithmeticFunctions.isNFree` function over a block. -- Value at @0@, if zero falls into block, is undefined. -- -- 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, Enum (Prime a), Bits a, UniqueFactorisation 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 -> MU.write as (fromIntegral ix) False U.freeze as where len :: a len = fromIntegral len' highIndex :: a highIndex = lowIndex + len - 1 ps :: [a] ps = if highIndex < 4 then [] else map unPrime [nextPrime 2 .. precPrime (integerSquareRoot highIndex)] -- | For a given nonnegative integer power @n@, generate all @n@-free -- numbers in ascending order, starting at @1@. -- -- When @n@ is @0@ or @1@, the resulting list is @[1]@. nFrees :: forall a. (Integral a, Bits a, UniqueFactorisation a, Enum (Prime a)) => Word -- ^ Power @n@ to be used to generate @n@-free numbers. -> [a] -- ^ Generated infinite list of @n@-free numbers. nFrees 0 = [1] nFrees 1 = [1] nFrees n = concatMap (uncurry (nFreesBlock n)) $ zip bounds strides where -- The 56th element of @iterate (2 *) 256@ is @2^64 :: Word == 0@, so to -- avoid overflow only the first 55 elements of this list are used. -- 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 (intToWord (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, Bits a, UniqueFactorisation a, Enum (Prime 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 #-} arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions/SieveBlock.hs0000644000000000000000000001722607346545000023626 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.SieveBlock -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Bulk evaluation of arithmetic functions over continuous intervals -- without factorisation. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.ArithmeticFunctions.SieveBlock ( runFunctionOverBlock , SieveBlockConfig(..) , multiplicativeSieveBlockConfig , additiveSieveBlockConfig , sieveBlock , sieveBlockUnboxed , sieveBlockMoebius ) where import Control.Monad (forM_, when) import Control.Monad.ST (runST) import Data.Bits import Data.Coerce import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as MG import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU import GHC.Exts import Math.NumberTheory.ArithmeticFunctions.Class import Math.NumberTheory.ArithmeticFunctions.Moebius (Moebius, sieveBlockMoebius) import Math.NumberTheory.Logarithms (wordLog2, integerLogBase') import Math.NumberTheory.Primes import Math.NumberTheory.Primes.Types import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.Utils.FromIntegral (wordToInt, intToWord) -- | A record, which specifies a function to evaluate over a block. -- -- For example, here is a configuration for the totient function: -- -- > SieveBlockConfig -- > { sbcEmpty = 1 -- > , sbcFunctionOnPrimePower = \p a -> (unPrime p - 1) * unPrime p ^ (a - 1) -- > , sbcAppend = (*) -- > } data SieveBlockConfig a = SieveBlockConfig { sbcEmpty :: a -- ^ value of a function on 1 , sbcFunctionOnPrimePower :: Prime Word -> Word -> a -- ^ how to evaluate a function on prime powers , sbcAppend :: a -> a -> a -- ^ how to combine values of a function on coprime arguments } -- | Create a config for a multiplicative function from its definition on prime powers. multiplicativeSieveBlockConfig :: Num a => (Prime Word -> Word -> a) -> SieveBlockConfig a multiplicativeSieveBlockConfig f = SieveBlockConfig { sbcEmpty = 1 , sbcFunctionOnPrimePower = f , sbcAppend = (*) } -- | Create a config for an additive function from its definition on prime powers. additiveSieveBlockConfig :: Num a => (Prime Word -> Word -> a) -> SieveBlockConfig a additiveSieveBlockConfig f = SieveBlockConfig { sbcEmpty = 0 , sbcFunctionOnPrimePower = f , sbcAppend = (+) } -- | 'runFunctionOverBlock' @f@ @x@ @l@ evaluates an arithmetic function -- for integers between @x@ and @x+l-1@ and returns a vector of length @l@. -- It completely avoids factorisation, so it is asymptotically faster than -- pointwise evaluation of @f@. -- -- Value of @f@ at 0, if zero falls into block, is undefined. -- -- Beware that for underlying non-commutative monoids the results may potentially -- differ from pointwise application via 'runFunction'. -- -- 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 :: ArithmeticFunction Word a -> Word -> Word -> V.Vector a runFunctionOverBlock (ArithmeticFunction f g) = (G.map g .) . sieveBlock SieveBlockConfig { sbcEmpty = mempty , sbcAppend = mappend , sbcFunctionOnPrimePower = coerce f } -- | Evaluate a function over a block in accordance to provided configuration. -- Value of @f@ at 0, if zero falls into block, is undefined. -- -- Based on Algorithm M of 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, following code lists smallest prime factors: -- -- >>> sieveBlock (SieveBlockConfig maxBound (\p _ -> unPrime p) min) 2 10 :: Data.Vector.Vector Word -- [2,3,2,5,2,7,2,3,2,11] -- -- And this is how to factorise all numbers in a block: -- -- >>> sieveBlock (SieveBlockConfig [] (\p k -> [(unPrime p, k)]) (++)) 2 10 :: Data.Vector.Vector [(Word, Word)] -- [[(2,1)],[(3,1)],[(2,2)],[(5,1)],[(2,1),(3,1)],[(7,1)],[(2,3)],[(3,2)],[(2,1),(5,1)],[(11,1)]] sieveBlock :: forall v a. G.Vector v a => SieveBlockConfig a -> Word -> Word -> v a sieveBlock _ _ 0 = G.empty sieveBlock (SieveBlockConfig empty f append) !lowIndex' len' = runST $ do let lowIndex :: Int lowIndex = wordToInt lowIndex' len :: Int len = wordToInt len' highIndex :: Int highIndex = lowIndex + len - 1 highIndex' :: Word highIndex' = intToWord highIndex ps :: [Int] ps = if highIndex < 4 then [] else map unPrime [nextPrime 2 .. precPrime (integerSquareRoot highIndex)] as <- MU.replicate len 1 bs <- MG.replicate len empty let doPrime 2 = do let fs = V.generate (wordLog2 highIndex') (\k -> f (Prime 2) (intToWord k + 1)) npLow = (lowIndex' + 1) `shiftR` 1 npHigh = highIndex' `shiftR` 1 forM_ [npLow .. npHigh] $ \np@(W# np#) -> do let ix = wordToInt (np `shiftL` 1) - lowIndex :: Int tz = I# (word2Int# (ctz# np#)) MU.unsafeModify as (\x -> x `shiftL` (tz + 1)) ix MG.unsafeModify bs (\y -> y `append` V.unsafeIndex fs tz) ix doPrime p = do let p' = intToWord p f0 = f (Prime p') 1 logp = integerLogBase' (toInteger p) (toInteger highIndex) - 1 fs = V.generate logp (\k -> f (Prime p') (intToWord k + 2)) npLow = (lowIndex + p - 1) `quot` p npHigh = highIndex `quot` p forM_ [npLow .. npHigh] $ \np -> do let !(I# ix#) = np * p - lowIndex (q, r) = np `quotRem` p if r /= 0 then do MU.unsafeModify as (* p') (I# ix#) MG.unsafeModify bs (`append` f0) (I# ix#) else do let pow = highestPowerDividing p q MU.unsafeModify as (\x -> x * p' ^ (pow + 2)) (I# ix#) MG.unsafeModify bs (\y -> y `append` V.unsafeIndex fs (wordToInt pow)) (I# ix#) forM_ ps doPrime forM_ [0 .. len - 1] $ \k -> do a <- MU.unsafeRead as k let a' = intToWord (k + lowIndex) when (a /= a') $ MG.unsafeModify bs (\b -> b `append` f (Prime $ a' `quot` a) 1) k G.unsafeFreeze bs -- This is a variant of 'Math.NumberTheory.Utils.splitOff', -- specialized for better performance. highestPowerDividing :: Int -> Int -> Word highestPowerDividing !_ 0 = 0 highestPowerDividing p n = go 0 n where go !k m = case m `quotRem` p of (q, 0) -> go (k + 1) q _ -> k -- | This is 'sieveBlock' specialized to unboxed vectors. -- -- >>> sieveBlockUnboxed (SieveBlockConfig 1 (\_ a -> a + 1) (*)) 1 10 -- [1,2,2,3,2,4,2,4,3,4] sieveBlockUnboxed :: U.Unbox a => SieveBlockConfig a -> Word -> Word -> U.Vector a sieveBlockUnboxed = sieveBlock {-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Int -> Word -> Word -> U.Vector Int #-} {-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Word -> Word -> Word -> U.Vector Word #-} {-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Bool -> Word -> Word -> U.Vector Bool #-} {-# SPECIALIZE sieveBlockUnboxed :: SieveBlockConfig Moebius -> Word -> Word -> U.Vector Moebius #-} arithmoi-0.12.1.0/Math/NumberTheory/ArithmeticFunctions/Standard.hs0000644000000000000000000003147007346545000023335 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.Standard -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Textbook arithmetic functions. -- {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.ArithmeticFunctions.Standard ( -- * List divisors divisors, divisorsA , divisorsList, divisorsListA , divisorsSmall, divisorsSmallA , divisorsTo, divisorsToA -- * Multiplicative functions , multiplicative , divisorCount, tau, tauA , sigma, sigmaA , totient, totientA , jordan, jordanA , ramanujan, ramanujanA , moebius, moebiusA, Moebius(..), runMoebius , liouville, liouvilleA -- * Additive functions , additive , smallOmega, smallOmegaA , bigOmega, bigOmegaA -- * Misc , carmichael, carmichaelA , expMangoldt, expMangoldtA , isNFree, isNFreeA, nFrees, nFreesBlock ) where import Data.Coerce import Data.Euclidean (GcdDomain(divide)) import Data.IntSet (IntSet) import qualified Data.IntSet as IS import Data.Maybe import Data.Set (Set) import qualified Data.Set as S import Data.Semigroup import Math.NumberTheory.ArithmeticFunctions.Class import Math.NumberTheory.ArithmeticFunctions.Moebius import Math.NumberTheory.ArithmeticFunctions.NFreedom (nFrees, nFreesBlock) import Math.NumberTheory.Primes import Math.NumberTheory.Utils.FromIntegral import Numeric.Natural -- | Create a multiplicative function from the function on prime's powers. See examples below. multiplicative :: Num a => (Prime n -> Word -> a) -> ArithmeticFunction n a multiplicative f = ArithmeticFunction ((Product .) . f) getProduct -- | 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 :: (Ord n, Num n) => ArithmeticFunction n (Set n) divisorsA = ArithmeticFunction (\p -> SetProduct . divisorsHelper (unPrime p)) (S.insert 1 . getSetProduct) divisorsHelper :: Num n => n -> Word -> Set n divisorsHelper _ 0 = S.empty divisorsHelper p 1 = S.singleton p divisorsHelper p a = S.fromDistinctAscList $ p : p * p : map (p ^) [3 .. wordToInt a] {-# INLINE divisorsHelper #-} -- | 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 :: Num n => ArithmeticFunction n [n] divisorsListA = ArithmeticFunction (\p -> ListProduct . divisorsListHelper (unPrime p)) ((1 :) . getListProduct) divisorsListHelper :: Num n => n -> Word -> [n] divisorsListHelper _ 0 = [] divisorsListHelper p 1 = [p] divisorsListHelper p a = p : p * p : map (p ^) [3 .. wordToInt a] {-# INLINE divisorsListHelper #-} -- | See 'divisorsSmallA'. divisorsSmall :: Int -> IntSet divisorsSmall = runFunction divisorsSmallA -- | Same as 'divisors', but with better performance on cost of type restriction. divisorsSmallA :: ArithmeticFunction Int IntSet divisorsSmallA = ArithmeticFunction (\p -> IntSetProduct . divisorsHelperSmall (unPrime p)) (IS.insert 1 . getIntSetProduct) divisorsHelperSmall :: Int -> Word -> IntSet divisorsHelperSmall _ 0 = IS.empty divisorsHelperSmall p 1 = IS.singleton p divisorsHelperSmall p a = IS.fromDistinctAscList $ p : p * p : map (p ^) [3 .. wordToInt a] {-# INLINE divisorsHelperSmall #-} -- | See 'divisorsToA'. divisorsTo :: (UniqueFactorisation n, Integral n) => n -> n -> Set n divisorsTo to = runFunction (divisorsToA to) -- | The set of all (positive) divisors up to an inclusive bound. divisorsToA :: (UniqueFactorisation n, Integral n) => n -> ArithmeticFunction n (Set n) divisorsToA to = ArithmeticFunction f unwrap where f p k = BoundedSetProduct (\bound -> divisorsToHelper bound (unPrime p) k) unwrap (BoundedSetProduct res) = if 1 <= to then S.insert 1 (res to) else res to -- | Generate at most @a@ powers of @p@ up to an inclusive bound @b@. divisorsToHelper :: (Ord n, Num n) => n -> n -> Word -> Set n divisorsToHelper _ _ 0 = S.empty divisorsToHelper b p 1 = if p <= b then S.singleton p else S.empty divisorsToHelper b p a = S.fromDistinctAscList $ take (wordToInt a) $ takeWhile (<=b) $ iterate (p*) p {-# INLINE divisorsToHelper #-} -- | Synonym for 'tau'. -- -- >>> map divisorCount [1..10] -- [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 -- | The number of (positive) divisors of an argument. -- -- > tauA = multiplicative (\_ k -> k + 1) tauA :: Num a => ArithmeticFunction n a tauA = multiplicative $ const (fromIntegral . succ) -- | See 'sigmaA'. sigma :: (UniqueFactorisation n, Integral n, Num a, GcdDomain a) => Word -> n -> a sigma = runFunction . sigmaA {-# INLINABLE sigma #-} -- | The sum of the @k@-th powers of (positive) divisors of an argument. -- -- > sigmaA = multiplicative (\p k -> sum $ map (p ^) [0..k]) -- > sigmaA 0 = tauA sigmaA :: (Integral n, Num a, GcdDomain a) => Word -> ArithmeticFunction n a sigmaA 0 = tauA sigmaA 1 = multiplicative $ sigmaHelper . fromIntegral' . unPrime sigmaA a = multiplicative $ sigmaHelper . (^ wordToInt a) . fromIntegral' . unPrime {-# INLINABLE sigmaA #-} sigmaHelper :: (Num a, GcdDomain a) => a -> Word -> a sigmaHelper pa 1 = pa + 1 sigmaHelper pa 2 = pa * pa + pa + 1 sigmaHelper pa k = fromJust ((pa ^ wordToInt (k + 1) - 1) `divide` (pa - 1)) {-# INLINE sigmaHelper #-} -- | See 'totientA'. totient :: UniqueFactorisation n => n -> n totient = runFunction totientA {-# INLINABLE totient #-} -- | Calculates the totient of a positive number @n@, i.e. -- the number of @k@ with @1 <= k <= n@ and @'gcd' n k == 1@, -- in other words, the order of the group of units in @ℤ/(n)@. totientA :: Num n => ArithmeticFunction n n totientA = multiplicative $ jordanHelper . unPrime {-# INLINABLE totientA #-} -- | See 'jordanA'. jordan :: UniqueFactorisation n => Word -> n -> n jordan = runFunction . jordanA -- | Calculates the k-th Jordan function of an argument. -- -- > jordanA 1 = totientA jordanA :: Num n => Word -> ArithmeticFunction n n jordanA 0 = multiplicative $ \_ _ -> 0 jordanA 1 = totientA jordanA a = multiplicative $ jordanHelper . (^ wordToInt a) . unPrime jordanHelper :: Num n => n -> Word -> n jordanHelper pa 1 = pa - 1 jordanHelper pa 2 = (pa - 1) * pa jordanHelper pa k = (pa - 1) * pa ^ wordToInt (k - 1) {-# INLINE jordanHelper #-} -- | See 'ramanujanA'. ramanujan :: Integer -> Integer ramanujan = runFunction ramanujanA -- | Calculates the -- of a positive number @n@, using formulas given ramanujanA :: ArithmeticFunction Integer Integer ramanujanA = multiplicative $ ramanujanHelper . unPrime ramanujanHelper :: Integer -> Word -> Integer ramanujanHelper _ 0 = 1 ramanujanHelper 2 1 = -24 ramanujanHelper p 1 = (65 * sigmaHelper (p ^ (11 :: Int)) 1 + 691 * sigmaHelper (p ^ (5 :: Int)) 1 - 691 * 252 * 2 * sum [sigma 5 k * sigma 5 (p-k) | k <- [1..(p `quot` 2)]]) `quot` 756 ramanujanHelper p k = sum $ zipWith3 (\a b c -> a * b * c) paPowers tpPowers binomials where pa = p ^ (11 :: Int) tp = ramanujanHelper p 1 paPowers = iterate (* (-pa)) 1 binomials = scanl (\acc j -> acc * (k' - 2 * j) * (k' - 2 * j - 1) `quot` (k' - j) `quot` (j + 1)) 1 [0 .. k' `quot` 2 - 1] k' = wordToInteger k 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 -- | Calculates the Möbius function of an argument. moebiusA :: ArithmeticFunction n Moebius moebiusA = ArithmeticFunction (const f) id where f 1 = MoebiusN f 0 = MoebiusP f _ = MoebiusZ -- | See 'liouvilleA'. liouville :: (UniqueFactorisation n, Num a) => n -> a liouville = runFunction liouvilleA -- | Calculates the Liouville function of an argument. liouvilleA :: Num a => ArithmeticFunction n a liouvilleA = ArithmeticFunction (const $ Xor . odd) runXor -- | See 'carmichaelA'. carmichael :: (UniqueFactorisation n, Integral n) => n -> n carmichael = runFunction carmichaelA {-# 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 @ℤ/(n)@. carmichaelA :: Integral n => ArithmeticFunction n n carmichaelA = ArithmeticFunction (\p -> LCM . f (unPrime p)) getLCM where f 2 1 = 1 f 2 2 = 2 f 2 k = 2 ^ wordToInt (k - 2) f p 1 = p - 1 f p 2 = (p - 1) * p f p k = (p - 1) * p ^ wordToInt (k - 1) -- | Create an additive function from the function on prime's powers. See examples below. 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 -- | Number of distinct prime factors. -- -- > smallOmegaA = additive (\_ _ -> 1) smallOmegaA :: Num a => ArithmeticFunction n a smallOmegaA = additive $ const $ const 1 -- | See 'bigOmegaA'. bigOmega :: UniqueFactorisation n => n -> Word bigOmega = runFunction bigOmegaA -- | Number of prime factors, counted with multiplicity. -- -- > bigOmegaA = additive (\_ k -> k) bigOmegaA :: ArithmeticFunction n Word bigOmegaA = additive $ const id -- | 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 :: Num n => ArithmeticFunction n n expMangoldtA = ArithmeticFunction (const . MangoldtOne . unPrime) runMangoldt data Mangoldt a = MangoldtZero | MangoldtOne a | MangoldtMany runMangoldt :: Num a => Mangoldt a -> a runMangoldt m = case m of MangoldtZero -> 1 MangoldtOne a -> a MangoldtMany -> 1 instance Semigroup (Mangoldt a) where MangoldtZero <> a = a a <> MangoldtZero = a _ <> _ = MangoldtMany 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 } instance Integral a => Semigroup (LCM a) where (<>) = coerce (lcm :: a -> a -> a) instance Integral a => Monoid (LCM a) where mempty = LCM 1 mappend = (<>) newtype Xor = Xor { _getXor :: Bool } runXor :: Num a => Xor -> a runXor m = case m of Xor False -> 1 Xor True -> -1 instance Semigroup Xor where (<>) = coerce ((/=) :: Bool -> Bool -> Bool) instance Monoid Xor where mempty = Xor False mappend = (<>) newtype SetProduct a = SetProduct { getSetProduct :: Set a } instance (Num a, Ord a) => Semigroup (SetProduct a) where SetProduct s1 <> SetProduct s2 = SetProduct $ s1 <> s2 <> foldMap (\n -> S.mapMonotonic (* n) s2) s1 instance (Num a, Ord a) => Monoid (SetProduct a) where mempty = SetProduct mempty mappend = (<>) newtype ListProduct a = ListProduct { getListProduct :: [a] } instance Num a => Semigroup (ListProduct a) where ListProduct s1 <> ListProduct s2 = ListProduct $ s1 <> s2 <> foldMap (\n -> map (* n) s2) s1 instance Num a => Monoid (ListProduct a) where mempty = ListProduct mempty mappend = (<>) -- Represent as a Reader monad newtype BoundedSetProduct a = BoundedSetProduct { _getBoundedSetProduct :: a -> Set a } takeWhileLE :: Ord a => a -> Set a -> Set a takeWhileLE b xs = if m then S.insert b ls else ls where (ls, m, _) = S.splitMember b xs instance (Ord a, Num a) => Semigroup (BoundedSetProduct a) where BoundedSetProduct f1 <> BoundedSetProduct f2 = BoundedSetProduct f where f b = s1 <> s2 <> foldMap (\n -> takeWhileLE b $ S.mapMonotonic (* n) s2) s1 where s1 = f1 b s2 = f2 b instance (Ord a, Num a) => Monoid (BoundedSetProduct a) where mempty = BoundedSetProduct mempty mappend = (<>) newtype IntSetProduct = IntSetProduct { getIntSetProduct :: IntSet } instance Semigroup IntSetProduct where IntSetProduct s1 <> IntSetProduct s2 = IntSetProduct $ IS.unions $ s1 : s2 : map (\n -> IS.map (* n) s2) (IS.toAscList s1) instance Monoid IntSetProduct where mempty = IntSetProduct mempty mappend = (<>) arithmoi-0.12.1.0/Math/NumberTheory/Curves/0000755000000000000000000000000007346545000016521 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Curves/Montgomery.hs0000644000000000000000000001452507346545000021224 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Curves.Montgomery -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Arithmetic on Montgomery elliptic curves. -- This is an internal module, exposed only for purposes of testing. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Curves.Montgomery ( Point , pointX , pointZ , pointN , pointA24 , SomePoint(..) , newPoint , add , double , multiply ) where import Data.Proxy import GHC.Exts import GHC.Integer.Logarithms import GHC.TypeNats (KnownNat, SomeNat(..), Nat, natVal, someNatVal) import Math.NumberTheory.Utils (recipMod) -- | We use the Montgomery form of elliptic curve: -- b Y² = X³ + a X² + X (mod n). -- See Eq. (10.3.1.1) at p. 260 of by P. L. Montgomery. -- -- Switching to projective space by substitutions Y = y \/ z, X = x \/ z, -- we get b y² z = x³ + a x² z + x z² (mod n). -- The point on projective elliptic curve is characterized by three coordinates, -- but it appears that only x- and z-components matter for computations. -- By the same reason there is no need to store coefficient b. -- -- That said, the chosen curve is represented by a24 = (a + 2) \/ 4 -- and modulo n at type level, making points on different curves -- incompatible. data Point (a24 :: Nat) (n :: Nat) = Point { pointX :: !Integer -- ^ Extract x-coordinate. , 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) -- | In projective space 'Point's are equal, if they are both at infinity -- or if respective ratios 'pointX' \/ 'pointZ' are equal. instance KnownNat n => Eq (Point a24 n) where Point _ 0 == Point _ 0 = True Point _ 0 == _ = False _ == Point _ 0 = False p@(Point x1 z1) == Point x2 z2 = let n = pointN p in (x1 * z2 - x2 * z1) `rem` n == 0 -- | For debugging. instance (KnownNat a24, KnownNat n) => Show (Point a24 n) where show p = "(" ++ show (pointX p) ++ ", " ++ show (pointZ p) ++ ") (a24 " ++ show (pointA24 p) ++ ", mod " ++ show (pointN p) ++ ")" -- | Point on unknown curve. data SomePoint where SomePoint :: (KnownNat a24, KnownNat n) => Point a24 n -> SomePoint instance Show SomePoint where show (SomePoint p) = show p -- | 'newPoint' @s@ @n@ creates a point on an elliptic curve modulo @n@, uniquely determined by seed @s@. -- Some choices of @s@ and @n@ produce ill-parametrized curves, which is reflected by return value 'Nothing'. -- -- We choose a curve by Suyama's parametrization. See Eq. (3)-(4) at p. 4 -- of -- by K. Gaj, S. Kwon et al. newPoint :: Integer -> Integer -> Maybe SomePoint newPoint s n = do a24denRecip <- recipMod a24den n a24 <- case a24num * a24denRecip `rem` n of -- (a+2)/4 = 0 corresponds to singular curve with A = -2 0 -> Nothing -- (a+2)/4 = 1 corresponds to singular curve with A = 2 1 -> Nothing t -> Just t SomeNat (_ :: Proxy a24Ty) <- if a24 < 0 then Nothing else Just $ someNatVal $ fromInteger a24 SomeNat (_ :: Proxy nTy) <- if n < 0 then Nothing else Just $ someNatVal $ fromInteger n return $ SomePoint (Point x z :: Point a24Ty nTy) where u = s * s `rem` n - 5 v = 4 * s d = v - u x = u * u * u `mod` n z = v * v * v `mod` n a24num = d * d * d * (3 * u + v) `mod` n a24den = 16 * x * v `rem` n -- | If @p0@ + @p1@ = @p2@, then 'add' @p0@ @p1@ @p2@ equals to @p1@ + @p2@. -- It is also required that z-coordinates of @p0@, @p1@ and @p2@ are coprime with modulo -- of elliptic curve; and x-coordinate of @p0@ is non-zero. -- If preconditions do not hold, return value is undefined. -- -- Remarkably such addition does not require 'KnownNat' @a24@ constraint. -- -- Computations follow Algorithm 3 at p. 4 -- of -- by K. Gaj, S. Kwon et al. add :: KnownNat n => Point a24 n -> Point a24 n -> Point a24 n -> Point a24 n add p0@(Point x0 z0) (Point x1 z1) (Point x2 z2) = Point x3 z3 where n = pointN p0 a = (x1 - z1) * (x2 + z2) `rem` n b = (x1 + z1) * (x2 - z2) `rem` n apb = a + b amb = a - b c = apb * apb `rem` n d = amb * amb `rem` n x3 = c * z0 `mod` n z3 = d * x0 `mod` n -- | Multiply by 2. -- -- Computations follow Algorithm 3 at p. 4 -- of -- by K. Gaj, S. Kwon et al. double :: (KnownNat a24, KnownNat n) => Point a24 n -> Point a24 n double p@(Point x z) = Point x' z' where n = pointN p a24 = pointA24 p r = x + z s = x - z u = r * r `rem` n v = s * s `rem` n t = u - v x' = u * v `mod` n z' = (v + a24 * t `rem` n) * t `mod` n -- | Multiply by given number, using binary algorithm. multiply :: (KnownNat a24, KnownNat n) => Word -> Point a24 n -> Point a24 n multiply 0 _ = Point 0 0 multiply 1 p = p multiply (W# w##) p = case wordLog2# w## of l# -> go (l# -# 1#) p (double p) where go 0# !p0 !p1 = case w## `and#` 1## of 0## -> double p0 _ -> add p p0 p1 go i# p0 p1 = case uncheckedShiftRL# w## i# `and#` 1## of 0## -> go (i# -# 1#) (double p0) (add p p0 p1) _ -> go (i# -# 1#) (add p p0 p1) (double p1) arithmoi-0.12.1.0/Math/NumberTheory/Diophantine.hs0000644000000000000000000000542607346545000020057 0ustar0000000000000000-- Module for Diophantine Equations and related functions module Math.NumberTheory.Diophantine ( cornacchiaPrimitive , cornacchia ) where import Math.NumberTheory.Moduli.Sqrt ( sqrtsModFactorisation ) import Math.NumberTheory.Primes ( factorise , unPrime , UniqueFactorisation ) import Math.NumberTheory.Roots ( integerSquareRoot ) import Math.NumberTheory.Utils.FromIntegral -- | See `cornacchiaPrimitive`, this is the internal algorithm implementation -- | as described at https://en.wikipedia.org/wiki/Cornacchia%27s_algorithm cornacchiaPrimitive' :: Integer -> Integer -> [(Integer, Integer)] cornacchiaPrimitive' d m = concatMap (findSolution . head . dropWhile (\r -> r * r >= m) . gcdSeq m) roots where roots = filter (<= m `div` 2) $ sqrtsModFactorisation (m - d) (factorise m) gcdSeq a b = a : gcdSeq b (mod a b) -- If s = sqrt((m - r*r) / d) is an integer then (r, s) is a solution findSolution r = [ (r, s) | rem1 == 0 && s * s == s2 ] where (s2, rem1) = divMod (m - r * r) d s = integerSquareRoot s2 -- | Finds all primitive solutions (x,y) to the diophantine equation -- | x^2 + d*y^2 = m -- | when 1 <= d < m and gcd(d,m)=1 -- | Given m is square free these are all the positive integer solutions cornacchiaPrimitive :: Integer -> Integer -> [(Integer, Integer)] cornacchiaPrimitive d m | not (1 <= d && d < m) = error "precondition failed: 1 <= d < m" | gcd d m /= 1 = error "precondition failed: d and m coprime" | -- If d=1 then the algorithm doesn't generate symmetrical pairs d == 1 = concatMap genPairs solutions | otherwise = solutions where solutions = cornacchiaPrimitive' d m genPairs (x, y) = if x == y then [(x, y)] else [(x, y), (y, x)] -- Find numbers whose square is a factor of the input squareFactors :: UniqueFactorisation a => a -> [a] squareFactors = foldl squareProducts [1] . factorise where squareProducts acc f = [ a * b | a <- acc, b <- squarePowers f ] squarePowers (p, a) = map (unPrime p ^) [0 .. wordToInt a `div` 2] -- | Finds all positive integer solutions (x,y) to the -- | diophantine equation: -- | x^2 + d*y^2 = m -- | when 1 <= d < m and gcd(d,m)=1 cornacchia :: Integer -> Integer -> [(Integer, Integer)] cornacchia d m | not (1 <= d && d < m) = error "precondition failed: 1 <= d < m" | gcd d m /= 1 = error "precondition failed: d and m coprime" | otherwise = concatMap solve $ filter ((> d) . snd) candidates where candidates = map (\sf -> (sf, m `div` (sf * sf))) (squareFactors m) solve (sf, m') = map (\(x, y) -> (x * sf, y * sf)) (cornacchiaPrimitive d m') arithmoi-0.12.1.0/Math/NumberTheory/DirichletCharacters.hs0000644000000000000000000006675407346545000021537 0ustar0000000000000000-- | -- Module: Math.NumberTheory.DirichletCharacters -- Copyright: (c) 2018 Bhavik Mehta -- Licence: MIT -- Maintainer: Bhavik Mehta -- -- Implementation and enumeration of Dirichlet characters. -- {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} module Math.NumberTheory.DirichletCharacters ( -- * An absorbing semigroup OrZero, pattern Zero, pattern NonZero , orZeroToNum -- * Dirichlet characters , DirichletCharacter -- ** Construction , indexToChar , indicesToChars , characterNumber , allChars , fromTable -- ** Evaluation , eval , evalGeneral , evalAll -- ** Special Dirichlet characters , principalChar , isPrincipal , orderChar -- ** Real Dirichlet characters , RealCharacter , isRealCharacter , getRealChar , toRealFunction , jacobiCharacter -- ** Primitive characters , PrimitiveCharacter , isPrimitive , getPrimitiveChar , induced , makePrimitive , WithNat(..) -- * Roots of unity , RootOfUnity(..) , toRootOfUnity , toComplex -- * Debugging , validChar ) where #if !MIN_VERSION_base(4,12,0) import Control.Applicative (liftA2) #endif import Data.Bits (Bits(..)) import Data.Constraint import Data.Foldable import Data.Functor.Identity (Identity(..)) import Data.Kind import Data.List (sort, unfoldr) import Data.Maybe (mapMaybe, fromJust, fromMaybe) import Data.Mod #if MIN_VERSION_base(4,12,0) import Data.Monoid (Ap(..)) #endif import Data.Proxy (Proxy(..)) import Data.Ratio ((%), numerator, denominator) import Data.Semigroup (Semigroup(..),Product(..)) import Data.Traversable import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV import Data.Vector (Vector, (!)) import GHC.TypeNats (KnownNat, Nat, SomeNat(..), natVal, someNatVal) import Numeric.Natural (Natural) import Math.NumberTheory.ArithmeticFunctions (totient) import Math.NumberTheory.Moduli.Chinese import Math.NumberTheory.Moduli.Internal (discreteLogarithmPP) import Math.NumberTheory.Moduli.Multiplicative import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes import Math.NumberTheory.RootsOfUnity import Math.NumberTheory.Utils import Math.NumberTheory.Utils.FromIntegral -- | A Dirichlet character mod \(n\) is a group homomorphism from \((\mathbb{Z}/n\mathbb{Z})^*\) -- to \(\mathbb{C}^*\), represented abstractly by `DirichletCharacter`. In particular, they take -- values at roots of unity and can be evaluated using `eval`. -- A Dirichlet character can be extended to a completely multiplicative function on \(\mathbb{Z}\) -- by assigning the value 0 for \(a\) sharing a common factor with \(n\), using `evalGeneral`. -- -- There are finitely many possible Dirichlet characters for a given modulus, in particular there -- are \(\phi(n)\) characters modulo \(n\), where \(\phi\) refers to Euler's `totient` function. -- This gives rise to `Enum` and `Bounded` instances. newtype DirichletCharacter (n :: Nat) = Generated [DirichletFactor] -- | The group (Z/nZ)^* decomposes to a product (Z/2^k0 Z)^* x (Z/p1^k1 Z)^* x ... x (Z/pi^ki Z)^* -- where n = 2^k0 p1^k1 ... pi^ki, and the pj are odd primes, k0 possibly 0. Thus, a group -- homomorphism from (Z/nZ)^* is characterised by group homomorphisms from each of these factor -- groups. Furthermore, for odd p, we have (Z/p^k Z)^* isomorphic to Z / p^(k-1)*(p-1) Z, an -- additive group, where an isomorphism is specified by a choice of primitive root. -- Similarly, for k >= 2, (Z/2^k Z)^* is isomorphic to Z/2Z * (Z / 2^(k-2) Z) (and for k < 2 -- it is trivial). (See @lambda@ for this isomorphism). -- Thus, to specify a Dirichlet character, it suffices to specify the value of generators -- of each of these cyclic groups, when primitive roots are given. This data is given by a -- DirichletFactor. -- We have the invariant that the factors must be given in strictly increasing order, and the -- generator is as given by @generator@, and are each non-trivial. These conditions are verified -- using `validChar`. data DirichletFactor = OddPrime { _getPrime :: Prime Natural , _getPower :: Word , _getGenerator :: Natural , _getValue :: RootOfUnity } | TwoPower { _getPower2 :: Int -- this ought to be Word, but many applications -- needed to use wordToInt, so Int is cleaner -- Required to be >= 2 , _getFirstValue :: RootOfUnity , _getSecondValue :: RootOfUnity } | Two instance Eq (DirichletCharacter n) where Generated a == Generated b = a == b instance Eq DirichletFactor where TwoPower _ x1 x2 == TwoPower _ y1 y2 = x1 == y1 && x2 == y2 OddPrime _ _ _ x == OddPrime _ _ _ y = x == y Two == Two = True _ == _ = False -- | For primes, define the canonical primitive root as the smallest such. generator :: Prime Natural -> Word -> Natural generator p k = case cyclicGroupFromFactors [(p, k)] of Nothing -> error "illegal" Just (Some cg) | Sub Dict <- proofFromCyclicGroup cg -> unMod $ multElement $ unPrimitiveRoot $ head $ mapMaybe (isPrimitiveRoot cg) [2..maxBound] -- | Implement the function \(\lambda\) from page 5 of -- https://www2.eecs.berkeley.edu/Pubs/TechRpts/1984/CSD-84-186.pdf lambda :: Integer -> Int -> Integer lambda x e = ((xPower - 1) `shiftR` (e+1)) .&. (modulus - 1) where modulus = 1 `shiftL` (e - 2) largeMod = 1 `shiftL` (2 * e - 1) xPower = case someNatVal largeMod of SomeNat (_ :: Proxy largeMod) -> toInteger (unMod (fromInteger x ^ (2 * modulus) :: Mod largeMod)) -- | For elements of the multiplicative group \((\mathbb{Z}/n\mathbb{Z})^*\), a Dirichlet -- character evaluates to a root of unity. eval :: DirichletCharacter n -> MultMod n -> RootOfUnity eval (Generated ds) m = foldMap (evalFactor m') ds where m' = toInteger $ unMod $ multElement m -- | Evaluate each factor of the Dirichlet character. evalFactor :: Integer -> DirichletFactor -> RootOfUnity evalFactor m = \case OddPrime (toInteger . unPrime -> p) k (toInteger -> a) b -> discreteLogarithmPP p k a (m `rem` p^k) `stimes` b TwoPower k s b -> (if testBit m 1 then s else mempty) <> lambda (thingy k m) k `stimes` b Two -> mempty thingy :: (Bits p, Num p) => Int -> p -> p thingy k m = if testBit m 1 then bit k - m' else m' where m' = m .&. (bit k - 1) -- | A character can evaluate to a root of unity or zero: represented by @Nothing@. evalGeneral :: KnownNat n => DirichletCharacter n -> Mod n -> OrZero RootOfUnity evalGeneral chi t = case isMultElement t of Nothing -> Zero Just x -> NonZero $ eval chi x -- | Give the principal character for this modulus: a principal character mod \(n\) is 1 for -- \(a\) coprime to \(n\), and 0 otherwise. principalChar :: KnownNat n => DirichletCharacter n principalChar = minBound mulChars :: DirichletCharacter n -> DirichletCharacter n -> DirichletCharacter n mulChars (Generated x) (Generated y) = Generated (zipWith combine x y) where combine :: DirichletFactor -> DirichletFactor -> DirichletFactor combine Two Two = Two combine (OddPrime p k g n) (OddPrime _ _ _ m) = OddPrime p k g (n <> m) combine (TwoPower k a n) (TwoPower _ b m) = TwoPower k (a <> b) (n <> m) combine _ _ = error "internal error: malformed DirichletCharacter" -- | This Semigroup is in fact a group, so @stimes@ can be called with a negative first argument. instance Semigroup (DirichletCharacter n) where (<>) = mulChars stimes = stimesChar instance KnownNat n => Monoid (DirichletCharacter n) where mempty = principalChar mappend = (<>) stimesChar :: Integral a => a -> DirichletCharacter n -> DirichletCharacter n stimesChar s (Generated xs) = Generated (map mult xs) where mult :: DirichletFactor -> DirichletFactor mult (OddPrime p k g n) = OddPrime p k g (s `stimes` n) mult (TwoPower k a b) = TwoPower k (s `stimes` a) (s `stimes` b) mult Two = Two -- | We define `succ` and `pred` with more efficient implementations than -- @`toEnum` . (+1) . `fromEnum`@. instance KnownNat n => Enum (DirichletCharacter n) where toEnum = indexToChar . intToNatural fromEnum = integerToInt . characterNumber succ x = makeChar x (characterNumber x + 1) pred x = makeChar x (characterNumber x - 1) enumFromTo x y = bulkMakeChars x [fromEnum x..fromEnum y] enumFrom x = bulkMakeChars x [fromEnum x..] enumFromThenTo x y z = bulkMakeChars x [fromEnum x, fromEnum y..fromEnum z] enumFromThen x y = bulkMakeChars x [fromEnum x, fromEnum y..] instance KnownNat n => Bounded (DirichletCharacter n) where minBound = indexToChar 0 maxBound = indexToChar (totient n - 1) where n = natVal (Proxy :: Proxy n) -- | We have a (non-canonical) enumeration of dirichlet characters. characterNumber :: DirichletCharacter n -> Integer characterNumber (Generated y) = foldl' go 0 y where go x (OddPrime p k _ a) = x * m + numerator (fromRootOfUnity a * (m % 1)) where p' = naturalToInteger (unPrime p) m = p'^(k-1)*(p'-1) go x (TwoPower k a b) = x' * 2 + numerator (fromRootOfUnity a * 2) where m = bit (k-2) :: Integer x' = x `shiftL` (k-2) + numerator (fromRootOfUnity b * (m % 1)) go x Two = x -- | Give the dirichlet character from its number. -- Inverse of `characterNumber`. indexToChar :: forall n. KnownNat n => Natural -> DirichletCharacter n indexToChar = runIdentity . indicesToChars . Identity -- | Give a collection of dirichlet characters from their numbers. This may be more efficient than -- `indexToChar` for multiple characters, as it prevents some internal recalculations. indicesToChars :: forall n f. (KnownNat n, Functor f) => f Natural -> f (DirichletCharacter n) indicesToChars = fmap (Generated . unroll t . (`mod` m)) where n = natVal (Proxy :: Proxy n) (Product m, t) = mkTemplate n -- | List all characters for the modulus. This is preferred to using @[minBound..maxBound]@. allChars :: forall n. KnownNat n => [DirichletCharacter n] allChars = indicesToChars [0..m-1] where m = totient $ natVal (Proxy :: Proxy n) -- | The same as `indexToChar`, but if we're given a character we can create others more efficiently. makeChar :: Integral a => DirichletCharacter n -> a -> DirichletCharacter n makeChar x = runIdentity . bulkMakeChars x . Identity -- | Use one character to make many more: better than indicesToChars since it avoids recalculating -- some primitive roots bulkMakeChars :: (Integral a, Functor f) => DirichletCharacter n -> f a -> f (DirichletCharacter n) bulkMakeChars x = fmap (Generated . unroll t . (`mod` m) . fromIntegral') where (Product m, t) = templateFromCharacter x -- We assign each natural a unique Template, which can be decorated (eg in `unroll`) to -- form a DirichletCharacter. A Template effectively holds the information carried around -- in a DirichletFactor which depends only on the modulus of the character. data Template = OddTemplate { _getPrime' :: Prime Natural , _getPower' :: Word , _getGenerator' :: !Natural , _getModulus' :: !Natural } | TwoPTemplate { _getPower2' :: Int , _getModulus' :: !Natural } -- the modulus is derivable from the other values, but calculation -- may be expensive, so we pre-calculate it -- morally getModulus should be a prefactored but seems to be -- pointless here | TwoTemplate templateFromCharacter :: DirichletCharacter n -> (Product Natural, [Template]) templateFromCharacter (Generated t) = traverse go t where go (OddPrime p k g _) = (Product m, OddTemplate p k g m) where p' = unPrime p m = p'^(k-1)*(p'-1) go (TwoPower k _ _) = (Product (2*m), TwoPTemplate k m) where m = bit (k-2) go Two = (Product 1, TwoTemplate) mkTemplate :: Natural -> (Product Natural, [Template]) mkTemplate = go . sort . factorise where go :: [(Prime Natural, Word)] -> (Product Natural, [Template]) go ((unPrime -> 2, 1): xs) = (Product 1, [TwoTemplate]) <> traverse odds xs go ((unPrime -> 2, wordToInt -> k): xs) = (Product (2*m), [TwoPTemplate k m]) <> traverse odds xs where m = bit (k-2) go xs = traverse odds xs odds :: (Prime Natural, Word) -> (Product Natural, Template) odds (p, k) = (Product m, OddTemplate p k (generator p k) m) where p' = unPrime p m = p'^(k-1)*(p'-1) -- the validity of the producted dirichletfactor list here requires the template to be valid unroll :: [Template] -> Natural -> [DirichletFactor] unroll t m = snd (mapAccumL func m t) where func :: Natural -> Template -> (Natural, DirichletFactor) func a (OddTemplate p k g n) = (a1, OddPrime p k g (toRootOfUnity $ toInteger a2 % toInteger n)) where (a1,a2) = quotRem a n func a (TwoPTemplate k n) = (b1, TwoPower k (toRootOfUnity $ toInteger a2 % 2) (toRootOfUnity $ toInteger b2 % toInteger n)) where (a1,a2) = quotRem a 2 (b1,b2) = quotRem a1 n func a TwoTemplate = (a, Two) -- | Test if a given Dirichlet character is prinicpal for its modulus: a principal character mod -- \(n\) is 1 for \(a\) coprime to \(n\), and 0 otherwise. isPrincipal :: DirichletCharacter n -> Bool isPrincipal chi = characterNumber chi == 0 -- | Induce a Dirichlet character to a higher modulus. If \(d \mid n\), then \(a \bmod{n}\) can be -- reduced to \(a \bmod{d}\). Thus, the multiplicative function on \(\mathbb{Z}/d\mathbb{Z}\) -- induces a multiplicative function on \(\mathbb{Z}/n\mathbb{Z}\). -- -- >>> :set -XTypeApplications -XDataKinds -- >>> chi = indexToChar 5 :: DirichletCharacter 45 -- >>> chi2 = induced @135 chi :: Maybe (DirichletCharacter 135) induced :: forall n d. (KnownNat d, KnownNat n) => DirichletCharacter d -> Maybe (DirichletCharacter n) induced (Generated start) = if n `rem` d == 0 then Just (Generated (combine (snd $ mkTemplate n) start)) else Nothing where n = natVal (Proxy :: Proxy n) d = natVal (Proxy :: Proxy d) combine :: [Template] -> [DirichletFactor] -> [DirichletFactor] combine [] _ = [] combine ts [] = map newFactor ts combine (t:xs) (y:ys) = case (t,y) of (TwoTemplate, Two) -> Two: combine xs ys (TwoTemplate, _) -> Two: combine xs (y:ys) (TwoPTemplate k _, Two) -> TwoPower k mempty mempty: combine xs ys (TwoPTemplate k _, TwoPower _ a b) -> TwoPower k a b: combine xs ys (TwoPTemplate k _, _) -> TwoPower k mempty mempty: combine xs (y:ys) (OddTemplate p k _ _, OddPrime q _ g a) | p == q -> OddPrime p k g a: combine xs ys (OddTemplate p k g _, OddPrime q _ _ _) | p < q -> OddPrime p k g mempty: combine xs (y:ys) _ -> error "internal error in induced: please report this as a bug" newFactor :: Template -> DirichletFactor newFactor TwoTemplate = Two newFactor (TwoPTemplate k _) = TwoPower k mempty mempty newFactor (OddTemplate p k g _) = OddPrime p k g mempty -- | The gives a real Dirichlet -- character for odd moduli. jacobiCharacter :: forall n. KnownNat n => Maybe (RealCharacter n) jacobiCharacter = if odd n then Just $ RealChar $ Generated $ map go $ snd $ mkTemplate n else Nothing where n = natVal (Proxy :: Proxy n) go :: Template -> DirichletFactor go (OddTemplate p k g _) = OddPrime p k g $ toRootOfUnity (toInteger k % 2) -- jacobi symbol of a primitive root mod p over p is always -1 go _ = error "internal error in jacobiCharacter: please report this as a bug" -- every factor of n should be odd -- | A Dirichlet character is real if it is real-valued. newtype RealCharacter n = RealChar { -- | Extract the character itself from a `RealCharacter`. getRealChar :: DirichletCharacter n } deriving Eq -- | Test if a given `DirichletCharacter` is real, and if so give a `RealCharacter`. isRealCharacter :: DirichletCharacter n -> Maybe (RealCharacter n) isRealCharacter t@(Generated xs) = if all real xs then Just (RealChar t) else Nothing where real :: DirichletFactor -> Bool real (OddPrime _ _ _ a) = a <> a == mempty real (TwoPower _ _ b) = b <> b == mempty real Two = True -- TODO: it should be possible to calculate this without eval/evalGeneral -- and thus avoid using discrete log calculations: consider the order of m -- inside each of the factor groups? -- | Evaluate a real Dirichlet character, which can only take values \(-1,0,1\). toRealFunction :: KnownNat n => RealCharacter n -> Mod n -> Int toRealFunction (RealChar chi) m = case evalGeneral chi m of Zero -> 0 NonZero t | t == mempty -> 1 NonZero t | t == RootOfUnity (1 % 2) -> -1 _ -> error "internal error in toRealFunction: please report this as a bug" -- A real character should not be able to evaluate to -- anything other than {-1,0,1}, so should not reach this branch -- | Test if the internal DirichletCharacter structure is valid. validChar :: forall n. KnownNat n => DirichletCharacter n -> Bool validChar (Generated xs) = correctDecomposition && all correctPrimitiveRoot xs && all validValued xs where correctDecomposition = sort (factorise n) == map getPP xs getPP (TwoPower k _ _) = (two, intToWord k) getPP (OddPrime p k _ _) = (p, k) getPP Two = (two,1) correctPrimitiveRoot (OddPrime p k g _) = g == generator p k correctPrimitiveRoot _ = True validValued (TwoPower k a b) = a <> a == mempty && (bit (k-2) :: Integer) `stimes` b == mempty validValued (OddPrime (unPrime -> p) k _ a) = (p^(k-1)*(p-1)) `stimes` a == mempty validValued Two = True n = natVal (Proxy :: Proxy n) two = nextPrime 2 -- | Get the order of the Dirichlet Character. orderChar :: DirichletCharacter n -> Integer orderChar (Generated xs) = foldl' lcm 1 $ map orderFactor xs where orderFactor (TwoPower _ (RootOfUnity a) (RootOfUnity b)) = denominator a `lcm` denominator b orderFactor (OddPrime _ _ _ (RootOfUnity a)) = denominator a orderFactor Two = 1 -- | Test if a Dirichlet character is . isPrimitive :: DirichletCharacter n -> Maybe (PrimitiveCharacter n) isPrimitive t@(Generated xs) = if all primitive xs then Just (PrimitiveCharacter t) else Nothing where primitive :: DirichletFactor -> Bool primitive Two = False -- for odd p, we're testing if phi(p^(k-1)) `stimes` a is 1, since this means the -- character can come from some the smaller modulus p^(k-1) primitive (OddPrime _ 1 _ a) = a /= mempty primitive (OddPrime (unPrime -> p) k _ a) = (p^(k-2)*(p-1)) `stimes` a /= mempty primitive (TwoPower 2 a _) = a /= mempty primitive (TwoPower k _ b) = (bit (k-3) :: Integer) `stimes` b /= mempty -- | A Dirichlet character is primitive if cannot be 'induced' from any character with -- strictly smaller modulus. newtype PrimitiveCharacter n = PrimitiveCharacter { -- | Extract the character itself from a `PrimitiveCharacter`. getPrimitiveChar :: DirichletCharacter n } deriving Eq -- | Wrapper to hide an unknown type-level natural. data WithNat (a :: Nat -> Type) where WithNat :: KnownNat m => a m -> WithNat a -- | This function also provides access to the new modulus on type level, with a KnownNat instance makePrimitive :: DirichletCharacter n -> WithNat PrimitiveCharacter makePrimitive (Generated xs) = case someNatVal (product mods) of SomeNat (Proxy :: Proxy m) -> WithNat (PrimitiveCharacter (Generated ys) :: PrimitiveCharacter m) where (mods,ys) = unzip (mapMaybe prim xs) prim :: DirichletFactor -> Maybe (Natural, DirichletFactor) prim Two = Nothing prim (OddPrime p' k g a) = case find works options of Nothing -> error "invalid character" Just (0,_) -> Nothing Just (i,_) -> Just (p^i, OddPrime p' i g a) where options = (0,1): [(i,p^(i-1)*(p-1)) | i <- [1..k]] works (_,phi) = phi `stimes` a == mempty p = unPrime p' prim (TwoPower k a b) = case find worksb options of Nothing -> error "invalid character" Just (2,_) | a == mempty -> Nothing Just (i,_) -> Just (bit i :: Natural, TwoPower i a b) where options = [(i, bit (i-2) :: Natural) | i <- [2..k]] worksb (_,phi) = phi `stimes` b == mempty #if !MIN_VERSION_base(4,12,0) newtype Ap f a = Ap { getAp :: f a } deriving (Eq, Functor, Applicative, Monad) instance (Applicative f, Semigroup a) => Semigroup (Ap f a) where (<>) = liftA2 (<>) instance (Applicative f, Semigroup a, Monoid a) => Monoid (Ap f a) where mempty = pure mempty mappend = (<>) #endif -- | Similar to Maybe, but with different Semigroup and Monoid instances. type OrZero a = Ap Maybe a -- | 'Ap' 'Nothing' pattern Zero :: OrZero a pattern Zero = Ap Nothing -- | 'Ap' ('Just' x) pattern NonZero :: a -> OrZero a pattern NonZero x = Ap (Just x) {-# COMPLETE Zero, NonZero #-} -- | Interpret an `OrZero` as a number, taking the `Zero` case to be 0. orZeroToNum :: Num a => (b -> a) -> OrZero b -> a orZeroToNum _ Zero = 0 orZeroToNum f (NonZero x) = f x -- | In general, evaluating a DirichletCharacter at a point involves solving the discrete logarithm -- problem, which can be hard: the implementations here are around O(sqrt n). -- However, evaluating a dirichlet character at every point amounts to solving the discrete -- logarithm problem at every point also, which can be done together in O(n) time, better than -- using a complex algorithm at each point separately. Thus, if a large number of evaluations -- of a dirichlet character are required, `evalAll` will be better than `evalGeneral`, since -- computations can be shared. evalAll :: forall n. KnownNat n => DirichletCharacter n -> Vector (OrZero RootOfUnity) evalAll (Generated xs) = V.generate (naturalToInt n) func where n = natVal (Proxy :: Proxy n) vectors = map mkVector xs func :: Int -> OrZero RootOfUnity func m = foldMap go vectors where go :: (Int, Vector (OrZero RootOfUnity)) -> OrZero RootOfUnity go (modulus,v) = v ! (m `mod` modulus) mkVector :: DirichletFactor -> (Int, Vector (OrZero RootOfUnity)) mkVector Two = (2, V.fromList [Zero, mempty]) mkVector (OddPrime p k (naturalToInt -> g) a) = (modulus, w) where p' = unPrime p modulus = naturalToInt (p'^k) :: Int w = V.create $ do v <- MV.replicate modulus Zero -- TODO: we're in the ST monad here anyway, could be better to use STRefs to manage -- this loop, the current implementation probably doesn't fuse well let powers = iterateMaybe go (1,mempty) go (m,x) = if m' > 1 then Just (m', x<>a) else Nothing where m' = m*g `mod` modulus for_ powers $ \(m,x) -> MV.unsafeWrite v m (NonZero x) -- don't bother with bounds check since m was reduced mod p^k return v -- for powers of two we use lambda directly instead, since the generators of the cyclic -- groups aren't obvious; it's possible to get them though: -- 5^(lambda(5)^{-1} mod 2^(p-2)) mod 2^p mkVector (TwoPower k a b) = (modulus, w) where modulus = bit k w = V.generate modulus f f m | even m = Zero | otherwise = NonZero ((if testBit m 1 then a else mempty) <> lambda (toInteger m'') k `stimes` b) where m'' = thingy k m -- somewhere between unfoldr and iterate iterateMaybe :: (a -> Maybe a) -> a -> [a] iterateMaybe f x = unfoldr (fmap (\t -> (t, f t))) (Just x) -- | Attempt to construct a character from its table of values. -- An inverse to `evalAll`, defined only on its image. fromTable :: forall n. KnownNat n => Vector (OrZero RootOfUnity) -> Maybe (DirichletCharacter n) fromTable v = if length v == naturalToInt n then traverse makeFactor tmpl >>= check . Generated else Nothing where n = natVal (Proxy :: Proxy n) n' = naturalToInteger n :: Integer tmpl = snd (mkTemplate n) check :: DirichletCharacter n -> Maybe (DirichletCharacter n) check chi = if evalAll chi == v then Just chi else Nothing makeFactor :: Template -> Maybe DirichletFactor makeFactor TwoTemplate = Just Two makeFactor (TwoPTemplate k _) = TwoPower k <$> getValue (-1,bit k) <*> getValue (exp4 k, bit k) makeFactor (OddTemplate p k g _) = OddPrime p k g <$> getValue (toInteger g, toInteger (unPrime p)^k) getValue :: (Integer, Integer) -> Maybe RootOfUnity getValue (g, m) = getAp (v ! fromInteger (fst (fromJust (chinese (g, m) (1, n' `quot` m))) `mod` n')) exp4terms :: [Rational] exp4terms = [4^k % product [1..k] | k <- [0..]] -- For reasons that aren't clear to me, `exp4` gives the inverse of 1 under lambda, so it gives the generator -- This is the same as https://oeis.org/A320814 -- In particular, lambda (exp4 n) n == 1 (for n >= 3) -- I've verified this for 3 <= n <= 2000, so the reasoning in fromTable should be accurate for moduli below 2^2000 exp4 :: Int -> Integer exp4 n = (`mod` bit n) $ sum $ map (\q -> (numerator q * fromMaybe (error "error in exp4") (recipMod (denominator q) (bit n))) `mod` bit n) $ take n exp4terms arithmoi-0.12.1.0/Math/NumberTheory/Euclidean/0000755000000000000000000000000007346545000017143 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Euclidean/Coprimes.hs0000644000000000000000000001146107346545000021263 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Euclidean.Coprimes -- Copyright: (c) 2017-2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Container for pairwise coprime numbers. {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Math.NumberTheory.Euclidean.Coprimes ( splitIntoCoprimes , Coprimes , unCoprimes , singleton , insert ) where import Prelude hiding (gcd, quot, rem) import Data.Coerce import Data.Euclidean import Data.List (tails) import Data.Maybe #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Data.Semiring (Semiring(..), isZero) import Data.Traversable -- | A list of pairwise coprime numbers -- with their multiplicities. newtype Coprimes a b = Coprimes { unCoprimes :: [(a, b)] -- ^ Unwrap. } deriving (Eq, Show) unsafeDivide :: GcdDomain a => a -> a -> a unsafeDivide x y = case x `divide` y of Nothing -> error "violated prerequisite of unsafeDivide" Just z -> z -- | Check whether an element is a unit of the ring. isUnit :: (Eq a, GcdDomain a) => a -> Bool isUnit x = not (isZero x) && isJust (one `divide` x) doPair :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> a -> b -> (a, a, [(a, b)]) doPair x xm y ym | isUnit g = (x, y, []) | otherwise = (x', y', concat rests) where g = gcd x y (x', g', xgs) = doPair (x `unsafeDivide` g) xm g (xm + ym) xgs' = if isUnit g' then xgs else (g', xm + ym) : xgs (y', rests) = mapAccumL go (y `unsafeDivide` g) xgs' go w (t, tm) = (w', if isUnit t' || tm == 0 then acc else (t', tm) : acc) where (w', t', acc) = doPair w ym t tm _propDoPair :: (Eq a, Num a, GcdDomain a, Integral b) => a -> b -> a -> b -> Bool _propDoPair x xm y ym = isJust (x `divide` x') && isJust (y `divide` y') && coprime x' y' && all (coprime x' . fst) rest && all (coprime y' . fst) rest && not (any (isUnit . fst) rest) && and [ coprime s t | (s, _) : ts <- tails rest, (t, _) <- ts ] && abs ((x ^ xm) * (y ^ ym)) == abs ((x' ^ xm) * (y' ^ ym) * product (map (uncurry (^)) rest)) where (x', y', rest) = doPair x xm y ym insertInternal :: forall a b. (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> Coprimes a b -> (Coprimes a b, Coprimes a b) insertInternal xx xm | isZero xx && xm == 0 = (, Coprimes []) | isZero xx = const (Coprimes [(zero, 1)], Coprimes []) | otherwise = coerce (go ([], []) xx) where go :: ([(a, b)], [(a, b)]) -> a -> [(a, b)] -> ([(a, b)], [(a, b)]) go (old, new) x rest | isUnit x = (rest ++ old, new) go (old, new) x [] = (old, (x, xm) : new) go _ _ ((x, _) : _) | isZero x = ([(zero, 1)], []) go (old, new) x ((y, ym) : rest) | isUnit y' = go (old, xys ++ new) x' rest | otherwise = go ((y', ym) : old, xys ++ new) x' rest where (x', y', xys) = doPair x xm y ym -- | Wrap a non-zero number with its multiplicity into 'Coprimes'. -- -- >>> singleton 210 1 -- Coprimes {unCoprimes = [(210,1)]} singleton :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> Coprimes a b singleton a b | isZero a && b == 0 = Coprimes [] | isUnit a = Coprimes [] | otherwise = Coprimes [(a, b)] -- | Add a non-zero number with its multiplicity to 'Coprimes'. -- -- >>> insert 360 1 (singleton 210 1) -- Coprimes {unCoprimes = [(7,1),(5,2),(3,3),(2,4)]} -- >>> insert 2 4 (insert 7 1 (insert 5 2 (singleton 4 3))) -- Coprimes {unCoprimes = [(7,1),(5,2),(2,10)]} insert :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> Coprimes a b -> Coprimes a b insert x xm ys = Coprimes $ unCoprimes zs <> unCoprimes ws where (zs, ws) = insertInternal x xm ys instance (Eq a, GcdDomain a, Eq b, Num b) => Semigroup (Coprimes a b) where (Coprimes xs) <> ys = Coprimes $ unCoprimes zs <> foldMap unCoprimes wss where (zs, wss) = mapAccumL (\vs (x, xm) -> insertInternal x xm vs) ys xs instance (Eq a, GcdDomain a, Eq b, Num b) => Monoid (Coprimes a b) where mempty = Coprimes [] mappend = (<>) -- | The input list is assumed to be a factorisation of some number -- into a list of powers of (possibly, composite) non-zero factors. The output -- list is a factorisation of the same number such that all factors -- are coprime. Such transformation is crucial to continue factorisation -- (lazily, in parallel or concurrent fashion) without -- having to merge multiplicities of primes, which occurs more than in one -- composite factor. -- -- >>> splitIntoCoprimes [(140, 1), (165, 1)] -- Coprimes {unCoprimes = [(28,1),(33,1),(5,2)]} -- >>> splitIntoCoprimes [(360, 1), (210, 1)] -- Coprimes {unCoprimes = [(7,1),(5,2),(3,3),(2,4)]} splitIntoCoprimes :: (Eq a, GcdDomain a, Eq b, Num b) => [(a, b)] -> Coprimes a b splitIntoCoprimes = foldl (\acc (x, xm) -> insert x xm acc) mempty arithmoi-0.12.1.0/Math/NumberTheory/Moduli.hs0000644000000000000000000000130407346545000017035 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Miscellaneous functions related to modular arithmetic. -- module Math.NumberTheory.Moduli ( module Math.NumberTheory.Moduli.Class , module Math.NumberTheory.Moduli.Chinese , module Math.NumberTheory.Moduli.Multiplicative , module Math.NumberTheory.Moduli.Singleton , module Math.NumberTheory.Moduli.Sqrt ) where import Math.NumberTheory.Moduli.Chinese import Math.NumberTheory.Moduli.Class import Math.NumberTheory.Moduli.Multiplicative import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Moduli.Sqrt arithmoi-0.12.1.0/Math/NumberTheory/Moduli/0000755000000000000000000000000007346545000016503 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Moduli/Cbrt.hs0000644000000000000000000001477107346545000017743 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Cbrt -- Copyright: (c) 2020 Federico Bongiorno -- Licence: MIT -- Maintainer: Federico Bongiorno -- -- -- of two Eisenstein Integers. {-# LANGUAGE LambdaCase #-} module Math.NumberTheory.Moduli.Cbrt ( CubicSymbol(..) , cubicSymbol , symbolToNum ) where import Math.NumberTheory.Quadratic.EisensteinIntegers import Math.NumberTheory.Utils.FromIntegral import qualified Data.Euclidean as A import Math.NumberTheory.Utils import Data.Semigroup -- | Represents the -- -- It is either @0@, @ω@, @ω²@ or @1@. data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) -- | The set of cubic symbols form a semigroup. Note `stimes` -- is allowed to take non-positive values. In other words, the set -- of non-zero cubic symbols is regarded as a group. -- -- >>> import Data.Semigroup -- >>> stimes (-1) Omega -- ω² -- >>> stimes 0 Zero -- 1 instance Semigroup CubicSymbol where Zero <> _ = Zero _ <> Zero = Zero One <> y = y x <> One = x Omega <> Omega = OmegaSquare Omega <> OmegaSquare = One OmegaSquare <> Omega = One OmegaSquare <> OmegaSquare = Omega stimes k n = case (k `mod` 3, n) of (0, _) -> One (1, symbol) -> symbol (2, Omega) -> OmegaSquare (2, OmegaSquare) -> Omega (2, symbol) -> symbol _ -> error "Math.NumberTheory.Moduli.Cbrt: exponentiation undefined." instance Show CubicSymbol where show = \case Zero -> "0" Omega -> "ω" OmegaSquare -> "ω²" One -> "1" -- | Converts a -- -- to an Eisenstein Integer. symbolToNum :: CubicSymbol -> EisensteinInteger symbolToNum = \case Zero -> 0 Omega -> ω OmegaSquare -> -1 - ω One -> 1 -- The algorithm `cubicSymbol` is adapted from -- . -- It is divided in the following steps. -- -- (1) Check whether @beta@ is coprime to 3. -- (2) Replace @alpha@ by the remainder of @alpha@ mod @beta@ -- This does not affect the cubic symbol. -- (3) Replace @alpha@ and @beta@ by their associated primary -- divisors and keep track of how their cubic residue changes. -- (4) Check if any of the two numbers is a zero or a unit. In this -- case, return their cubic residue. -- (5) Otherwise, invoke cubic reciprocity by swapping @alpha@ and -- @beta@. Note both numbers have to be primary. -- Return to Step 2. -- | -- of two Eisenstein Integers. -- The first argument is the numerator and the second argument -- is the denominator. The latter must be coprime to @3@. -- This condition is checked. -- -- If the arguments have a common factor, the result -- is 'Zero', otherwise it is either 'Omega', 'OmegaSquare' or 'One'. -- -- >>> cubicSymbol (45 + 23*ω) (11 - 30*ω) -- 0 -- >>> cubicSymbol (31 - ω) (1 +10*ω) -- ω cubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol cubicSymbol alpha beta = case beta `A.rem` (1 - ω) of -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ -- In particular, it returns an error if @beta == 0@ 0 -> error "Math.NumberTheory.Moduli.Cbrt: denominator is not coprime to 3." _ -> cubicSymbolHelper alpha beta cubicSymbolHelper :: EisensteinInteger -> EisensteinInteger -> CubicSymbol cubicSymbolHelper alpha beta = cubicReciprocity primaryRemainder primaryBeta <> newSymbol where (primaryRemainder, primaryBeta, newSymbol) = extractPrimaryContributions remainder beta remainder = A.rem alpha beta cubicReciprocity :: EisensteinInteger -> EisensteinInteger -> CubicSymbol -- Note @cubicReciprocity 0 1 = One@. It is better to adopt this convention. cubicReciprocity _ 1 = One -- Checks if first argument is zero. Note the second argument is never zero. cubicReciprocity 0 _ = Zero -- This checks if the first argument is a unit. Because it's primary, -- it is enough to pattern match with 1. cubicReciprocity 1 _ = One -- Otherwise, cubic reciprocity is called. cubicReciprocity alpha beta = cubicSymbolHelper beta alpha -- | This function takes two Eisenstein intgers @alpha@ and @beta@ and returns -- three arguments @(gamma, delta, newSymbol)@. @gamma@ and @delta@ are the -- associated primary numbers of alpha and beta respectively. @newSymbol@ -- is the cubic symbol measuring the discrepancy between the cubic residue -- of @alpha@ and @beta@, and the cubic residue of @gamma@ and @delta@. extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, CubicSymbol) extractPrimaryContributions alpha beta = (gamma, delta, newSymbol) where newSymbol = stimes (j * m) Omega <> stimes (- m - n) i m :+ n = A.quot (delta - 1) 3 (i, gamma) = getPrimaryDecomposition alphaThreeFree (_, delta) = getPrimaryDecomposition beta j = wordToInteger jIntWord -- This function outputs data such that -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@. (jIntWord, alphaThreeFree) = splitOff (1 - ω) alpha -- | This function takes an Eisenstein number @e@ and returns @(symbol, delta)@ -- where @delta@ is its associated primary integer and @symbol@ is the -- cubic symbol discrepancy between @e@ and @delta@. @delta@ is defined to be -- the unique associated Eisenstein Integer to @e@ such that -- \( \textrm{delta} \equiv 1 (\textrm{mod} 3) \). -- Note that @delta@ exists if and only if @e@ is coprime to 3. In this -- case, an error message is displayed. getPrimaryDecomposition :: EisensteinInteger -> (CubicSymbol, EisensteinInteger) -- This is the case where a common factor between @alpha@ and @beta@ is detected. -- In this instance @cubicReciprocity@ will return `Zero`. -- Strictly speaking, this is not a primary decomposition. getPrimaryDecomposition 0 = (Zero, 0) getPrimaryDecomposition e = case e `A.rem` 3 of 1 -> (One, e) 1 :+ 1 -> (OmegaSquare, -ω * e) 0 :+ 1 -> (Omega, (-1 - ω) * e) (-1) :+ 0 -> (One, -e) (-1) :+ (-1) -> (OmegaSquare, ω * e) 0 :+ (-1) -> (Omega, (1 + ω) * e) _ -> error "Math.NumberTheory.Moduli.Cbrt: primary decomposition failed." arithmoi-0.12.1.0/Math/NumberTheory/Moduli/Chinese.hs0000644000000000000000000000565407346545000020427 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Chinese -- Copyright: (c) 2011 Daniel Fischer, 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Chinese remainder theorem -- {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Moduli.Chinese ( -- * Safe interface chinese , chineseSomeMod ) where import Prelude hiding ((^), (+), (-), (*), rem, mod, quot, gcd, lcm) import Data.Euclidean import Data.Mod import Data.Ratio import Data.Semiring (Semiring(..), (+), (-), (*), Ring) import GHC.TypeNats (KnownNat, natVal) import Math.NumberTheory.Moduli.SomeMod -- | 'chinese' @(n1, m1)@ @(n2, m2)@ returns @(n, lcm m1 m2)@ such that -- @n \`mod\` m1 == n1@ and @n \`mod\` m2 == n2@, if exists. -- Moduli @m1@ and @m2@ are allowed to have common factors. -- -- >>> chinese (1, 2) (2, 3) -- Just (-1, 6) -- >>> chinese (3, 4) (5, 6) -- Just (-1, 12) -- >>> chinese (3, 4) (2, 6) -- Nothing chinese :: forall a. (Eq a, Ring a, Euclidean a) => (a, a) -> (a, a) -> Maybe (a, a) chinese (n1, m1) (n2, m2) | d == one = Just ((v * m2 * n1 + u * m1 * n2) `rem` m, m) | (n1 - n2) `rem` d == zero = Just ((v * (m2 `quot` d) * n1 + u * (m1 `quot` d) * n2) `rem` m, m) | otherwise = Nothing where (d, u, v) = extendedGCD m1 m2 m = if d == one then m1 * m2 else (m1 `quot` d) * m2 {-# SPECIALISE chinese :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) #-} {-# SPECIALISE chinese :: (Word, Word) -> (Word, Word) -> Maybe (Word, Word) #-} {-# SPECIALISE chinese :: (Integer, Integer) -> (Integer, Integer) -> Maybe (Integer, Integer) #-} isCompatible :: KnownNat m => Mod m -> Rational -> Bool isCompatible n r = case invertMod (fromInteger (denominator r)) of Nothing -> False Just r' -> r' * fromInteger (numerator r) == n -- | Same as 'chinese', but operates on residues. -- -- >>> :set -XDataKinds -- >>> import Data.Mod -- >>> (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 (SomeMod n1) (SomeMod n2) = (\(n, m) -> n `modulo` fromInteger m) <$> chinese (toInteger $ unMod n1, toInteger $ natVal n1) (toInteger $ unMod n2, toInteger $ natVal n2) chineseSomeMod (SomeMod n) (InfMod r) | isCompatible n r = Just $ InfMod r | otherwise = Nothing chineseSomeMod (InfMod r) (SomeMod n) | isCompatible n r = Just $ InfMod r | otherwise = Nothing chineseSomeMod (InfMod r1) (InfMod r2) | r1 == r2 = Just $ InfMod r1 | otherwise = Nothing ------------------------------------------------------------------------------- -- Utils extendedGCD :: (Eq a, Ring a, Euclidean a) => a -> a -> (a, a, a) extendedGCD a b = (g, s, t) where (g, s) = gcdExt a b t = (g - a * s) `quot` b arithmoi-0.12.1.0/Math/NumberTheory/Moduli/Class.hs0000644000000000000000000000337407346545000020113 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Class -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Safe modular arithmetic with modulo on type level. -- {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Moduli.Class ( -- * Known modulo Mod , getVal , getNatVal , getMod , getNatMod , invertMod , powMod , (^%) -- * Multiplicative group , MultMod , multElement , isMultElement , invertGroup -- * Unknown modulo , SomeMod(..) , modulo , invertSomeMod , powSomeMod -- * Re-exported from GHC.TypeNats.Compat , KnownNat ) where import Data.Mod import GHC.Natural import GHC.TypeNats (KnownNat, natVal) import Math.NumberTheory.Moduli.Multiplicative import Math.NumberTheory.Moduli.SomeMod -- | Linking type and value levels: extract modulo @m@ as a value. getMod :: KnownNat m => Mod m -> Integer getMod = toInteger . natVal {-# INLINE getMod #-} -- | Linking type and value levels: extract modulo @m@ as a value. getNatMod :: KnownNat m => Mod m -> Natural getNatMod = natVal {-# INLINE getNatMod #-} -- | The canonical representative of the residue class, always between 0 and m-1 inclusively. getVal :: Mod m -> Integer getVal = toInteger . unMod {-# INLINE getVal #-} -- | The canonical representative of the residue class, always between 0 and m-1 inclusively. getNatVal :: Mod m -> Natural getNatVal = unMod {-# INLINE getNatVal #-} -- | Synonym of '(^%)'. powMod :: (KnownNat m, Integral a) => Mod m -> a -> Mod m powMod = (^%) {-# INLINE powMod #-} arithmoi-0.12.1.0/Math/NumberTheory/Moduli/Equations.hs0000644000000000000000000000746207346545000021020 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Equations -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Polynomial modular equations. -- {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} module Math.NumberTheory.Moduli.Equations ( solveLinear , solveQuadratic ) where import Data.Constraint import Data.Maybe import Data.Mod import GHC.Integer.GMP.Internals import GHC.TypeNats (KnownNat, natVal) import Math.NumberTheory.Moduli.Chinese import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Moduli.Sqrt import Math.NumberTheory.Primes import Math.NumberTheory.Utils (recipMod) ------------------------------------------------------------------------------- -- Linear equations -- | Find all solutions of ax + b ≡ 0 (mod m). -- -- >>> :set -XDataKinds -- >>> solveLinear (6 :: Mod 10) 4 -- solving 6x + 4 ≡ 0 (mod 10) -- [(1 `modulo` 10),(6 `modulo` 10)] solveLinear :: KnownNat m => Mod m -- ^ a -> Mod m -- ^ b -> [Mod m] -- ^ list of x solveLinear a b = map fromInteger $ solveLinear' (toInteger (natVal a)) (toInteger (unMod a)) (toInteger (unMod b)) solveLinear' :: Integer -> Integer -> Integer -> [Integer] solveLinear' m a b = case solveLinearCoprime m' (a `quot` d) (b `quot` d) of Nothing -> [] Just x -> map (\i -> x + m' * i) [0 .. d - 1] where d = m `gcd` a `gcd` b m' = m `quot` d solveLinearCoprime :: Integer -> Integer -> Integer -> Maybe Integer solveLinearCoprime 1 _ _ = Just 0 solveLinearCoprime m a b = (\a1 -> negate b * a1 `mod` m) <$> recipMod a m ------------------------------------------------------------------------------- -- Quadratic equations -- | Find all solutions of ax² + bx + c ≡ 0 (mod m). -- -- >>> :set -XDataKinds -- >>> solveQuadratic sfactors (1 :: Mod 32) 0 (-17) -- solving x² - 17 ≡ 0 (mod 32) -- [(9 `modulo` 32),(25 `modulo` 32),(7 `modulo` 32),(23 `modulo` 32)] solveQuadratic :: SFactors Integer m -> Mod m -- ^ a -> Mod m -- ^ b -> Mod m -- ^ c -> [Mod m] -- ^ list of x solveQuadratic sm a b c = case proofFromSFactors sm of Sub Dict -> map fromInteger $ fst $ combine $ map (\(p, n) -> (solveQuadraticPrimePower a' b' c' p n, unPrime p ^ n)) $ unSFactors sm where a' = toInteger $ unMod a b' = toInteger $ unMod b c' = toInteger $ unMod c combine :: [([Integer], Integer)] -> ([Integer], Integer) combine = foldl (\(xs, xm) (ys, ym) -> ([ fst $ fromJust $ chinese (x, xm) (y, ym) | x <- xs, y <- ys ], xm * ym)) ([0], 1) solveQuadraticPrimePower :: Integer -> Integer -> Integer -> Prime Integer -> Word -> [Integer] solveQuadraticPrimePower a b c p = go where go :: Word -> [Integer] go 0 = [0] go 1 = solveQuadraticPrime a b c p go k = concatMap (liftRoot k) (go (k - 1)) -- Hensel lifting -- https://en.wikipedia.org/wiki/Hensel%27s_lemma#Hensel_lifting liftRoot :: Word -> Integer -> [Integer] liftRoot k r = case recipMod (2 * a * r + b) pk of Nothing -> case fr of 0 -> map (\i -> r + pk `quot` p' * i) [0 .. p' - 1] _ -> [] Just invDeriv -> [(r - fr * invDeriv) `mod` pk] where pk = p' ^ k fr = (a * r * r + b * r + c) `mod` pk p' :: Integer p' = unPrime p solveQuadraticPrime :: Integer -> Integer -> Integer -> Prime Integer -> [Integer] solveQuadraticPrime a b c (unPrime -> 2 :: Integer) = case (even c, even (a + b)) of (True, True) -> [0, 1] (True, _) -> [0] (_, False) -> [1] _ -> [] solveQuadraticPrime a b c p | a `rem` p' == 0 = solveLinear' p' b c | otherwise = map (\n -> (n - b) * recipModInteger (2 * a) p' `mod` p') $ sqrtsModPrime (b * b - 4 * a * c) p where p' :: Integer p' = unPrime p arithmoi-0.12.1.0/Math/NumberTheory/Moduli/Internal.hs0000644000000000000000000001323507346545000020617 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Internal -- Copyright: (c) 2020 Bhavik Mehta -- Licence: MIT -- Maintainer: Bhavik Mehta -- -- Multiplicative groups of integers modulo m. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Moduli.Internal ( isPrimitiveRoot' , discreteLogarithmPP ) where import qualified Data.Map as M import Data.Maybe import Data.Mod import Data.Proxy import GHC.TypeNats (SomeNat(..), someNatVal) import GHC.Integer.GMP.Internals import Numeric.Natural import Math.NumberTheory.Moduli.Chinese import Math.NumberTheory.Moduli.Equations import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes import Math.NumberTheory.Roots import Math.NumberTheory.Utils.FromIntegral -- https://en.wikipedia.org/wiki/Primitive_root_modulo_n#Finding_primitive_roots isPrimitiveRoot' :: (Integral a, UniqueFactorisation a) => CyclicGroup a m -> a -> Bool isPrimitiveRoot' cg r = case cg of CG2 -> r == 1 CG4 -> r == 3 CGOddPrimePower p k -> oddPrimePowerTest (unPrime p) k r CGDoubleOddPrimePower p k -> doubleOddPrimePowerTest (unPrime p) k r where oddPrimePowerTest p 1 g = oddPrimeTest p (g `mod` p) oddPrimePowerTest p _ g = oddPrimeTest p (g `mod` p) && case someNatVal (fromIntegral' (p * p)) of SomeNat (_ :: Proxy pp) -> fromIntegral g ^ (p - 1) /= (1 :: Mod pp) doubleOddPrimePowerTest p k g = odd g && oddPrimePowerTest p k g oddPrimeTest p g = g /= 0 && gcd g p == 1 && case someNatVal (fromIntegral' p) of SomeNat (_ :: Proxy p) -> all (\x -> fromIntegral g ^ x /= (1 :: Mod p)) pows where pows = map (\(q, _) -> (p - 1) `quot` unPrime q) (factorise (p - 1)) -- Implementation of Bach reduction (https://www2.eecs.berkeley.edu/Pubs/TechRpts/1984/CSD-84-186.pdf) {-# INLINE discreteLogarithmPP #-} discreteLogarithmPP :: Integer -> Word -> Integer -> Integer -> Natural discreteLogarithmPP p 1 a b = discreteLogarithmPrime p a b discreteLogarithmPP p k a b = fromInteger $ if result < 0 then result + pkMinusPk1 else result where baseSol = toInteger $ discreteLogarithmPrime p (a `rem` p) (b `rem` p) thetaA = theta p pkMinusOne a thetaB = theta p pkMinusOne b pkMinusOne = p^(k-1) c = (recipModInteger thetaA pkMinusOne * thetaB) `rem` pkMinusOne (result, pkMinusPk1) = fromJust $ chinese (baseSol, p-1) (c, pkMinusOne) -- compute the homomorphism theta given in https://math.stackexchange.com/a/1864495/418148 {-# INLINE theta #-} theta :: Integer -> Integer -> Integer -> Integer theta p pkMinusOne a = (numerator `quot` pk) `rem` pkMinusOne where pk = pkMinusOne * p p2kMinusOne = pkMinusOne * pk numerator = (powModInteger a (pk - pkMinusOne) p2kMinusOne - 1) `rem` p2kMinusOne -- TODO: Use Pollig-Hellman to reduce the problem further into groups of prime order. -- While Bach reduction simplifies the problem into groups of the form (Z/pZ)*, these -- have non-prime order, and the Pollig-Hellman algorithm can reduce the problem into -- smaller groups of prime order. -- In addition, the gcd check before solveLinear is applied in Pollard below will be -- made redundant, since n would be prime. discreteLogarithmPrime :: Integer -> Integer -> Integer -> Natural discreteLogarithmPrime p a b | p < 100000000 = intToNatural $ discreteLogarithmPrimeBSGS (fromInteger p) (fromInteger a) (fromInteger b) | otherwise = discreteLogarithmPrimePollard p a b discreteLogarithmPrimeBSGS :: Int -> Int -> Int -> Int discreteLogarithmPrimeBSGS p a b = head [i*m + j | (v,i) <- zip giants [0..m-1], j <- maybeToList (M.lookup v table)] where m = integerSquareRoot (p - 2) + 1 -- simple way of ceiling (sqrt (p-1)) babies = iterate (.* a) 1 table = M.fromList (zip babies [0..m-1]) aInv = recipModInteger (toInteger a) (toInteger p) bigGiant = fromInteger $ powModInteger aInv (toInteger m) (toInteger p) giants = iterate (.* bigGiant) b x .* y = x * y `rem` p -- TODO: Use more advanced walks, in order to reduce divisions, cf -- https://maths-people.anu.edu.au/~brent/pd/rpb231.pdf -- This will slightly improve the expected time to collision, and can reduce the -- number of divisions performed. discreteLogarithmPrimePollard :: Integer -> Integer -> Integer -> Natural discreteLogarithmPrimePollard p a b = case concatMap runPollard [(x,y) | x <- [0..n], y <- [0..n]] of (t:_) -> fromInteger t [] -> error ("discreteLogarithm: pollard's rho failed, please report this as a bug. inputs " ++ show [p,a,b]) where n = p-1 -- order of the cyclic group halfN = n `quot` 2 mul2 m = if m < halfN then m * 2 else m * 2 - n sqrtN = integerSquareRoot n step (xi,!ai,!bi) = case xi `rem` 3 of 0 -> (xi*xi `rem` p, mul2 ai, mul2 bi) 1 -> ( a*xi `rem` p, ai+1, bi) _ -> ( b*xi `rem` p, ai, bi+1) initialise (x,y) = (powModInteger a x n * powModInteger b y n `rem` n, x, y) begin t = go (step t) (step (step t)) check t = powModInteger a t p == b go tort@(xi,ai,bi) hare@(x2i,a2i,b2i) | xi == x2i, gcd (bi - b2i) n < sqrtN = case someNatVal (fromInteger n) of SomeNat (Proxy :: Proxy n) -> map (toInteger . unMod) $ solveLinear (fromInteger (bi - b2i) :: Mod n) (fromInteger (ai - a2i)) | xi == x2i = [] | otherwise = go (step tort) (step (step hare)) runPollard = filter check . begin . initialise arithmoi-0.12.1.0/Math/NumberTheory/Moduli/JacobiSymbol.hs0000644000000000000000000001027007346545000021414 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.JacobiSymbol -- Copyright: (c) 2011 Daniel Fischer, 2017-2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- Description: Deprecated -- -- -- is a generalization of the Legendre symbol, useful for primality -- testing and integer factorization. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Math.NumberTheory.Moduli.JacobiSymbol ( JacobiSymbol(..) , jacobi , symbolToNum ) where import Data.Bits #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Numeric.Natural import Math.NumberTheory.Utils -- | Represents three possible values of -- . data JacobiSymbol = MinusOne | Zero | One deriving (Eq, Ord, Show) instance Semigroup JacobiSymbol where (<>) = \case MinusOne -> negJS Zero -> const Zero One -> id negJS :: JacobiSymbol -> JacobiSymbol negJS = \case MinusOne -> One Zero -> Zero One -> MinusOne {-# SPECIALISE symbolToNum :: JacobiSymbol -> Integer, JacobiSymbol -> Int, JacobiSymbol -> Word, JacobiSymbol -> Natural #-} -- | Convenience function to convert out of a Jacobi symbol symbolToNum :: Num a => JacobiSymbol -> a symbolToNum = \case Zero -> 0 One -> 1 MinusOne -> -1 -- | of two arguments. -- The lower argument (\"denominator\") must be odd and positive, -- this condition is checked. -- -- If arguments have a common factor, the result -- is 'Zero', otherwise it is 'MinusOne' or 'One'. -- -- >>> jacobi 1001 9911 -- arguments have a common factor 11 -- Zero -- >>> jacobi 1001 9907 -- MinusOne {-# SPECIALISE jacobi :: Integer -> Integer -> JacobiSymbol, Natural -> Natural -> JacobiSymbol, Int -> Int -> JacobiSymbol, Word -> Word -> JacobiSymbol #-} jacobi :: (Integral a, Bits a) => a -> a -> JacobiSymbol jacobi _ 1 = One jacobi a b | b < 0 = error "Math.NumberTheory.Moduli.jacobi: negative denominator" | evenI b = error "Math.NumberTheory.Moduli.jacobi: even denominator" | otherwise = jacobi' a b -- b odd, > 1 jacobi' :: (Integral a, Bits a) => a -> a -> JacobiSymbol jacobi' 0 _ = Zero jacobi' 1 _ = One jacobi' a b | a < 0 = let n = if rem4is3 b then MinusOne else One (z, o) = shiftToOddCount (negate a) s = if evenI z || rem8is1or7 b then n else negJS n in s <> jacobi' o b | a >= b = case a `rem` b of 0 -> Zero r -> jacPS One r b | evenI a = case shiftToOddCount a of (z, o) -> let r = if rem4is3 o && rem4is3 b then MinusOne else One s = if evenI z || rem8is1or7 b then r else negJS r in jacOL s b o | otherwise = jacOL (if rem4is3 a && rem4is3 b then MinusOne else One) b a -- numerator positive and smaller than denominator jacPS :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol jacPS !acc a b | evenI a = case shiftToOddCount a of (z, o) | evenI z || rem8is1or7 b -> jacOL (if rem4is3 o && rem4is3 b then negJS acc else acc) b o | otherwise -> jacOL (if rem4is3 o && rem4is3 b then acc else negJS acc) b o | otherwise = jacOL (if rem4is3 a && rem4is3 b then negJS acc else acc) b a -- numerator odd, positive and larger than denominator jacOL :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol jacOL !acc _ 1 = acc jacOL !acc a b = case a `rem` b of 0 -> Zero r -> jacPS acc r b -- Utilities -- Sadly, GHC do not optimise `Prelude.even` to a bit test automatically. evenI :: Bits a => a -> Bool evenI n = not (n `testBit` 0) -- For an odd input @n@ test whether n `rem` 4 == 1 rem4is3 :: Bits a => a -> Bool rem4is3 n = n `testBit` 1 -- For an odd input @n@ test whether (n `rem` 8) `elem` [1, 7] rem8is1or7 :: Bits a => a -> Bool rem8is1or7 n = n `testBit` 1 == n `testBit` 2 arithmoi-0.12.1.0/Math/NumberTheory/Moduli/Multiplicative.hs0000644000000000000000000001017207346545000022033 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Multiplicative -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Multiplicative groups of integers modulo m. -- {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} module Math.NumberTheory.Moduli.Multiplicative ( -- * Multiplicative group MultMod , multElement , isMultElement , invertGroup -- * Primitive roots , PrimitiveRoot , unPrimitiveRoot , isPrimitiveRoot , discreteLogarithm ) where import Control.Monad import Data.Constraint import Data.Mod import Data.Semigroup import GHC.TypeNats (KnownNat, natVal) import Numeric.Natural import Math.NumberTheory.Moduli.Internal import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes -- | This type represents elements of the multiplicative group mod m, i.e. -- those elements which are coprime to m. Use @isMultElement@ to construct. newtype MultMod m = MultMod { multElement :: Mod m -- ^ Unwrap a residue. } deriving (Eq, Ord, Show) instance KnownNat m => Semigroup (MultMod m) where MultMod a <> MultMod b = MultMod (a * b) stimes k a@(MultMod a') | k >= 0 = MultMod (a' ^% k) | otherwise = invertGroup $ stimes (-k) a -- ^ This Semigroup is in fact a group, so @stimes@ can be called with a negative first argument. instance KnownNat m => Monoid (MultMod m) where mempty = MultMod 1 mappend = (<>) instance KnownNat m => Bounded (MultMod m) where minBound = MultMod 1 maxBound = MultMod (-1) -- | Attempt to construct a multiplicative group element. isMultElement :: KnownNat m => Mod m -> Maybe (MultMod m) isMultElement a = if unMod a `gcd` natVal a == 1 then Just $ MultMod a else Nothing -- | For elements of the multiplicative group, we can safely perform the inverse -- without needing to worry about failure. invertGroup :: KnownNat m => MultMod m -> MultMod m invertGroup (MultMod a) = case invertMod a of Just b -> MultMod b Nothing -> error "Math.NumberTheory.Moduli.invertGroup: failed to invert element" -- | 'PrimitiveRoot' m is a type which is only inhabited -- by of m. newtype PrimitiveRoot m = PrimitiveRoot { unPrimitiveRoot :: MultMod m -- ^ Extract primitive root value. } deriving (Eq, Show) -- | Check whether a given modular residue is -- a . -- -- >>> :set -XDataKinds -- >>> import Data.Maybe -- >>> isPrimitiveRoot (fromJust cyclicGroup) (1 :: Mod 13) -- Nothing -- >>> isPrimitiveRoot (fromJust cyclicGroup) (2 :: Mod 13) -- Just (PrimitiveRoot {unPrimitiveRoot = MultMod {multElement = (2 `modulo` 13)}}) isPrimitiveRoot :: (Integral a, UniqueFactorisation a) => CyclicGroup a m -> Mod m -> Maybe (PrimitiveRoot m) isPrimitiveRoot cg r = case proofFromCyclicGroup cg of Sub Dict -> do r' <- isMultElement r guard $ isPrimitiveRoot' cg (fromIntegral (unMod r)) return $ PrimitiveRoot r' -- | Computes the discrete logarithm. Currently uses a combination of the baby-step -- giant-step method and Pollard's rho algorithm, with Bach reduction. -- -- >>> :set -XDataKinds -- >>> import Data.Maybe -- >>> let cg = fromJust cyclicGroup :: CyclicGroup Integer 13 -- >>> let rt = fromJust (isPrimitiveRoot cg 2) -- >>> let x = fromJust (isMultElement 11) -- >>> discreteLogarithm cg rt x -- 7 discreteLogarithm :: CyclicGroup Integer m -> PrimitiveRoot m -> MultMod m -> Natural discreteLogarithm cg (multElement . unPrimitiveRoot -> a) (multElement -> b) = case cg of CG2 -> 0 -- the only valid input was a=1, b=1 CG4 -> if unMod b == 1 then 0 else 1 -- the only possible input here is a=3 with b = 1 or 3 CGOddPrimePower (unPrime -> p) k -> discreteLogarithmPP p k (toInteger (unMod a)) (toInteger (unMod b)) CGDoubleOddPrimePower (unPrime -> p) k -> discreteLogarithmPP p k (toInteger (unMod a) `rem` p^k) (toInteger (unMod b) `rem` p^k) -- we have the isomorphism t -> t `rem` p^k from (Z/2p^kZ)* -> (Z/p^kZ)* arithmoi-0.12.1.0/Math/NumberTheory/Moduli/Singleton.hs0000644000000000000000000002377007346545000021012 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Singleton -- Copyright: (c) 2019 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Singleton data types. -- {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} module Math.NumberTheory.Moduli.Singleton ( -- * SFactors singleton SFactors , sfactors , someSFactors , unSFactors , proofFromSFactors -- * CyclicGroup singleton , CyclicGroup , cyclicGroup , cyclicGroupFromFactors , cyclicGroupFromModulo , proofFromCyclicGroup , pattern CG2 , pattern CG4 , pattern CGOddPrimePower , pattern CGDoubleOddPrimePower -- * SFactors \<=\> CyclicGroup , cyclicGroupToSFactors , sfactorsToCyclicGroup -- * Some wrapper , Some(..) ) where import Control.DeepSeq import Data.Constraint import Data.Kind import Data.List (sort) import qualified Data.Map as M import Data.Proxy #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import GHC.Generics import GHC.TypeNats (KnownNat, Nat, natVal) import Numeric.Natural import Unsafe.Coerce import Math.NumberTheory.Roots (highestPower) import Math.NumberTheory.Primes import Math.NumberTheory.Primes.Types import Math.NumberTheory.Utils.FromIntegral -- | Wrapper to hide an unknown type-level natural. data Some (a :: Nat -> Type) where Some :: a m -> Some a -- | From "Data.Constraint.Nat". newtype Magic n = Magic (KnownNat n => Dict (KnownNat n)) -- | This singleton data type establishes a correspondence -- between a modulo @m@ on type level -- and its factorisation on term level. newtype SFactors a (m :: Nat) = SFactors { unSFactors :: [(Prime a, Word)] -- ^ Factors of @m@. } deriving (Show, Generic) instance Eq (SFactors a m) where _ == _ = True instance Ord (SFactors a m) where _ `compare` _ = EQ instance NFData a => NFData (SFactors a m) instance Ord a => Eq (Some (SFactors a)) where Some (SFactors xs) == Some (SFactors ys) = xs == ys instance Ord a => Ord (Some (SFactors a)) where Some (SFactors xs) `compare` Some (SFactors ys) = xs `compare` ys instance Show a => Show (Some (SFactors a)) where showsPrec p (Some x) = showsPrec p x instance NFData a => NFData (Some (SFactors a)) where rnf (Some x) = rnf x -- | Create a singleton from a type-level positive modulo @m@, -- passed in a constraint. -- -- >>> :set -XDataKinds -- >>> sfactors :: SFactors Integer 13 -- SFactors {unSFactors = [(Prime 13,1)]} sfactors :: forall a m. (Ord a, UniqueFactorisation a, KnownNat m) => SFactors a m sfactors = if m == 0 then error "sfactors: modulo must be positive" else SFactors (sort (factorise m)) where m = fromIntegral (natVal (Proxy :: Proxy m)) -- | Create a singleton from factors of @m@. -- Factors must be distinct, as in output of 'factorise'. -- -- >>> import Math.NumberTheory.Primes -- >>> someSFactors (factorise 98) -- SFactors {unSFactors = [(Prime 2,1),(Prime 7,2)]} someSFactors :: (Ord a, Num a) => [(Prime a, Word)] -> Some (SFactors a) someSFactors = Some . SFactors -- Just a precaution against ill-formed lists of factors . M.assocs . M.fromListWith (+) -- | Convert a singleton to a proof that @m@ is known. Usage example: -- -- > toModulo :: SFactors Integer m -> Natural -- > toModulo t = case proofFromSFactors t of Sub Dict -> natVal t proofFromSFactors :: Integral a => SFactors a m -> (() :- KnownNat m) proofFromSFactors (SFactors fs) = Sub $ unsafeCoerce (Magic Dict) (fromIntegral' (factorBack fs) :: Natural) -- | This singleton data type establishes a correspondence -- between a modulo @m@ on type level -- and a cyclic group of the same order on term level. data CyclicGroup a (m :: Nat) = CG2' -- ^ Residues modulo 2. | CG4' -- ^ Residues modulo 4. | CGOddPrimePower' (Prime a) Word -- ^ Residues modulo @p@^@k@ for __odd__ prime @p@. | CGDoubleOddPrimePower' (Prime a) Word -- ^ Residues modulo 2@p@^@k@ for __odd__ prime @p@. deriving (Show, Generic) instance Eq (CyclicGroup a m) where _ == _ = True instance Ord (CyclicGroup a m) where _ `compare` _ = EQ instance NFData a => NFData (CyclicGroup a m) instance Eq a => Eq (Some (CyclicGroup a)) where Some CG2' == Some CG2' = True Some CG4' == Some CG4' = True Some (CGOddPrimePower' p1 k1) == Some (CGOddPrimePower' p2 k2) = p1 == p2 && k1 == k2 Some (CGDoubleOddPrimePower' p1 k1) == Some (CGDoubleOddPrimePower' p2 k2) = p1 == p2 && k1 == k2 _ == _ = False instance Ord a => Ord (Some (CyclicGroup a)) where compare (Some x) (Some y) = case x of CG2' -> case y of CG2' -> EQ _ -> LT CG4' -> case y of CG2' -> GT CG4' -> EQ _ -> LT CGOddPrimePower' p1 k1 -> case y of CGDoubleOddPrimePower'{} -> LT CGOddPrimePower' p2 k2 -> p1 `compare` p2 <> k1 `compare` k2 _ -> GT CGDoubleOddPrimePower' p1 k1 -> case y of CGDoubleOddPrimePower' p2 k2 -> p1 `compare` p2 <> k1 `compare` k2 _ -> GT instance Show a => Show (Some (CyclicGroup a)) where showsPrec p (Some x) = showsPrec p x instance NFData a => NFData (Some (CyclicGroup a)) where rnf (Some x) = rnf x -- | Create a singleton from a type-level positive modulo @m@, -- passed in a constraint. -- -- >>> :set -XDataKinds -- >>> import Data.Maybe -- >>> cyclicGroup :: Maybe (CyclicGroup Integer 169) -- Just (CGOddPrimePower' (Prime 13) 2) -- -- >>> :set -XTypeOperators -XNoStarIsType -- >>> import GHC.TypeNats -- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer 4) -- Just CG4' -- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer (2 * 13 ^ 3)) -- Just (CGDoubleOddPrimePower' (Prime 13) 3) -- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer (4 * 13)) -- Nothing cyclicGroup :: forall a m. (Integral a, UniqueFactorisation a, KnownNat m) => Maybe (CyclicGroup a m) cyclicGroup = fromModuloInternal m where m = fromIntegral (natVal (Proxy :: Proxy m)) -- | Create a singleton from factors. -- Factors must be distinct, as in output of 'factorise'. cyclicGroupFromFactors :: (Eq a, Num a) => [(Prime a, Word)] -> Maybe (Some (CyclicGroup a)) cyclicGroupFromFactors = \case [(unPrime -> 2, 1)] -> Just $ Some CG2' [(unPrime -> 2, 2)] -> Just $ Some CG4' [(unPrime -> 2, _)] -> Nothing [(p, k)] -> Just $ Some $ CGOddPrimePower' p k [(unPrime -> 2, 1), (p, k)] -> Just $ Some $ CGDoubleOddPrimePower' p k [(p, k), (unPrime -> 2, 1)] -> Just $ Some $ CGDoubleOddPrimePower' p k _ -> Nothing -- | Similar to 'cyclicGroupFromFactors' . 'factorise', -- but much faster, because it -- but performes only one primality test instead of full -- factorisation. cyclicGroupFromModulo :: (Integral a, UniqueFactorisation a) => a -> Maybe (Some (CyclicGroup a)) cyclicGroupFromModulo = fmap Some . fromModuloInternal fromModuloInternal :: (Integral a, UniqueFactorisation a) => a -> Maybe (CyclicGroup a m) fromModuloInternal = \case 2 -> Just CG2' 4 -> Just CG4' n | even n -> uncurry CGDoubleOddPrimePower' <$> isOddPrimePower (n `div` 2) | otherwise -> uncurry CGOddPrimePower' <$> isOddPrimePower n isOddPrimePower :: (Integral a, UniqueFactorisation a) => a -> Maybe (Prime a, Word) isOddPrimePower n | even n = Nothing | otherwise = (, k) <$> isPrime p where (p, k) = highestPower n -- | Convert a cyclic group to a proof that @m@ is known. Usage example: -- -- > toModulo :: CyclicGroup Integer m -> Natural -- > toModulo t = case proofFromCyclicGroup t of Sub Dict -> natVal t proofFromCyclicGroup :: Integral a => CyclicGroup a m -> (() :- KnownNat m) proofFromCyclicGroup = proofFromSFactors . cyclicGroupToSFactors -- | Check whether a multiplicative group of residues, -- characterized by its modulo, is cyclic and, if yes, return its form. -- -- >>> :set -XTypeOperators -XNoStarIsType -- >>> import GHC.TypeNats -- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer 4) -- Just CG4' -- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer (2 * 13 ^ 3)) -- Just (CGDoubleOddPrimePower' (Prime 13) 3) -- >>> sfactorsToCyclicGroup (sfactors :: SFactors Integer (4 * 13)) -- Nothing sfactorsToCyclicGroup :: (Eq a, Num a) => SFactors a m -> Maybe (CyclicGroup a m) sfactorsToCyclicGroup (SFactors fs) = case fs of [(unPrime -> 2, 1)] -> Just CG2' [(unPrime -> 2, 2)] -> Just CG4' [(unPrime -> 2, _)] -> Nothing [(p, k)] -> Just $ CGOddPrimePower' p k [(p, k), (unPrime -> 2, 1)] -> Just $ CGDoubleOddPrimePower' p k [(unPrime -> 2, 1), (p, k)] -> Just $ CGDoubleOddPrimePower' p k _ -> Nothing -- | Invert 'sfactorsToCyclicGroup'. -- -- >>> import Data.Maybe -- >>> cyclicGroupToSFactors (fromJust (sfactorsToCyclicGroup (sfactors :: SFactors Integer 4))) -- SFactors {unSFactors = [(Prime 2,2)]} cyclicGroupToSFactors :: Num a => CyclicGroup a m -> SFactors a m cyclicGroupToSFactors = SFactors . \case CG2' -> [(Prime 2, 1)] CG4' -> [(Prime 2, 2)] CGOddPrimePower' p k -> [(p, k)] CGDoubleOddPrimePower' p k -> [(Prime 2, 1), (p, k)] -- | Unidirectional pattern for residues modulo 2. pattern CG2 :: CyclicGroup a m pattern CG2 <- CG2' -- | Unidirectional pattern for residues modulo 4. pattern CG4 :: CyclicGroup a m pattern CG4 <- CG4' -- | Unidirectional pattern for residues modulo @p@^@k@ for __odd__ prime @p@. pattern CGOddPrimePower :: Prime a -> Word -> CyclicGroup a m pattern CGOddPrimePower p k <- CGOddPrimePower' p k -- | Unidirectional pattern for residues modulo 2@p@^@k@ for __odd__ prime @p@. pattern CGDoubleOddPrimePower :: Prime a -> Word -> CyclicGroup a m pattern CGDoubleOddPrimePower p k <- CGDoubleOddPrimePower' p k #if __GLASGOW_HASKELL__ > 801 {-# COMPLETE CG2, CG4, CGOddPrimePower, CGDoubleOddPrimePower #-} #endif arithmoi-0.12.1.0/Math/NumberTheory/Moduli/SomeMod.hs0000644000000000000000000001404607346545000020407 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.SomeMod -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Safe modular arithmetic with modulo on type level. -- {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Moduli.SomeMod ( SomeMod(..) , modulo , invertSomeMod , powSomeMod ) where import Data.Euclidean (GcdDomain(..), Euclidean(..), Field) import Data.Mod import Data.Proxy #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Data.Semiring (Semiring(..), Ring(..)) import Data.Type.Equality import GHC.TypeNats (KnownNat, SomeNat(..), sameNat, natVal, someNatVal) import Numeric.Natural -- | This type represents residues with unknown modulo and rational numbers. -- One can freely combine them in arithmetic expressions, but each operation -- will spend time on modulo's recalculation: -- -- >>> 2 `modulo` 10 + 4 `modulo` 15 -- (1 `modulo` 5) -- >>> (2 `modulo` 10) * (4 `modulo` 15) -- (3 `modulo` 5) -- >>> import Data.Ratio -- >>> 2 `modulo` 10 + fromRational (3 % 7) -- (1 `modulo` 10) -- >>> 2 `modulo` 10 * fromRational (3 % 7) -- (8 `modulo` 10) -- -- If performance is crucial, it is recommended to extract @Mod m@ for further processing -- by pattern matching. E. g., -- -- > case modulo n m of -- > SomeMod k -> process k -- Here k has type Mod m -- > InfMod{} -> error "impossible" data SomeMod where SomeMod :: KnownNat m => Mod m -> SomeMod InfMod :: Rational -> SomeMod instance Eq SomeMod where SomeMod mx == SomeMod my = natVal mx == natVal my && unMod mx == unMod my InfMod rx == InfMod ry = rx == ry _ == _ = False instance Ord SomeMod where SomeMod mx `compare` SomeMod my = natVal mx `compare` natVal my <> unMod mx `compare` unMod my SomeMod{} `compare` InfMod{} = LT InfMod{} `compare` SomeMod{} = GT InfMod rx `compare` InfMod ry = rx `compare` ry instance Show SomeMod where show = \case SomeMod m -> show m InfMod r -> show r -- | Create modular value by representative of residue class and modulo. -- One can use the result either directly (via functions from 'Num' and 'Fractional'), -- or deconstruct it by pattern matching. Note that 'modulo' never returns 'InfMod'. modulo :: Integer -> Natural -> SomeMod modulo n m = case someNatVal m of SomeNat (_ :: Proxy t) -> SomeMod (fromInteger n :: Mod t) {-# INLINABLE modulo #-} infixl 7 `modulo` liftUnOp :: (forall k. KnownNat k => Mod k -> Mod k) -> (Rational -> Rational) -> SomeMod -> SomeMod liftUnOp fm fr = \case SomeMod m -> SomeMod (fm m) InfMod r -> InfMod (fr r) {-# INLINEABLE liftUnOp #-} liftBinOpMod :: (KnownNat m, KnownNat n) => (forall k. KnownNat k => Mod k -> Mod k -> Mod k) -> Mod m -> Mod n -> SomeMod liftBinOpMod f mx my = case someNatVal m of SomeNat (_ :: Proxy t) -> SomeMod (fromIntegral (x `mod` m) `f` fromIntegral (y `mod` m) :: Mod t) where x = unMod mx y = unMod my m = natVal mx `Prelude.gcd` natVal my liftBinOp :: (forall k. KnownNat k => Mod k -> Mod k -> Mod k) -> (Rational -> Rational -> Rational) -> SomeMod -> SomeMod -> SomeMod liftBinOp _ fr (InfMod rx) (InfMod ry) = InfMod (rx `fr` ry) liftBinOp fm _ (InfMod rx) (SomeMod my) = SomeMod (fromRational rx `fm` my) liftBinOp fm _ (SomeMod mx) (InfMod ry) = SomeMod (mx `fm` fromRational ry) liftBinOp fm _ (SomeMod (mx :: Mod m)) (SomeMod (my :: Mod n)) = case (Proxy :: Proxy m) `sameNat` (Proxy :: Proxy n) of Nothing -> liftBinOpMod fm mx my Just Refl -> SomeMod (mx `fm` my) instance Num SomeMod where (+) = liftBinOp (+) (+) (-) = liftBinOp (-) (-) negate = liftUnOp Prelude.negate Prelude.negate {-# INLINE negate #-} (*) = liftBinOp (*) (*) abs = id {-# INLINE abs #-} signum = const 1 {-# INLINE signum #-} fromInteger = InfMod . fromInteger {-# INLINE fromInteger #-} instance Semiring SomeMod where plus = (+) times = (*) zero = InfMod 0 one = InfMod 1 fromNatural = fromIntegral instance Ring SomeMod where negate = Prelude.negate -- | Beware that division by residue, which is not coprime with the modulo, -- will result in runtime error. Consider using 'invertSomeMod' instead. instance Fractional SomeMod where fromRational = InfMod {-# INLINE fromRational #-} recip x = case invertSomeMod x of Nothing -> error "recip{SomeMod}: residue is not coprime with modulo" Just y -> y -- | See the warning about division above. instance GcdDomain SomeMod where divide x y = Just (x / y) gcd = const $ const 1 lcm = const $ const 1 coprime = const $ const True -- | See the warning about division above. instance Euclidean SomeMod where degree = const 0 quotRem x y = (x / y, 0) quot = (/) rem = const $ const 0 -- | See the warning about division above. instance Field SomeMod -- | Computes the inverse value, if it exists. -- -- >>> invertSomeMod (3 `modulo` 10) -- because 3 * 7 = 1 :: Mod 10 -- Just (7 `modulo` 10) -- >>> invertSomeMod (4 `modulo` 10) -- Nothing -- >>> import Data.Ratio -- >>> invertSomeMod (fromRational (2 % 5)) -- Just 5 % 2 invertSomeMod :: SomeMod -> Maybe SomeMod invertSomeMod = \case SomeMod m -> fmap SomeMod (invertMod m) InfMod r -> Just (InfMod (recip r)) {-# INLINABLE [1] invertSomeMod #-} {-# SPECIALISE [1] powSomeMod :: SomeMod -> Integer -> SomeMod, SomeMod -> Natural -> SomeMod, SomeMod -> Int -> SomeMod, SomeMod -> Word -> SomeMod #-} -- | Drop-in replacement for 'Prelude.^', with much better performance. -- When -O is enabled, there is a rewrite rule, which specialises 'Prelude.^' to 'powSomeMod'. -- -- >>> powSomeMod (3 `modulo` 10) 4 -- (1 `modulo` 10) powSomeMod :: Integral a => SomeMod -> a -> SomeMod powSomeMod (SomeMod m) a = SomeMod (m ^% a) powSomeMod (InfMod r) a = InfMod (r ^ a) {-# INLINABLE [1] powSomeMod #-} {-# RULES "^%SomeMod" forall x p. x ^ p = powSomeMod x p #-} arithmoi-0.12.1.0/Math/NumberTheory/Moduli/Sqrt.hs0000644000000000000000000002106707346545000017776 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Sqrt -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Modular square roots and -- . -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} module Math.NumberTheory.Moduli.Sqrt ( -- * Modular square roots sqrtsMod , sqrtsModFactorisation , sqrtsModPrimePower , sqrtsModPrime -- * Jacobi symbol , JacobiSymbol(..) , jacobi , symbolToNum ) where import Control.Monad (liftM2) import Data.Bits import Data.Constraint import Data.Maybe import Data.Mod import Data.Proxy import GHC.TypeNats (KnownNat, SomeNat(..), natVal, someNatVal) import Math.NumberTheory.Moduli.Chinese import Math.NumberTheory.Moduli.JacobiSymbol import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes import Math.NumberTheory.Utils (shiftToOddCount, splitOff) import Math.NumberTheory.Utils.FromIntegral -- | List all modular square roots. -- -- >>> :set -XDataKinds -- >>> sqrtsMod sfactors (1 :: Mod 60) -- [(1 `modulo` 60),(49 `modulo` 60),(41 `modulo` 60),(29 `modulo` 60),(31 `modulo` 60),(19 `modulo` 60),(11 `modulo` 60),(59 `modulo` 60)] sqrtsMod :: SFactors Integer m -> Mod m -> [Mod m] sqrtsMod sm a = case proofFromSFactors sm of Sub Dict -> map fromInteger $ sqrtsModFactorisation (toInteger (unMod a)) (unSFactors sm) -- | List all square roots modulo a number, the factorisation of which is -- passed as a second argument. -- -- >>> sqrtsModFactorisation 1 (factorise 60) -- [1,49,41,29,31,19,11,59] sqrtsModFactorisation :: Integer -> [(Prime Integer, Word)] -> [Integer] sqrtsModFactorisation _ [] = [0] sqrtsModFactorisation n pps = map fst $ foldl1 (liftM2 comb) cs where ms :: [Integer] ms = map (\(p, pow) -> unPrime p ^ pow) pps rs :: [[Integer]] rs = map (uncurry (sqrtsModPrimePower n)) pps cs :: [[(Integer, Integer)]] cs = zipWith (\l m -> map (, m) l) rs ms comb t1 t2 = (if ch < 0 then ch + m else ch, m) where (ch, m) = fromJust $ chinese t1 t2 -- | List all square roots modulo the power of a prime. -- -- >>> 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 (unPrime -> prime) expo = let primeExpo = prime ^ expo in case splitOff prime (nn `mod` primeExpo) of (_, 0) -> [0, prime ^ ((expo + 1) `quot` 2) .. primeExpo - 1] (kk, n) | odd kk -> [] | otherwise -> case (if prime == 2 then sqM2P n expo' else sqrtModPP' n prime expo') of Nothing -> [] Just r -> let rr = r * prime ^ k in if prime == 2 && k + 1 == t then go rr os else go rr os ++ go (primeExpo - rr) os where k = kk `quot` 2 t = (if prime == 2 then expo - k - 1 else expo - k) `max` ((expo + 1) `quot` 2) expo' = expo - 2 * k os = [0, prime ^ t .. primeExpo - 1] -- equivalent to map ((`mod` primeExpo) . (+ r)) rs, -- but avoids division go r rs = map (+ r) ps ++ map (+ (r - primeExpo)) qs where (ps, qs) = span (< primeExpo - r) rs -- | List all square roots by prime modulo. -- -- >>> import Data.Maybe -- >>> import Math.NumberTheory.Primes -- >>> sqrtsModPrime 1 (fromJust (isPrime 5)) -- [1,4] -- >>> sqrtsModPrime 0 (fromJust (isPrime 5)) -- [0] -- >>> sqrtsModPrime 2 (fromJust (isPrime 5)) -- [] sqrtsModPrime :: Integer -> Prime Integer -> [Integer] sqrtsModPrime n (unPrime -> 2) = [n `mod` 2] sqrtsModPrime n (unPrime -> prime) = case jacobi n prime of MinusOne -> [] Zero -> [0] One -> case someNatVal (fromInteger prime) of SomeNat (_ :: Proxy p) -> let r = toInteger (unMod (sqrtModP' @p (fromInteger n))) in [r, prime - r] ------------------------------------------------------------------------------- -- Internals -- | @sqrtModP' square prime@ finds a square root of @square@ modulo -- prime. @prime@ /must/ be a (positive) prime, and @square@ /must/ be a positive -- quadratic residue modulo @prime@, i.e. @'jacobi square prime == 1@. sqrtModP' :: KnownNat p => Mod p -> Mod p sqrtModP' square | prime == 2 = square | rem4 prime == 3 = square ^ ((prime + 1) `quot` 4) | square == maxBound = sqrtOfMinusOne | otherwise = tonelliShanks square where prime = natVal square -- | @p@ must be of form @4k + 1@ sqrtOfMinusOne :: KnownNat p => Mod p sqrtOfMinusOne = res where p = natVal res k = (p - 1) `quot` 4 res = head $ dropWhile (\n -> n == 1 || n == maxBound) $ map (^ k) [2 .. maxBound - 1] -- | @tonelliShanks square prime@ calculates a square root of @square@ -- modulo @prime@, where @prime@ is a prime of the form @4*k + 1@ and -- @square@ is a positive quadratic residue modulo @prime@, using the -- Tonelli-Shanks algorithm. tonelliShanks :: forall p. KnownNat p => Mod p -> Mod p tonelliShanks square = loop rc t1 generator log2 where prime = natVal square (log2, q) = shiftToOddCount (prime - 1) generator = findNonSquare ^ q rc = square ^ ((q + 1) `quot` 2) t1 = square ^ q msquare 0 x = x msquare k x = msquare (k-1) (x * x) findPeriod per 1 = per findPeriod per x = findPeriod (per + 1) (x * x) loop :: Mod p -> Mod p -> Mod p -> Word -> Mod p loop !r t c m | t == 1 = r | otherwise = loop nextR nextT nextC nextM where nextM = findPeriod 0 t b = msquare (m - 1 - nextM) c nextR = r * b nextC = b * b nextT = t * nextC -- | prime must be odd, n must be coprime with prime sqrtModPP' :: Integer -> Integer -> Word -> Maybe Integer sqrtModPP' n prime expo = case jacobi n prime of MinusOne -> Nothing Zero -> Nothing One -> case someNatVal (fromInteger prime) of SomeNat (_ :: Proxy p) -> Just $ fixup $ sqrtModP' @p (fromInteger n) where fixup :: KnownNat p => Mod p -> Integer fixup r | diff' == 0 = r' | expo <= e = r' | otherwise = hoist (recip (2 * r)) r' (fromInteger q) (prime^e) where r' = toInteger (unMod r) diff' = r' * r' - n (e, q) = splitOff prime diff' hoist :: KnownNat p => Mod p -> Integer -> Mod p -> Integer -> Integer hoist inv root elim pp | diff' == 0 = root' | expo <= ex = root' | otherwise = hoist inv root' (fromInteger nelim) (prime ^ ex) where root' = root + toInteger (unMod (inv * negate elim)) * pp diff' = root' * root' - n (ex, nelim) = splitOff prime diff' -- dirty, dirty sqM2P :: Integer -> Word -> Maybe Integer sqM2P n e | e < 2 = Just (n `mod` 2) | n' == 0 = Just 0 | odd k = Nothing | otherwise = (`mod` mdl) . (`shiftL` wordToInt k2) <$> solve s e2 where mdl = 1 `shiftL` wordToInt e n' = n `mod` mdl (k, s) = shiftToOddCount n' k2 = k `quot` 2 e2 = e - k solve _ 1 = Just 1 solve 1 _ = Just 1 solve r _ | rem4 r == 3 = Nothing -- otherwise r ≡ 1 (mod 4) | rem8 r == 5 = Nothing -- otherwise r ≡ 1 (mod 8) | otherwise = fixup r (fst $ shiftToOddCount (r-1)) where fixup x pw | pw >= e2 = Just x | otherwise = fixup x' pw' where x' = x + (1 `shiftL` (wordToInt pw - 1)) d = x'*x' - r pw' = if d == 0 then e2 else fst (shiftToOddCount d) ------------------------------------------------------------------------------- -- Utilities rem4 :: Integral a => a -> Int rem4 n = fromIntegral n .&. 3 rem8 :: Integral a => a -> Int rem8 n = fromIntegral n .&. 7 findNonSquare :: KnownNat n => Mod n findNonSquare = res where n = natVal res res | rem8 n == 3 || rem8 n == 5 = 2 | otherwise = fromIntegral $ head $ dropWhile (\p -> jacobi p n /= MinusOne) candidates -- It is enough to consider only prime candidates, but -- the probability that the smallest non-residue is > 67 -- is small and 'jacobi' test is fast, -- so we use [71..n] instead of filter isPrime [71..n]. candidates = 3:5:7:11:13:17:19:23:29:31:37:41:43:47:53:59:61:67:[71..n] arithmoi-0.12.1.0/Math/NumberTheory/MoebiusInversion.hs0000644000000000000000000001420707346545000021112 0ustar0000000000000000-- | -- Module: Math.NumberTheory.MoebiusInversion -- Copyright: (c) 2012 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Generalised Möbius inversion {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.MoebiusInversion ( generalInversion , totientSum ) where import Control.Monad import Control.Monad.ST import Data.Proxy import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as MG import Math.NumberTheory.Roots import Math.NumberTheory.Utils.FromIntegral -- | @totientSum n@ is, for @n > 0@, the sum of @[totient k | k <- [1 .. n]]@, -- computed via generalised Möbius inversion. -- See for the -- formula used for @totientSum@. -- -- >>> import Data.Proxy -- >>> totientSum (Proxy :: Proxy Data.Vector.Unboxed.Vector) 100 :: Int -- 3044 -- >>> totientSum (Proxy :: Proxy Data.Vector.Vector) 100 :: Integer -- 3044 totientSum :: (Integral t, G.Vector v t) => Proxy v -> Word -> t totientSum _ 0 = 0 totientSum proxy n = generalInversion proxy (triangle . fromIntegral) n where triangle k = (k * (k + 1)) `quot` 2 -- | @generalInversion g n@ evaluates the generalised Möbius inversion of @g@ -- at the argument @n@. -- -- The generalised Möbius inversion implemented here allows an efficient -- calculation of isolated values of the function @f : N -> Z@ if the function -- @g@ defined by -- -- > -- > g n = sum [f (n `quot` k) | k <- [1 .. n]] -- > -- -- can be cheaply computed. By the generalised Möbius inversion formula, then -- -- > -- > f n = sum [moebius k * g (n `quot` k) | k <- [1 .. n]] -- > -- -- which allows the computation in /O/(n) steps, if the values of the -- Möbius function are known. A slightly different formula, used here, -- does not need the values of the Möbius function and allows the -- computation in /O/(n^0.75) steps, using /O/(n^0.5) memory. -- -- An example of a pair of such functions where the inversion allows a -- more efficient computation than the direct approach is -- -- > -- > f n = number of reduced proper fractions with denominator <= n -- > -- > g n = number of proper fractions with denominator <= n -- > -- -- (a /proper fraction/ is a fraction @0 < n/d < 1@). Then @f n@ is the -- cardinality of the Farey sequence of order @n@ (minus 1 or 2 if 0 and/or -- 1 are included in the Farey sequence), or the sum of the totients of -- the numbers @2 <= k <= n@. @f n@ is not easily directly computable, -- but then @g n = n*(n-1)/2@ is very easy to compute, and hence the inversion -- gives an efficient method of computing @f n@. -- -- Since the function arguments are used as array indices, the domain of -- @f@ is restricted to 'Int'. -- -- The value @f n@ is then computed by @generalInversion g n@. Note that when -- many values of @f@ are needed, there are far more efficient methods, this -- method is only appropriate to compute isolated values of @f@. generalInversion :: (Num t, G.Vector v t) => Proxy v -> (Word -> t) -> Word -> t generalInversion proxy fun n = case n of 0 ->error "Möbius inversion only defined on positive domain" 1 -> fun 1 2 -> fun 2 - fun 1 3 -> fun 3 - 2*fun 1 _ -> runST (fastInvertST proxy (fun . intToWord) (wordToInt n)) fastInvertST :: forall s t v. (Num t, G.Vector v t) => Proxy v -> (Int -> t) -> Int -> ST s t fastInvertST _ fun n = do let !k0 = integerSquareRoot (n `quot` 2) !mk0 = n `quot` (2*k0+1) kmax a m = (a `quot` m - 1) `quot` 2 small <- MG.unsafeNew (mk0 + 1) :: ST s (G.Mutable v s t) MG.unsafeWrite small 0 0 MG.unsafeWrite small 1 $! fun 1 when (mk0 >= 2) $ MG.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 <- MG.unsafeRead small m let nxtk = kmax i (m+1) mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1) kloop !acc k | k == 0 = do MG.unsafeWrite small i $! acc calcit switch change (i+1) | otherwise = do val <- MG.unsafeRead small (i `quot` (2*k+1)) kloop (acc-val) (k-1) mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1 (sw, ch) <- calcit 1 8 3 large <- MG.unsafeNew k0 :: ST s (G.Mutable v s t) let calcbig :: Int -> Int -> Int -> ST s (G.Mutable v s t) calcbig switch change j | j == 0 = return large | (2*j-1)*change <= n = calcbig (switch+1) (change + 4*switch+6) j | otherwise = do let i = n `quot` (2*j-1) mloop !acc k m | k < switch = kloop acc k | otherwise = do val <- MG.unsafeRead small m let nxtk = kmax i (m+1) mloop (acc - fromIntegral (k-nxtk)*val) nxtk (m+1) kloop !acc k | k == 0 = do MG.unsafeWrite large (j-1) $! acc calcbig switch change (j-1) | otherwise = do let m = i `quot` (2*k+1) val <- if m <= mk0 then MG.unsafeRead small m else MG.unsafeRead large (k*(2*j-1)+j-1) kloop (acc-val) (k-1) mloop (fun i - fun (i `quot` 2)) ((i-1) `quot` 2) 1 mvec <- calcbig sw ch k0 MG.unsafeRead mvec 0 arithmoi-0.12.1.0/Math/NumberTheory/Powers/0000755000000000000000000000000007346545000016531 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Powers/Modular.hs0000644000000000000000000000537507346545000020502 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Powers.Modular -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Modular powers (a. k. a. modular exponentiation). -- module Math.NumberTheory.Powers.Modular {-# DEPRECATED "Use Data.Mod or Data.Mod.Word instead" #-} ( powMod , powModWord , powModInt ) where import GHC.Natural (powModNatural) import qualified GHC.Integer.GMP.Internals as GMP (powModInteger) import Math.NumberTheory.Utils.FromIntegral -- | @powMod@ @b@ @e@ @m@ computes (@b^e@) \`mod\` @m@ in effective way. -- An exponent @e@ must be non-negative, a modulo @m@ must be positive. -- Otherwise the behaviour of @powMod@ is undefined. -- -- >>> powMod 2 3 5 -- 3 -- >>> powMod 3 12345678901234567890 1001 -- 1 -- -- See also 'Math.NumberTheory.Moduli.Class.powMod' and 'Math.NumberTheory.Moduli.Class.powSomeMod'. -- -- For finite numeric types ('Int', 'Word', etc.) -- modulo @m@ should be such that @m^2@ does not overflow, -- otherwise the behaviour is undefined. If you -- need both to fit into machine word and to handle large moduli, -- take a look at 'powModInt' and 'powModWord'. -- -- >>> powMod 3 101 (2^60-1 :: Integer) -- correct -- 1018105167100379328 -- >>> powMod 3 101 (2^60-1 :: Int) -- incorrect due to overflow -- 1115647832265427613 -- >>> powModInt 3 101 (2^60-1 :: Int) -- correct -- 1018105167100379328 powMod :: (Integral a, Integral b) => a -> b -> a -> a powMod x y m | m <= 0 = error "powModInt: non-positive modulo" | y < 0 = error "powModInt: negative exponent" | otherwise = f (x `rem` m) y 1 `mod` m where f _ 0 acc = acc f b e acc = f (b * b `rem` m) (e `quot` 2) (if odd e then b * acc `rem` m else acc) {-# INLINE [1] powMod #-} {-# RULES "powMod/Integer" powMod = powModInteger #-} -- Work around https://ghc.haskell.org/trac/ghc/ticket/14085 powModInteger :: Integer -> Integer -> Integer -> Integer powModInteger b e m = GMP.powModInteger (b `mod` m) e m {-# RULES "powMod/Natural" powMod = powModNatural "powMod/Word" powMod = powModWord "powMod/Int" powMod = powModInt #-} -- | Specialised version of 'powMod', able to handle large moduli correctly. -- -- >>> powModWord 3 101 (2^60-1) -- 1018105167100379328 powModWord :: Word -> Word -> Word -> Word powModWord b e m = fromInteger $ GMP.powModInteger (toInteger b) (toInteger e) (toInteger m) -- | Specialised version of 'powMod', able to handle large moduli correctly. -- -- >>> powModInt 3 101 (2^60-1) -- 1018105167100379328 powModInt :: Int -> Int -> Int -> Int powModInt x y m | m <= 0 = error "powModInt: non-positive modulo" | y < 0 = error "powModInt: negative exponent" | otherwise = wordToInt $ powModWord (intToWord (x `mod` m)) (intToWord y) (intToWord m) arithmoi-0.12.1.0/Math/NumberTheory/Prefactored.hs0000644000000000000000000001237607346545000020055 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Prefactored -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Type for numbers, accompanied by their factorisation. -- {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} module Math.NumberTheory.Prefactored ( Prefactored(prefValue, prefFactors) , fromValue , fromFactors ) where import Prelude hiding ((^), gcd) import Control.Arrow import Data.Euclidean import Data.Semigroup import Data.Semiring (Semiring(..), Mul(..), (^)) import qualified Data.Semiring as Semiring import Unsafe.Coerce import Math.NumberTheory.Euclidean.Coprimes import Math.NumberTheory.Primes import Math.NumberTheory.Primes.Types -- | A container for a number and its pairwise coprime (but not necessarily prime) -- factorisation. -- It is designed to preserve information about factors under multiplication. -- One can use this representation to speed up prime factorisation -- and computation of arithmetic functions. -- -- For instance, let @p@ and @q@ be big primes: -- -- >>> let p = 1000000000000000000000000000057 :: Integer -- >>> let q = 2000000000000000000000000000071 :: Integer -- -- 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 = 1000000000000000000000000000057 :: Prefactored Integer -- >>> let q = 2000000000000000000000000000071 :: Prefactored Integer -- -- 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) -- 2133305798262843681544648472180210822742702690942899511234131900112583590230336435053688694839034890779375223070157301188739881477320529552945446912000 -- -- Let us look under the hood: -- -- >>> import Math.NumberTheory.ArithmeticFunctions -- >>> prefFactors $ totient (p^2 * q^3) -- Coprimes {unCoprimes = [(1000000000000000000000000000057,1),(41666666666666666666666666669,1),(2000000000000000000000000000071,2),(111111111111111111111111111115,1),(2,4),(3,3)]} -- >>> prefFactors $ totient $ totient (p^2 * q^3) -- Coprimes {unCoprimes = [(39521,1),(227098769,1),(22222222222222222222222222223,1),(2000000000000000000000000000071,1),(361696272343,1),(85331809838489,1),(6046667,1),(199937,1),(5,3),(41666666666666666666666666669,1),(2,22),(3,8)]} -- -- Pairwise coprimality of factors is crucial, because it allows -- us to process them independently, possibly even -- in parallel or concurrent fashion. -- -- Following invariant is guaranteed to hold: -- -- > abs (prefValue x) = abs (product (map (uncurry (^)) (prefFactors x))) data Prefactored a = Prefactored { prefValue :: a -- ^ Number itself. , prefFactors :: Coprimes a Word -- ^ List of pairwise coprime (but not necessarily prime) factors, -- accompanied by their multiplicities. } deriving (Eq, Show) -- | Create 'Prefactored' from a given number. -- -- >>> fromValue 123 -- Prefactored {prefValue = 123, prefFactors = Coprimes {unCoprimes = [(123,1)]}} fromValue :: (Eq a, GcdDomain a) => a -> Prefactored a fromValue a = Prefactored a (singleton a 1) -- | Create 'Prefactored' from a given list of pairwise coprime -- (but not necessarily prime) factors with multiplicities. -- -- >>> fromFactors (splitIntoCoprimes [(140, 1), (165, 1)]) -- Prefactored {prefValue = 23100, prefFactors = Coprimes {unCoprimes = [(28,1),(33,1),(5,2)]}} -- >>> fromFactors (splitIntoCoprimes [(140, 2), (165, 3)]) -- Prefactored {prefValue = 88045650000, prefFactors = Coprimes {unCoprimes = [(28,2),(33,3),(5,5)]}} fromFactors :: Semiring a => Coprimes a Word -> Prefactored a fromFactors as = Prefactored (getMul $ foldMap (\(a, k) -> Mul $ a ^ k) (unCoprimes as)) as instance (Eq a, GcdDomain a) => Semiring (Prefactored a) where Prefactored v1 _ `plus` Prefactored v2 _ = fromValue (v1 `plus` v2) Prefactored v1 f1 `times` Prefactored v2 f2 = Prefactored (v1 `times` v2) (f1 <> f2) fromNatural n = fromValue (fromNatural n) instance (Eq a, Num a, GcdDomain a) => Num (Prefactored a) where Prefactored v1 _ + Prefactored v2 _ = fromValue (v1 + v2) Prefactored v1 _ - Prefactored v2 _ = fromValue (v1 - v2) Prefactored v1 f1 * Prefactored v2 f2 = Prefactored (v1 * v2) (f1 <> f2) negate (Prefactored v f) = Prefactored (negate v) f abs (Prefactored v f) = Prefactored (abs v) f signum (Prefactored v _) = Prefactored (signum v) mempty fromInteger n = fromValue (fromInteger n) instance (Eq a, GcdDomain a, UniqueFactorisation a) => UniqueFactorisation (Prefactored a) where factorise (Prefactored _ f) = concatMap (\(x, xm) -> map (\(p, k) -> (Prime $ fromValue $ unPrime p, k * xm)) (factorise x)) (unCoprimes f) isPrime (Prefactored _ f) = case unCoprimes f of [(n, 1)] -> Prime . fromValue . unPrime <$> isPrime n _ -> Nothing arithmoi-0.12.1.0/Math/NumberTheory/Primes.hs0000644000000000000000000002372207346545000017053 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes -- Copyright: (c) 2016-2018 Andrew.Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Math.NumberTheory.Primes ( Prime , unPrime , toPrimeIntegral , nextPrime , precPrime , UniqueFactorisation(..) , factorBack , -- * Old interface primes ) where import Data.Bits import Data.Coerce import Data.Maybe import Data.Word import Numeric.Natural import Math.NumberTheory.Primes.Counting (nthPrime, primeCount) import qualified Math.NumberTheory.Primes.Factorisation.Montgomery as F (factorise) import qualified Math.NumberTheory.Primes.Testing.Probabilistic as T (isPrime) import Math.NumberTheory.Primes.Sieve.Eratosthenes (primes, sieveRange, primeList, psieveFrom, primeSieve) import Math.NumberTheory.Primes.Small import Math.NumberTheory.Primes.Types import Math.NumberTheory.Utils (toWheel30, fromWheel30) import Math.NumberTheory.Utils.FromIntegral -- | 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 = coerce . F.factorise isPrime n = if T.isPrime (toInteger n) then Just (Prime $ abs n) else Nothing instance UniqueFactorisation Word where factorise = coerce . F.factorise 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 = coerce . F.factorise isPrime n = if T.isPrime (toInteger n) then Just (Prime n) else Nothing -- | Restore a number from its factorisation. factorBack :: Num a => [(Prime a, Word)] -> a factorBack = product . map (\(p, k) -> unPrime p ^ k) -- | Smallest prime, greater or equal to argument. -- -- > nextPrime (-100) == 2 -- > 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 . 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 . 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 . 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' smallPrimesLimit :: Integral a => a smallPrimesLimit = fromIntegral (maxBound :: Word16) enumFromToGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> [Prime a] enumFromToGeneric p@(Prime p') q@(Prime q') | p' <= smallPrimesLimit, q' <= smallPrimesLimit = map (Prime . fromIntegral) $ smallPrimesFromTo (fromIntegral p') (fromIntegral q') | p' <= smallPrimesLimit = map (Prime . fromIntegral) (smallPrimesFromTo (fromIntegral p') smallPrimesLimit) ++ enumFromToGeneric' (nextPrime smallPrimesLimit) q | otherwise = enumFromToGeneric' p q enumFromToGeneric' :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> [Prime a] enumFromToGeneric' p@(Prime p') q@(Prime q') = takeWhile (<= q) $ dropWhile (< p) $ case chooseAlgorithm p' q' of IsPrime -> Prime 2 : Prime 3 : Prime 5 : mapMaybe (isPrime . 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') `rem` delta == 0) $ enumFromGeneric p where delta = q' - p' EQ -> repeat p GT -> filter (\(Prime r') -> (p' - r') `rem` delta == 0) $ reverse $ enumFromToGeneric (Prime 2) p where delta = p' - q' enumFromThenToGeneric :: (Bits a, Integral a, UniqueFactorisation a) => Prime a -> Prime a -> Prime a -> [Prime a] enumFromThenToGeneric p@(Prime p') (Prime q') r@(Prime r') = case p' `compare` q' of LT -> filter (\(Prime t') -> (t' - p') `rem` delta == 0) $ enumFromToGeneric p r where delta = q' - p' EQ -> if p' <= r' then repeat p else [] GT -> filter (\(Prime t') -> (p' - t') `rem` delta == 0) $ reverse $ enumFromToGeneric r p where delta = p' - q' instance Enum (Prime Integer) where toEnum = nthPrime 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 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 n fromEnum = integerToInt . primeCount . intToInteger . unPrime succ = succGenericBounded pred = predGeneric enumFrom = enumFromGeneric enumFromTo = enumFromToGeneric enumFromThen = enumFromThenGeneric enumFromThenTo = enumFromThenToGeneric instance Bounded (Prime Int) where minBound = Prime 2 maxBound = precPrime maxBound instance Enum (Prime Word) where toEnum n = if p > wordToInteger maxBound then error $ "Enum.toEnum{Prime}: " ++ show n ++ "th prime = " ++ show p ++ " is out of bounds of Word" else Prime (integerToWord p) where Prime p = nthPrime n fromEnum = integerToInt . primeCount . wordToInteger . unPrime succ = succGenericBounded pred = predGeneric enumFrom = enumFromGeneric enumFromTo = enumFromToGeneric enumFromThen = enumFromThenGeneric enumFromThenTo = enumFromThenToGeneric instance Bounded (Prime Word) where minBound = Prime 2 maxBound = precPrime maxBound arithmoi-0.12.1.0/Math/NumberTheory/Primes/0000755000000000000000000000000007346545000016511 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Primes/Counting.hs0000644000000000000000000000127507346545000020640 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Counting -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Number of primes not exceeding @n@, @π(n)@, and @n@-th prime; also fast, but -- reasonably accurate approximations to these. module Math.NumberTheory.Primes.Counting ( -- * Exact functions primeCount , primeCountMaxArg , nthPrime -- * Approximations , approxPrimeCount , approxPrimeCountOverestimateLimit , nthPrimeApprox , nthPrimeApproxUnderestimateLimit ) where import Math.NumberTheory.Primes.Counting.Impl import Math.NumberTheory.Primes.Counting.Approximate arithmoi-0.12.1.0/Math/NumberTheory/Primes/Counting/0000755000000000000000000000000007346545000020277 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Primes/Counting/Approximate.hs0000644000000000000000000000447507346545000023136 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Counting.Approximate -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Approximations to the number of primes below a limit and the -- n-th prime. -- module Math.NumberTheory.Primes.Counting.Approximate ( approxPrimeCount , approxPrimeCountOverestimateLimit , nthPrimeApprox , nthPrimeApproxUnderestimateLimit ) where -- For prime p = 3742914359 we have -- approxPrimeCount p = 178317879 -- primeCount p = 178317880 -- | Following property holds: -- -- > approxPrimeCount n >= primeCount n || n >= approxPrimeCountOverestimateLimit approxPrimeCountOverestimateLimit :: Integral a => a approxPrimeCountOverestimateLimit = 3742914359 -- | @'approxPrimeCount' n@ gives an -- approximation of the number of primes not exceeding -- @n@. The approximation is fairly good for @n@ large enough. approxPrimeCount :: Integral a => a -> a approxPrimeCount = truncate . max 0 . appi . fromIntegral -- | Following property holds: -- -- > nthPrimeApprox n <= nthPrime n || n >= nthPrimeApproxUnderestimateLimit nthPrimeApproxUnderestimateLimit :: Integer nthPrimeApproxUnderestimateLimit = 1000000000000 -- | @'nthPrimeApprox' n@ gives an -- approximation to the n-th prime. The approximation -- is fairly good for @n@ large enough. nthPrimeApprox :: Integer -> Integer nthPrimeApprox = max 1 . truncate . nthApp . fromIntegral . max 3 -- Basically the approximation of the prime count by Li(x), -- adjusted to give close but slightly too high estimates -- in the interesting range. The constants are empirically -- determined. appi :: Double -> Double appi x = y - y/300000 + 7*ll where y = x*l*(1+l*(1+l*h)) w = log x l = 1/w ll = log w h | x < 10000000 = 2.5625 | x < 50000000 = 2.5 | x < 120000000 = 617/256 | otherwise = 2.0625 + l*(3+ll*l*(13.25+ll*l*57.75)) -- Basically an approximation to the inverse of Li(x), with -- empirically determined constants to get close results -- in the interesting range. nthApp :: Double -> Double nthApp x = a where l = log x ll = log l li = 1/l l2 = ll*ll a = x*(l+ll-1+li*(ll-2-li*(ll*(0.3+li*(1+0.02970812*l2*l2*l2*li)) + 8.725*(ll-2.749)*(ll-3.892)*li))) + l*ll + 35 arithmoi-0.12.1.0/Math/NumberTheory/Primes/Counting/Impl.hs0000644000000000000000000004324307346545000021542 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Counting.Impl -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Number of primes not exceeding @n@, @π(n)@, and @n@-th prime. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fspec-constr-count=24 #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Math.NumberTheory.Primes.Counting.Impl ( primeCount , primeCountMaxArg , nthPrime ) where import Math.NumberTheory.Primes.Sieve.Eratosthenes (PrimeSieve(..), primeList, primeSieve, psieveFrom, sieveTo, sieveBits, sieveRange) import Math.NumberTheory.Primes.Sieve.Indexing (toPrim, idxPr) import Math.NumberTheory.Primes.Counting.Approximate (nthPrimeApprox, approxPrimeCount) import Math.NumberTheory.Primes.Types import Math.NumberTheory.Roots import Math.NumberTheory.Utils.FromIntegral import Control.Monad.ST import Data.Array.Base import Data.Array.ST import Data.Bits import Data.Int import Unsafe.Coerce -- | Maximal allowed argument of 'primeCount'. Currently 8e18. primeCountMaxArg :: Integer primeCountMaxArg = 8000000000000000000 -- | @'primeCount' n == π(n)@ is the number of (positive) primes not exceeding @n@. -- -- For efficiency, the calculations are done on 64-bit signed integers, therefore @n@ must -- not exceed 'primeCountMaxArg'. -- -- Requires @/O/(n^0.5)@ space, the time complexity is roughly @/O/(n^0.7)@. -- For small bounds, @'primeCount' n@ simply counts the primes not exceeding @n@, -- for bounds from @30000@ on, Meissel's algorithm is used in the improved form due to -- D.H. Lehmer, cf. -- . primeCount :: Integer -> Integer primeCount n | n > primeCountMaxArg = error $ "primeCount: can't handle bound " ++ show n | n < 2 = 0 | n < 1000 = intToInteger . length . takeWhile (<= n) . map unPrime . primeList . primeSieve $ max 242 n | n < 30000 = runST $ do ba <- sieveTo n (s,e) <- getBounds ba ct <- countFromTo s e ba return (intToInteger $ ct+3) | otherwise = let !ub = cop $ fromInteger n !sr = integerSquareRoot ub !cr = nxtEnd $ integerCubeRoot ub + 15 nxtEnd k = k - (k `rem` 30) + 31 !phn1 = calc ub cr !cs = cr+6 !pdf = sieveCount ub cs sr in phn1 - pdf -- | @'nthPrime' n@ calculates the @n@-th prime. Numbering of primes is -- @1@-based, so @'nthPrime' 1 == 2@. -- -- Requires @/O/((n*log n)^0.5)@ space, the time complexity is roughly @/O/((n*log n)^0.7@. -- The argument must be strictly positive. nthPrime :: Int -> Prime Integer nthPrime 1 = Prime 2 nthPrime 2 = Prime 3 nthPrime 3 = Prime 5 nthPrime 4 = Prime 7 nthPrime 5 = Prime 11 nthPrime 6 = Prime 13 nthPrime n | n < 1 = error "Prime indexing starts at 1" | n < 200000 = Prime $ countToNth (n - 3) [primeSieve (p0 + p0 `quot` 32 + 37)] | p0 > toInteger (maxBound :: Int) = error $ "nthPrime: index " ++ show n ++ " is too large to handle" | miss > 0 = Prime $ tooLow n (fromInteger p0) miss | otherwise = Prime $ tooHigh n (fromInteger p0) (negate miss) where p0 = nthPrimeApprox (toInteger n) miss = n - fromInteger (primeCount p0) -------------------------------------------------------------------------------- -- The Works -- -------------------------------------------------------------------------------- -- TODO: do something better in case we guess too high. -- Not too pressing, since I think a) nthPrimeApprox always underestimates -- in the range we can handle, and b) it's always "goodEnough" tooLow :: Int -> Int -> Int -> Integer tooLow n p0 shortage | p1 > toInteger (maxBound :: Int) = error $ "nthPrime: index " ++ show n ++ " is too large to handle" | goodEnough = lowSieve p0 shortage | c1 < n = lowSieve (fromInteger p1) (n-c1) | otherwise = lowSieve p0 shortage -- a third count wouldn't make it faster, I think where gap = truncate (log (intToDouble p0 :: Double)) est = toInteger shortage * gap p1 = toInteger p0 + est goodEnough = 3*est*est*est < 2*p1*p1 -- a second counting would be more work than sieving c1 = fromInteger (primeCount p1) tooHigh :: Int -> Int -> Int -> Integer tooHigh n p0 surplus | c < n = lowSieve b (n-c) | otherwise = tooHigh n b (c-n) where gap = truncate (log (intToDouble p0 :: Double)) b = p0 - (surplus * gap * 11) `quot` 10 c = fromInteger (primeCount (toInteger b)) lowSieve :: Int -> Int -> Integer lowSieve a miss = countToNth (miss+rep) psieves where strt = a + 1 + (a .&. 1) psieves@(PS vO ba:_) = psieveFrom (toInteger strt) rep | o0 < 0 = 0 | otherwise = sum [1 | i <- [0 .. r2], ba `unsafeAt` i] where o0 = toInteger strt - vO - 9 -- (strt - 2) - v0 - 7 r0 = fromInteger o0 `rem` 30 r1 = r0 `quot` 3 r2 = min 7 (if r1 > 5 then r1-1 else r1) -- highSieve :: Integer -> Integer -> Integer -> Integer -- highSieve a surp gap = error "Oh shit" sieveCount :: Int64 -> Int64 -> Int64 -> Integer sieveCount ub cr sr = runST (sieveCountST ub cr sr) sieveCountST :: forall s. Int64 -> Int64 -> Int64 -> ST s Integer sieveCountST ub cr sr = do let psieves = psieveFrom (int64ToInteger cr) pisr = approxPrimeCount sr picr = approxPrimeCount cr diff = pisr - picr size = int64ToInt (diff + diff `quot` 50) + 30 store <- unsafeNewArray_ (0,size-1) :: ST s (STUArray s Int Int64) let feed :: Int64 -> Int -> Int -> UArray Int Bool -> [PrimeSieve] -> ST s Integer feed voff !wi !ri uar sves | ri == sieveBits = case sves of (PS vO ba : more) -> feed (fromInteger vO) wi 0 ba more _ -> error "prime stream ended prematurely" | pval > sr = do stu <- unsafeThaw uar eat 0 0 voff (wi-1) ri stu sves | uar `unsafeAt` ri = do unsafeWrite store wi (ub `quot` pval) feed voff (wi+1) (ri+1) uar sves | otherwise = feed voff wi (ri+1) uar sves where pval = voff + toPrim ri eat :: Integer -> Integer -> Int64 -> Int -> Int -> STUArray s Int Bool -> [PrimeSieve] -> ST s Integer eat !acc !btw voff !wi !si stu sves | si == sieveBits = case sves of [] -> error "Premature end of prime stream" (PS vO ba : more) -> do nstu <- unsafeThaw ba eat acc btw (fromInteger vO) wi 0 nstu more | wi < 0 = return acc | otherwise = do qb <- unsafeRead store wi let dist = qb - voff - 7 if dist < intToInt64 sieveRange then do let (b,j) = idxPr (dist+7) !li = (b `shiftL` 3) .|. j new <- if li < si then return 0 else countFromTo si li stu let nbtw = btw + intToInteger new + 1 eat (acc+nbtw) nbtw voff (wi-1) (li+1) stu sves else do let (cpl,fds) = dist `quotRem` intToInt64 sieveRange (b,j) = idxPr (fds+7) !li = (b `shiftL` 3) .|. j ctLoop !lac 0 (PS vO ba : more) = do nstu <- unsafeThaw ba new <- countFromTo 0 li nstu let nbtw = btw + lac + 1 + intToInteger new eat (acc+nbtw) nbtw (integerToInt64 vO) (wi-1) (li+1) nstu more ctLoop lac s (ps : more) = do let !new = countAll ps ctLoop (lac + intToInteger new) (s-1) more ctLoop _ _ [] = error "Primes ended" new <- countFromTo si (sieveBits-1) stu ctLoop (intToInteger new) (cpl-1) sves case psieves of (PS vO ba : more) -> feed (fromInteger vO) 0 0 ba more _ -> error "No primes sieved" calc :: Int64 -> Int64 -> Integer calc lim plim = runST (calcST lim plim) calcST :: forall s. Int64 -> Int64 -> ST s Integer calcST lim plim = do !parr <- sieveTo (int64ToInteger plim) (plo,phi) <- getBounds parr !pct <- countFromTo plo phi parr !ar1 <- unsafeNewArray_ (0,end-1) unsafeWrite ar1 0 lim unsafeWrite ar1 1 1 !ar2 <- unsafeNewArray_ (0,end-1) let go :: Int -> Int -> STUArray s Int Int64 -> STUArray s Int Int64 -> ST s Integer go cap pix old new | pix == 2 = coll cap old | otherwise = do isp <- unsafeRead parr pix if isp then do let !n = fromInteger (toPrim pix) !ncap <- treat cap n old new go ncap (pix-1) new old else go cap (pix-1) old new coll :: Int -> STUArray s Int Int64 -> ST s Integer coll stop ar = let cgo !acc i | i < stop = do !k <- unsafeRead ar i !v <- unsafeRead ar (i+1) cgo (acc + int64ToInteger v*cp6 k) (i+2) | otherwise = return (acc+intToInteger pct+2) in cgo 0 0 go 2 start ar1 ar2 where (bt,ri) = idxPr plim !start = 8*bt + ri !size = int64ToInt $ integerSquareRoot lim `quot` 4 !end = 2*size treat :: Int -> Int64 -> STUArray s Int Int64 -> STUArray s Int Int64 -> ST s Int treat end n old new = do qi0 <- locate n 0 (end `quot` 2 - 1) old let collect stop !acc ix | ix < end = do !k <- unsafeRead old ix if k < stop then do v <- unsafeRead old (ix+1) collect stop (acc-v) (ix+2) else return (acc,ix) | otherwise = return (acc,ix) goTreat !wi !ci qi | qi < end = do !key <- unsafeRead old qi !val <- unsafeRead old (qi+1) let !q0 = key `quot` n !r0 = int64ToInt (q0 `rem` 30030) !nkey = q0 - int8ToInt64 (cpDfAr `unsafeAt` r0) nk0 = q0 + int8ToInt64 (cpGpAr `unsafeAt` (r0+1) + 1) !nlim = n*nk0 (wi1,ci1) <- copyTo end nkey old ci new wi ckey <- unsafeRead old ci1 (!acc, !ci2) <- if ckey == nkey then do !ov <- unsafeRead old (ci1+1) return (ov-val,ci1+2) else return (-val,ci1) (!tot, !nqi) <- collect nlim acc (qi+2) unsafeWrite new wi1 nkey unsafeWrite new (wi1+1) tot goTreat (wi1+2) ci2 nqi | otherwise = copyRem end old ci new wi goTreat 0 0 qi0 -------------------------------------------------------------------------------- -- Auxiliaries -- -------------------------------------------------------------------------------- locate :: Int64 -> Int -> Int -> STUArray s Int Int64 -> ST s Int locate p low high arr = do let go lo hi | lo < hi = do let !md = (lo+hi) `quot` 2 v <- unsafeRead arr (2*md) case compare p v of LT -> go lo md EQ -> return (2*md) GT -> go (md+1) hi | otherwise = return (2*lo) go low high {-# INLINE copyTo #-} copyTo :: Int -> Int64 -> STUArray s Int Int64 -> Int -> STUArray s Int Int64 -> Int -> ST s (Int,Int) copyTo end lim old oi new ni = do let go ri wi | ri < end = do ok <- unsafeRead old ri if ok < lim then do !ov <- unsafeRead old (ri+1) unsafeWrite new wi ok unsafeWrite new (wi+1) ov go (ri+2) (wi+2) else return (wi,ri) | otherwise = return (wi,ri) go oi ni {-# INLINE copyRem #-} copyRem :: Int -> STUArray s Int Int64 -> Int -> STUArray s Int Int64 -> Int -> ST s Int copyRem end old oi new ni = do let go ri wi | ri < end = do unsafeRead old ri >>= unsafeWrite new wi go (ri+1) (wi+1) | otherwise = return wi go oi ni {-# INLINE cp6 #-} cp6 :: Int64 -> Integer cp6 k = case k `quotRem` 30030 of (q,r) -> 5760*int64ToInteger q + int16ToInteger (cpCtAr `unsafeAt` int64ToInt r) cop :: Int64 -> Int64 cop m = m - int8ToInt64 (cpDfAr `unsafeAt` int64ToInt (m `rem` 30030)) -------------------------------------------------------------------------------- -- Ugly helper arrays -- -------------------------------------------------------------------------------- cpCtAr :: UArray Int Int16 cpCtAr = runSTUArray $ do ar <- newArray (0,30029) 1 let zilch s i | i < 30030 = unsafeWrite ar i 0 >> zilch s (i+s) | otherwise = return () accumulate ct i | i < 30030 = do v <- unsafeRead ar i let !ct' = ct+v unsafeWrite ar i ct' accumulate ct' (i+1) | otherwise = return ar zilch 2 0 zilch 6 3 zilch 10 5 zilch 14 7 zilch 22 11 zilch 26 13 accumulate 1 2 cpDfAr :: UArray Int Int8 cpDfAr = runSTUArray $ do ar <- newArray (0,30029) 0 let note s i | i < 30029 = unsafeWrite ar i 1 >> note s (i+s) | otherwise = return () accumulate d i | i < 30029 = do v <- unsafeRead ar i if v == 0 then accumulate 2 (i+2) else do unsafeWrite ar i d accumulate (d+1) (i+1) | otherwise = return ar note 2 0 note 6 3 note 10 5 note 14 7 note 22 11 note 26 13 accumulate 2 3 cpGpAr :: UArray Int Int8 cpGpAr = runSTUArray $ do ar <- newArray (0,30030) 0 unsafeWrite ar 30030 1 let note s i | i < 30029 = unsafeWrite ar i 1 >> note s (i+s) | otherwise = return () accumulate d i | i < 1 = return ar | otherwise = do v <- unsafeRead ar i if v == 0 then accumulate 2 (i-2) else do unsafeWrite ar i d accumulate (d+1) (i-1) note 2 0 note 6 3 note 10 5 note 14 7 note 22 11 note 26 13 accumulate 2 30027 ------------------------------------------------------------------------------- -- Prime counting rMASK :: Int rMASK = finiteBitSize (0 :: Word) - 1 wSHFT :: (Bits a, Num a) => a wSHFT = if finiteBitSize (0 :: Word) == 64 then 6 else 5 tOPB :: Int tOPB = finiteBitSize (0 :: Word) `shiftR` 1 tOPM :: (Bits a, Num a) => a tOPM = (1 `shiftL` tOPB) - 1 -- find the n-th set bit in a list of PrimeSieves, -- aka find the (n+3)-rd prime countToNth :: Int -> [PrimeSieve] -> Integer countToNth !_ [] = error "countToNth: Prime stream ended prematurely" countToNth !n (PS v0 bs : more) = go n 0 where wa :: UArray Int Word wa = unsafeCoerce bs go !k i | i == snd (bounds wa) = countToNth k more | otherwise = let w = unsafeAt wa i bc = popCount w in if bc < k then go (k-bc) (i+1) else let j = bc - k px = top w j bc in v0 + toPrim (px + (i `shiftL` wSHFT)) -- count all set bits in a chunk, do it wordwise for speed. countAll :: PrimeSieve -> Int countAll (PS _ bs) = go 0 0 where wa :: UArray Int Word wa = unsafeCoerce bs go !ct i | i == snd (bounds wa) = ct | otherwise = go (ct + popCount (unsafeAt wa i)) (i+1) -- Find the j-th highest of bc set bits in the Word w. top :: Word -> Int -> Int -> Int top w j bc = go 0 tOPB tOPM bn w where !bn = bc-j go !_ _ !_ !_ 0 = error "Too few bits set" go bs 0 _ _ wd = if wd .&. 1 == 0 then error "Too few bits, shift 0" else bs go bs a msk ix wd = case popCount (wd .&. msk) of lc | lc < ix -> go (bs+a) a msk (ix-lc) (wd `unsafeShiftR` a) | otherwise -> let !na = a `shiftR` 1 in go bs na (msk `unsafeShiftR` na) ix wd -- count set bits between two indices (inclusive) -- start and end must both be valid indices and start <= end countFromTo :: Int -> Int -> STUArray s Int Bool -> ST s Int countFromTo start end ba = do wa <- (castSTUArray :: STUArray s Int Bool -> ST s (STUArray s Int Word)) ba let !sb = start `shiftR` wSHFT !si = start .&. rMASK !eb = end `shiftR` wSHFT !ei = end .&. rMASK count !acc i | i == eb = do w <- unsafeRead wa i return (acc + popCount (w `shiftL` (rMASK - ei))) | otherwise = do w <- unsafeRead wa i count (acc + popCount w) (i+1) if sb < eb then do w <- unsafeRead wa sb count (popCount (w `shiftR` si)) (sb+1) else do w <- unsafeRead wa sb let !w1 = w `shiftR` si return (popCount (w1 `shiftL` (rMASK - ei + si))) arithmoi-0.12.1.0/Math/NumberTheory/Primes/Factorisation/0000755000000000000000000000000007346545000021316 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Primes/Factorisation/Montgomery.hs0000644000000000000000000004340307346545000024016 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Factorisation.Montgomery -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Factorisation of 'Integer's by the elliptic curve algorithm after Montgomery. -- The algorithm is explained at -- -- and -- -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Primes.Factorisation.Montgomery ( -- * Complete factorisation functions -- ** Functions with input checking factorise -- -- * Partial factorisation , smallFactors -- -- ** Single curve worker , montgomeryFactorisation , findParms ) where import Control.Arrow import Control.Monad.Trans.State.Lazy import Data.Array.Base (bounds, unsafeAt) import Data.Bits import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.List (foldl') import Data.Maybe import Data.Mod import Data.Proxy #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Data.Traversable import GHC.Exts import GHC.Integer.GMP.Internals hiding (integerToInt, wordToInteger) import GHC.Natural import GHC.TypeNats (KnownNat, SomeNat(..), natVal, someNatVal) import System.Random import Math.NumberTheory.Curves.Montgomery import Math.NumberTheory.Euclidean.Coprimes (splitIntoCoprimes, unCoprimes) import Math.NumberTheory.Logarithms (integerLogBase') import Math.NumberTheory.Roots import Math.NumberTheory.Primes.Sieve.Eratosthenes (PrimeSieve(..), psieveFrom) import Math.NumberTheory.Primes.Sieve.Indexing (toPrim) import Math.NumberTheory.Primes.Small import Math.NumberTheory.Primes.Testing.Probabilistic import Math.NumberTheory.Utils hiding (splitOff) import Math.NumberTheory.Utils.FromIntegral -- | @'factorise' n@ produces the prime factorisation of @n@. @'factorise' 0@ is -- an error and the factorisation of @1@ is empty. Uses a 'StdGen' produced in -- an arbitrary manner from the bit-pattern of @n@. -- -- __Warning:__ there are no guarantees of any particular -- order of prime factors, do not expect them to be ascending. factorise :: Integral a => a -> [(a, Word)] factorise 0 = error "0 has no prime factorisation" factorise n' = map (first fromIntegral) sfs <> map (first fromInteger) rest where n = abs n' (sfs, mb) = smallFactors (fromIntegral' n) sg = mkStdGen (fromIntegral n `xor` 0xdeadbeef) rest = case mb of Nothing -> [] Just m -> stdGenFactorisation (Just $ 65536 * 65536) sg Nothing (toInteger m) ---------------------------------------------------------------------------------------------------- -- Factorisation wrappers -- ---------------------------------------------------------------------------------------------------- -- | A wrapper around 'curveFactorisation' providing a few default arguments. -- 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, Word)] -- ^ List of prime factors and exponents stdGenFactorisation primeBound = curveFactorisation primeBound bailliePSW (\m -> randomR (6, m - 2)) -- | 'curveFactorisation' is the driver for the factorisation. Its performance (and success) -- can be influenced by passing appropriate arguments. If you know that @n@ has no prime divisors -- below @b@, any divisor found less than @b*b@ must be prime, thus giving @Just (b*b)@ as the -- first argument allows skipping the comparatively expensive primality test for those. -- If @n@ is such that all prime divisors must have a specific easy to test for structure, a -- custom primality test can improve the performance (normally, it will make very little -- difference, since @n@ has not many divisors, and many curves have to be tried to find one). -- More influence has the pseudo random generator (a function @prng@ with @6 <= fst (prng k s) <= k-2@ -- and an initial state for the PRNG) used to generate the curves to try. A lucky choice here can -- make a huge difference. So, if the default takes too long, try another one; or you can improve your -- chances for a quick result by running several instances in parallel. -- -- 'curveFactorisation' @n@ requires that small (< 65536) prime factors of @n@ -- have been stripped before. Otherwise it is likely to cycle forever. -- -- 'curveFactorisation' is unlikely to succeed if @n@ has more than one (really) large prime factor. -- curveFactorisation :: forall g. Maybe Integer -- ^ Lower bound for composite divisors -> (Integer -> Bool) -- ^ A primality test -> (Integer -> g -> (Integer, g)) -- ^ A PRNG -> g -- ^ Initial PRNG state -> Maybe Int -- ^ Estimated number of digits of the smallest prime factor -> Integer -- ^ The number to factorise -> [(Integer, Word)] -- ^ List of prime factors and exponents curveFactorisation primeBound primeTest prng seed mbdigs n | n == 1 = [] | ptest n = [(n, 1)] | otherwise = evalState (fact n digits) seed where digits :: Int digits = fromMaybe 8 mbdigs ptest :: Integer -> Bool ptest = maybe primeTest (\bd k -> k <= bd || primeTest k) primeBound rndR :: Integer -> State g Integer rndR k = state (prng k) perfPw :: Integer -> (Integer, Word) perfPw = maybe highestPower (largePFPower . integerSquareRoot) primeBound fact :: Integer -> Int -> State g [(Integer, Word)] fact 1 _ = return mempty fact m digs = do let (b1, b2, ct) = findParms digs -- All factors (both @pfs@ and @cfs@), are pairwise coprime. This is -- because 'repFact' returns either a single factor, or output of 'workFact'. -- In its turn, 'workFact' returns either a single factor, -- or concats 'repFact's over coprime integers. Induction completes the proof. Factors pfs cfs <- repFact m b1 b2 ct case cfs of [] -> return pfs _ -> do nfs <- forM cfs $ \(k, j) -> map (second (* j)) <$> fact k (if null pfs then digs + 5 else digs) return $ mconcat (pfs : nfs) repFact :: Integer -> Word -> Word -> Word -> State g Factors repFact 1 _ _ _ = return mempty repFact m b1 b2 count = case perfPw m of (_, 1) -> workFact m b1 b2 count (b, e) | ptest b -> return $ singlePrimeFactor b e | otherwise -> modifyPowers (* e) <$> workFact b b1 b2 count workFact :: Integer -> Word -> Word -> Word -> State g Factors workFact 1 _ _ _ = return mempty workFact m _ _ 0 = return $ singleCompositeFactor m 1 workFact m b1 b2 count = do s <- rndR m case someNatVal (fromInteger m) of SomeNat (_ :: Proxy t) -> case montgomeryFactorisation b1 b2 (fromInteger s :: Mod t) of Nothing -> workFact m b1 b2 (count - 1) Just d -> do let cs = unCoprimes $ splitIntoCoprimes [(d, 1), (m `quot` d, 1)] -- Since all @cs@ are coprime, we can factor each of -- them and just concat results, without summing up -- powers of the same primes in different elements. fmap mconcat $ forM cs $ \(x, xm) -> if ptest x then pure $ singlePrimeFactor x xm else fmap (modifyPowers (* xm)) (repFact x b1 b2 (count - 1)) data Factors = Factors { _primeFactors :: [(Integer, Word)] , _compositeFactors :: [(Integer, Word)] } deriving (Show) singlePrimeFactor :: Integer -> Word -> Factors singlePrimeFactor a b = Factors [(a, b)] [] singleCompositeFactor :: Integer -> Word -> Factors singleCompositeFactor a b = Factors [] [(a, b)] instance Semigroup Factors where Factors pfs1 cfs1 <> Factors pfs2 cfs2 = Factors (pfs1 <> pfs2) (cfs1 <> cfs2) instance Monoid Factors where mempty = Factors [] [] mappend = (<>) modifyPowers :: (Word -> Word) -> Factors -> Factors modifyPowers f (Factors pfs cfs) = Factors (map (second f) pfs) (map (second f) cfs) ------------------------------------------------------------------------------- -- largePFPower -- | @'largePFPower' bd n@ produces the pair @(b,k)@ with the largest -- exponent @k@ such that @n == b^k@, where @bd > 1@ (it is expected -- that @bd@ is much larger, at least @1000@ or so), @n > bd^2@ and @n@ -- has no prime factors @p <= bd@, skipping the trial division phase -- of @'highestPower'@ when that is a priori known to be superfluous. -- It is only present to avoid duplication of work in factorisation -- and primality testing, it is not expected to be generally useful. -- The assumptions are not checked, if they are not satisfied, wrong -- results and wasted work may be the consequence. largePFPower :: Integer -> Integer -> (Integer, Word) largePFPower bd n = rawPower ln n where ln = intToWord (integerLogBase' (bd+1) n) rawPower :: Word -> Integer -> (Integer, Word) rawPower mx n = case exactRoot 4 n of Just r -> case rawPower (mx `quot` 4) r of (m,e) -> (m, 4*e) Nothing -> case exactSquareRoot n of Just r -> case rawOddPower (mx `quot` 2) r of (m,e) -> (m, 2*e) Nothing -> rawOddPower mx n rawOddPower :: Word -> Integer -> (Integer, Word) rawOddPower mx n | mx < 3 = (n,1) rawOddPower mx n = case exactCubeRoot n of Just r -> case rawOddPower (mx `quot` 3) r of (m,e) -> (m, 3*e) Nothing -> badPower mx n badPower :: Word -> Integer -> (Integer, Word) badPower mx n | mx < 5 = (n,1) | otherwise = go 1 mx n (takeWhile (<= mx) $ scanl (+) 5 $ cycle [2,4]) where go !e b m (k:ks) | b < k = (m,e) | otherwise = case exactRoot k m of Just r -> go (e*k) (b `quot` k) r (k:ks) Nothing -> go e b m ks go e _ m [] = (m,e) ---------------------------------------------------------------------------------------------------- -- The workhorse -- ---------------------------------------------------------------------------------------------------- -- | @'montgomeryFactorisation' n b1 b2 s@ tries to find a factor of @n@ using the -- curve and point determined by the seed @s@ (@6 <= s < n-1@), multiplying the -- point by the least common multiple of all numbers @<= b1@ and all primes -- between @b1@ and @b2@. The idea is that there's a good chance that the order -- of the point in the curve over one prime factor divides the multiplier, but the -- order over another factor doesn't, if @b1@ and @b2@ are appropriately chosen. -- If they are too small, none of the orders will probably divide the multiplier, -- if they are too large, all probably will, so they should be chosen to fit -- the expected size of the smallest factor. -- -- It is assumed that @n@ has no small prime factors. -- -- The result is maybe a nontrivial divisor of @n@. montgomeryFactorisation :: KnownNat n => Word -> Word -> Mod n -> Maybe Integer montgomeryFactorisation b1 b2 s = case newPoint (toInteger (unMod s)) n of Nothing -> Nothing Just (SomePoint p0) -> do -- Small step: for each prime p <= b1 -- multiply point 'p0' by the highest power p^k <= b1. let q = foldl (flip multiply) p0 smallPowers z = pointZ q case gcd n z of -- If small step did not succeed, perform a big step. 1 -> case gcd n (bigStep q b1 b2) of 1 -> Nothing g -> Just g g -> Just g where n = toInteger (natVal s) smallPowers = map findPower $ takeWhile (<= b1) (2 : 3 : 5 : list primeStore) findPower p = go p where go acc | acc <= b1 `quot` p = go (acc * p) | otherwise = acc -- | The implementation follows the algorithm at p. 6-7 -- of -- by K. Gaj, S. Kwon et al. bigStep :: (KnownNat a24, KnownNat n) => Point a24 n -> Word -> Word -> Integer bigStep q b1 b2 = rs where n = pointN q b0 = b1 - b1 `rem` wheel qks = zip [0..] $ map (`multiply` q) wheelCoprimes qs = enumAndMultiplyFromThenTo q b0 (b0 + wheel) b2 rs = foldl' (\ts (_cHi, p) -> foldl' (\us (_cLo, pq) -> us * (pointZ p * pointX pq - pointX p * pointZ pq) `rem` n ) ts qks) 1 qs wheel :: Word wheel = 210 wheelCoprimes :: [Word] wheelCoprimes = [ k | k <- [1 .. wheel `div` 2], k `gcd` wheel == 1 ] -- | Same as map (id *** flip multiply p) [from, thn .. to], -- but calculated in more efficient way. enumAndMultiplyFromThenTo :: (KnownNat a24, KnownNat n) => Point a24 n -> Word -> Word -> Word -> [(Word, Point a24 n)] enumAndMultiplyFromThenTo p from thn to = zip [from, thn .. to] progression where step = thn - from pFrom = multiply from p pThen = multiply thn p pStep = multiply step p progression = pFrom : pThen : zipWith (`add` pStep) progression (tail progression) -- primes, compactly stored as a bit sieve primeStore :: [PrimeSieve] primeStore = psieveFrom 7 -- generate list of primes from arrays list :: [PrimeSieve] -> [Word] list sieves = concat [[off + toPrim i | i <- [0 .. li], unsafeAt bs i] | PS vO bs <- sieves, let { (_,li) = bounds bs; off = fromInteger vO; }] -- | @'smallFactors' n@ finds all prime divisors of @n > 1@ up to 2^16 by trial division and returns the -- list of these together with their multiplicities, and a possible remaining factor which may be composite. smallFactors :: Natural -> ([(Natural, Word)], Maybe Natural) smallFactors = \case NatS# 0## -> error "0 has no prime factorisation" NatS# n# -> case shiftToOddCount# n# of (# 0##, m# #) -> goWord m# 1 (# k#, m# #) -> (2, W# k#) <: goWord m# 1 NatJ# n -> case shiftToOddCountBigNat n of (0, m) -> goBigNat m 1 (k, m) -> (2, k) <: goBigNat m 1 where x <: ~(l,b) = (x:l,b) !(Ptr smallPrimesAddr#) = smallPrimesPtr goBigNat :: BigNat -> Int -> ([(Natural, Word)], Maybe Natural) goBigNat !m i@(I# i#) | isTrue# (sizeofBigNat# m ==# 1#) = goWord (bigNatToWord m) i | i >= smallPrimesLength = ([], Just (NatJ# m)) | otherwise = let p# = #if MIN_VERSION_base(4,16,0) word16ToWord# #endif (indexWord16OffAddr# smallPrimesAddr# i#) in case m `quotRemBigNatWord` p# of (# mp, 0## #) -> let (# k, r #) = splitOff 1 mp in (NatS# p#, k) <: goBigNat r (i + 1) where splitOff !k x = case x `quotRemBigNatWord` p# of (# xp, 0## #) -> splitOff (k + 1) xp _ -> (# k, x #) _ -> goBigNat m (i + 1) goWord :: Word# -> Int -> ([(Natural, Word)], Maybe Natural) goWord 1## !_ = ([], Nothing) goWord m# !i | i >= smallPrimesLength = if isTrue# (m# `leWord#` 4294967295##) -- 65536 * 65536 - 1 then ([(NatS# m#, 1)], Nothing) else ([], Just (NatS# m#)) goWord m# i@(I# i#) = let p# = #if MIN_VERSION_base(4,16,0) word16ToWord# #endif (indexWord16OffAddr# smallPrimesAddr# i#) in if isTrue# (m# `ltWord#` (p# `timesWord#` p#)) then ([(NatS# m#, 1)], Nothing) else case m# `quotRemWord#` p# of (# mp#, 0## #) -> let !(# k#, r# #) = splitOff 1## mp# in (NatS# p#, W# k#) <: goWord r# (i + 1) where splitOff k# x# = case x# `quotRemWord#` p# of (# xp#, 0## #) -> splitOff (k# `plusWord#` 1##) xp# _ -> (# k#, x# #) _ -> goWord m# (i + 1) -- | For a given estimated decimal length of the smallest prime factor -- ("tier") return parameters B1, B2 and the number of curves to try -- before next "tier". -- Roughly based on http://www.mersennewiki.org/index.php/Elliptic_Curve_Method#Choosing_the_best_parameters_for_ECM testParms :: IntMap (Word, Word, Word) testParms = IM.fromList [ (12, ( 400, 40000, 10)) , (15, ( 2000, 200000, 25)) , (20, ( 11000, 1100000, 90)) , (25, ( 50000, 5000000, 300)) , (30, ( 250000, 25000000, 700)) , (35, ( 1000000, 100000000, 1800)) , (40, ( 3000000, 300000000, 5100)) , (45, ( 11000000, 1100000000, 10600)) , (50, ( 43000000, 4300000000, 19300)) , (55, ( 110000000, 11000000000, 49000)) , (60, ( 260000000, 26000000000, 124000)) , (65, ( 850000000, 85000000000, 210000)) , (70, (2900000000, 290000000000, 340000)) ] findParms :: Int -> (Word, Word, Word) findParms digs = maybe (wheel, 1000, 7) snd (IM.lookupLT digs testParms) arithmoi-0.12.1.0/Math/NumberTheory/Primes/Factorisation/TrialDivision.hs0000644000000000000000000000612507346545000024436 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Factorisation.TrialDivision -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Factorisation and primality testing using trial division. -- -- Used to create and check certificates. -- Currently not exposed because it's not that useful, is it? -- But the trial...To functions are exported from other modules. {-# LANGUAGE BangPatterns #-} module Math.NumberTheory.Primes.Factorisation.TrialDivision ( trialDivisionWith , trialDivisionTo , trialDivisionPrimeTo ) where import Math.NumberTheory.Primes.Sieve.Eratosthenes (primeList, primeSieve, psieveList) import Math.NumberTheory.Roots 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, Word)] trialDivisionWith prs n | n < 0 = trialDivisionWith prs (-n) | n == 0 = error "trialDivision of 0" | n == 1 = [] | otherwise = go n (integerSquareRoot n) prs where go !m !r (p:ps) | r < p = [(m,1)] | otherwise = case splitOff p m of (0,_) -> go m r ps (k,q) -> (p,k) : if q == 1 then [] else go q (integerSquareRoot q) ps go m _ _ = [(m,1)] -- | @'trialDivisionTo' bound n@ produces a factorisation of @n@ using the -- 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, Word)] trialDivisionTo bd | bd < 100 = trialDivisionTo 100 | 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). trialDivisionPrimeWith :: [Integer] -> Integer -> Bool trialDivisionPrimeWith prs n | n < 0 = trialDivisionPrimeWith prs (-n) | n < 2 = False | otherwise = go n (integerSquareRoot n) prs where go !m !r (p:ps) = r < p || m `rem` p /= 0 && go m r ps go _ _ _ = True -- | @'trialDivisionPrimeTo' bound n@ tests whether @n@ is coprime to all primes @<= bound@. -- If @n <= bound^2@, this is a full prime test, but very slow if @n@ has no small prime divisors. trialDivisionPrimeTo :: Integer -> Integer -> Bool trialDivisionPrimeTo bd | bd < 100 = trialDivisionPrimeTo 100 | bd < 10000000 = trialDivisionPrimeWith (map unPrime $ primeList $ primeSieve bd) | otherwise = trialDivisionPrimeWith (takeWhile (<= bd) $ map unPrime $ psieveList >>= primeList) arithmoi-0.12.1.0/Math/NumberTheory/Primes/IntSet.hs0000644000000000000000000002405207346545000020256 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.IntSet -- Copyright: (c) 2020 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- A newtype wrapper around 'IntSet'. -- -- This module is intended to be imported qualified, e. g., -- -- > import Math.NumberTheory.Primes.IntSet (PrimeIntSet) -- > import qualified Math.NumberTheory.Primes.IntSet as PrimeIntSet -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Math.NumberTheory.Primes.IntSet ( -- * Set type PrimeIntSet , unPrimeIntSet -- * Construction -- | Use 'Data.Monoid.mempty' to create an empty set. , singleton , fromList , fromAscList , fromDistinctAscList -- * Insertion , insert -- * Deletion , delete -- * Query , member , notMember , lookupEQ , lookupLT , lookupGT , lookupLE , lookupGE , null , size , isSubsetOf , isProperSubsetOf , disjoint -- * Combine -- | Use 'Data.Semigroup.<>' for unions. , difference , (\\) , symmetricDifference , intersection -- * Filter , filter , partition , split , splitMember , splitLookupEQ , splitRoot -- * Folds , foldr , foldl , foldr' , foldl' -- * Min/Max , deleteMin , deleteMax , minView , maxView -- * Conversion , toAscList , toDescList ) where import Prelude ((>), (/=), (==), (-), Eq, Ord, Show, Monoid, Bool, Maybe(..), Int, Word, otherwise) import Control.DeepSeq (NFData) import Data.Coerce (coerce) import Data.Data (Data) import Data.Function (on) import Data.IntSet (IntSet) import qualified Data.IntSet.Internal as IS import Data.Semigroup (Semigroup) import qualified GHC.Exts (IsList(..)) import Math.NumberTheory.Primes.Types (Prime(..)) import Math.NumberTheory.Utils.FromIntegral (wordToInt, intToWord) import Data.Bits (Bits(..)) import Utils.Containers.Internal.BitUtil (highestBitMask) -- | A set of 'Prime' integers. newtype PrimeIntSet = PrimeIntSet { -- | Convert to a set of integers. unPrimeIntSet :: IntSet } deriving (Eq, Ord, Data, Show, Semigroup, Monoid, NFData) instance GHC.Exts.IsList PrimeIntSet where type Item PrimeIntSet = Prime Int fromList = coerce IS.fromList toList = coerce IS.toList -- | Build a singleton set. singleton :: Prime Int -> PrimeIntSet singleton = coerce IS.singleton -- | Build a set from a list of primes. fromList :: [Prime Int] -> PrimeIntSet fromList = coerce IS.fromList -- | Build a set from an ascending list of primes -- (the precondition is not checked). fromAscList :: [Prime Int] -> PrimeIntSet fromAscList = coerce IS.fromAscList -- | Build a set from an ascending list of distinct primes -- (the precondition is not checked). fromDistinctAscList :: [Prime Int] -> PrimeIntSet fromDistinctAscList = coerce IS.fromDistinctAscList -- | Insert a prime into the set. insert :: Prime Int -> PrimeIntSet -> PrimeIntSet insert = coerce IS.insert -- | Delete an integer from the set. delete :: Int -> PrimeIntSet -> PrimeIntSet delete = coerce IS.delete -- | Check whether the given prime is a member of the set. member :: Prime Int -> PrimeIntSet -> Bool member = coerce IS.member -- | Check whether the given prime is not a member of the set. notMember :: Prime Int -> PrimeIntSet -> Bool notMember = coerce IS.notMember -- | Find a prime in the set, -- equal to the given integer, if any exists. lookupEQ :: Int -> PrimeIntSet -> Maybe (Prime Int) lookupEQ x xs | coerce member x xs = Just (Prime x) | otherwise = Nothing -- | Find the largest prime in the set, -- smaller than the given integer, if any exists. lookupLT :: Int -> PrimeIntSet -> Maybe (Prime Int) lookupLT = coerce IS.lookupLT -- | Find the smallest prime in the set, -- greater than the given integer, if any exists. lookupGT :: Int -> PrimeIntSet -> Maybe (Prime Int) lookupGT = coerce IS.lookupGT -- | Find the largest prime in the set, -- smaller or equal to the given integer, if any exists. lookupLE :: Int -> PrimeIntSet -> Maybe (Prime Int) lookupLE = coerce IS.lookupLE -- | Find the smallest prime in the set, -- greater or equal to the given integer, if any exists. lookupGE :: Int -> PrimeIntSet -> Maybe (Prime Int) lookupGE = coerce IS.lookupGE -- | Check whether the set is empty. null :: PrimeIntSet -> Bool null = coerce IS.null -- | Cardinality of the set. size :: PrimeIntSet -> Int size = coerce IS.size -- | Check whether the first argument is a subset of the second one. isSubsetOf :: PrimeIntSet -> PrimeIntSet -> Bool isSubsetOf = coerce IS.isSubsetOf -- | Check whether the first argument is a proper subset of the second one. isProperSubsetOf :: PrimeIntSet -> PrimeIntSet -> Bool isProperSubsetOf = coerce IS.isProperSubsetOf #if MIN_VERSION_containers(0,5,11) -- | Check whether two sets are disjoint. disjoint :: PrimeIntSet -> PrimeIntSet -> Bool disjoint = coerce IS.disjoint #else -- | Check whether two sets are disjoint. disjoint :: PrimeIntSet -> PrimeIntSet -> Bool disjoint (PrimeIntSet x) (PrimeIntSet y) = IS.null (IS.intersection x y) #endif -- | Difference between a set of primes and a set of integers. difference :: PrimeIntSet -> IntSet -> PrimeIntSet difference = coerce IS.difference -- | An alias to 'difference'. (\\) :: PrimeIntSet -> IntSet -> PrimeIntSet (\\) = coerce (IS.\\) infixl 9 \\{- -} -- | Symmetric difference of two sets of primes. symmetricDifference :: PrimeIntSet -> PrimeIntSet -> PrimeIntSet symmetricDifference = coerce symmDiff -- | Intersection of a set of primes and a set of integers. intersection :: PrimeIntSet -> IntSet -> PrimeIntSet intersection = coerce IS.intersection -- | Filter primes satisfying a predicate. filter :: (Prime Int -> Bool) -> PrimeIntSet -> PrimeIntSet filter = coerce IS.filter -- | Partition primes according to a predicate. partition :: (Prime Int -> Bool) -> PrimeIntSet -> (PrimeIntSet, PrimeIntSet) partition = coerce IS.partition -- | Split into primes strictly less and strictly greater -- than the first argument. split :: Int -> PrimeIntSet -> (PrimeIntSet, PrimeIntSet) split = coerce IS.split -- | Simultaneous 'split' and 'member'. splitMember :: Prime Int -> PrimeIntSet -> (PrimeIntSet, Bool, PrimeIntSet) splitMember = coerce IS.splitMember -- | Simultaneous 'split' and 'lookupEQ'. splitLookupEQ :: Int -> PrimeIntSet -> (PrimeIntSet, Maybe (Prime Int), PrimeIntSet) splitLookupEQ x xs = (lt, if eq then Just (Prime x) else Nothing, gt) where (lt, eq, gt) = coerce IS.splitMember x xs -- | Decompose a set into pieces based on the structure of the underlying tree. splitRoot :: PrimeIntSet -> [PrimeIntSet] splitRoot = coerce IS.splitRoot -- | Fold a set using the given right-associative operator. foldr :: forall b. (Prime Int -> b -> b) -> b -> PrimeIntSet -> b foldr = coerce (IS.foldr @b) -- | Fold a set using the given left-associative operator. foldl :: forall a. (a -> Prime Int -> a) -> a -> PrimeIntSet -> a foldl = coerce (IS.foldl @a) -- | A strict version of 'foldr'. foldr' :: forall b. (Prime Int -> b -> b) -> b -> PrimeIntSet -> b foldr' = coerce (IS.foldr' @b) -- | A strict version of 'foldl'. foldl' :: forall a. (a -> Prime Int -> a) -> a -> PrimeIntSet -> a foldl' = coerce (IS.foldl' @a) -- | Delete the smallest prime in the set. deleteMin :: PrimeIntSet -> PrimeIntSet deleteMin = coerce IS.deleteMin -- | Delete the largest prime in the set. deleteMax :: PrimeIntSet -> PrimeIntSet deleteMax = coerce IS.deleteMax -- | Split a set into the smallest prime and the rest, if non-empty. minView :: PrimeIntSet -> Maybe (Prime Int, PrimeIntSet) minView = coerce IS.minView -- | Split a set into the largest prime and the rest, if non-empty. maxView :: PrimeIntSet -> Maybe (Prime Int, PrimeIntSet) maxView = coerce IS.maxView -- | Convert the set to a list of ascending primes. toAscList :: PrimeIntSet -> [Prime Int] toAscList = coerce IS.toAscList -- | Convert the set to a list of descending primes. toDescList :: PrimeIntSet -> [Prime Int] toDescList = coerce IS.toDescList ------------------------------------------------------------------------------- -- IntSet helpers -- | Symmetric difference of two sets. -- Implementation is inspired by 'Data.IntSet.union' -- and 'Data.IntSet.difference'. symmDiff :: IntSet -> IntSet -> IntSet symmDiff t1 t2 = case t1 of IS.Bin p1 m1 l1 r1 -> case t2 of IS.Bin p2 m2 l2 r2 | shorter m1 m2 -> symmDiff1 | shorter m2 m1 -> symmDiff2 | p1 == p2 -> bin p1 m1 (symmDiff l1 l2) (symmDiff r1 r2) | otherwise -> link p1 t1 p2 t2 where symmDiff1 | mask p2 m1 /= p1 = link p1 t1 p2 t2 | p2 .&. m1 == 0 = bin p1 m1 (symmDiff l1 t2) r1 | otherwise = bin p1 m1 l1 (symmDiff r1 t2) symmDiff2 | mask p1 m2 /= p2 = link p1 t1 p2 t2 | p1 .&. m2 == 0 = bin p2 m2 (symmDiff t1 l2) r2 | otherwise = bin p2 m2 l2 (symmDiff t1 r2) IS.Tip kx bm -> symmDiffBM kx bm t1 IS.Nil -> t1 IS.Tip kx bm -> symmDiffBM kx bm t2 IS.Nil -> t2 shorter :: Int -> Int -> Bool shorter = (>) `on` intToWord symmDiffBM :: Int -> Word -> IntSet -> IntSet symmDiffBM !kx !bm t = case t of IS.Bin p m l r | mask kx m /= p -> link kx (IS.Tip kx bm) p t | kx .&. m == 0 -> bin p m (symmDiffBM kx bm l) r | otherwise -> bin p m l (symmDiffBM kx bm r) IS.Tip kx' bm' | kx' == kx -> if bm' == bm then IS.Nil else IS.Tip kx (bm' `xor` bm) | otherwise -> link kx (IS.Tip kx bm) kx' t IS.Nil -> IS.Tip kx bm link :: Int -> IntSet -> Int -> IntSet -> IntSet link p1 t1 p2 t2 | p1 .&. m == 0 = IS.Bin p m t1 t2 | otherwise = IS.Bin p m t2 t1 where m = wordToInt (highestBitMask (intToWord p1 `xor` intToWord p2)) p = mask p1 m {-# INLINE link #-} bin :: Int -> Int -> IntSet -> IntSet -> IntSet bin p m l r = case r of IS.Nil -> l _ -> case l of IS.Nil -> r _ -> IS.Bin p m l r {-# INLINE bin #-} mask :: Int -> Int -> Int mask i m = i .&. (complement (m - 1) `xor` m) {-# INLINE mask #-} arithmoi-0.12.1.0/Math/NumberTheory/Primes/Sieve/0000755000000000000000000000000007346545000017564 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Primes/Sieve/Eratosthenes.hs0000644000000000000000000003755307346545000022601 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Sieve.Eratosthenes -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Sieve -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fspec-constr-count=8 #-} module Math.NumberTheory.Primes.Sieve.Eratosthenes ( primes , psieveFrom , PrimeSieve(..) , psieveList , primeList , primeSieve , sieveBits , sieveRange , sieveTo ) where import Control.Monad (when) import Control.Monad.ST import Data.Array.Base import Data.Array.ST import Data.Bits import Data.Coerce import Data.Proxy import Data.Word import Math.NumberTheory.Primes.Sieve.Indexing import Math.NumberTheory.Primes.Types import Math.NumberTheory.Roots import Math.NumberTheory.Utils.FromIntegral iXMASK :: Num a => a iXMASK = 0xFFFFF iXBITS :: Int iXBITS = 20 iXJMASK :: Num a => a iXJMASK = 0x7FFFFF iXJBITS :: Int iXJBITS = 23 jMASK :: Int jMASK = 7 jBITS :: Int jBITS = 3 -- Sieve in 128K chunks. -- Large enough to get something done per chunk -- and hopefully small enough to fit in the cache. sieveBytes :: Int sieveBytes = 128 * 1024 -- Number of bits per chunk. sieveBits :: Int sieveBits = 8 * sieveBytes -- Last index of chunk. lastIndex :: Int lastIndex = sieveBits - 1 -- Range of a chunk. sieveRange :: Int sieveRange = 30 * sieveBytes wSHFT :: (Bits a, Num a) => a wSHFT = if finiteBitSize (0 :: Word) == 64 then 6 else 5 -- | Compact store of primality flags. data PrimeSieve = PS !Integer {-# UNPACK #-} !(UArray Int Bool) -- | Sieve primes up to (and including) a bound (or 7, if bound is smaller). -- For small enough bounds, this is more efficient than -- using the segmented sieve. -- -- Since arrays are 'Int'-indexed, overflow occurs when the sieve -- size comes near @'maxBound' :: 'Int'@, that corresponds to an -- upper bound near @15/8*'maxBound'@. On @32@-bit systems, that -- is often within memory limits, so don't give bounds larger than -- @8*10^9@ there. primeSieve :: Integer -> PrimeSieve primeSieve bound = PS 0 (runSTUArray $ sieveTo bound) -- | Generate a list of primes for consumption from a -- 'PrimeSieve'. primeList :: forall a. Integral a => PrimeSieve -> [Prime a] primeList ps@(PS v _) | doesNotFit (Proxy :: Proxy a) v = [] -- has an overflow already happened? | 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) = map ((+ fromInteger v0) . toPrim) $ filter (unsafeAt bs) [lo..hi] where (lo, hi) = bounds bs -- | Returns true if integer is beyond representation range of type a. doesNotFit :: forall a. Integral a => Proxy a -> Integer -> Bool doesNotFit _ v = toInteger (fromInteger v :: a) /= v -- | Extracts the longest strictly increasing prefix of the list -- (possibly infinite). takeWhileIncreasing :: Ord a => [a] -> [a] takeWhileIncreasing = \case [] -> [] x : xs -> x : foldr go (const []) xs x where go :: Ord a => a -> (a -> [a]) -> a -> [a] go y f z = if z < y then y : f y else [] -- | Ascending list of primes. -- -- >>> take 10 primes -- [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 -- -- >>> primes !! 1000000 :: Prime Int -- (5.32 secs, 6,945,267,496 bytes) -- Prime 15485867 -- >>> primes !! 1000000 :: Prime Int -- (5.19 secs, 6,945,267,496 bytes) -- Prime 15485867 -- -- against -- -- >>> let primes' = primes :: [Prime Int] -- >>> primes' !! 1000000 :: Prime Int -- (5.29 secs, 6,945,269,856 bytes) -- Prime 15485867 -- >>> primes' !! 1000000 :: Prime Int -- (0.02 secs, 336,232 bytes) -- Prime 15485867 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'@ -- than keeping the list of primes alive during the entire run. psieveList :: [PrimeSieve] psieveList = makeSieves plim sqlim 0 0 cache where plim = 4801 -- prime #647, 644 of them to use sqlim = plim*plim cache = runSTUArray $ do sieve <- sieveTo (4801 :: Integer) new <- unsafeNewArray_ (0,1287) :: ST s (STUArray s Int Word64) let fill j indx | 1279 < indx = return new -- index of 4801 = 159*30 + 31 ~> 159*8+7 | otherwise = do p <- unsafeRead sieve indx if p then do let !i = indx .&. jMASK k = indx `shiftR` jBITS strt1 = (k*(30*k + 2*rho i) + byte i) `shiftL` jBITS + idx i !strt = intToWord64 (strt1 .&. iXMASK) !skip = intToWord64 (strt1 `shiftR` iXBITS) !ixes = intToWord64 indx `shiftL` iXJBITS + strt `shiftL` jBITS + intToWord64 i unsafeWrite new j skip unsafeWrite new (j+1) ixes fill (j+2) (indx+1) else fill j (indx+1) fill 0 0 makeSieves :: Integer -> Integer -> Integer -> Integer -> UArray Int Word64 -> [PrimeSieve] makeSieves plim sqlim bitOff valOff cache | valOff' < sqlim = let (nc, bs) = runST $ do cch <- unsafeThaw cache :: ST s (STUArray s Int Word64) bs0 <- slice cch fcch <- unsafeFreeze cch fbs0 <- unsafeFreeze bs0 return (fcch, fbs0) in PS valOff bs : makeSieves plim sqlim bitOff' valOff' nc | otherwise = let plim' = plim + 4800 sqlim' = plim' * plim' (nc,bs) = runST $ do cch <- growCache bitOff plim cache bs0 <- slice cch fcch <- unsafeFreeze cch fbs0 <- unsafeFreeze bs0 return (fcch, fbs0) in PS valOff bs : makeSieves plim' sqlim' bitOff' valOff' nc where valOff' = valOff + intToInteger sieveRange bitOff' = bitOff + intToInteger sieveBits slice :: STUArray s Int Word64 -> ST s (STUArray s Int Bool) slice cache = do hi <- snd `fmap` getBounds cache sieve <- newArray (0,lastIndex) True let treat pr | hi < pr = return sieve | otherwise = do w <- unsafeRead cache pr if w /= 0 then unsafeWrite cache pr (w-1) else do ixes <- unsafeRead cache (pr+1) let !stj = word64ToInt ixes .&. iXJMASK -- position of multiple and index of cofactor !ixw = word64ToInt (ixes `shiftR` iXJBITS) -- prime data, up to 41 bits !i = ixw .&. jMASK !k = ixw - i -- On 32-bits, k > 44717396 means overflow is possible in tick !o = i `shiftL` jBITS !j = stj .&. jMASK -- index of cofactor !s = stj `shiftR` jBITS -- index of first multiple to tick off (n, u) <- tick k o j s let !skip = intToWord64 (n `shiftR` iXBITS) !strt = intToWord64 (n .&. iXMASK) unsafeWrite cache pr skip unsafeWrite cache (pr+1) ((ixes .&. complement iXJMASK) .|. strt `shiftL` jBITS .|. intToWord64 u) treat (pr+2) tick stp off j ix | lastIndex < ix = return (ix - sieveBits, j) | otherwise = do p <- unsafeRead sieve ix when p (unsafeWrite sieve ix False) tick stp off ((j+1) .&. jMASK) (ix + stp*delta j + tau (off+j)) treat 0 -- | Sieve up to bound in one go. sieveTo :: Integer -> ST s (STUArray s Int Bool) sieveTo bound = arr where (bytes,lidx) = idxPr bound !mxidx = 8*bytes+lidx mxval :: Integer mxval = 30*intToInteger bytes + intToInteger (rho lidx) !mxsve = integerSquareRoot mxval (kr,r) = idxPr mxsve !svbd = 8*kr+r arr = do ar <- newArray (0,mxidx) True let start k i = 8*(k*(30*k+2*rho i) + byte i) + idx i tick stp off j ix | mxidx < ix = return () | otherwise = do p <- unsafeRead ar ix when p (unsafeWrite ar ix False) tick stp off ((j+1) .&. jMASK) (ix + stp*delta j + tau (off+j)) sift ix | svbd < ix = return ar | otherwise = do p <- unsafeRead ar ix when p (do let i = ix .&. jMASK k = ix `shiftR` jBITS !off = i `shiftL` jBITS !stp = ix - i tick stp off i (start k i)) sift (ix+1) sift 0 growCache :: Integer -> Integer -> UArray Int Word64 -> ST s (STUArray s Int Word64) growCache offset plim old = do let (_,num) = bounds old (bt,ix) = idxPr plim !start = 8*bt+ix+1 !nlim = plim+4800 sieve <- sieveTo nlim -- Implement SieveFromTo for this, it's pretty wasteful when nlim isn't (_,hi) <- getBounds sieve -- very small anymore more <- countFromToWd start hi sieve new <- unsafeNewArray_ (0,num+2*more) :: ST s (STUArray s Int Word64) let copy i | num < i = return () | otherwise = do unsafeWrite new i (old `unsafeAt` i) copy (i+1) copy 0 let fill j indx | hi < indx = return new | otherwise = do p <- unsafeRead sieve indx if p then do let !i = indx .&. jMASK k :: Integer k = intToInteger (indx `shiftR` jBITS) strt0 = ((k*(30*k + intToInteger (2*rho i)) + intToInteger (byte i)) `shiftL` jBITS) + intToInteger (idx i) strt1 = strt0 - offset !strt = integerToWord64 strt1 .&. iXMASK !skip = integerToWord64 (strt1 `shiftR` iXBITS) !ixes = intToWord64 indx `shiftL` iXJBITS .|. strt `shiftL` jBITS .|. intToWord64 i unsafeWrite new j skip unsafeWrite new (j+1) ixes fill (j+2) (indx+1) else fill j (indx+1) fill (num+1) start -- Danger: relies on start and end being the first resp. last -- index in a Word -- Do not use except in growCache and psieveFrom {-# INLINE countFromToWd #-} countFromToWd :: Int -> Int -> STUArray s Int Bool -> ST s Int countFromToWd start end ba = do wa <- (castSTUArray :: STUArray s Int Bool -> ST s (STUArray s Int Word)) ba let !sb = start `shiftR` wSHFT !eb = end `shiftR` wSHFT count !acc i | eb < i = return acc | otherwise = do w <- unsafeRead wa i count (acc + popCount w) (i+1) count 0 sb -- | @'psieveFrom' n@ creates the list of 'PrimeSieve's starting roughly -- at @n@. Due to the organisation of the sieve, the list may contain -- a few primes less than @n@. -- This form uses less memory than @['Integer']@, hence it may be preferable -- to use this if it is to be reused. psieveFrom :: Integer -> [PrimeSieve] psieveFrom n = makeSieves plim sqlim bitOff valOff cache where k0 = ((n `max` 7) - 7) `quot` 30 -- beware arithmetic underflow valOff = 30*k0 bitOff = 8*k0 start = valOff+7 ssr = integerSquareRoot (start-1) + 1 end1 = start - 6 + intToInteger sieveRange plim0 = integerSquareRoot end1 plim = plim0 + 4801 - (plim0 `rem` 4800) sqlim = plim*plim cache = runSTUArray $ do sieve <- sieveTo plim (lo,hi) <- getBounds sieve pct <- countFromToWd lo hi sieve new <- unsafeNewArray_ (0,2*pct-1) :: ST s (STUArray s Int Word64) let fill j indx | hi < indx = return new | otherwise = do isPr <- unsafeRead sieve indx if isPr then do let !i = indx .&. jMASK !moff = i `shiftL` jBITS k :: Integer k = intToInteger (indx `shiftR` jBITS) p = 30*k+intToInteger (rho i) q0 = (start-1) `quot` p (skp0,q1) = q0 `quotRem` intToInteger sieveRange (b0,r0) | q1 == 0 = (-1,6) | q1 < 7 = (-1,7) | otherwise = idxPr (integerToInt q1 :: Int) (b1,r1) | r0 == 7 = (b0+1,0) | otherwise = (b0,r0+1) b2 = skp0*intToInteger sieveBytes + intToInteger b1 strt0 = ((k*(30*b2 + intToInteger (rho r1)) + b2 * intToInteger (rho i) + intToInteger (mu (moff + r1))) `shiftL` jBITS) + intToInteger (nu (moff + r1)) strt1 = ((k*(30*k + intToInteger (2*rho i)) + intToInteger (byte i)) `shiftL` jBITS) + intToInteger (idx i) (strt2,r2) | p < ssr = (strt0 - bitOff,r1) | otherwise = (strt1 - bitOff, i) !strt = integerToWord64 strt2 .&. iXMASK !skip = integerToWord64 (strt2 `shiftR` iXBITS) !ixes = intToWord64 indx `shiftL` iXJBITS .|. strt `shiftL` jBITS .|. intToWord64 r2 unsafeWrite new j skip unsafeWrite new (j+1) ixes fill (j+2) (indx+1) else fill j (indx+1) fill 0 0 {-# INLINE delta #-} delta :: Int -> Int delta = unsafeAt deltas deltas :: UArray Int Int deltas = listArray (0,7) [4,2,4,2,4,6,2,6] {-# INLINE tau #-} tau :: Int -> Int tau = unsafeAt taus taus :: UArray Int Int taus = listArray (0,63) [ 7, 4, 7, 4, 7, 12, 3, 12 , 12, 6, 11, 6, 12, 18, 5, 18 , 14, 7, 13, 7, 14, 21, 7, 21 , 18, 9, 19, 9, 18, 27, 9, 27 , 20, 10, 21, 10, 20, 30, 11, 30 , 25, 12, 25, 12, 25, 36, 13, 36 , 31, 15, 31, 15, 31, 47, 15, 47 , 33, 17, 33, 17, 33, 49, 17, 49 ] {-# INLINE byte #-} byte :: Int -> Int byte = unsafeAt startByte startByte :: UArray Int Int startByte = listArray (0,7) [1,3,5,9,11,17,27,31] {-# INLINE idx #-} idx :: Int -> Int idx = unsafeAt startIdx startIdx :: UArray Int Int startIdx = listArray (0,7) [4,7,4,4,7,4,7,7] {-# INLINE mu #-} mu :: Int -> Int mu = unsafeAt mArr {-# INLINE nu #-} nu :: Int -> Int nu = unsafeAt nArr mArr :: UArray Int Int mArr = listArray (0,63) [ 1, 2, 2, 3, 4, 5, 6, 7 , 2, 3, 4, 6, 6, 8, 10, 11 , 2, 4, 5, 7, 8, 9, 12, 13 , 3, 6, 7, 9, 10, 12, 16, 17 , 4, 6, 8, 10, 11, 14, 18, 19 , 5, 8, 9, 12, 14, 17, 22, 23 , 6, 10, 12, 16, 18, 22, 27, 29 , 7, 11, 13, 17, 19, 23, 29, 31 ] nArr :: UArray Int Int nArr = listArray (0,63) [ 4, 3, 7, 6, 2, 1, 5, 0 , 3, 7, 5, 0, 6, 2, 4, 1 , 7, 5, 4, 1, 0, 6, 3, 2 , 6, 0, 1, 4, 5, 7, 2, 3 , 2, 6, 0, 5, 7, 3, 1, 4 , 1, 2, 6, 7, 3, 4, 0, 5 , 5, 4, 3, 2, 1, 0, 7, 6 , 0, 1, 2, 3, 4, 5, 6, 7 ] arithmoi-0.12.1.0/Math/NumberTheory/Primes/Sieve/Indexing.hs0000644000000000000000000000207207346545000021666 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Sieve.Indexing -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Auxiliary stuff, conversion between number and index, -- remainders modulo 30 and related things. module Math.NumberTheory.Primes.Sieve.Indexing ( idxPr , toPrim , rho ) where import Data.Array.Base import Data.Bits {-# INLINE idxPr #-} idxPr :: Integral a => a -> (Int,Int) idxPr n0 | n0 < 7 = (0, 0) | otherwise = (fromIntegral bytes0, rm3) where n = if fromIntegral n0 .&. 1 == (1 :: Int) then n0 else n0 - 1 (bytes0,rm0) = (n-7) `quotRem` 30 rm1 = fromIntegral rm0 rm2 = rm1 `quot` 3 rm3 = min 7 (if rm2 > 5 then rm2-1 else rm2) {-# INLINE toPrim #-} toPrim :: Num a => Int -> a toPrim ix = 30*fromIntegral k + fromIntegral (rho i) where i = ix .&. 7 k = ix `shiftR` 3 {-# INLINE rho #-} rho :: Int -> Int rho = unsafeAt residues residues :: UArray Int Int residues = listArray (0,7) [7,11,13,17,19,23,29,31] arithmoi-0.12.1.0/Math/NumberTheory/Primes/Small.hs0000644000000000000000000022442407346545000020125 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Small -- Copyright: (c) 2019 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- This is an internal module, -- defining an array of precalculated primes < 2^16. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} module Math.NumberTheory.Primes.Small ( smallPrimesPtr , smallPrimesLength , smallPrimesFromTo ) where import GHC.Exts hiding (fromList) import GHC.Word smallPrimesFromTo :: Word16 -> Word16 -> [Word16] smallPrimesFromTo from to = go k0# where !(Ptr smallPrimesAddr#) = smallPrimesPtr !(D# fromD#) = fromIntegral from k0# | from <= 5 = 0# | otherwise = double2Int# (fromD# /## logDouble# fromD#) go k# | I# k# >= smallPrimesLength = [] | p > to = [] | p < from = go (k# +# 1#) | otherwise = p : go (k# +# 1#) where p = W16# (indexWord16OffAddr# smallPrimesAddr# k#) -- length smallPrimes smallPrimesLength :: Int smallPrimesLength = 6542 -- concatMap (\x -> map Data.Char.chr [x `mod` 256, x `quot` 256]) smallPrimes smallPrimesPtr :: Ptr Word16 smallPrimesPtr = Ptr "\STX\NUL\ETX\NUL\ENQ\NUL\a\NUL\v\NUL\r\NUL\DC1\NUL\DC3\NUL\ETB\NUL\GS\NUL\US\NUL%\NUL)\NUL+\NUL/\NUL5\NUL;\NUL=\NULC\NULG\NULI\NULO\NULS\NULY\NULa\NULe\NULg\NULk\NULm\NULq\NUL\DEL\NUL\131\NUL\137\NUL\139\NUL\149\NUL\151\NUL\157\NUL\163\NUL\167\NUL\173\NUL\179\NUL\181\NUL\191\NUL\193\NUL\197\NUL\199\NUL\211\NUL\223\NUL\227\NUL\229\NUL\233\NUL\239\NUL\241\NUL\251\NUL\SOH\SOH\a\SOH\r\SOH\SI\SOH\NAK\SOH\EM\SOH\ESC\SOH%\SOH3\SOH7\SOH9\SOH=\SOHK\SOHQ\SOH[\SOH]\SOHa\SOHg\SOHo\SOHu\SOH{\SOH\DEL\SOH\133\SOH\141\SOH\145\SOH\153\SOH\163\SOH\165\SOH\175\SOH\177\SOH\183\SOH\187\SOH\193\SOH\201\SOH\205\SOH\207\SOH\211\SOH\223\SOH\231\SOH\235\SOH\243\SOH\247\SOH\253\SOH\t\STX\v\STX\GS\STX#\STX-\STX3\STX9\STX;\STXA\STXK\STXQ\STXW\STXY\STX_\STXe\STXi\STXk\STXw\STX\129\STX\131\STX\135\STX\141\STX\147\STX\149\STX\161\STX\165\STX\171\STX\179\STX\189\STX\197\STX\207\STX\215\STX\221\STX\227\STX\231\STX\239\STX\245\STX\249\STX\SOH\ETX\ENQ\ETX\DC3\ETX\GS\ETX)\ETX+\ETX5\ETX7\ETX;\ETX=\ETXG\ETXU\ETXY\ETX[\ETX_\ETXm\ETXq\ETXs\ETXw\ETX\139\ETX\143\ETX\151\ETX\161\ETX\169\ETX\173\ETX\179\ETX\185\ETX\199\ETX\203\ETX\209\ETX\215\ETX\223\ETX\229\ETX\241\ETX\245\ETX\251\ETX\253\ETX\a\EOT\t\EOT\SI\EOT\EM\EOT\ESC\EOT%\EOT'\EOT-\EOT?\EOTC\EOTE\EOTI\EOTO\EOTU\EOT]\EOTc\EOTi\EOT\DEL\EOT\129\EOT\139\EOT\147\EOT\157\EOT\163\EOT\169\EOT\177\EOT\189\EOT\193\EOT\199\EOT\205\EOT\207\EOT\213\EOT\225\EOT\235\EOT\253\EOT\255\EOT\ETX\ENQ\t\ENQ\v\ENQ\DC1\ENQ\NAK\ENQ\ETB\ENQ\ESC\ENQ'\ENQ)\ENQ/\ENQQ\ENQW\ENQ]\ENQe\ENQw\ENQ\129\ENQ\143\ENQ\147\ENQ\149\ENQ\153\ENQ\159\ENQ\167\ENQ\171\ENQ\173\ENQ\179\ENQ\191\ENQ\201\ENQ\203\ENQ\207\ENQ\209\ENQ\213\ENQ\219\ENQ\231\ENQ\243\ENQ\251\ENQ\a\ACK\r\ACK\DC1\ACK\ETB\ACK\US\ACK#\ACK+\ACK/\ACK=\ACKA\ACKG\ACKI\ACKM\ACKS\ACKU\ACK[\ACKe\ACKy\ACK\DEL\ACK\131\ACK\133\ACK\157\ACK\161\ACK\163\ACK\173\ACK\185\ACK\187\ACK\197\ACK\205\ACK\211\ACK\217\ACK\223\ACK\241\ACK\247\ACK\251\ACK\253\ACK\t\a\DC3\a\US\a'\a7\aE\aK\aO\aQ\aU\aW\aa\am\as\ay\a\139\a\141\a\157\a\159\a\181\a\187\a\195\a\201\a\205\a\207\a\211\a\219\a\225\a\235\a\237\a\247\a\ENQ\b\SI\b\NAK\b!\b#\b'\b)\b3\b?\bA\bQ\bS\bY\b]\b_\bi\bq\b\131\b\155\b\159\b\165\b\173\b\189\b\191\b\195\b\203\b\219\b\221\b\225\b\233\b\239\b\245\b\249\b\ENQ\t\a\t\GS\t#\t%\t+\t/\t5\tC\tI\tM\tO\tU\tY\t_\tk\tq\tw\t\133\t\137\t\143\t\155\t\163\t\169\t\173\t\199\t\217\t\227\t\235\t\239\t\245\t\247\t\253\t\DC3\n\US\n!\n1\n9\n=\nI\nW\na\nc\ng\no\nu\n{\n\DEL\n\129\n\133\n\139\n\147\n\151\n\153\n\159\n\169\n\171\n\181\n\189\n\193\n\207\n\217\n\229\n\231\n\237\n\241\n\243\n\ETX\v\DC1\v\NAK\v\ESC\v#\v)\v-\v?\vG\vQ\vW\v]\ve\vo\v{\v\137\v\141\v\147\v\153\v\155\v\183\v\185\v\195\v\203\v\207\v\221\v\225\v\233\v\245\v\251\v\a\f\v\f\DC1\f%\f/\f1\fA\f[\f_\fa\fm\fs\fw\f\131\f\137\f\145\f\149\f\157\f\179\f\181\f\185\f\187\f\199\f\227\f\229\f\235\f\241\f\247\f\251\f\SOH\r\ETX\r\SI\r\DC3\r\US\r!\r+\r-\r=\r?\rO\rU\ri\ry\r\129\r\133\r\135\r\139\r\141\r\163\r\171\r\183\r\189\r\199\r\201\r\205\r\211\r\213\r\219\r\229\r\231\r\243\r\253\r\255\r\t\SO\ETB\SO\GS\SO!\SO'\SO/\SO5\SO;\SOK\SOW\SOY\SO]\SOk\SOq\SOu\SO}\SO\135\SO\143\SO\149\SO\155\SO\177\SO\183\SO\185\SO\195\SO\209\SO\213\SO\219\SO\237\SO\239\SO\249\SO\a\SI\v\SI\r\SI\ETB\SI%\SI)\SI1\SIC\SIG\SIM\SIO\SIS\SIY\SI[\SIg\SIk\SI\DEL\SI\149\SI\161\SI\163\SI\167\SI\173\SI\179\SI\181\SI\187\SI\209\SI\211\SI\217\SI\233\SI\239\SI\251\SI\253\SI\ETX\DLE\SI\DLE\US\DLE!\DLE%\DLE+\DLE9\DLE=\DLE?\DLEQ\DLEi\DLEs\DLEy\DLE{\DLE\133\DLE\135\DLE\145\DLE\147\DLE\157\DLE\163\DLE\165\DLE\175\DLE\177\DLE\187\DLE\193\DLE\201\DLE\231\DLE\241\DLE\243\DLE\253\DLE\ENQ\DC1\v\DC1\NAK\DC1'\DC1-\DC19\DC1E\DC1G\DC1Y\DC1_\DC1c\DC1i\DC1o\DC1\129\DC1\131\DC1\141\DC1\155\DC1\161\DC1\165\DC1\167\DC1\171\DC1\195\DC1\197\DC1\209\DC1\215\DC1\231\DC1\239\DC1\245\DC1\251\DC1\r\DC2\GS\DC2\US\DC2#\DC2)\DC2+\DC21\DC27\DC2A\DC2G\DC2S\DC2_\DC2q\DC2s\DC2y\DC2}\DC2\143\DC2\151\DC2\175\DC2\179\DC2\181\DC2\185\DC2\191\DC2\193\DC2\205\DC2\209\DC2\223\DC2\253\DC2\a\DC3\r\DC3\EM\DC3'\DC3-\DC37\DC3C\DC3E\DC3I\DC3O\DC3W\DC3]\DC3g\DC3i\DC3m\DC3{\DC3\129\DC3\135\DC3\139\DC3\145\DC3\147\DC3\157\DC3\159\DC3\175\DC3\187\DC3\195\DC3\213\DC3\217\DC3\223\DC3\235\DC3\237\DC3\243\DC3\249\DC3\255\DC3\ESC\DC4!\DC4/\DC43\DC4;\DC4E\DC4M\DC4Y\DC4k\DC4o\DC4q\DC4u\DC4\141\DC4\153\DC4\159\DC4\161\DC4\177\DC4\183\DC4\189\DC4\203\DC4\213\DC4\227\DC4\231\DC4\ENQ\NAK\v\NAK\DC1\NAK\ETB\NAK\US\NAK%\NAK)\NAK+\NAK7\NAK=\NAKA\NAKC\NAKI\NAK_\NAKe\NAKg\NAKk\NAK}\NAK\DEL\NAK\131\NAK\143\NAK\145\NAK\151\NAK\155\NAK\181\NAK\187\NAK\193\NAK\197\NAK\205\NAK\215\NAK\247\NAK\a\SYN\t\SYN\SI\SYN\DC3\SYN\NAK\SYN\EM\SYN\ESC\SYN%\SYN3\SYN9\SYN=\SYNE\SYNO\SYNU\SYNi\SYNm\SYNo\SYNu\SYN\147\SYN\151\SYN\159\SYN\169\SYN\175\SYN\181\SYN\189\SYN\195\SYN\207\SYN\211\SYN\217\SYN\219\SYN\225\SYN\229\SYN\235\SYN\237\SYN\247\SYN\249\SYN\t\ETB\SI\ETB#\ETB'\ETB3\ETBA\ETB]\ETBc\ETBw\ETB{\ETB\141\ETB\149\ETB\155\ETB\159\ETB\165\ETB\179\ETB\185\ETB\191\ETB\201\ETB\203\ETB\213\ETB\225\ETB\233\ETB\243\ETB\245\ETB\255\ETB\a\CAN\DC3\CAN\GS\CAN5\CAN7\CAN;\CANC\CANI\CANM\CANU\CANg\CANq\CANw\CAN}\CAN\DEL\CAN\133\CAN\143\CAN\155\CAN\157\CAN\167\CAN\173\CAN\179\CAN\185\CAN\193\CAN\199\CAN\209\CAN\215\CAN\217\CAN\223\CAN\229\CAN\235\CAN\245\CAN\253\CAN\NAK\EM\ESC\EM1\EM3\EME\EMI\EMQ\EM[\EMy\EM\129\EM\147\EM\151\EM\153\EM\163\EM\169\EM\171\EM\177\EM\181\EM\199\EM\207\EM\219\EM\237\EM\253\EM\ETX\SUB\ENQ\SUB\DC1\SUB\ETB\SUB!\SUB#\SUB-\SUB/\SUB5\SUB?\SUBM\SUBQ\SUBi\SUBk\SUB{\SUB}\SUB\135\SUB\137\SUB\147\SUB\167\SUB\171\SUB\173\SUB\177\SUB\185\SUB\201\SUB\207\SUB\213\SUB\215\SUB\227\SUB\243\SUB\251\SUB\255\SUB\ENQ\ESC#\ESC%\ESC/\ESC1\ESC7\ESC;\ESCA\ESCG\ESCO\ESCU\ESCY\ESCe\ESCk\ESCs\ESC\DEL\ESC\131\ESC\145\ESC\157\ESC\167\ESC\191\ESC\197\ESC\209\ESC\215\ESC\217\ESC\239\ESC\247\ESC\t\FS\DC3\FS\EM\FS'\FS+\FS-\FS3\FS=\FSE\FSK\FSO\FSU\FSs\FS\129\FS\139\FS\141\FS\153\FS\163\FS\165\FS\181\FS\183\FS\201\FS\225\FS\243\FS\249\FS\t\GS\ESC\GS!\GS#\GS5\GS9\GS?\GSA\GSK\GSS\GS]\GSc\GSi\GSq\GSu\GS{\GS}\GS\135\GS\137\GS\149\GS\153\GS\159\GS\165\GS\167\GS\179\GS\183\GS\197\GS\215\GS\219\GS\225\GS\245\GS\249\GS\SOH\RS\a\RS\v\RS\DC3\RS\ETB\RS%\RS+\RS/\RS=\RSI\RSM\RSO\RSm\RSq\RS\137\RS\143\RS\149\RS\161\RS\173\RS\187\RS\193\RS\197\RS\199\RS\203\RS\221\RS\227\RS\239\RS\247\RS\253\RS\SOH\US\r\US\SI\US\ESC\US9\USI\USK\USQ\USg\USu\US{\US\133\US\145\US\151\US\153\US\157\US\165\US\175\US\181\US\187\US\211\US\225\US\231\US\235\US\243\US\255\US\DC1 \ESC \GS ' ) - 3 G M Q _ c e i w } \137 \161 \171 \177 \185 \195 \197 \227 \231 \237 \239 \251 \255 \r!\DC3!5!A!I!O!Y![!_!s!}!\133!\149!\151!\161!\175!\179!\181!\193!\199!\215!\221!\229!\233!\241!\245!\251!\ETX\"\t\"\SI\"\ESC\"!\"%\"+\"1\"9\"K\"O\"c\"g\"s\"u\"\DEL\"\133\"\135\"\145\"\157\"\159\"\163\"\183\"\189\"\219\"\225\"\229\"\237\"\247\"\ETX#\t#\v#'#)#/#3#5#E#Q#S#Y#c#k#\131#\143#\149#\167#\173#\177#\191#\197#\201#\213#\221#\227#\239#\243#\249#\ENQ$\v$\ETB$\EM$)$=$A$C$M$_$g$k$y$}$\DEL$\133$\155$\161$\175$\181$\187$\197$\203$\205$\215$\217$\221$\223$\245$\247$\251$\SOH%\a%\DC3%\EM%'%1%=%C%K%O%s%\129%\141%\147%\151%\157%\159%\171%\177%\189%\205%\207%\217%\225%\247%\249%\ENQ&\v&\SI&\NAK&'&)&5&;&?&K&S&Y&e&i&o&{&\129&\131&\143&\155&\159&\173&\179&\195&\201&\203&\213&\221&\239&\245&\ETB'\EM'5'7'M'S'U'_'k'm's'w'\DEL'\149'\155'\157'\167'\175'\179'\185'\193'\197'\209'\227'\239'\ETX(\a(\r(\DC3(\ESC(\US(!(1(=(?(I(Q([(](a(g(u(\129(\151(\159(\187(\189(\193(\213(\217(\219(\223(\237(\247(\ETX)\ENQ)\DC1)!)#)?)G)])e)i)o)u)\131)\135)\143)\155)\161)\167)\171)\191)\195)\213)\215)\227)\233)\237)\243)\SOH*\DC3*\GS*%*/*O*U*_*e*k*m*s*\131*\137*\139*\151*\157*\185*\187*\197*\205*\221*\227*\235*\241*\251*\DC3+'+1+3+=+?+K+O+U+i+m+o+{+\141+\151+\153+\163+\165+\169+\189+\205+\231+\235+\243+\249+\253+\t,\SI,\ETB,#,/,5,9,A,W,Y,i,w,\129,\135,\147,\159,\173,\179,\183,\203,\207,\219,\225,\227,\233,\239,\255,\a-\GS-\US-;-C-I-M-a-e-q-\137-\157-\161-\169-\179-\181-\197-\199-\211-\223-\SOH.\ETX.\a.\r.\EM.\US.%.-.3.7.9.?.W.[.o.y.\DEL.\133.\147.\151.\157.\163.\165.\177.\183.\193.\195.\205.\211.\231.\235.\ENQ/\t/\v/\DC1/'/)/A/E/K/M/Q/W/o/u/}/\129/\131/\165/\171/\179/\195/\207/\209/\219/\221/\231/\237/\245/\249/\SOH0\r0#0)070;0U0Y0[0g0q0y0}0\133\&0\145\&0\149\&0\163\&0\169\&0\185\&0\191\&0\199\&0\203\&0\209\&0\215\&0\223\&0\229\&0\239\&0\251\&0\253\&0\ETX1\t1\EM1!1'1-191C1E1K1]1a1g1m1s1\DEL1\145\&1\153\&1\159\&1\169\&1\177\&1\195\&1\199\&1\213\&1\219\&1\237\&1\247\&1\255\&1\t2\NAK2\ETB2\GS2)252Y2]2c2k2o2u2w2{2\141\&2\153\&2\159\&2\167\&2\173\&2\179\&2\183\&2\201\&2\203\&2\207\&2\209\&2\233\&2\237\&2\243\&2\249\&2\a3%3+3/353A3G3[3_3g3k3s3y3\DEL3\131\&3\161\&3\163\&3\173\&3\185\&3\193\&3\203\&3\211\&3\235\&3\241\&3\253\&3\SOH4\SI4\DC34\EM4\ESC474E4U4W4c4i4m4\129\&4\139\&4\145\&4\151\&4\157\&4\165\&4\175\&4\187\&4\201\&4\211\&4\225\&4\241\&4\255\&4\t5\ETB5\GS5-535;5A5Q5e5o5q5w5{5}5\129\&5\141\&5\143\&5\153\&5\155\&5\161\&5\183\&5\189\&5\191\&5\195\&5\213\&5\221\&5\231\&5\239\&5\ENQ6\a6\DC16#6165676;6M6O6S6Y6a6k6m6\139\&6\143\&6\173\&6\175\&6\185\&6\187\&6\205\&6\209\&6\227\&6\233\&6\247\&6\SOH7\ETX7\a7\ESC7?7E7I7O7]7a7u7\DEL7\141\&7\163\&7\169\&7\171\&7\201\&7\213\&7\223\&7\241\&7\243\&7\247\&7\ENQ8\v8!83858A8G8K8S8W8_8e8o8q8}8\143\&8\153\&8\167\&8\183\&8\197\&8\201\&8\207\&8\213\&8\215\&8\221\&8\225\&8\227\&8\255\&8\SOH9\GS9#9%9)9/9=9A9M9[9k9y9}9\131\&9\139\&9\145\&9\149\&9\155\&9\161\&9\167\&9\175\&9\179\&9\187\&9\191\&9\205\&9\221\&9\229\&9\235\&9\239\&9\251\&9\ETX:\DC3:\NAK:\US:':+:1:K:Q:[:c:g:m:y:\135:\165:\169:\183:\205:\213:\225:\229:\235:\243:\253:\ETX;\DC1;\ESC;!;#;-;9;E;S;Y;_;q;{;\129;\137;\155;\159;\165;\167;\173;\183;\185;\195;\203;\209;\215;\225;\227;\245;\255;\SOH<\r<\DC1<\ETB<\US<)<5\t>\SI>\DC1>\GS>#>)>/>3>A>W>c>e>w>\129>\135>\161>\185>\189>\191>\195>\197>\201>\215>\219>\225>\231>\239>\255>\v?\r?7?;?=?A?Y?_?e?g?y?}?\139?\145?\173?\191?\205?\211?\221?\233?\235?\241?\253?\ESC@!@%@+@1@?@C@E@]@a@g@m@\135@\145@\163@\169@\177@\183@\189@\219@\223@\235@\247@\249@\tA\vA\DC1A\NAKA!A3A5A;A?AYAeAkAwA{A\147A\171A\183A\189A\191A\203A\231A\239A\243A\249A\ENQB\aB\EMB\USB#B)B/BCBSBUB[BaBsB}B\131B\133B\137B\145B\151B\157B\181B\197B\203B\211B\221B\227B\241B\aC\SIC\USC%C'C3C7C9COCWCiC\139C\141C\147C\165C\169C\175C\181C\189C\199C\207C\225C\231C\235C\237C\241C\249C\tD\vD\ETBD#D)D;D?DEDKDQDSDYDeDoD\131D\143D\161D\165D\171D\173D\189D\191D\201D\215D\219D\249D\251D\ENQE\DC1E\DC3E+E1EAEIESEUEaEwE}E\DELE\143E\163E\173E\175E\187E\199E\217E\227E\239E\245E\247E\SOHF\ETXF\tF\DC3F%F'F3F9F=FCFEF]FyF{F\DELF\129F\139F\141F\157F\169F\177F\199F\201F\207F\211F\213F\223F\229F\249F\ENQG\SIG\ETBG#G)G/G5G9GKGMGQG]GoGqG}G\131G\135G\137G\153G\165G\177G\191G\195G\203G\221G\225G\237G\251G\SOHH\aH\vH\DC3H\EMH\GSH1H=HGHUHYH[HkHmHyH\151H\155H\161H\185H\205H\229H\239H\247H\ETXI\rI\EMI\USI+I7I=IEIUIcIiImIsI\151I\171I\181I\211I\223I\225I\229I\231I\ETXJ\SIJ\GSJ#J9JAJEJWJ]JkJ}J\129J\135J\137J\143J\177J\195J\197J\213J\219J\237J\239J\aK\vK\rK\DC3K\USK%K1K;KCKIKYKeKmKwK\133K\173K\179K\181K\187K\191K\203K\217K\221K\223K\227K\229K\233K\241K\247K\SOHL\aL\rL\SIL\NAKL\ESCL!L-L3LKLULWLaLgLsLyL\DELL\141L\147L\153L\205L\225L\231L\241L\243L\253L\ENQM\SIM\ESCM'M)M/M3MAMQMYMeMkM\129M\131M\141M\149M\155M\177M\179M\201M\207M\215M\225M\237M\249M\251M\ENQN\vN\ETBN\EMN\GSN+N5N7N=NONSN_NgNyN\133N\139N\145N\149N\155N\161N\175N\179N\181N\193N\205N\209N\215N\233N\251N\aO\tO\EMO%O-O?OIOcOgOmOuO{O\129O\133O\135O\145O\165O\169O\175O\183O\187O\207O\217O\219O\253O\255O\ETXP\ESCP\GSP)P5P?PEPGPSPqPwP\131P\147P\159P\161P\183P\201P\213P\227P\237P\239P\251P\aQ\vQ\rQ\DC1Q\ETBQ#Q%Q5QGQIQqQyQ\137Q\143Q\151Q\161Q\163Q\167Q\185Q\193Q\203Q\211Q\223Q\227Q\245Q\247Q\tR\DC3R\NAKR\EMR\ESCR\USR'RCRERKRaRmRsR\129R\147R\151R\157R\165R\171R\177R\187R\195R\199R\201R\219R\229R\235R\255R\NAKS\GSS#SASESGSKS]ScS\129S\131S\135S\143S\149S\153S\159S\171S\185S\219S\233S\239S\243S\245S\251S\255S\rT\DC1T\DC3T\EMT5T7T;TATITSTUT_TaTkTmTqT\143T\145T\157T\169T\179T\197T\209T\223T\233T\235T\247T\253T\aU\rU\ESCU'U+U9U=UOUQU[UcUgUoUyU\133U\151U\169U\177U\183U\201U\217U\231U\237U\243U\253U\vV\SIV\NAKV\ETBV#V/V3V9V?VKVMV]V_VkVqVuV\131V\137V\141V\143V\155V\173V\177V\213V\231V\243V\255V\SOHW\ENQW\aW\vW\DC3W\USW#WGWMW_WaWmWwW}W\137W\161W\169W\175W\181W\197W\209W\211W\229W\239W\ETXX\rX\SIX\NAKX'X+X-XUX[X]XmXoXsX{X\141X\151X\163X\169X\171X\181X\189X\193X\199X\211X\213X\223X\241X\249X\255X\ETXY\ETBY\ESCY!YEYKYMYWY]YuY{Y\137Y\153Y\159Y\177Y\179Y\189Y\209Y\219Y\227Y\233Y\237Y\243Y\245Y\255Y\SOHZ\rZ\DC1Z\DC3Z\ETBZ\USZ)Z/Z;ZMZ[ZgZwZ\DELZ\133Z\149Z\157Z\161Z\163Z\169Z\187Z\211Z\229Z\239Z\251Z\253Z\SOH[\SI[\EM[\US[%[+[=[I[K[g[y[\135[\151[\163[\177[\201[\213[\235[\241[\243[\253[\ENQ\\\t\\\v\\\SI\\\GS\\)\\/\\3\\9\\G\\K\\M\\Q\\o\\u\\w\\}\\\135\\\137\\\167\\\189\\\191\\\195\\\201\\\209\\\215\\\221\\\237\\\249\\\ENQ]\v]\DC3]\ETB]\EM]1]=]A]G]O]U][]e]g]m]y]\149]\163]\169]\173]\185]\193]\199]\211]\215]\221]\235]\241]\253]\a^\r^\DC3^\ESC^!^'^+^-^1^9^E^I^W^i^s^u^\133^\139^\159^\165^\175^\183^\187^\217^\253^\t_\DC1_'_3_5_;_G_W_]_c_e_w_{_\149_\153_\161_\179_\189_\197_\207_\213_\227_\231_\251_\DC1`#`/`7`S`_`e`k`s`y`\133`\157`\173`\187`\191`\205`\217`\223`\233`\245`\ta\SIa\DC3a\ESCa-a9aKaUaWa[aoaya\135a\139a\145a\147a\157a\181a\199a\201a\205a\225a\241a\255a\tb\ETBb\GSb!b'b;bAbKbQbSb_beb\131b\141b\149b\155b\159b\165b\173b\213b\215b\219b\221b\233b\251b\255b\ENQc\rc\ETBc\GSc/cAcCcOc_cgcmcqcwc}c\DELc\179c\193c\197c\217c\233c\235c\239c\245c\SOHd\ETXd\td\NAKd!d'd+d9dCdIdOd]dgdud\133d\141d\147d\159d\163d\171d\193d\199d\201d\219d\241d\247d\249d\ve\DC1e!e/e9e?eKeMeSeWe_eqe}e\141e\143e\147e\161e\165e\173e\185e\197e\227e\243e\251e\255e\SOHf\af\GSf)f1f;fAfGfMf[fafsf}f\137f\139f\149f\151f\155f\181f\185f\197f\205f\209f\227f\235f\245f\ETXg\DC3g\EMg\USg'g1g7g?gEgQg[gogyg\129g\133g\145g\171g\189g\193g\205g\223g\229g\ETXh\th\DC1h\ETBh-h9h;h?hEhKhMhWhYh]hchihkhqh\135h\153h\159h\177h\189h\197h\209h\215h\225h\237h\239h\255h\SOHi\vi\ri\ETBi)i/iCiGiIiOieikiqi\131i\137i\151i\163i\179i\181i\187i\193i\197i\211i\223i\227i\229i\247i\aj+j7j=jKjgjijuj{j\135j\141j\145j\147j\163j\193j\201j\225j\231j\ENQk\SIk\DC1k#k'k-k9kAkWkYk_kuk\135k\137k\147k\149k\159k\189k\191k\219k\225k\239k\255k\ENQl\EMl)l+l1l5lUlYl[l_lelglslwl}l\131l\143l\145l\151l\155l\161l\169l\175l\179l\199l\203l\235l\245l\253l\rm\SIm%m'm+m1m9m?mOm]mamsm{m\DELm\147m\153m\165m\177m\183m\193m\195m\205m\207m\219m\247m\ETXn\NAKn\ETBn)n3n;nEnunwn{n\129n\137n\147n\149n\159n\189n\191n\227n\233n\243n\249n\251n\ro\DC1o\ETBo\USo/o=oMoSoaoeoyo}o\131o\133o\143o\155o\157o\163o\175o\181o\187o\191o\203o\205o\211o\215o\227o\233o\241o\245o\247o\253o\SIp\EMp\USp'p3p9pOpQpWpcpupyp\135p\141p\145p\165p\171p\187p\195p\199p\207p\229p\237p\249p\255p\ENQq\NAKq!q3qQqYq]q_qcqiq\131q\135q\149q\173q\195q\201q\203q\209q\219q\225q\239q\245q\251q\ar\DC1r\ETBr\EMr%r/r;rCrUrgrqrwr\DELr\143r\149r\155r\163r\179r\199r\203r\205r\215r\217r\227r\239r\245r\253r\ETXs\rs!s+s=sWs[sas\DELs\129s\133s\141s\147s\159s\171s\189s\193s\201s\223s\229s\231s\243s\NAKt\ESCt-t9t?tAt]tkt{t\137t\141t\155t\167t\171t\177t\183t\185t\221t\225t\231t\251t\au\USu%u;u=uMu_ukuwu\137u\139u\145u\151u\157u\161u\167u\181u\185u\187u\209u\217u\229u\235u\245u\251u\ETXv\SIv!v-v3v=v?vUvcvivovsv\133v\139v\159v\181v\183v\195v\219v\223v\241v\ETXw\ENQw\ESCw\GSw!w-w5wAwKwYw]w_wqw\129w\167w\173w\179w\185w\197w\207w\213w\225w\233w\239w\243w\249w\ax%x+x5x=xSxYxaxmxwxyx\131x\133x\139x\149x\151x\161x\173x\191x\211x\217x\221x\229x\251x\SOHy\ay%y+y9y?yKyWy]ygyiysy\145y\147y\163y\171y\175y\177y\183y\201y\205y\207y\213y\217y\243y\247y\255y\ENQz\SIz\DC1z\NAKz\ESCz#z'z-zKzWzYz_zeziz}z\147z\155z\159z\161z\165z\237z\245z\249z\SOH{\ETB{\EM{\GS{+{5{7{;{O{U{_{q{w{\139{\155{\161{\169{\175{\179{\199{\211{\233{\235{\239{\241{\253{\a|\EM|\ESC|1|7|I|g|i|s|\129|\139|\147|\163|\213|\219|\229|\237|\247|\ETX}\t}\ESC}\GS}3}9};}?}E}M}S}Y}c}u}w}\141}\143}\159}\173}\183}\189}\191}\203}\213}\233}\237}\251}\SOH~\ENQ~)~+~/~5~A~C~G~U~a~g~k~q~s~y~}~\145~\155~\157~\167~\173~\185~\187~\211~\223~\235~\241~\247~\251~\DC3\DEL\NAK\DEL\EM\DEL1\DEL3\DEL9\DEL=\DELC\DELK\DEL[\DELa\DELc\DELm\DELy\DEL\135\DEL\141\DEL\175\DEL\181\DEL\195\DEL\201\DEL\205\DEL\207\DEL\237\DEL\ETX\128\v\128\SI\128\NAK\128\GS\128!\128#\128?\128A\128G\128K\128e\128w\128\141\128\143\128\149\128\165\128\171\128\173\128\189\128\201\128\203\128\215\128\219\128\225\128\231\128\245\128\255\128\ENQ\129\r\129\EM\129\GS\129/\129\&1\129;\129C\129S\129Y\129_\129}\129\DEL\129\137\129\155\129\157\129\167\129\175\129\179\129\187\129\199\129\223\129\a\130\t\130\NAK\130\US\130%\130\&1\130\&3\130?\130C\130E\130I\130O\130a\130o\130{\130\129\130\133\130\147\130\177\130\181\130\189\130\199\130\207\130\213\130\223\130\241\130\249\130\253\130\v\131\ESC\131!\131)\131-\131\&3\131\&5\131?\131A\131M\131Q\131S\131W\131]\131e\131i\131o\131\143\131\167\131\177\131\185\131\203\131\213\131\215\131\221\131\231\131\233\131\237\131\255\131\ENQ\132\DC1\132\DC3\132#\132%\132;\132A\132G\132O\132a\132e\132w\132\131\132\139\132\145\132\149\132\169\132\175\132\205\132\227\132\239\132\241\132\247\132\t\133\r\133K\133O\133Q\133]\133c\133m\133o\133{\133\135\133\163\133\165\133\169\133\183\133\205\133\211\133\213\133\219\133\225\133\235\133\249\133\253\133\255\133\t\134\SI\134\ETB\134!\134/\134\&9\134?\134A\134M\134c\134u\134}\134\135\134\153\134\165\134\167\134\179\134\183\134\195\134\197\134\207\134\209\134\215\134\233\134\239\134\245\134\ETB\135\GS\135\US\135+\135/\135\&5\135G\135Y\135[\135k\135q\135w\135\DEL\135\133\135\143\135\161\135\169\135\179\135\187\135\197\135\199\135\203\135\221\135\247\135\ETX\136\EM\136\ESC\136\US\136!\136\&7\136=\136C\136Q\136a\136g\136{\136\133\136\145\136\147\136\165\136\207\136\211\136\235\136\237\136\243\136\253\136\t\137\v\137\DC1\137\ESC\137#\137'\137-\137\&9\137E\137M\137Q\137W\137c\137\129\137\149\137\155\137\179\137\185\137\195\137\207\137\209\137\219\137\239\137\245\137\251\137\255\137\v\138\EM\138#\138\&5\138A\138I\138O\138[\138_\138m\138w\138y\138\133\138\163\138\179\138\181\138\193\138\199\138\203\138\205\138\209\138\215\138\241\138\245\138\a\139\t\139\r\139\DC3\139!\139W\139]\139\145\139\147\139\163\139\169\139\175\139\187\139\213\139\217\139\219\139\225\139\247\139\253\139\255\139\v\140\ETB\140\GS\140'\140\&9\140;\140G\140S\140]\140o\140{\140\129\140\137\140\143\140\153\140\159\140\167\140\171\140\173\140\177\140\197\140\221\140\227\140\233\140\243\140\SOH\141\v\141\r\141#\141)\141\&7\141A\141[\141_\141q\141y\141\133\141\145\141\155\141\167\141\173\141\181\141\197\141\203\141\211\141\217\141\223\141\245\141\247\141\SOH\142\NAK\142\US\142%\142Q\142c\142i\142s\142u\142y\142\DEL\142\141\142\145\142\171\142\175\142\177\142\189\142\199\142\207\142\211\142\219\142\231\142\235\142\247\142\255\142\NAK\143\GS\143#\143-\143?\143E\143K\143S\143Y\143e\143i\143q\143\131\143\141\143\153\143\159\143\171\143\173\143\179\143\183\143\185\143\201\143\213\143\225\143\239\143\249\143\a\144\r\144\ETB\144#\144%\144\&1\144\&7\144;\144A\144C\144O\144S\144m\144s\144\133\144\139\144\149\144\155\144\157\144\175\144\185\144\193\144\197\144\223\144\233\144\253\144\ETX\145\DC3\145'\145\&3\145=\145E\145O\145Q\145a\145g\145{\145\133\145\153\145\157\145\187\145\189\145\193\145\201\145\217\145\219\145\237\145\241\145\243\145\249\145\ETX\146\NAK\146!\146/\146A\146G\146W\146k\146q\146u\146}\146\131\146\135\146\141\146\153\146\161\146\171\146\173\146\185\146\191\146\195\146\197\146\203\146\213\146\215\146\231\146\243\146\SOH\147\v\147\DC1\147\EM\147\US\147;\147=\147C\147U\147s\147\149\147\151\147\167\147\179\147\181\147\199\147\215\147\221\147\229\147\239\147\247\147\SOH\148\t\148\DC3\148?\148E\148K\148O\148c\148g\148i\148m\148{\148\151\148\159\148\165\148\181\148\195\148\225\148\231\148\ENQ\149\t\149\ETB\149!\149'\149-\149\&5\149\&9\149K\149W\149]\149_\149u\149\129\149\137\149\143\149\155\149\159\149\173\149\177\149\183\149\185\149\189\149\207\149\227\149\233\149\249\149\US\150/\150\&1\150\&5\150;\150=\150e\150\143\150\157\150\161\150\167\150\169\150\193\150\203\150\209\150\211\150\229\150\239\150\251\150\253\150\r\151\SI\151\NAK\151%\151+\151\&3\151\&7\151\&9\151C\151I\151Q\151[\151]\151o\151\DEL\151\135\151\147\151\165\151\177\151\183\151\195\151\205\151\211\151\217\151\235\151\247\151\ENQ\152\t\152\v\152\NAK\152)\152/\152;\152A\152Q\152k\152o\152\129\152\131\152\135\152\167\152\177\152\185\152\191\152\195\152\201\152\207\152\221\152\227\152\245\152\249\152\251\152\r\153\ETB\153\US\153)\153\&1\153;\153=\153A\153G\153I\153S\153}\153\133\153\145\153\149\153\155\153\173\153\175\153\191\153\199\153\203\153\205\153\215\153\229\153\241\153\251\153\SI\154\DC3\154\ESC\154%\154K\154O\154U\154W\154a\154u\154\DEL\154\139\154\145\154\157\154\183\154\195\154\199\154\207\154\235\154\243\154\247\154\255\154\ETB\155\GS\155'\155/\155\&5\155E\155Q\155Y\155c\155o\155w\155\141\155\147\155\149\155\159\155\161\155\167\155\177\155\183\155\189\155\197\155\203\155\207\155\221\155\249\155\SOH\156\DC1\156#\156+\156/\156\&5\156I\156M\156_\156e\156g\156\DEL\156\151\156\157\156\163\156\175\156\187\156\191\156\193\156\215\156\217\156\227\156\233\156\241\156\253\156\SOH\157\NAK\157'\157-\157\&1\157=\157U\157[\157a\157\151\157\159\157\165\157\169\157\195\157\231\157\235\157\237\157\241\157\v\158\ETB\158#\158'\158-\158\&3\158;\158G\158Q\158S\158_\158o\158\129\158\135\158\143\158\149\158\161\158\179\158\189\158\191\158\245\158\249\158\251\158\ENQ\159#\159/\159\&7\159;\159C\159S\159a\159m\159s\159w\159}\159\137\159\143\159\145\159\149\159\163\159\175\159\179\159\193\159\199\159\223\159\229\159\235\159\245\159\SOH\160\r\160!\160\&3\160\&9\160?\160O\160W\160[\160a\160u\160y\160\153\160\157\160\171\160\181\160\183\160\189\160\201\160\217\160\219\160\223\160\229\160\241\160\243\160\253\160\ENQ\161\v\161\SI\161\DC1\161\ESC\161)\161/\161\&5\161A\161S\161u\161}\161\135\161\141\161\165\161\171\161\173\161\183\161\195\161\197\161\227\161\237\161\251\161\a\162\DC3\162#\162)\162/\162\&1\162C\162G\162M\162k\162y\162}\162\131\162\137\162\139\162\145\162\149\162\155\162\169\162\175\162\179\162\187\162\197\162\209\162\215\162\247\162\SOH\163\t\163\US\163!\163+\163\&1\163I\163Q\163U\163s\163y\163{\163\135\163\151\163\159\163\165\163\169\163\175\163\183\163\199\163\213\163\219\163\225\163\229\163\231\163\241\163\253\163\255\163\SI\164\GS\164!\164#\164'\164;\164M\164W\164Y\164c\164i\164u\164\147\164\155\164\173\164\185\164\195\164\197\164\203\164\209\164\213\164\225\164\237\164\239\164\243\164\255\164\DC1\165)\165+\165\&5\165;\165C\165S\165[\165a\165m\165w\165\133\165\139\165\151\165\157\165\163\165\167\165\169\165\193\165\197\165\203\165\211\165\217\165\221\165\223\165\227\165\233\165\247\165\251\165\ETX\166\r\166%\166=\166I\166K\166Q\166]\166s\166\145\166\147\166\153\166\171\166\181\166\187\166\193\166\201\166\205\166\207\166\213\166\223\166\231\166\241\166\247\166\255\166\SI\167\NAK\167#\167)\167-\167E\167M\167W\167Y\167e\167k\167o\167\147\167\149\167\171\167\177\167\185\167\191\167\201\167\209\167\215\167\227\167\237\167\251\167\ENQ\168\v\168\GS\168)\168+\168\&7\168;\168U\168_\168m\168}\168\143\168\151\168\169\168\181\168\193\168\199\168\215\168\229\168\253\168\a\169\DC3\169\ESC\169\&1\169\&7\169\&9\169C\169\DEL\169\133\169\135\169\139\169\147\169\163\169\177\169\187\169\193\169\217\169\223\169\235\169\253\169\NAK\170\ETB\170\&5\170\&9\170;\170G\170M\170W\170Y\170]\170k\170q\170\129\170\131\170\141\170\149\170\171\170\191\170\197\170\201\170\233\170\239\170\SOH\171\ENQ\171\a\171\v\171\r\171\DC1\171\EM\171M\171[\171q\171s\171\137\171\157\171\167\171\175\171\185\171\187\171\193\171\197\171\211\171\215\171\221\171\241\171\245\171\251\171\253\171\t\172\NAK\172\ESC\172'\172\&7\172\&9\172E\172O\172W\172[\172a\172c\172\DEL\172\139\172\147\172\157\172\169\172\171\172\175\172\189\172\217\172\225\172\231\172\235\172\237\172\241\172\247\172\249\172\ENQ\173?\173E\173S\173]\173_\173e\173\129\173\161\173\165\173\195\173\203\173\209\173\213\173\219\173\231\173\243\173\245\173\249\173\255\173\ENQ\174\DC3\174#\174+\174I\174M\174O\174Y\174a\174g\174k\174q\174\139\174\143\174\155\174\157\174\167\174\185\174\197\174\209\174\227\174\229\174\233\174\245\174\253\174\t\175\DC3\175'\175+\175\&3\175C\175O\175W\175]\175m\175u\175\DEL\175\139\175\153\175\159\175\163\175\171\175\183\175\187\175\207\175\213\175\253\175\ENQ\176\NAK\176\ESC\176?\176A\176G\176K\176Q\176S\176i\176{\176}\176\135\176\141\176\177\176\191\176\203\176\207\176\225\176\233\176\237\176\251\176\ENQ\177\a\177\DC1\177\EM\177\GS\177\US\177\&1\177A\177M\177[\177e\177s\177y\177\DEL\177\169\177\179\177\185\177\191\177\211\177\221\177\229\177\241\177\245\177\SOH\178\DC3\178\NAK\178\US\178-\178?\178I\178[\178c\178i\178m\178{\178\129\178\139\178\169\178\183\178\189\178\195\178\199\178\211\178\249\178\253\178\255\178\ETX\179\t\179\DC1\179\GS\179'\179-\179?\179E\179w\179}\179\129\179\135\179\147\179\155\179\165\179\197\179\203\179\225\179\227\179\237\179\249\179\v\180\r\180\DC3\180\ETB\180\&5\180=\180C\180I\180[\180e\180g\180k\180w\180\139\180\149\180\157\180\181\180\191\180\193\180\199\180\221\180\227\180\229\180\247\180\SOH\181\r\181\SI\181-\181?\181K\181g\181i\181o\181s\181y\181\135\181\141\181\153\181\163\181\171\181\175\181\187\181\213\181\223\181\231\181\237\181\253\181\255\181\t\182\ESC\182)\182/\182\&3\182\&9\182G\182W\182Y\182_\182c\182o\182\131\182\135\182\155\182\159\182\165\182\177\182\179\182\215\182\219\182\225\182\227\182\237\182\239\182\ENQ\183\r\183\DC3\183\GS\183)\183\&5\183G\183U\183m\183\145\183\149\183\169\183\193\183\203\183\209\183\211\183\239\183\245\183\a\184\SI\184\DC3\184\EM\184!\184'\184+\184-\184\&9\184U\184g\184u\184\133\184\147\184\165\184\175\184\183\184\189\184\193\184\199\184\205\184\213\184\235\184\247\184\249\184\ETX\185\NAK\185\ESC\185\GS\185/\185\&9\185;\185G\185Q\185c\185\131\185\137\185\141\185\147\185\153\185\161\185\167\185\173\185\183\185\203\185\209\185\221\185\231\185\239\185\249\185\a\186\r\186\ETB\186%\186)\186+\186A\186S\186U\186_\186a\186e\186y\186}\186\DEL\186\161\186\163\186\175\186\181\186\191\186\193\186\203\186\221\186\227\186\241\186\253\186\t\187\US\187'\187-\187=\187C\187K\187O\187[\187a\187i\187m\187\145\187\151\187\157\187\177\187\201\187\207\187\219\187\237\187\247\187\249\187\ETX\188\GS\188#\188\&3\188;\188A\188E\188]\188o\188w\188\131\188\143\188\153\188\171\188\183\188\185\188\209\188\213\188\225\188\243\188\255\188\r\189\ETB\189\EM\189\GS\189\&5\189A\189O\189Y\189_\189a\189g\189k\189q\189\139\189\143\189\149\189\155\189\157\189\179\189\187\189\205\189\209\189\227\189\235\189\239\189\a\190\t\190\NAK\190!\190%\190'\190[\190]\190o\190u\190y\190\DEL\190\139\190\141\190\147\190\159\190\169\190\177\190\181\190\183\190\207\190\217\190\219\190\229\190\231\190\243\190\249\190\v\191\&3\191\&9\191M\191]\191_\191k\191q\191{\191\135\191\137\191\141\191\147\191\161\191\173\191\185\191\207\191\213\191\221\191\225\191\227\191\243\191\ENQ\192\DC1\192\DC3\192\EM\192)\192/\192\&1\192\&7\192;\192G\192e\192m\192}\192\DEL\192\145\192\155\192\179\192\181\192\187\192\211\192\215\192\217\192\239\192\241\192\SOH\193\ETX\193\t\193\NAK\193\EM\193+\193\&3\193\&7\193E\193I\193[\193s\193y\193{\193\129\193\139\193\141\193\151\193\189\193\195\193\205\193\219\193\225\193\231\193\255\193\ETX\194\ENQ\194\DC1\194!\194/\194?\194K\194M\194S\194]\194w\194{\194}\194\137\194\143\194\147\194\159\194\167\194\179\194\189\194\207\194\213\194\227\194\255\194\SOH\195\a\195\DC1\195\DC3\195\ETB\195%\195G\195I\195O\195e\195g\195q\195\DEL\195\131\195\133\195\149\195\157\195\167\195\173\195\181\195\191\195\199\195\203\195\209\195\211\195\227\195\233\195\239\195\SOH\196\US\196-\196\&3\196\&7\196U\196W\196a\196o\196s\196\135\196\145\196\153\196\157\196\165\196\183\196\187\196\201\196\207\196\211\196\235\196\241\196\247\196\t\197\ESC\197\GS\197A\197G\197Q\197_\197k\197o\197u\197w\197\149\197\155\197\159\197\161\197\167\197\195\197\215\197\219\197\239\197\251\197\DC3\198#\198\&5\198A\198O\198U\198Y\198e\198\133\198\145\198\151\198\161\198\169\198\179\198\185\198\203\198\205\198\221\198\235\198\241\198\a\199\r\199\EM\199\ESC\199-\199\&1\199\&9\199W\199c\199g\199s\199u\199\DEL\199\165\199\187\199\189\199\193\199\207\199\213\199\225\199\249\199\253\199\255\199\ETX\200\DC1\200\GS\200'\200)\200\&9\200?\200S\200W\200k\200\129\200\141\200\143\200\147\200\149\200\161\200\183\200\207\200\213\200\219\200\221\200\227\200\231\200\237\200\239\200\249\200\ENQ\201\DC1\201\ETB\201\EM\201\US\201/\201\&7\201=\201A\201S\201_\201k\201y\201}\201\137\201\143\201\151\201\157\201\175\201\181\201\191\201\203\201\217\201\223\201\227\201\235\201\SOH\202\a\202\t\202%\202\&7\202\&9\202K\202U\202[\202i\202s\202u\202\DEL\202\141\202\147\202\157\202\159\202\181\202\187\202\195\202\201\202\217\202\229\202\237\202\ETX\203\ENQ\203\t\203\ETB\203)\203\&5\203;\203S\203Y\203c\203e\203q\203\135\203\153\203\159\203\179\203\185\203\195\203\209\203\213\203\215\203\221\203\233\203\255\203\r\204\EM\204\GS\204#\204+\204A\204C\204M\204Y\204a\204\137\204\139\204\145\204\155\204\163\204\167\204\209\204\229\204\233\204\t\205\NAK\205\US\205%\205\&1\205=\205?\205I\205Q\205W\205[\205c\205g\205\129\205\147\205\151\205\159\205\187\205\193\205\211\205\217\205\229\205\231\205\241\205\247\205\253\205\v\206\NAK\206!\206/\206G\206M\206Q\206e\206{\206}\206\143\206\147\206\153\206\165\206\167\206\183\206\201\206\215\206\221\206\227\206\231\206\237\206\245\206\a\207\v\207\EM\207\&7\207;\207M\207U\207_\207a\207e\207m\207y\207}\207\137\207\155\207\157\207\169\207\179\207\181\207\197\207\205\207\209\207\239\207\241\207\247\207\DC3\208\NAK\208\US\208!\208\&3\208=\208K\208O\208i\208o\208\129\208\133\208\153\208\159\208\163\208\171\208\189\208\193\208\205\208\231\208\255\208\ETX\209\ETB\209-\209/\209A\209W\209Y\209]\209i\209k\209q\209w\209}\209\129\209\135\209\149\209\153\209\177\209\189\209\195\209\213\209\215\209\227\209\255\209\r\210\DC1\210\ETB\210\US\210\&5\210;\210G\210Y\210a\210e\210y\210\DEL\210\131\210\137\210\139\210\157\210\163\210\167\210\179\210\191\210\199\210\227\210\233\210\241\210\251\210\253\210\NAK\211!\211+\211C\211K\211U\211i\211u\211{\211\135\211\147\211\151\211\165\211\177\211\201\211\235\211\253\211\ENQ\212\SI\212\NAK\212'\212/\212\&3\212;\212K\212Y\212_\212c\212i\212\129\212\131\212\137\212\141\212\147\212\149\212\165\212\171\212\177\212\197\212\221\212\225\212\227\212\231\212\245\212\249\212\v\213\r\213\DC3\213\US\213#\213\&1\213\&5\213\&7\213I\213Y\213_\213e\213g\213w\213\139\213\145\213\151\213\181\213\185\213\193\213\199\213\223\213\239\213\245\213\251\213\ETX\214\SI\214-\214\&1\214C\214U\214]\214a\214{\214\133\214\135\214\157\214\165\214\175\214\189\214\195\214\199\214\217\214\225\214\237\214\t\215\v\215\DC1\215\NAK\215!\215'\215?\215E\215M\215W\215k\215{\215\131\215\161\215\167\215\173\215\177\215\179\215\189\215\203\215\209\215\219\215\251\215\DC1\216#\216%\216)\216+\216/\216\&7\216M\216U\216g\216s\216\143\216\145\216\161\216\173\216\191\216\205\216\215\216\233\216\245\216\251\216\ESC\217%\217\&3\217\&9\217C\217E\217O\217Q\217W\217m\217o\217s\217y\217\129\217\139\217\145\217\159\217\165\217\169\217\181\217\211\217\235\217\241\217\247\217\255\217\ENQ\218\t\218\v\218\SI\218\NAK\218\GS\218#\218)\218?\218Q\218Y\218]\218_\218q\218w\218{\218}\218\141\218\159\218\179\218\189\218\195\218\201\218\231\218\233\218\245\218\DC1\219\ETB\219\GS\219#\219%\219\&1\219;\219C\219U\219g\219k\219s\219\133\219\143\219\145\219\173\219\175\219\185\219\199\219\203\219\205\219\235\219\247\219\r\220'\220\&1\220\&9\220?\220I\220Q\220a\220o\220u\220{\220\133\220\147\220\153\220\157\220\159\220\169\220\181\220\183\220\189\220\199\220\207\220\211\220\213\220\223\220\249\220\SI\221\NAK\221\ETB\221#\221\&5\221\&9\221S\221W\221_\221i\221o\221}\221\135\221\137\221\155\221\161\221\171\221\191\221\197\221\203\221\207\221\231\221\233\221\237\221\245\221\251\221\v\222\EM\222)\222;\222=\222A\222M\222O\222Y\222[\222a\222m\222w\222}\222\131\222\151\222\157\222\161\222\167\222\205\222\209\222\215\222\227\222\241\222\245\222\SOH\223\t\223\DC3\223\US\223+\223\&3\223\&7\223=\223K\223U\223[\223g\223i\223s\223\133\223\135\223\153\223\163\223\171\223\181\223\183\223\195\223\199\223\213\223\241\223\243\223\ETX\224\ENQ\224\ETB\224\GS\224'\224-\224\&5\224E\224S\224q\224{\224\143\224\149\224\159\224\183\224\185\224\213\224\215\224\227\224\243\224\249\224\SOH\225%\225)\225\&1\225\&5\225C\225O\225Y\225a\225m\225q\225w\225\DEL\225\131\225\137\225\151\225\173\225\181\225\187\225\191\225\193\225\203\225\209\225\229\225\239\225\247\225\253\225\ETX\226\EM\226+\226-\226=\226C\226W\226[\226u\226y\226\135\226\157\226\171\226\175\226\187\226\193\226\201\226\205\226\211\226\217\226\243\226\253\226\255\226\DC1\227#\227'\227)\227\&9\227;\227M\227Q\227W\227_\227c\227i\227u\227w\227}\227\131\227\159\227\197\227\201\227\209\227\225\227\251\227\255\227\SOH\228\v\228\ETB\228\EM\228#\228+\228\&1\228;\228G\228I\228S\228U\228m\228q\228\143\228\169\228\175\228\181\228\199\228\205\228\211\228\233\228\235\228\245\228\a\229!\229%\229\&7\229?\229E\229K\229W\229g\229m\229u\229\133\229\139\229\147\229\163\229\165\229\207\229\t\230\DC1\230\NAK\230\ESC\230\GS\230!\230)\230\&9\230?\230S\230W\230c\230o\230u\230\129\230\131\230\141\230\143\230\149\230\171\230\173\230\183\230\189\230\197\230\203\230\213\230\227\230\233\230\239\230\243\230\ENQ\231\r\231\ETB\231\US\231/\231=\231G\231I\231S\231U\231a\231g\231k\231\DEL\231\137\231\145\231\197\231\205\231\215\231\221\231\223\231\233\231\241\231\251\231\SOH\232\a\232\SI\232\EM\232\ESC\232\&1\232\&3\232\&7\232=\232K\232O\232Q\232i\232u\232y\232\147\232\165\232\169\232\175\232\189\232\219\232\225\232\229\232\235\232\237\232\ETX\233\v\233\SI\233\NAK\233\ETB\233-\233\&3\233;\233K\233Q\233_\233c\233i\233{\233\131\233\143\233\149\233\161\233\185\233\215\233\231\233\239\233\DC1\234\EM\234/\234\&5\234C\234M\234_\234m\234q\234}\234\133\234\137\234\173\234\179\234\185\234\187\234\197\234\199\234\203\234\223\234\229\234\235\234\245\234\SOH\235\a\235\t\235\&1\235\&9\235?\235[\235a\235c\235o\235\129\235\133\235\157\235\171\235\177\235\183\235\193\235\213\235\223\235\237\235\253\235\v\236\ESC\236!\236)\236M\236Q\236]\236i\236o\236{\236\173\236\185\236\191\236\195\236\201\236\207\236\215\236\221\236\231\236\233\236\243\236\245\236\a\237\DC1\237\US\237/\237\&7\237=\237A\237U\237Y\237[\237e\237k\237y\237\139\237\149\237\187\237\197\237\215\237\217\237\227\237\229\237\241\237\245\237\247\237\251\237\t\238\SI\238\EM\238!\238I\238O\238c\238g\238s\238{\238\129\238\163\238\171\238\193\238\201\238\213\238\223\238\225\238\241\238\ESC\239'\239/\239E\239M\239c\239k\239q\239\147\239\149\239\155\239\159\239\173\239\179\239\195\239\197\239\219\239\225\239\233\239\SOH\240\ETB\240\GS\240\US\240+\240/\240\&5\240C\240G\240O\240g\240k\240q\240w\240y\240\143\240\163\240\169\240\173\240\187\240\191\240\197\240\203\240\211\240\217\240\227\240\233\240\241\240\247\240\a\241\NAK\241\ESC\241!\241\&7\241=\241U\241u\241{\241\141\241\147\241\165\241\175\241\183\241\213\241\231\241\237\241\253\241\t\242\SI\242\ESC\242\GS\242#\242'\242\&3\242;\242A\242W\242_\242e\242i\242w\242\129\242\147\242\167\242\177\242\179\242\185\242\189\242\191\242\219\242\237\242\239\242\249\242\255\242\ENQ\243\v\243\EM\243A\243Y\243[\243_\243g\243s\243w\243\139\243\143\243\175\243\193\243\209\243\215\243\251\243\ETX\244\t\244\r\244\DC3\244!\244%\244+\244E\244K\244U\244c\244u\244\DEL\244\133\244\139\244\153\244\163\244\169\244\175\244\189\244\195\244\219\244\223\244\237\244\ETX\245\v\245\ETB\245!\245)\245\&5\245G\245Q\245c\245k\245\131\245\141\245\149\245\153\245\177\245\183\245\201\245\207\245\209\245\219\245\249\245\251\245\ENQ\246\a\246\v\246\r\246\&5\246\&7\246S\246[\246a\246g\246y\246\DEL\246\137\246\151\246\155\246\173\246\203\246\221\246\223\246\235\246\t\247\SI\247-\247\&1\247C\247O\247Q\247U\247c\247i\247s\247y\247\129\247\135\247\145\247\157\247\159\247\165\247\177\247\187\247\189\247\207\247\211\247\231\247\235\247\241\247\255\247\ENQ\248\v\248!\248'\248-\248\&5\248G\248Y\248c\248e\248o\248q\248w\248{\248\129\248\141\248\159\248\161\248\171\248\179\248\183\248\201\248\203\248\209\248\215\248\221\248\231\248\239\248\249\248\255\248\DC1\249\GS\249%\249\&1\249\&7\249;\249A\249O\249_\249a\249m\249q\249w\249\157\249\163\249\169\249\185\249\205\249\233\249\253\249\a\250\r\250\DC3\250!\250%\250?\250C\250Q\250[\250m\250{\250\151\250\153\250\157\250\171\250\187\250\189\250\217\250\223\250\231\250\237\250\SI\251\ETB\251\ESC\251-\251/\251?\251G\251M\251u\251}\251\143\251\147\251\177\251\183\251\195\251\197\251\227\251\233\251\243\251\SOH\252)\252\&7\252A\252C\252O\252Y\252a\252e\252m\252s\252y\252\149\252\151\252\155\252\167\252\181\252\197\252\205\252\235\252\251\252\r\253\SI\253\EM\253+\253\&1\253Q\253U\253g\253m\253o\253{\253\133\253\151\253\153\253\159\253\169\253\183\253\201\253\229\253\235\253\243\253\ETX\254\ENQ\254\t\254\GS\254'\254/\254A\254K\254M\254W\254_\254c\254i\254u\254{\254\143\254\147\254\149\254\155\254\159\254\179\254\189\254\215\254\233\254\243\254\245\254\a\255\r\255\GS\255+\255/\255I\255M\255[\255e\255q\255\DEL\255\133\255\139\255\143\255\157\255\167\255\169\255\199\255\217\255\239\255\241\255"# -- smallPrimes :: [Word16] -- smallPrimes = -- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997,1009,1013,1019,1021,1031,1033,1039,1049,1051,1061,1063,1069,1087,1091,1093,1097,1103,1109,1117,1123,1129,1151,1153,1163,1171,1181,1187,1193,1201,1213,1217,1223,1229,1231,1237,1249,1259,1277,1279,1283,1289,1291,1297,1301,1303,1307,1319,1321,1327,1361,1367,1373,1381,1399,1409,1423,1427,1429,1433,1439,1447,1451,1453,1459,1471,1481,1483,1487,1489,1493,1499,1511,1523,1531,1543,1549,1553,1559,1567,1571,1579,1583,1597,1601,1607,1609,1613,1619,1621,1627,1637,1657,1663,1667,1669,1693,1697,1699,1709,1721,1723,1733,1741,1747,1753,1759,1777,1783,1787,1789,1801,1811,1823,1831,1847,1861,1867,1871,1873,1877,1879,1889,1901,1907,1913,1931,1933,1949,1951,1973,1979,1987,1993,1997,1999,2003,2011,2017,2027,2029,2039,2053,2063,2069,2081,2083,2087,2089,2099,2111,2113,2129,2131,2137,2141,2143,2153,2161,2179,2203,2207,2213,2221,2237,2239,2243,2251,2267,2269,2273,2281,2287,2293,2297,2309,2311,2333,2339,2341,2347,2351,2357,2371,2377,2381,2383,2389,2393,2399,2411,2417,2423,2437,2441,2447,2459,2467,2473,2477,2503,2521,2531,2539,2543,2549,2551,2557,2579,2591,2593,2609,2617,2621,2633,2647,2657,2659,2663,2671,2677,2683,2687,2689,2693,2699,2707,2711,2713,2719,2729,2731,2741,2749,2753,2767,2777,2789,2791,2797,2801,2803,2819,2833,2837,2843,2851,2857,2861,2879,2887,2897,2903,2909,2917,2927,2939,2953,2957,2963,2969,2971,2999,3001,3011,3019,3023,3037,3041,3049,3061,3067,3079,3083,3089,3109,3119,3121,3137,3163,3167,3169,3181,3187,3191,3203,3209,3217,3221,3229,3251,3253,3257,3259,3271,3299,3301,3307,3313,3319,3323,3329,3331,3343,3347,3359,3361,3371,3373,3389,3391,3407,3413,3433,3449,3457,3461,3463,3467,3469,3491,3499,3511,3517,3527,3529,3533,3539,3541,3547,3557,3559,3571,3581,3583,3593,3607,3613,3617,3623,3631,3637,3643,3659,3671,3673,3677,3691,3697,3701,3709,3719,3727,3733,3739,3761,3767,3769,3779,3793,3797,3803,3821,3823,3833,3847,3851,3853,3863,3877,3881,3889,3907,3911,3917,3919,3923,3929,3931,3943,3947,3967,3989,4001,4003,4007,4013,4019,4021,4027,4049,4051,4057,4073,4079,4091,4093,4099,4111,4127,4129,4133,4139,4153,4157,4159,4177,4201,4211,4217,4219,4229,4231,4241,4243,4253,4259,4261,4271,4273,4283,4289,4297,4327,4337,4339,4349,4357,4363,4373,4391,4397,4409,4421,4423,4441,4447,4451,4457,4463,4481,4483,4493,4507,4513,4517,4519,4523,4547,4549,4561,4567,4583,4591,4597,4603,4621,4637,4639,4643,4649,4651,4657,4663,4673,4679,4691,4703,4721,4723,4729,4733,4751,4759,4783,4787,4789,4793,4799,4801,4813,4817,4831,4861,4871,4877,4889,4903,4909,4919,4931,4933,4937,4943,4951,4957,4967,4969,4973,4987,4993,4999,5003,5009,5011,5021,5023,5039,5051,5059,5077,5081,5087,5099,5101,5107,5113,5119,5147,5153,5167,5171,5179,5189,5197,5209,5227,5231,5233,5237,5261,5273,5279,5281,5297,5303,5309,5323,5333,5347,5351,5381,5387,5393,5399,5407,5413,5417,5419,5431,5437,5441,5443,5449,5471,5477,5479,5483,5501,5503,5507,5519,5521,5527,5531,5557,5563,5569,5573,5581,5591,5623,5639,5641,5647,5651,5653,5657,5659,5669,5683,5689,5693,5701,5711,5717,5737,5741,5743,5749,5779,5783,5791,5801,5807,5813,5821,5827,5839,5843,5849,5851,5857,5861,5867,5869,5879,5881,5897,5903,5923,5927,5939,5953,5981,5987,6007,6011,6029,6037,6043,6047,6053,6067,6073,6079,6089,6091,6101,6113,6121,6131,6133,6143,6151,6163,6173,6197,6199,6203,6211,6217,6221,6229,6247,6257,6263,6269,6271,6277,6287,6299,6301,6311,6317,6323,6329,6337,6343,6353,6359,6361,6367,6373,6379,6389,6397,6421,6427,6449,6451,6469,6473,6481,6491,6521,6529,6547,6551,6553,6563,6569,6571,6577,6581,6599,6607,6619,6637,6653,6659,6661,6673,6679,6689,6691,6701,6703,6709,6719,6733,6737,6761,6763,6779,6781,6791,6793,6803,6823,6827,6829,6833,6841,6857,6863,6869,6871,6883,6899,6907,6911,6917,6947,6949,6959,6961,6967,6971,6977,6983,6991,6997,7001,7013,7019,7027,7039,7043,7057,7069,7079,7103,7109,7121,7127,7129,7151,7159,7177,7187,7193,7207,7211,7213,7219,7229,7237,7243,7247,7253,7283,7297,7307,7309,7321,7331,7333,7349,7351,7369,7393,7411,7417,7433,7451,7457,7459,7477,7481,7487,7489,7499,7507,7517,7523,7529,7537,7541,7547,7549,7559,7561,7573,7577,7583,7589,7591,7603,7607,7621,7639,7643,7649,7669,7673,7681,7687,7691,7699,7703,7717,7723,7727,7741,7753,7757,7759,7789,7793,7817,7823,7829,7841,7853,7867,7873,7877,7879,7883,7901,7907,7919,7927,7933,7937,7949,7951,7963,7993,8009,8011,8017,8039,8053,8059,8069,8081,8087,8089,8093,8101,8111,8117,8123,8147,8161,8167,8171,8179,8191,8209,8219,8221,8231,8233,8237,8243,8263,8269,8273,8287,8291,8293,8297,8311,8317,8329,8353,8363,8369,8377,8387,8389,8419,8423,8429,8431,8443,8447,8461,8467,8501,8513,8521,8527,8537,8539,8543,8563,8573,8581,8597,8599,8609,8623,8627,8629,8641,8647,8663,8669,8677,8681,8689,8693,8699,8707,8713,8719,8731,8737,8741,8747,8753,8761,8779,8783,8803,8807,8819,8821,8831,8837,8839,8849,8861,8863,8867,8887,8893,8923,8929,8933,8941,8951,8963,8969,8971,8999,9001,9007,9011,9013,9029,9041,9043,9049,9059,9067,9091,9103,9109,9127,9133,9137,9151,9157,9161,9173,9181,9187,9199,9203,9209,9221,9227,9239,9241,9257,9277,9281,9283,9293,9311,9319,9323,9337,9341,9343,9349,9371,9377,9391,9397,9403,9413,9419,9421,9431,9433,9437,9439,9461,9463,9467,9473,9479,9491,9497,9511,9521,9533,9539,9547,9551,9587,9601,9613,9619,9623,9629,9631,9643,9649,9661,9677,9679,9689,9697,9719,9721,9733,9739,9743,9749,9767,9769,9781,9787,9791,9803,9811,9817,9829,9833,9839,9851,9857,9859,9871,9883,9887,9901,9907,9923,9929,9931,9941,9949,9967,9973,10007,10009,10037,10039,10061,10067,10069,10079,10091,10093,10099,10103,10111,10133,10139,10141,10151,10159,10163,10169,10177,10181,10193,10211,10223,10243,10247,10253,10259,10267,10271,10273,10289,10301,10303,10313,10321,10331,10333,10337,10343,10357,10369,10391,10399,10427,10429,10433,10453,10457,10459,10463,10477,10487,10499,10501,10513,10529,10531,10559,10567,10589,10597,10601,10607,10613,10627,10631,10639,10651,10657,10663,10667,10687,10691,10709,10711,10723,10729,10733,10739,10753,10771,10781,10789,10799,10831,10837,10847,10853,10859,10861,10867,10883,10889,10891,10903,10909,10937,10939,10949,10957,10973,10979,10987,10993,11003,11027,11047,11057,11059,11069,11071,11083,11087,11093,11113,11117,11119,11131,11149,11159,11161,11171,11173,11177,11197,11213,11239,11243,11251,11257,11261,11273,11279,11287,11299,11311,11317,11321,11329,11351,11353,11369,11383,11393,11399,11411,11423,11437,11443,11447,11467,11471,11483,11489,11491,11497,11503,11519,11527,11549,11551,11579,11587,11593,11597,11617,11621,11633,11657,11677,11681,11689,11699,11701,11717,11719,11731,11743,11777,11779,11783,11789,11801,11807,11813,11821,11827,11831,11833,11839,11863,11867,11887,11897,11903,11909,11923,11927,11933,11939,11941,11953,11959,11969,11971,11981,11987,12007,12011,12037,12041,12043,12049,12071,12073,12097,12101,12107,12109,12113,12119,12143,12149,12157,12161,12163,12197,12203,12211,12227,12239,12241,12251,12253,12263,12269,12277,12281,12289,12301,12323,12329,12343,12347,12373,12377,12379,12391,12401,12409,12413,12421,12433,12437,12451,12457,12473,12479,12487,12491,12497,12503,12511,12517,12527,12539,12541,12547,12553,12569,12577,12583,12589,12601,12611,12613,12619,12637,12641,12647,12653,12659,12671,12689,12697,12703,12713,12721,12739,12743,12757,12763,12781,12791,12799,12809,12821,12823,12829,12841,12853,12889,12893,12899,12907,12911,12917,12919,12923,12941,12953,12959,12967,12973,12979,12983,13001,13003,13007,13009,13033,13037,13043,13049,13063,13093,13099,13103,13109,13121,13127,13147,13151,13159,13163,13171,13177,13183,13187,13217,13219,13229,13241,13249,13259,13267,13291,13297,13309,13313,13327,13331,13337,13339,13367,13381,13397,13399,13411,13417,13421,13441,13451,13457,13463,13469,13477,13487,13499,13513,13523,13537,13553,13567,13577,13591,13597,13613,13619,13627,13633,13649,13669,13679,13681,13687,13691,13693,13697,13709,13711,13721,13723,13729,13751,13757,13759,13763,13781,13789,13799,13807,13829,13831,13841,13859,13873,13877,13879,13883,13901,13903,13907,13913,13921,13931,13933,13963,13967,13997,13999,14009,14011,14029,14033,14051,14057,14071,14081,14083,14087,14107,14143,14149,14153,14159,14173,14177,14197,14207,14221,14243,14249,14251,14281,14293,14303,14321,14323,14327,14341,14347,14369,14387,14389,14401,14407,14411,14419,14423,14431,14437,14447,14449,14461,14479,14489,14503,14519,14533,14537,14543,14549,14551,14557,14561,14563,14591,14593,14621,14627,14629,14633,14639,14653,14657,14669,14683,14699,14713,14717,14723,14731,14737,14741,14747,14753,14759,14767,14771,14779,14783,14797,14813,14821,14827,14831,14843,14851,14867,14869,14879,14887,14891,14897,14923,14929,14939,14947,14951,14957,14969,14983,15013,15017,15031,15053,15061,15073,15077,15083,15091,15101,15107,15121,15131,15137,15139,15149,15161,15173,15187,15193,15199,15217,15227,15233,15241,15259,15263,15269,15271,15277,15287,15289,15299,15307,15313,15319,15329,15331,15349,15359,15361,15373,15377,15383,15391,15401,15413,15427,15439,15443,15451,15461,15467,15473,15493,15497,15511,15527,15541,15551,15559,15569,15581,15583,15601,15607,15619,15629,15641,15643,15647,15649,15661,15667,15671,15679,15683,15727,15731,15733,15737,15739,15749,15761,15767,15773,15787,15791,15797,15803,15809,15817,15823,15859,15877,15881,15887,15889,15901,15907,15913,15919,15923,15937,15959,15971,15973,15991,16001,16007,16033,16057,16061,16063,16067,16069,16073,16087,16091,16097,16103,16111,16127,16139,16141,16183,16187,16189,16193,16217,16223,16229,16231,16249,16253,16267,16273,16301,16319,16333,16339,16349,16361,16363,16369,16381,16411,16417,16421,16427,16433,16447,16451,16453,16477,16481,16487,16493,16519,16529,16547,16553,16561,16567,16573,16603,16607,16619,16631,16633,16649,16651,16657,16661,16673,16691,16693,16699,16703,16729,16741,16747,16759,16763,16787,16811,16823,16829,16831,16843,16871,16879,16883,16889,16901,16903,16921,16927,16931,16937,16943,16963,16979,16981,16987,16993,17011,17021,17027,17029,17033,17041,17047,17053,17077,17093,17099,17107,17117,17123,17137,17159,17167,17183,17189,17191,17203,17207,17209,17231,17239,17257,17291,17293,17299,17317,17321,17327,17333,17341,17351,17359,17377,17383,17387,17389,17393,17401,17417,17419,17431,17443,17449,17467,17471,17477,17483,17489,17491,17497,17509,17519,17539,17551,17569,17573,17579,17581,17597,17599,17609,17623,17627,17657,17659,17669,17681,17683,17707,17713,17729,17737,17747,17749,17761,17783,17789,17791,17807,17827,17837,17839,17851,17863,17881,17891,17903,17909,17911,17921,17923,17929,17939,17957,17959,17971,17977,17981,17987,17989,18013,18041,18043,18047,18049,18059,18061,18077,18089,18097,18119,18121,18127,18131,18133,18143,18149,18169,18181,18191,18199,18211,18217,18223,18229,18233,18251,18253,18257,18269,18287,18289,18301,18307,18311,18313,18329,18341,18353,18367,18371,18379,18397,18401,18413,18427,18433,18439,18443,18451,18457,18461,18481,18493,18503,18517,18521,18523,18539,18541,18553,18583,18587,18593,18617,18637,18661,18671,18679,18691,18701,18713,18719,18731,18743,18749,18757,18773,18787,18793,18797,18803,18839,18859,18869,18899,18911,18913,18917,18919,18947,18959,18973,18979,19001,19009,19013,19031,19037,19051,19069,19073,19079,19081,19087,19121,19139,19141,19157,19163,19181,19183,19207,19211,19213,19219,19231,19237,19249,19259,19267,19273,19289,19301,19309,19319,19333,19373,19379,19381,19387,19391,19403,19417,19421,19423,19427,19429,19433,19441,19447,19457,19463,19469,19471,19477,19483,19489,19501,19507,19531,19541,19543,19553,19559,19571,19577,19583,19597,19603,19609,19661,19681,19687,19697,19699,19709,19717,19727,19739,19751,19753,19759,19763,19777,19793,19801,19813,19819,19841,19843,19853,19861,19867,19889,19891,19913,19919,19927,19937,19949,19961,19963,19973,19979,19991,19993,19997,20011,20021,20023,20029,20047,20051,20063,20071,20089,20101,20107,20113,20117,20123,20129,20143,20147,20149,20161,20173,20177,20183,20201,20219,20231,20233,20249,20261,20269,20287,20297,20323,20327,20333,20341,20347,20353,20357,20359,20369,20389,20393,20399,20407,20411,20431,20441,20443,20477,20479,20483,20507,20509,20521,20533,20543,20549,20551,20563,20593,20599,20611,20627,20639,20641,20663,20681,20693,20707,20717,20719,20731,20743,20747,20749,20753,20759,20771,20773,20789,20807,20809,20849,20857,20873,20879,20887,20897,20899,20903,20921,20929,20939,20947,20959,20963,20981,20983,21001,21011,21013,21017,21019,21023,21031,21059,21061,21067,21089,21101,21107,21121,21139,21143,21149,21157,21163,21169,21179,21187,21191,21193,21211,21221,21227,21247,21269,21277,21283,21313,21317,21319,21323,21341,21347,21377,21379,21383,21391,21397,21401,21407,21419,21433,21467,21481,21487,21491,21493,21499,21503,21517,21521,21523,21529,21557,21559,21563,21569,21577,21587,21589,21599,21601,21611,21613,21617,21647,21649,21661,21673,21683,21701,21713,21727,21737,21739,21751,21757,21767,21773,21787,21799,21803,21817,21821,21839,21841,21851,21859,21863,21871,21881,21893,21911,21929,21937,21943,21961,21977,21991,21997,22003,22013,22027,22031,22037,22039,22051,22063,22067,22073,22079,22091,22093,22109,22111,22123,22129,22133,22147,22153,22157,22159,22171,22189,22193,22229,22247,22259,22271,22273,22277,22279,22283,22291,22303,22307,22343,22349,22367,22369,22381,22391,22397,22409,22433,22441,22447,22453,22469,22481,22483,22501,22511,22531,22541,22543,22549,22567,22571,22573,22613,22619,22621,22637,22639,22643,22651,22669,22679,22691,22697,22699,22709,22717,22721,22727,22739,22741,22751,22769,22777,22783,22787,22807,22811,22817,22853,22859,22861,22871,22877,22901,22907,22921,22937,22943,22961,22963,22973,22993,23003,23011,23017,23021,23027,23029,23039,23041,23053,23057,23059,23063,23071,23081,23087,23099,23117,23131,23143,23159,23167,23173,23189,23197,23201,23203,23209,23227,23251,23269,23279,23291,23293,23297,23311,23321,23327,23333,23339,23357,23369,23371,23399,23417,23431,23447,23459,23473,23497,23509,23531,23537,23539,23549,23557,23561,23563,23567,23581,23593,23599,23603,23609,23623,23627,23629,23633,23663,23669,23671,23677,23687,23689,23719,23741,23743,23747,23753,23761,23767,23773,23789,23801,23813,23819,23827,23831,23833,23857,23869,23873,23879,23887,23893,23899,23909,23911,23917,23929,23957,23971,23977,23981,23993,24001,24007,24019,24023,24029,24043,24049,24061,24071,24077,24083,24091,24097,24103,24107,24109,24113,24121,24133,24137,24151,24169,24179,24181,24197,24203,24223,24229,24239,24247,24251,24281,24317,24329,24337,24359,24371,24373,24379,24391,24407,24413,24419,24421,24439,24443,24469,24473,24481,24499,24509,24517,24527,24533,24547,24551,24571,24593,24611,24623,24631,24659,24671,24677,24683,24691,24697,24709,24733,24749,24763,24767,24781,24793,24799,24809,24821,24841,24847,24851,24859,24877,24889,24907,24917,24919,24923,24943,24953,24967,24971,24977,24979,24989,25013,25031,25033,25037,25057,25073,25087,25097,25111,25117,25121,25127,25147,25153,25163,25169,25171,25183,25189,25219,25229,25237,25243,25247,25253,25261,25301,25303,25307,25309,25321,25339,25343,25349,25357,25367,25373,25391,25409,25411,25423,25439,25447,25453,25457,25463,25469,25471,25523,25537,25541,25561,25577,25579,25583,25589,25601,25603,25609,25621,25633,25639,25643,25657,25667,25673,25679,25693,25703,25717,25733,25741,25747,25759,25763,25771,25793,25799,25801,25819,25841,25847,25849,25867,25873,25889,25903,25913,25919,25931,25933,25939,25943,25951,25969,25981,25997,25999,26003,26017,26021,26029,26041,26053,26083,26099,26107,26111,26113,26119,26141,26153,26161,26171,26177,26183,26189,26203,26209,26227,26237,26249,26251,26261,26263,26267,26293,26297,26309,26317,26321,26339,26347,26357,26371,26387,26393,26399,26407,26417,26423,26431,26437,26449,26459,26479,26489,26497,26501,26513,26539,26557,26561,26573,26591,26597,26627,26633,26641,26647,26669,26681,26683,26687,26693,26699,26701,26711,26713,26717,26723,26729,26731,26737,26759,26777,26783,26801,26813,26821,26833,26839,26849,26861,26863,26879,26881,26891,26893,26903,26921,26927,26947,26951,26953,26959,26981,26987,26993,27011,27017,27031,27043,27059,27061,27067,27073,27077,27091,27103,27107,27109,27127,27143,27179,27191,27197,27211,27239,27241,27253,27259,27271,27277,27281,27283,27299,27329,27337,27361,27367,27397,27407,27409,27427,27431,27437,27449,27457,27479,27481,27487,27509,27527,27529,27539,27541,27551,27581,27583,27611,27617,27631,27647,27653,27673,27689,27691,27697,27701,27733,27737,27739,27743,27749,27751,27763,27767,27773,27779,27791,27793,27799,27803,27809,27817,27823,27827,27847,27851,27883,27893,27901,27917,27919,27941,27943,27947,27953,27961,27967,27983,27997,28001,28019,28027,28031,28051,28057,28069,28081,28087,28097,28099,28109,28111,28123,28151,28163,28181,28183,28201,28211,28219,28229,28277,28279,28283,28289,28297,28307,28309,28319,28349,28351,28387,28393,28403,28409,28411,28429,28433,28439,28447,28463,28477,28493,28499,28513,28517,28537,28541,28547,28549,28559,28571,28573,28579,28591,28597,28603,28607,28619,28621,28627,28631,28643,28649,28657,28661,28663,28669,28687,28697,28703,28711,28723,28729,28751,28753,28759,28771,28789,28793,28807,28813,28817,28837,28843,28859,28867,28871,28879,28901,28909,28921,28927,28933,28949,28961,28979,29009,29017,29021,29023,29027,29033,29059,29063,29077,29101,29123,29129,29131,29137,29147,29153,29167,29173,29179,29191,29201,29207,29209,29221,29231,29243,29251,29269,29287,29297,29303,29311,29327,29333,29339,29347,29363,29383,29387,29389,29399,29401,29411,29423,29429,29437,29443,29453,29473,29483,29501,29527,29531,29537,29567,29569,29573,29581,29587,29599,29611,29629,29633,29641,29663,29669,29671,29683,29717,29723,29741,29753,29759,29761,29789,29803,29819,29833,29837,29851,29863,29867,29873,29879,29881,29917,29921,29927,29947,29959,29983,29989,30011,30013,30029,30047,30059,30071,30089,30091,30097,30103,30109,30113,30119,30133,30137,30139,30161,30169,30181,30187,30197,30203,30211,30223,30241,30253,30259,30269,30271,30293,30307,30313,30319,30323,30341,30347,30367,30389,30391,30403,30427,30431,30449,30467,30469,30491,30493,30497,30509,30517,30529,30539,30553,30557,30559,30577,30593,30631,30637,30643,30649,30661,30671,30677,30689,30697,30703,30707,30713,30727,30757,30763,30773,30781,30803,30809,30817,30829,30839,30841,30851,30853,30859,30869,30871,30881,30893,30911,30931,30937,30941,30949,30971,30977,30983,31013,31019,31033,31039,31051,31063,31069,31079,31081,31091,31121,31123,31139,31147,31151,31153,31159,31177,31181,31183,31189,31193,31219,31223,31231,31237,31247,31249,31253,31259,31267,31271,31277,31307,31319,31321,31327,31333,31337,31357,31379,31387,31391,31393,31397,31469,31477,31481,31489,31511,31513,31517,31531,31541,31543,31547,31567,31573,31583,31601,31607,31627,31643,31649,31657,31663,31667,31687,31699,31721,31723,31727,31729,31741,31751,31769,31771,31793,31799,31817,31847,31849,31859,31873,31883,31891,31907,31957,31963,31973,31981,31991,32003,32009,32027,32029,32051,32057,32059,32063,32069,32077,32083,32089,32099,32117,32119,32141,32143,32159,32173,32183,32189,32191,32203,32213,32233,32237,32251,32257,32261,32297,32299,32303,32309,32321,32323,32327,32341,32353,32359,32363,32369,32371,32377,32381,32401,32411,32413,32423,32429,32441,32443,32467,32479,32491,32497,32503,32507,32531,32533,32537,32561,32563,32569,32573,32579,32587,32603,32609,32611,32621,32633,32647,32653,32687,32693,32707,32713,32717,32719,32749,32771,32779,32783,32789,32797,32801,32803,32831,32833,32839,32843,32869,32887,32909,32911,32917,32933,32939,32941,32957,32969,32971,32983,32987,32993,32999,33013,33023,33029,33037,33049,33053,33071,33073,33083,33091,33107,33113,33119,33149,33151,33161,33179,33181,33191,33199,33203,33211,33223,33247,33287,33289,33301,33311,33317,33329,33331,33343,33347,33349,33353,33359,33377,33391,33403,33409,33413,33427,33457,33461,33469,33479,33487,33493,33503,33521,33529,33533,33547,33563,33569,33577,33581,33587,33589,33599,33601,33613,33617,33619,33623,33629,33637,33641,33647,33679,33703,33713,33721,33739,33749,33751,33757,33767,33769,33773,33791,33797,33809,33811,33827,33829,33851,33857,33863,33871,33889,33893,33911,33923,33931,33937,33941,33961,33967,33997,34019,34031,34033,34039,34057,34061,34123,34127,34129,34141,34147,34157,34159,34171,34183,34211,34213,34217,34231,34253,34259,34261,34267,34273,34283,34297,34301,34303,34313,34319,34327,34337,34351,34361,34367,34369,34381,34403,34421,34429,34439,34457,34469,34471,34483,34487,34499,34501,34511,34513,34519,34537,34543,34549,34583,34589,34591,34603,34607,34613,34631,34649,34651,34667,34673,34679,34687,34693,34703,34721,34729,34739,34747,34757,34759,34763,34781,34807,34819,34841,34843,34847,34849,34871,34877,34883,34897,34913,34919,34939,34949,34961,34963,34981,35023,35027,35051,35053,35059,35069,35081,35083,35089,35099,35107,35111,35117,35129,35141,35149,35153,35159,35171,35201,35221,35227,35251,35257,35267,35279,35281,35291,35311,35317,35323,35327,35339,35353,35363,35381,35393,35401,35407,35419,35423,35437,35447,35449,35461,35491,35507,35509,35521,35527,35531,35533,35537,35543,35569,35573,35591,35593,35597,35603,35617,35671,35677,35729,35731,35747,35753,35759,35771,35797,35801,35803,35809,35831,35837,35839,35851,35863,35869,35879,35897,35899,35911,35923,35933,35951,35963,35969,35977,35983,35993,35999,36007,36011,36013,36017,36037,36061,36067,36073,36083,36097,36107,36109,36131,36137,36151,36161,36187,36191,36209,36217,36229,36241,36251,36263,36269,36277,36293,36299,36307,36313,36319,36341,36343,36353,36373,36383,36389,36433,36451,36457,36467,36469,36473,36479,36493,36497,36523,36527,36529,36541,36551,36559,36563,36571,36583,36587,36599,36607,36629,36637,36643,36653,36671,36677,36683,36691,36697,36709,36713,36721,36739,36749,36761,36767,36779,36781,36787,36791,36793,36809,36821,36833,36847,36857,36871,36877,36887,36899,36901,36913,36919,36923,36929,36931,36943,36947,36973,36979,36997,37003,37013,37019,37021,37039,37049,37057,37061,37087,37097,37117,37123,37139,37159,37171,37181,37189,37199,37201,37217,37223,37243,37253,37273,37277,37307,37309,37313,37321,37337,37339,37357,37361,37363,37369,37379,37397,37409,37423,37441,37447,37463,37483,37489,37493,37501,37507,37511,37517,37529,37537,37547,37549,37561,37567,37571,37573,37579,37589,37591,37607,37619,37633,37643,37649,37657,37663,37691,37693,37699,37717,37747,37781,37783,37799,37811,37813,37831,37847,37853,37861,37871,37879,37889,37897,37907,37951,37957,37963,37967,37987,37991,37993,37997,38011,38039,38047,38053,38069,38083,38113,38119,38149,38153,38167,38177,38183,38189,38197,38201,38219,38231,38237,38239,38261,38273,38281,38287,38299,38303,38317,38321,38327,38329,38333,38351,38371,38377,38393,38431,38447,38449,38453,38459,38461,38501,38543,38557,38561,38567,38569,38593,38603,38609,38611,38629,38639,38651,38653,38669,38671,38677,38693,38699,38707,38711,38713,38723,38729,38737,38747,38749,38767,38783,38791,38803,38821,38833,38839,38851,38861,38867,38873,38891,38903,38917,38921,38923,38933,38953,38959,38971,38977,38993,39019,39023,39041,39043,39047,39079,39089,39097,39103,39107,39113,39119,39133,39139,39157,39161,39163,39181,39191,39199,39209,39217,39227,39229,39233,39239,39241,39251,39293,39301,39313,39317,39323,39341,39343,39359,39367,39371,39373,39383,39397,39409,39419,39439,39443,39451,39461,39499,39503,39509,39511,39521,39541,39551,39563,39569,39581,39607,39619,39623,39631,39659,39667,39671,39679,39703,39709,39719,39727,39733,39749,39761,39769,39779,39791,39799,39821,39827,39829,39839,39841,39847,39857,39863,39869,39877,39883,39887,39901,39929,39937,39953,39971,39979,39983,39989,40009,40013,40031,40037,40039,40063,40087,40093,40099,40111,40123,40127,40129,40151,40153,40163,40169,40177,40189,40193,40213,40231,40237,40241,40253,40277,40283,40289,40343,40351,40357,40361,40387,40423,40427,40429,40433,40459,40471,40483,40487,40493,40499,40507,40519,40529,40531,40543,40559,40577,40583,40591,40597,40609,40627,40637,40639,40693,40697,40699,40709,40739,40751,40759,40763,40771,40787,40801,40813,40819,40823,40829,40841,40847,40849,40853,40867,40879,40883,40897,40903,40927,40933,40939,40949,40961,40973,40993,41011,41017,41023,41039,41047,41051,41057,41077,41081,41113,41117,41131,41141,41143,41149,41161,41177,41179,41183,41189,41201,41203,41213,41221,41227,41231,41233,41243,41257,41263,41269,41281,41299,41333,41341,41351,41357,41381,41387,41389,41399,41411,41413,41443,41453,41467,41479,41491,41507,41513,41519,41521,41539,41543,41549,41579,41593,41597,41603,41609,41611,41617,41621,41627,41641,41647,41651,41659,41669,41681,41687,41719,41729,41737,41759,41761,41771,41777,41801,41809,41813,41843,41849,41851,41863,41879,41887,41893,41897,41903,41911,41927,41941,41947,41953,41957,41959,41969,41981,41983,41999,42013,42017,42019,42023,42043,42061,42071,42073,42083,42089,42101,42131,42139,42157,42169,42179,42181,42187,42193,42197,42209,42221,42223,42227,42239,42257,42281,42283,42293,42299,42307,42323,42331,42337,42349,42359,42373,42379,42391,42397,42403,42407,42409,42433,42437,42443,42451,42457,42461,42463,42467,42473,42487,42491,42499,42509,42533,42557,42569,42571,42577,42589,42611,42641,42643,42649,42667,42677,42683,42689,42697,42701,42703,42709,42719,42727,42737,42743,42751,42767,42773,42787,42793,42797,42821,42829,42839,42841,42853,42859,42863,42899,42901,42923,42929,42937,42943,42953,42961,42967,42979,42989,43003,43013,43019,43037,43049,43051,43063,43067,43093,43103,43117,43133,43151,43159,43177,43189,43201,43207,43223,43237,43261,43271,43283,43291,43313,43319,43321,43331,43391,43397,43399,43403,43411,43427,43441,43451,43457,43481,43487,43499,43517,43541,43543,43573,43577,43579,43591,43597,43607,43609,43613,43627,43633,43649,43651,43661,43669,43691,43711,43717,43721,43753,43759,43777,43781,43783,43787,43789,43793,43801,43853,43867,43889,43891,43913,43933,43943,43951,43961,43963,43969,43973,43987,43991,43997,44017,44021,44027,44029,44041,44053,44059,44071,44087,44089,44101,44111,44119,44123,44129,44131,44159,44171,44179,44189,44201,44203,44207,44221,44249,44257,44263,44267,44269,44273,44279,44281,44293,44351,44357,44371,44381,44383,44389,44417,44449,44453,44483,44491,44497,44501,44507,44519,44531,44533,44537,44543,44549,44563,44579,44587,44617,44621,44623,44633,44641,44647,44651,44657,44683,44687,44699,44701,44711,44729,44741,44753,44771,44773,44777,44789,44797,44809,44819,44839,44843,44851,44867,44879,44887,44893,44909,44917,44927,44939,44953,44959,44963,44971,44983,44987,45007,45013,45053,45061,45077,45083,45119,45121,45127,45131,45137,45139,45161,45179,45181,45191,45197,45233,45247,45259,45263,45281,45289,45293,45307,45317,45319,45329,45337,45341,45343,45361,45377,45389,45403,45413,45427,45433,45439,45481,45491,45497,45503,45523,45533,45541,45553,45557,45569,45587,45589,45599,45613,45631,45641,45659,45667,45673,45677,45691,45697,45707,45737,45751,45757,45763,45767,45779,45817,45821,45823,45827,45833,45841,45853,45863,45869,45887,45893,45943,45949,45953,45959,45971,45979,45989,46021,46027,46049,46051,46061,46073,46091,46093,46099,46103,46133,46141,46147,46153,46171,46181,46183,46187,46199,46219,46229,46237,46261,46271,46273,46279,46301,46307,46309,46327,46337,46349,46351,46381,46399,46411,46439,46441,46447,46451,46457,46471,46477,46489,46499,46507,46511,46523,46549,46559,46567,46573,46589,46591,46601,46619,46633,46639,46643,46649,46663,46679,46681,46687,46691,46703,46723,46727,46747,46751,46757,46769,46771,46807,46811,46817,46819,46829,46831,46853,46861,46867,46877,46889,46901,46919,46933,46957,46993,46997,47017,47041,47051,47057,47059,47087,47093,47111,47119,47123,47129,47137,47143,47147,47149,47161,47189,47207,47221,47237,47251,47269,47279,47287,47293,47297,47303,47309,47317,47339,47351,47353,47363,47381,47387,47389,47407,47417,47419,47431,47441,47459,47491,47497,47501,47507,47513,47521,47527,47533,47543,47563,47569,47581,47591,47599,47609,47623,47629,47639,47653,47657,47659,47681,47699,47701,47711,47713,47717,47737,47741,47743,47777,47779,47791,47797,47807,47809,47819,47837,47843,47857,47869,47881,47903,47911,47917,47933,47939,47947,47951,47963,47969,47977,47981,48017,48023,48029,48049,48073,48079,48091,48109,48119,48121,48131,48157,48163,48179,48187,48193,48197,48221,48239,48247,48259,48271,48281,48299,48311,48313,48337,48341,48353,48371,48383,48397,48407,48409,48413,48437,48449,48463,48473,48479,48481,48487,48491,48497,48523,48527,48533,48539,48541,48563,48571,48589,48593,48611,48619,48623,48647,48649,48661,48673,48677,48679,48731,48733,48751,48757,48761,48767,48779,48781,48787,48799,48809,48817,48821,48823,48847,48857,48859,48869,48871,48883,48889,48907,48947,48953,48973,48989,48991,49003,49009,49019,49031,49033,49037,49043,49057,49069,49081,49103,49109,49117,49121,49123,49139,49157,49169,49171,49177,49193,49199,49201,49207,49211,49223,49253,49261,49277,49279,49297,49307,49331,49333,49339,49363,49367,49369,49391,49393,49409,49411,49417,49429,49433,49451,49459,49463,49477,49481,49499,49523,49529,49531,49537,49547,49549,49559,49597,49603,49613,49627,49633,49639,49663,49667,49669,49681,49697,49711,49727,49739,49741,49747,49757,49783,49787,49789,49801,49807,49811,49823,49831,49843,49853,49871,49877,49891,49919,49921,49927,49937,49939,49943,49957,49991,49993,49999,50021,50023,50033,50047,50051,50053,50069,50077,50087,50093,50101,50111,50119,50123,50129,50131,50147,50153,50159,50177,50207,50221,50227,50231,50261,50263,50273,50287,50291,50311,50321,50329,50333,50341,50359,50363,50377,50383,50387,50411,50417,50423,50441,50459,50461,50497,50503,50513,50527,50539,50543,50549,50551,50581,50587,50591,50593,50599,50627,50647,50651,50671,50683,50707,50723,50741,50753,50767,50773,50777,50789,50821,50833,50839,50849,50857,50867,50873,50891,50893,50909,50923,50929,50951,50957,50969,50971,50989,50993,51001,51031,51043,51047,51059,51061,51071,51109,51131,51133,51137,51151,51157,51169,51193,51197,51199,51203,51217,51229,51239,51241,51257,51263,51283,51287,51307,51329,51341,51343,51347,51349,51361,51383,51407,51413,51419,51421,51427,51431,51437,51439,51449,51461,51473,51479,51481,51487,51503,51511,51517,51521,51539,51551,51563,51577,51581,51593,51599,51607,51613,51631,51637,51647,51659,51673,51679,51683,51691,51713,51719,51721,51749,51767,51769,51787,51797,51803,51817,51827,51829,51839,51853,51859,51869,51871,51893,51899,51907,51913,51929,51941,51949,51971,51973,51977,51991,52009,52021,52027,52051,52057,52067,52069,52081,52103,52121,52127,52147,52153,52163,52177,52181,52183,52189,52201,52223,52237,52249,52253,52259,52267,52289,52291,52301,52313,52321,52361,52363,52369,52379,52387,52391,52433,52453,52457,52489,52501,52511,52517,52529,52541,52543,52553,52561,52567,52571,52579,52583,52609,52627,52631,52639,52667,52673,52691,52697,52709,52711,52721,52727,52733,52747,52757,52769,52783,52807,52813,52817,52837,52859,52861,52879,52883,52889,52901,52903,52919,52937,52951,52957,52963,52967,52973,52981,52999,53003,53017,53047,53051,53069,53077,53087,53089,53093,53101,53113,53117,53129,53147,53149,53161,53171,53173,53189,53197,53201,53231,53233,53239,53267,53269,53279,53281,53299,53309,53323,53327,53353,53359,53377,53381,53401,53407,53411,53419,53437,53441,53453,53479,53503,53507,53527,53549,53551,53569,53591,53593,53597,53609,53611,53617,53623,53629,53633,53639,53653,53657,53681,53693,53699,53717,53719,53731,53759,53773,53777,53783,53791,53813,53819,53831,53849,53857,53861,53881,53887,53891,53897,53899,53917,53923,53927,53939,53951,53959,53987,53993,54001,54011,54013,54037,54049,54059,54083,54091,54101,54121,54133,54139,54151,54163,54167,54181,54193,54217,54251,54269,54277,54287,54293,54311,54319,54323,54331,54347,54361,54367,54371,54377,54401,54403,54409,54413,54419,54421,54437,54443,54449,54469,54493,54497,54499,54503,54517,54521,54539,54541,54547,54559,54563,54577,54581,54583,54601,54617,54623,54629,54631,54647,54667,54673,54679,54709,54713,54721,54727,54751,54767,54773,54779,54787,54799,54829,54833,54851,54869,54877,54881,54907,54917,54919,54941,54949,54959,54973,54979,54983,55001,55009,55021,55049,55051,55057,55061,55073,55079,55103,55109,55117,55127,55147,55163,55171,55201,55207,55213,55217,55219,55229,55243,55249,55259,55291,55313,55331,55333,55337,55339,55343,55351,55373,55381,55399,55411,55439,55441,55457,55469,55487,55501,55511,55529,55541,55547,55579,55589,55603,55609,55619,55621,55631,55633,55639,55661,55663,55667,55673,55681,55691,55697,55711,55717,55721,55733,55763,55787,55793,55799,55807,55813,55817,55819,55823,55829,55837,55843,55849,55871,55889,55897,55901,55903,55921,55927,55931,55933,55949,55967,55987,55997,56003,56009,56039,56041,56053,56081,56087,56093,56099,56101,56113,56123,56131,56149,56167,56171,56179,56197,56207,56209,56237,56239,56249,56263,56267,56269,56299,56311,56333,56359,56369,56377,56383,56393,56401,56417,56431,56437,56443,56453,56467,56473,56477,56479,56489,56501,56503,56509,56519,56527,56531,56533,56543,56569,56591,56597,56599,56611,56629,56633,56659,56663,56671,56681,56687,56701,56711,56713,56731,56737,56747,56767,56773,56779,56783,56807,56809,56813,56821,56827,56843,56857,56873,56891,56893,56897,56909,56911,56921,56923,56929,56941,56951,56957,56963,56983,56989,56993,56999,57037,57041,57047,57059,57073,57077,57089,57097,57107,57119,57131,57139,57143,57149,57163,57173,57179,57191,57193,57203,57221,57223,57241,57251,57259,57269,57271,57283,57287,57301,57329,57331,57347,57349,57367,57373,57383,57389,57397,57413,57427,57457,57467,57487,57493,57503,57527,57529,57557,57559,57571,57587,57593,57601,57637,57641,57649,57653,57667,57679,57689,57697,57709,57713,57719,57727,57731,57737,57751,57773,57781,57787,57791,57793,57803,57809,57829,57839,57847,57853,57859,57881,57899,57901,57917,57923,57943,57947,57973,57977,57991,58013,58027,58031,58043,58049,58057,58061,58067,58073,58099,58109,58111,58129,58147,58151,58153,58169,58171,58189,58193,58199,58207,58211,58217,58229,58231,58237,58243,58271,58309,58313,58321,58337,58363,58367,58369,58379,58391,58393,58403,58411,58417,58427,58439,58441,58451,58453,58477,58481,58511,58537,58543,58549,58567,58573,58579,58601,58603,58613,58631,58657,58661,58679,58687,58693,58699,58711,58727,58733,58741,58757,58763,58771,58787,58789,58831,58889,58897,58901,58907,58909,58913,58921,58937,58943,58963,58967,58979,58991,58997,59009,59011,59021,59023,59029,59051,59053,59063,59069,59077,59083,59093,59107,59113,59119,59123,59141,59149,59159,59167,59183,59197,59207,59209,59219,59221,59233,59239,59243,59263,59273,59281,59333,59341,59351,59357,59359,59369,59377,59387,59393,59399,59407,59417,59419,59441,59443,59447,59453,59467,59471,59473,59497,59509,59513,59539,59557,59561,59567,59581,59611,59617,59621,59627,59629,59651,59659,59663,59669,59671,59693,59699,59707,59723,59729,59743,59747,59753,59771,59779,59791,59797,59809,59833,59863,59879,59887,59921,59929,59951,59957,59971,59981,59999,60013,60017,60029,60037,60041,60077,60083,60089,60091,60101,60103,60107,60127,60133,60139,60149,60161,60167,60169,60209,60217,60223,60251,60257,60259,60271,60289,60293,60317,60331,60337,60343,60353,60373,60383,60397,60413,60427,60443,60449,60457,60493,60497,60509,60521,60527,60539,60589,60601,60607,60611,60617,60623,60631,60637,60647,60649,60659,60661,60679,60689,60703,60719,60727,60733,60737,60757,60761,60763,60773,60779,60793,60811,60821,60859,60869,60887,60889,60899,60901,60913,60917,60919,60923,60937,60943,60953,60961,61001,61007,61027,61031,61043,61051,61057,61091,61099,61121,61129,61141,61151,61153,61169,61211,61223,61231,61253,61261,61283,61291,61297,61331,61333,61339,61343,61357,61363,61379,61381,61403,61409,61417,61441,61463,61469,61471,61483,61487,61493,61507,61511,61519,61543,61547,61553,61559,61561,61583,61603,61609,61613,61627,61631,61637,61643,61651,61657,61667,61673,61681,61687,61703,61717,61723,61729,61751,61757,61781,61813,61819,61837,61843,61861,61871,61879,61909,61927,61933,61949,61961,61967,61979,61981,61987,61991,62003,62011,62017,62039,62047,62053,62057,62071,62081,62099,62119,62129,62131,62137,62141,62143,62171,62189,62191,62201,62207,62213,62219,62233,62273,62297,62299,62303,62311,62323,62327,62347,62351,62383,62401,62417,62423,62459,62467,62473,62477,62483,62497,62501,62507,62533,62539,62549,62563,62581,62591,62597,62603,62617,62627,62633,62639,62653,62659,62683,62687,62701,62723,62731,62743,62753,62761,62773,62791,62801,62819,62827,62851,62861,62869,62873,62897,62903,62921,62927,62929,62939,62969,62971,62981,62983,62987,62989,63029,63031,63059,63067,63073,63079,63097,63103,63113,63127,63131,63149,63179,63197,63199,63211,63241,63247,63277,63281,63299,63311,63313,63317,63331,63337,63347,63353,63361,63367,63377,63389,63391,63397,63409,63419,63421,63439,63443,63463,63467,63473,63487,63493,63499,63521,63527,63533,63541,63559,63577,63587,63589,63599,63601,63607,63611,63617,63629,63647,63649,63659,63667,63671,63689,63691,63697,63703,63709,63719,63727,63737,63743,63761,63773,63781,63793,63799,63803,63809,63823,63839,63841,63853,63857,63863,63901,63907,63913,63929,63949,63977,63997,64007,64013,64019,64033,64037,64063,64067,64081,64091,64109,64123,64151,64153,64157,64171,64187,64189,64217,64223,64231,64237,64271,64279,64283,64301,64303,64319,64327,64333,64373,64381,64399,64403,64433,64439,64451,64453,64483,64489,64499,64513,64553,64567,64577,64579,64591,64601,64609,64613,64621,64627,64633,64661,64663,64667,64679,64693,64709,64717,64747,64763,64781,64783,64793,64811,64817,64849,64853,64871,64877,64879,64891,64901,64919,64921,64927,64937,64951,64969,64997,65003,65011,65027,65029,65033,65053,65063,65071,65089,65099,65101,65111,65119,65123,65129,65141,65147,65167,65171,65173,65179,65183,65203,65213,65239,65257,65267,65269,65287,65293,65309,65323,65327,65353,65357,65371,65381,65393,65407,65413,65419,65423,65437,65447,65449,65479,65497,65519,65521] arithmoi-0.12.1.0/Math/NumberTheory/Primes/Testing.hs0000644000000000000000000000117607346545000020467 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Testing -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Primality tests. module Math.NumberTheory.Primes.Testing ( -- * Standard tests isPrime , isCertifiedPrime -- * Partial tests , bailliePSW , millerRabinV , isStrongFermatPP , isFermatPP -- * Trial division , trialDivisionPrimeTo ) where import Math.NumberTheory.Primes.Testing.Probabilistic import Math.NumberTheory.Primes.Testing.Certified import Math.NumberTheory.Primes.Factorisation.TrialDivision arithmoi-0.12.1.0/Math/NumberTheory/Primes/Testing/0000755000000000000000000000000007346545000020126 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Primes/Testing/Certified.hs0000644000000000000000000002305207346545000022362 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Testing.Certified -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Deterministic primality testing. {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} module Math.NumberTheory.Primes.Testing.Certified ( isCertifiedPrime ) where import Data.List (foldl') import Data.Bits ((.&.)) import Data.Mod import Data.Proxy import GHC.Integer.GMP.Internals (powModInteger) import GHC.TypeNats (SomeNat(..), someNatVal) import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.Primes (unPrime) import Math.NumberTheory.Primes.Factorisation.TrialDivision (trialDivisionPrimeTo, trialDivisionTo, trialDivisionWith) import Math.NumberTheory.Primes.Factorisation.Montgomery (montgomeryFactorisation, smallFactors, findParms) import Math.NumberTheory.Primes.Testing.Probabilistic (bailliePSW, isPrime, isStrongFermatPP, lucasTest) import Math.NumberTheory.Primes.Sieve.Eratosthenes (primeList, primeSieve) import Math.NumberTheory.Utils (splitOff) -- | @'isCertifiedPrime' n@ tests primality of @n@, first trial division -- by small primes is performed, then a Baillie PSW test and finally a -- prime certificate is constructed and verified, provided no step before -- found @n@ to be composite. Constructing prime certificates can take -- a /very/ long time, so use this with care. isCertifiedPrime :: Integer -> Bool isCertifiedPrime n | n < 0 = isCertifiedPrime (-n) | otherwise = isPrime n && ((n < bpbd) || checkPrimalityProof (certifyBPSW n)) where bpbd = 100000000000000000 -- Although it is known that there are no Baillie PSW pseudoprimes below 2^64, -- use the verified bound 10^17, I don't know whether Gilchrist's result has been -- verified yet. -- | A proof of primality of a positive number. The type is -- abstract to ensure the validity of proofs. data PrimalityProof = Pocklington { cprime :: !Integer -- ^ The number whose primality is proved. , _factorisedPart, _cofactor :: !Integer , _knownFactors :: ![(Integer, Word, Integer, PrimalityProof)] } | TrialDivision { cprime :: !Integer -- ^ The number whose primality is proved. , _tdLimit :: !Integer } | Trivial { cprime :: !Integer -- ^ The number whose primality is proved. } deriving Show -- | Check the validity of a 'PrimalityProof'. Since it should be -- impossible to create invalid proofs by the public interface, this -- should never return 'False'. checkPrimalityProof :: PrimalityProof -> Bool checkPrimalityProof (Trivial n) = isTrivialPrime n checkPrimalityProof (TrialDivision p b) = p <= b*b && trialDivisionPrimeTo b p checkPrimalityProof (Pocklington p a b fcts) = b > 0 && a > b && a*b == pm1 && a == ppProd fcts && all verify fcts where pm1 = p-1 ppProd pps = product [pf^e | (pf,e,_,_) <- pps] verify (pf,_,base,proof) = pf == cprime proof && crit pf base && checkPrimalityProof proof crit pf base = gcd p (x-1) == 1 && y == 1 where x = powModInteger base (pm1 `quot` pf) p y = powModInteger x pf p -- | @'isTrivialPrime'@ checks whether its argument is a trivially -- known prime. isTrivialPrime :: Integer -> Bool isTrivialPrime n = n `elem` trivialPrimes -- | List of trivially known primes. trivialPrimes :: [Integer] trivialPrimes = [2,3,5,7,11,13,17,19,23,29] -- | Certify a small number. This is not exposed and should only -- be used where correct. It is always checked after use, though, -- so it shouldn't be able to lie. smallCert :: Integer -> PrimalityProof smallCert n | n < 30 = Trivial n | otherwise = TrialDivision n (integerSquareRoot n + 1) -- | @'certify' n@ constructs, for @n > 1@, a proof of either -- primality or compositeness of @n@. This may take a very long -- time if the number has no small(ish) prime divisors certify :: Integer -> Maybe PrimalityProof certify n | n < 2 = error "Only numbers larger than 1 can be certified" | n < 31 = case trialDivisionWith trivialPrimes n of ((p,_):_) | p < n -> Nothing | otherwise -> Just (Trivial n) _ -> error "Impossible" | n < billi = let r2 = integerSquareRoot n + 2 in case trialDivisionTo r2 n of ((p,_):_) | p < n -> Nothing | otherwise -> Just (TrialDivision n r2) _ -> error "Impossible" | otherwise = case smallFactors (fromInteger (abs n)) of ([], Just _) | not (isStrongFermatPP n 2) -> Nothing | not (lucasTest n) -> Nothing | otherwise -> Just (certifyBPSW n) -- if it isn't we error and ask for a report. ((toInteger -> p,_):_, _) | p == n -> Just (TrialDivision n (min 100000 n)) | otherwise -> Nothing _ -> error ("***Error factorising " ++ show n ++ "! Please report this to maintainer of arithmoi.") where billi = 1000000000000 -- | Certify a number known to be not too small, having no small prime divisors and having -- passed the Baillie PSW test. So we assume it's prime, erroring if not. -- Since it's presumably a large number, we don't bother with trial division and -- construct a Pocklington certificate. certifyBPSW :: Integer -> PrimalityProof certifyBPSW n = Pocklington n a b kfcts where nm1 = n-1 h = nm1 `quot` 2 m3 = fromInteger n .&. (3 :: Int) == 3 (a,pp,b) = findDecomposition nm1 kfcts0 = map check pp kfcts = foldl' force [] kfcts0 force xs t@(_,_,_,prf) = prf `seq` (t:xs) check (p,e,byTD) = go 2 where go bs | bs > h = error (bpswMessage n) | x == 1 = if m3 && (p == 2) then (p,e,n-bs,Trivial 2) else go (bs+1) | g /= 1 = error (bpswMessage n ++ found g) | y /= 1 = error (bpswMessage n ++ fermat bs) | byTD = (p,e,bs, smallCert p) | otherwise = case certify p of Nothing -> error ("***Error in factorisation code: " ++ show p ++ " was supposed to be prime but isn't.\n" ++ "Please report this to the maintainer.\n\n") Just ppr ->(p,e,bs,ppr) where q = nm1 `quot` p x = powModInteger bs q n y = powModInteger x p n g = gcd n (x-1) -- | Find a decomposition of p-1 for the pocklington certificate. -- Usually bloody slow if p-1 has two (or more) /large/ prime divisors. findDecomposition :: Integer -> (Integer, [(Integer, Word, Bool)], Integer) findDecomposition n = go 1 n [] prms where sr = integerSquareRoot n pbd = min 1000000 (sr+20) prms = map unPrime $ primeList (primeSieve pbd) go a b afs (p:ps) | a > b = (a,afs,b) | otherwise = case splitOff p b of (0,_) -> go a b afs ps (e,q) -> go (a*p^e) q ((p,e,True):afs) ps go a b afs [] | a > b = (a,afs,b) | bailliePSW b = (b,[(b,1,False)],a) -- Until a Baillie PSW pseudoprime is found, I'm going with this | e == 0 = error ("Error in factorisation, " ++ show p ++ " was found as a factor of " ++ show b ++ " but isn't.") | otherwise = go (a*p^e) q ((p,e,False):afs) [] where p = findFactor b 8 6 (e,q) = splitOff p b -- | Find a factor of a known composite with approximately digits digits, -- starting with curve s. Actually, this may loop infinitely, but the -- loop should not be entered before the heat death of the universe. findFactor :: Integer -> Int -> Integer -> Integer findFactor n digits s = case findLoop n lo hi count s of Left t -> findFactor n (digits+5) t Right f -> f where (lo,hi,count) = findParms digits -- | Find a factor or say with which curve to continue. findLoop :: Integer -> Word -> Word -> Word -> Integer -> Either Integer Integer findLoop _ _ _ 0 s = Left s findLoop n lo hi ct s | n <= s+2 = Left 6 | otherwise = case someNatVal (fromInteger n) of SomeNat (_ :: Proxy t) -> case montgomeryFactorisation lo hi (fromInteger s :: Mod t) of Nothing -> findLoop n lo hi (ct-1) (s+1) Just fct | bailliePSW fct -> Right fct | otherwise -> Right (findFactor fct 8 (s+1)) -- | Message in the unlikely case a Baillie PSW pseudoprime is found. bpswMessage :: Integer -> String bpswMessage n = unlines [ "\n***Congratulations! You found a Baillie PSW pseudoprime!" , "Please report this finding to the maintainers:" , "," , "" , "The number in question is:\n" , show n , "\nOther parties like wikipedia might also be interested." , "\nSorry for aborting your programm, but this is a major discovery." ] -- | Found a factor found :: Integer -> String found g = "\nA nontrivial divisor is:\n" ++ show g -- | Fermat failure fermat :: Integer -> String fermat b = "\nThe Fermat test fails for base\n" ++ show b arithmoi-0.12.1.0/Math/NumberTheory/Primes/Testing/Probabilistic.hs0000644000000000000000000002235307346545000023255 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Testing.Probabilistic -- Copyright: (c) 2011 Daniel Fischer, 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Probabilistic primality tests, Miller-Rabin and Baillie-PSW. {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Primes.Testing.Probabilistic ( isPrime , millerRabinV , bailliePSW , isStrongFermatPP , isFermatPP , lucasTest ) where import Data.Bits import Data.Mod import Data.Proxy import GHC.Exts (Word(..), Int(..), (-#), (<#), isTrue#) import GHC.Integer.GMP.Internals import GHC.TypeNats (KnownNat, SomeNat(..), someNatVal) import Math.NumberTheory.Moduli.JacobiSymbol import Math.NumberTheory.Primes.Small import Math.NumberTheory.Roots import Math.NumberTheory.Utils -- | @isPrime n@ tests whether @n@ is a prime (negative or positive). -- It is a combination of trial division and Baillie-PSW test. -- -- If @isPrime n@ returns @False@ then @n@ is definitely composite. -- There is a theoretical possibility that @isPrime n@ is @True@, -- but in fact @n@ is not prime. However, no such numbers are known -- and none exist below @2^64@. If you have found one, please report it, -- because it is a major discovery. isPrime :: Integer -> Bool isPrime n | n < 0 = isPrime (-n) | n < 2 = False | n < 4 = True | otherwise = millerRabinV 0 n -- trial division test && bailliePSW n -- | Miller-Rabin probabilistic primality test. It consists of the trial -- division test and several rounds of the strong Fermat test with different -- bases. The choice of trial divisors and bases are -- implementation details and may change in future silently. -- -- First argument stands for the number of rounds of strong Fermat test. -- If it is 0, only trial division test is performed. -- -- If @millerRabinV k n@ returns @False@ then @n@ is definitely composite. -- Otherwise @n@ may appear composite with probability @1/4^k@. millerRabinV :: Int -> Integer -> Bool millerRabinV k n | n < 0 = millerRabinV k (-n) | n < 2 = False | n < 4 = True | otherwise = go smallPrimes where go (p:ps) | p*p > n = True | otherwise = (n `rem` p /= 0) && go ps go [] = all (isStrongFermatPP n) (take k smallPrimes) smallPrimes = map toInteger $ smallPrimesFromTo minBound maxBound -- | @'isStrongFermatPP' n b@ tests whether non-negative @n@ is -- a strong Fermat probable prime for base @b@. -- -- Apart from primes, also some composite numbers have the tested -- property, but those are rare. Very rare are composite numbers -- having the property for many bases, so testing a large prime -- candidate with several bases can identify composite numbers -- with high probability. An odd number @n > 3@ is prime if and -- only if @'isStrongFermatPP' n b@ holds for all @b@ with -- @2 <= b <= (n-1)/2@, but of course checking all those bases -- would be less efficient than trial division, so one normally -- checks only a relatively small number of bases, depending on -- the desired degree of certainty. The probability that a randomly -- chosen base doesn't identify a composite number @n@ is less than -- @1/4@, so five to ten tests give a reasonable level of certainty -- in general. -- -- Please consult -- for the best choice of bases. isStrongFermatPP :: Integer -> Integer -> Bool isStrongFermatPP n b | n < 0 = error "isStrongFermatPP: negative argument" | n <= 1 = False | n == 2 = True | otherwise = case someNatVal (fromInteger n) of SomeNat (_ :: Proxy t) -> isStrongFermatPPMod (fromInteger b :: Mod t) isStrongFermatPPMod :: KnownNat n => Mod n -> Bool isStrongFermatPPMod b = b == 0 || a == 1 || go t a where m = -1 (t, u) = shiftToOddCount $ unMod m a = b ^% u go 0 _ = False go k x = x == m || go (k - 1) (x * x) -- | @'isFermatPP' n b@ tests whether @n@ is a Fermat probable prime -- for the base @b@, that is, whether @b^(n-1) `mod` n == 1@. -- This is a weaker but simpler condition. However, more is lost -- in strength than is gained in simplicity, so for primality testing, -- the strong check should be used. The remarks about -- the choice of bases to test from @'isStrongFermatPP'@ apply -- with the modification that if @a@ and @b@ are Fermat bases -- for @n@, then @a*b@ /always/ is a Fermat base for @n@ too. -- A /Charmichael number/ is a composite number @n@ which is a -- Fermat probable prime for all bases @b@ coprime to @n@. By the -- above, only primes @p <= n/2@ not dividing @n@ need to be tested -- to identify Carmichael numbers (however, testing all those -- primes would be less efficient than determining Carmichaelness -- from the prime factorisation; but testing an appropriate number -- of prime bases is reasonable to find out whether it's worth the -- effort to undertake the prime factorisation). isFermatPP :: Integer -> Integer -> Bool isFermatPP n b = case someNatVal (fromInteger n) of SomeNat (_ :: Proxy t) -> (fromInteger b :: Mod t) ^% (n-1) == 1 -- | Primality test after Baillie, Pomerance, Selfridge and Wagstaff. -- The Baillie-PSW test consists of a strong Fermat probable primality -- test followed by a (strong) Lucas primality test. This implementation -- assumes that the number @n@ to test is odd and larger than @3@. -- Even and small numbers have to be handled before. Also, before -- applying this test, trial division by small primes should be performed -- to identify many composites cheaply (although the Baillie-PSW test is -- rather fast, about the same speed as a strong Fermat test for four or -- five bases usually, it is, for large numbers, much more costly than -- trial division by small primes, the primes less than @1000@, say, so -- eliminating numbers with small prime factors beforehand is more efficient). -- -- The Baillie-PSW test is very reliable, so far no composite numbers -- passing it are known, and it is known (Gilchrist 2010) that no -- Baillie-PSW pseudoprimes exist below @2^64@. However, a heuristic argument -- by Pomerance indicates that there are likely infinitely many Baillie-PSW -- pseudoprimes. On the other hand, according to -- there is -- reason to believe that there are none with less than several -- thousand digits, so that for most use cases the test can be -- considered definitive. bailliePSW :: Integer -> Bool bailliePSW n = isStrongFermatPP n 2 && lucasTest n -- precondition: n odd, > 3 (no small prime factors, typically large) -- | The Lucas-Selfridge test, including square-check, but without -- the Fermat test. For package-internal use only. lucasTest :: Integer -> Bool lucasTest n | isSquare n || d == 0 = False | d == 1 = True | otherwise = uo == 0 || go t vo qo where d = find True 5 find !pos cd = case jacobi (n `rem` cd) cd of MinusOne -> if pos then cd else (-cd) Zero -> if cd == n then 1 else 0 One -> find (not pos) (cd+2) q = (1-d) `quot` 4 (t,o) = shiftToOddCount (n+1) (uo, vo, qo) = testLucas n q o go 0 _ _ = False go s vn qn = vn == 0 || go (s-1) ((vn*vn-2*qn) `rem` n) ((qn*qn) `rem` n) -- n odd positive, n > abs q, index odd testLucas :: Integer -> Integer -> Integer -> (Integer, Integer, Integer) testLucas n q (S# i#) = look (finiteBitSize (0 :: Word) - 2) where j = I# i# look k | testBit j k = go (k-1) 1 1 1 q | otherwise = look (k-1) go k un un1 vn qn | k < 0 = (un, vn, qn) | testBit j k = go (k-1) u2n1 u2n2 v2n1 q2n1 | otherwise = go (k-1) u2n u2n1 v2n q2n where u2n = (un*vn) `rem` n u2n1 = (un1*vn-qn) `rem` n u2n2 = ((un1-q*un)*vn-qn) `rem` n v2n = (vn*vn-2*qn) `rem` n v2n1 = ((un1 - (2*q)*un)*vn-qn) `rem` n q2n = (qn*qn) `rem` n q2n1 = (qn*qn*q) `rem` n testLucas n q (Jp# bn#) = test (s# -# 1#) where s# = sizeofBigNat# bn# test j# = case indexBigNat# bn# j# of 0## -> test (j# -# 1#) w# -> look (j# -# 1#) (W# w#) (finiteBitSize (0 :: Word) - 1) look j# w i | testBit w i = go j# w (i - 1) 1 1 1 q | otherwise = look j# w (i-1) go k# w i un un1 vn qn | i < 0 = if isTrue# (k# <# 0#) then (un,vn,qn) else go (k# -# 1#) (W# (indexBigNat# bn# k#)) (finiteBitSize (0 :: Word) - 1) un un1 vn qn | testBit w i = go k# w (i-1) u2n1 u2n2 v2n1 q2n1 | otherwise = go k# w (i-1) u2n u2n1 v2n q2n where u2n = (un*vn) `rem` n u2n1 = (un1*vn-qn) `rem` n u2n2 = ((un1-q*un)*vn-qn) `rem` n v2n = (vn*vn-2*qn) `rem` n v2n1 = ((un1 - (2*q)*un)*vn-qn) `rem` n q2n = (qn*qn) `rem` n q2n1 = (qn*qn*q) `rem` n -- Listed as a precondition of lucasTest testLucas _ _ _ = error "lucasTest: negative argument" arithmoi-0.12.1.0/Math/NumberTheory/Primes/Types.hs0000644000000000000000000001315707346545000020160 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.Types -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- This is an internal module, defining types for primes. -- Should not be exposed to users. -- {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} module Math.NumberTheory.Primes.Types ( Prime(..) , toPrimeIntegral ) where import Data.Bits import GHC.Generics import Control.DeepSeq import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Unboxed as U import Math.NumberTheory.Utils.FromIntegral -- $setup -- >>> import Math.NumberTheory.Primes (nextPrime, precPrime) -- | Wrapper for prime elements of @a@. It is supposed to be constructed -- by 'Math.NumberTheory.Primes.nextPrime' / 'Math.NumberTheory.Primes.precPrime'. -- and eliminated by 'unPrime'. -- -- One can leverage 'Enum' instance to generate lists of primes. -- Here are some examples. -- -- * Generate primes from the given interval: -- -- >>> :set -XFlexibleContexts -- >>> [nextPrime 101 .. precPrime 130] -- [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127] -- -- * Generate an infinite list of primes: -- -- > [nextPrime 101 ..] -- > [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127... -- -- * 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: -- -- >>> pred (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 a => NFData (Prime a) instance Show a => Show (Prime a) where showsPrec d (Prime p) r = (if d > 10 then "(" ++ s ++ ")" else s) ++ r where s = "Prime " ++ show p newtype instance U.MVector s (Prime a) = MV_Prime (U.MVector s a) newtype instance U.Vector (Prime a) = V_Prime (U.Vector a) instance U.Unbox a => U.Unbox (Prime a) instance M.MVector U.MVector a => M.MVector U.MVector (Prime a) where {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicOverlaps #-} {-# INLINE basicUnsafeNew #-} {-# INLINE basicInitialize #-} {-# INLINE basicUnsafeReplicate #-} {-# INLINE basicUnsafeRead #-} {-# INLINE basicUnsafeWrite #-} {-# INLINE basicClear #-} {-# INLINE basicSet #-} {-# INLINE basicUnsafeCopy #-} {-# INLINE basicUnsafeGrow #-} basicLength (MV_Prime v) = M.basicLength v basicUnsafeSlice i n (MV_Prime v) = MV_Prime $ M.basicUnsafeSlice i n v basicOverlaps (MV_Prime v1) (MV_Prime v2) = M.basicOverlaps v1 v2 basicUnsafeNew n = MV_Prime <$> M.basicUnsafeNew n basicInitialize (MV_Prime v) = M.basicInitialize v basicUnsafeReplicate n x = MV_Prime <$> M.basicUnsafeReplicate n (unPrime x) basicUnsafeRead (MV_Prime v) i = Prime <$> M.basicUnsafeRead v i basicUnsafeWrite (MV_Prime v) i x = M.basicUnsafeWrite v i (unPrime x) basicClear (MV_Prime v) = M.basicClear v basicSet (MV_Prime v) x = M.basicSet v (unPrime x) basicUnsafeCopy (MV_Prime v1) (MV_Prime v2) = M.basicUnsafeCopy v1 v2 basicUnsafeMove (MV_Prime v1) (MV_Prime v2) = M.basicUnsafeMove v1 v2 basicUnsafeGrow (MV_Prime v) n = MV_Prime <$> M.basicUnsafeGrow v n instance G.Vector U.Vector a => G.Vector U.Vector (Prime a) where {-# INLINE basicUnsafeFreeze #-} {-# INLINE basicUnsafeThaw #-} {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicUnsafeIndexM #-} {-# INLINE elemseq #-} basicUnsafeFreeze (MV_Prime v) = V_Prime <$> G.basicUnsafeFreeze v basicUnsafeThaw (V_Prime v) = MV_Prime <$> G.basicUnsafeThaw v basicLength (V_Prime v) = G.basicLength v basicUnsafeSlice i n (V_Prime v) = V_Prime $ G.basicUnsafeSlice i n v basicUnsafeIndexM (V_Prime v) i = Prime <$> G.basicUnsafeIndexM v i basicUnsafeCopy (MV_Prime mv) (V_Prime v) = G.basicUnsafeCopy mv v elemseq _ = seq -- | Convert between primes of different types, similar in spirit to 'toIntegralSized'. -- -- A simpler version of this function is: -- -- > toPrimeIntegral :: (Integral a, Integral b) => a -> Maybe b -- > toPrimeIntegral (Prime a) -- > | toInteger a == b = Just (Prime (fromInteger b)) -- > | otherwise = Nothing -- > where -- > b = toInteger a -- -- The point of 'toPrimeIntegral' is to avoid redundant conversions and conditions, -- when it is safe to do so, determining type sizes statically with 'bitSizeMaybe'. -- For example, 'toPrimeIntegral' from 'Prime' 'Int' to 'Prime' 'Word' boils down to -- 'Just' . 'fromIntegral'. -- toPrimeIntegral :: (Integral a, Integral b, Bits a, Bits b) => Prime a -> Maybe (Prime b) toPrimeIntegral (Prime a) = case unsignedWidth b of Nothing -> res Just bW -> case unsignedWidth a of Just aW | aW <= bW -> res _ | a <= bit bW - 1 -> res | otherwise -> Nothing where b = fromIntegral' a res = Just (Prime b) {-# INLINE toPrimeIntegral #-} unsignedWidth :: Bits a => a -> Maybe Int unsignedWidth t | isSigned t = subtract 1 <$> bitSizeMaybe t | otherwise = bitSizeMaybe t {-# INLINE unsignedWidth #-} arithmoi-0.12.1.0/Math/NumberTheory/Quadratic/0000755000000000000000000000000007346545000017167 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Quadratic/EisensteinIntegers.hs0000644000000000000000000003174507346545000023344 0ustar0000000000000000-- | -- Module: Math.NumberTheory.EisensteinIntegers -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- -- This module exports functions for manipulating Eisenstein integers, including -- computing their prime factorisations. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} module Math.NumberTheory.Quadratic.EisensteinIntegers ( EisensteinInteger(..) , ω , conjugate , norm , associates , ids -- * Primality functions , findPrime , primes ) where import Prelude hiding (quot, quotRem, gcd) import Control.DeepSeq import Data.Coerce import Data.Euclidean import Data.List (mapAccumL, partition) import Data.Maybe import Data.Ord (comparing) import qualified Data.Semiring as S import GHC.Generics (Generic) import Math.NumberTheory.Moduli.Sqrt import Math.NumberTheory.Primes.Types import qualified Math.NumberTheory.Primes as U import Math.NumberTheory.Utils (mergeBy) import Math.NumberTheory.Utils.FromIntegral infix 6 :+ -- | An Eisenstein integer is @a + bω@, where @a@ and @b@ are both integers. data EisensteinInteger = !Integer :+ !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@. ω :: EisensteinInteger ω = 0 :+ 1 instance Show EisensteinInteger where show (a :+ b) | b == 0 = show a | a == 0 = s ++ b' | otherwise = show a ++ op ++ b' where b' = if abs b == 1 then "ω" else show (abs b) ++ "*ω" op = if b > 0 then "+" else "-" s = if b > 0 then "" else "-" instance Num EisensteinInteger where (+) (a :+ b) (c :+ d) = (a + c) :+ (b + d) (*) (a :+ b) (c :+ d) = (a * c - b * d) :+ (b * (c - d) + a * d) abs = fst . absSignum negate (a :+ b) = (-a) :+ (-b) fromInteger n = n :+ 0 signum = snd . absSignum instance S.Semiring EisensteinInteger where plus = (+) times = (*) zero = 0 :+ 0 one = 1 :+ 0 fromNatural n = naturalToInteger n :+ 0 instance S.Ring EisensteinInteger where negate = negate -- | Returns an @EisensteinInteger@'s sign, and its associate in the first -- sextant. absSignum :: EisensteinInteger -> (EisensteinInteger, EisensteinInteger) absSignum 0 = (0, 0) absSignum z@(a :+ b) -- first sextant: 0 ≤ Arg(z) < π/3 | a > b && b >= 0 = (z, 1) -- second sextant: π/3 ≤ Arg(z) < 2π/3 | b >= a && a > 0 = (b :+ (b - a), 1 :+ 1) -- third sextant: 2π/3 ≤ Arg(z) < π | b > 0 && 0 >= a = ((b - a) :+ (-a), 0 :+ 1) -- fourth sextant: -π ≤ Arg(z) < -2π/3 | a < b && b <= 0 = (-z, -1) -- fifth sextant: -2π/3 ≤ Arg(η) < -π/3 | b <= a && a < 0 = ((-b) :+ (a - b), (-1) :+ (-1)) -- sixth sextant: -π/3 ≤ Arg(η) < 0 | otherwise = ((a - b) :+ a, 0 :+ (-1)) -- | List of all Eisenstein units, counterclockwise across all sextants, -- starting with @1@. ids :: [EisensteinInteger] ids = take 6 (iterate ((1 + ω) *) 1) -- | Produce a list of an @EisensteinInteger@'s associates. associates :: EisensteinInteger -> [EisensteinInteger] associates e = map (e *) ids instance GcdDomain EisensteinInteger instance Euclidean EisensteinInteger where degree = fromInteger . norm quotRem x (d :+ 0) = quotRemInt x d quotRem x y = (q, x - q * y) where (q, _) = quotRemInt (x * conjugate y) (norm y) quotRemInt :: EisensteinInteger -> Integer -> (EisensteinInteger, EisensteinInteger) quotRemInt z 1 = ( z, 0) quotRemInt z (-1) = (-z, 0) quotRemInt (a :+ b) c = (qa :+ qb, (ra - bumpA) :+ (rb - bumpB)) where halfC = abs c `quot` 2 bumpA = signum a * halfC bumpB = signum b * halfC (qa, ra) = (a + bumpA) `quotRem` c (qb, rb) = (b + bumpB) `quotRem` c -- | Conjugate a Eisenstein integer. conjugate :: EisensteinInteger -> EisensteinInteger conjugate (a :+ b) = (a - b) :+ (-b) -- | The square of the magnitude of a Eisenstein integer. norm :: EisensteinInteger -> Integer norm (a :+ b) = a*a - a * b + b*b -- | Checks if a given @EisensteinInteger@ is prime. @EisensteinInteger@s -- whose norm is a prime congruent to @0@ or @1@ modulo 3 are prime. -- See , -- page 12. isPrime :: EisensteinInteger -> Bool isPrime e | e == 0 = False -- Special case, @1 - ω@ is the only Eisenstein prime with norm @3@, -- and @abs (1 - ω) = 2 + ω@. | a' == 2 && b' == 1 = True | b' == 0 && a' `mod` 3 == 2 = isJust $ U.isPrime a' | nE `mod` 3 == 1 = isJust $ U.isPrime nE | otherwise = False where nE = norm e a' :+ b' = abs e -- | Remove @1 - ω@ factors from an @EisensteinInteger@, and calculate that -- prime's multiplicity in the number's factorisation. divideByThree :: EisensteinInteger -> (Word, EisensteinInteger) divideByThree = go 0 where go :: Word -> EisensteinInteger -> (Word, EisensteinInteger) go !n z@(a :+ b) | r1 == 0 && r2 == 0 = go (n + 1) (q1 :+ q2) | otherwise = (n, abs z) where -- @(a + a - b) :+ (a + b)@ is @z * (2 :+ 1)@, and @z * (2 :+ 1)/3@ -- is the same as @z / (1 :+ (-1))@. (q1, r1) = divMod (a + a - b) 3 (q2, r2) = divMod (a + b) 3 -- | Find an Eisenstein integer whose norm is the given prime number -- in the form @3k + 1@. -- -- >>> import Math.NumberTheory.Primes (nextPrime) -- >>> findPrime (nextPrime 7) -- Prime 3+2*ω findPrime :: Prime Integer -> U.Prime EisensteinInteger findPrime p = case (r, sqrtsModPrime (9 * q * q - 1) p) of (1, z : _) -> Prime $ abs $ gcd (unPrime p :+ 0) ((z - 3 * q) :+ 1) _ -> error "findPrime: argument must be prime p = 6k + 1" where (q, r) = unPrime p `quotRem` 6 -- | An infinite list of Eisenstein primes. Uses primes in @Z@ to exhaustively -- generate all Eisenstein primes in order of ascending norm. -- -- * 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. -- -- >>> take 10 primes -- [Prime 2+ω,Prime 2,Prime 3+2*ω,Prime 3+ω,Prime 4+3*ω,Prime 4+ω,Prime 5+3*ω,Prime 5+2*ω,Prime 5,Prime 6+5*ω] primes :: [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) [U.nextPrime 2 ..] 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)]] -- | [Implementation notes for factorise function] -- -- Compute the prime factorisation of a Eisenstein integer. -- -- 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 , -- 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. -- -- Aplying @norm@ to both sides of the equation from Theorem 8.4: -- -- 1. @norm μ = norm ( (-1)^a * ω^b * (1 - ω)^c * product [ π_i^a_i | i <- [1..N]] ) ==@ -- 2. @norm μ = norm ((-1)^a) * norm (ω^b) * norm ((1 - ω)^c) * norm (product [ π_i^a_i | i <- [1..N]]) ==@ -- 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 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). -- -- 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) (U.factorise $ norm g) where 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) | unPrime p `mod` 3 == 2 = let e' = e `quot` 2 in (z `quotI` (unPrime p ^ e'), [(Prime (unPrime p :+ 0), e')]) -- The @`rem` 3 == 0@ case need not be verified because the -- only Eisenstein primes whose norm are a multiple of 3 -- are @1 - ω@ and its associates, which have already been -- removed by the above @go z (3, e)@ pattern match. -- This @otherwise@ is mandatorily @`mod` 3 == 1@. | otherwise = (z', filter ((> 0) . snd) [(gp, k), (gp', k')]) where gp = findPrime p x :+ y = unPrime gp -- @gp'@ is @gp@'s conjugate. 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 :: 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 :: 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'' = iterate (\g -> fromMaybe err $ (g * unPrime p) `quotEvenI` np) z' !! max 0 (wordToInt d2) go1 :: Word -> Word -> EisensteinInteger -> (Word, EisensteinInteger) go1 0 d z = (d, z) go1 c d z | Just z' <- (z * unPrime p') `quotEvenI` np = go1 (c - 1) (d + 1) z' | otherwise = (d, z) err = error $ "divideByPrime: malformed arguments" ++ show (p, np, k) -- | Divide an Eisenstein integer by an even integer. quotEvenI :: EisensteinInteger -> Integer -> Maybe EisensteinInteger quotEvenI (x :+ y) n | xr == 0 , yr == 0 = Just (xq :+ yq) | otherwise = Nothing where (xq, xr) = x `quotRem` n (yq, yr) = y `quotRem` n ------------------------------------------------------------------------------- -- | 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 arithmoi-0.12.1.0/Math/NumberTheory/Quadratic/GaussianIntegers.hs0000644000000000000000000002047007346545000023001 0ustar0000000000000000-- | -- Module: Math.NumberTheory.GaussianIntegers -- Copyright: (c) 2016 Chris Fredrickson, Google Inc. -- Licence: MIT -- Maintainer: Chris Fredrickson -- -- This module exports functions for manipulating Gaussian integers, including -- computing their prime factorisations. -- {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-} module Math.NumberTheory.Quadratic.GaussianIntegers ( GaussianInteger(..), ι, conjugate, norm, primes, findPrime, ) where import Prelude hiding (quot, quotRem) import Control.DeepSeq (NFData) import Data.Coerce import Data.Euclidean import Data.List (mapAccumL, partition) import Data.Maybe import Data.Ord (comparing) import qualified Data.Semiring as S import GHC.Generics import Math.NumberTheory.Moduli.Sqrt import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.Primes.Types import qualified Math.NumberTheory.Primes as U import Math.NumberTheory.Utils (mergeBy) import Math.NumberTheory.Utils.FromIntegral infix 6 :+ -- |A Gaussian integer is a+bi, where a and b are both integers. data GaussianInteger = (:+) { real :: !Integer, imag :: !Integer } deriving (Eq, Ord, Generic) instance NFData GaussianInteger -- |The imaginary unit, where -- -- > ι .^ 2 == -1 ι :: GaussianInteger ι = 0 :+ 1 instance Show GaussianInteger where show (a :+ b) | b == 0 = show a | a == 0 = s ++ b' | otherwise = show a ++ op ++ b' where b' = if abs b == 1 then "ι" else show (abs b) ++ "*ι" op = if b > 0 then "+" else "-" s = if b > 0 then "" else "-" instance Num GaussianInteger where (+) (a :+ b) (c :+ d) = (a + c) :+ (b + d) (*) (a :+ b) (c :+ d) = (a * c - b * d) :+ (a * d + b * c) abs = fst . absSignum negate (a :+ b) = (-a) :+ (-b) fromInteger n = n :+ 0 signum = snd . absSignum instance S.Semiring GaussianInteger where plus = (+) times = (*) zero = 0 :+ 0 one = 1 :+ 0 fromNatural n = naturalToInteger n :+ 0 instance S.Ring GaussianInteger where negate = negate absSignum :: GaussianInteger -> (GaussianInteger, GaussianInteger) absSignum 0 = (0, 0) absSignum z@(a :+ b) -- first quadrant: (0, inf) x [0, inf)i | a > 0 && b >= 0 = (z, 1) -- second quadrant: (-inf, 0] x (0, inf)i | a <= 0 && b > 0 = (b :+ (-a), ι) -- third quadrant: (-inf, 0) x (-inf, 0]i | a < 0 && b <= 0 = (-z, -1) -- fourth quadrant: [0, inf) x (-inf, 0)i | otherwise = ((-b) :+ a, -ι) instance GcdDomain GaussianInteger instance Euclidean GaussianInteger where degree = fromInteger . norm quotRem x (d :+ 0) = quotRemInt x d quotRem x y = (q, x - q * y) where (q, _) = quotRemInt (x * conjugate y) (norm y) quotRemInt :: GaussianInteger -> Integer -> (GaussianInteger, GaussianInteger) quotRemInt z 1 = ( z, 0) quotRemInt z (-1) = (-z, 0) quotRemInt (a :+ b) c = (qa :+ qb, (ra - bumpA) :+ (rb - bumpB)) where halfC = abs c `quot` 2 bumpA = signum a * halfC bumpB = signum b * halfC (qa, ra) = (a + bumpA) `quotRem` c (qb, rb) = (b + bumpB) `quotRem` c -- |Conjugate a Gaussian integer. conjugate :: GaussianInteger -> GaussianInteger conjugate (r :+ i) = r :+ (-i) -- |The square of the magnitude of a Gaussian integer. norm :: GaussianInteger -> Integer norm (x :+ y) = x * x + y * y -- |Compute whether a given Gaussian integer is prime. isPrime :: GaussianInteger -> Bool isPrime g@(x :+ y) | x == 0 && y /= 0 = abs y `mod` 4 == 3 && isJust (U.isPrime y) | y == 0 && x /= 0 = abs x `mod` 4 == 3 && isJust (U.isPrime x) | otherwise = isJust $ U.isPrime $ norm g -- |An infinite list of the Gaussian primes. Uses primes in Z to exhaustively -- generate all Gaussian primes (up to associates), in order of ascending -- magnitude. -- -- >>> take 10 primes -- [Prime 1+ι,Prime 2+ι,Prime 1+2*ι,Prime 3,Prime 3+2*ι,Prime 2+3*ι,Prime 4+ι,Prime 1+4*ι,Prime 5+2*ι,Prime 2+5*ι] primes :: [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) [U.nextPrime 3 ..] l = [unPrime p :+ 0 | p <- leftPrimes] r = [g | p <- rightPrimes, let Prime (x :+ y) = findPrime p, g <- [x :+ y, y :+ x]] -- |Find a Gaussian integer whose norm is the given prime number -- of form 4k + 1 using -- . -- -- >>> import Math.NumberTheory.Primes (nextPrime) -- >>> findPrime (nextPrime 5) -- Prime 2+ι findPrime :: Prime Integer -> U.Prime GaussianInteger findPrime p = case sqrtsModPrime (-1) p of [] -> error "findPrime: an argument must be prime p = 4k + 1" z : _ -> Prime $ go (unPrime p) z -- Effectively we calculate gcdG' (p :+ 0) (z :+ 1) where sqrtp :: Integer sqrtp = integerSquareRoot (unPrime p) go :: Integer -> Integer -> GaussianInteger go g h | g <= sqrtp = g :+ h | otherwise = go h (g `mod` h) -- | 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 -> [(Prime GaussianInteger, Word)] factorise g = concat $ snd $ mapAccumL go g (U.factorise $ norm g) where go :: GaussianInteger -> (Prime Integer, Word) -> (GaussianInteger, [(Prime GaussianInteger, Word)]) go z (Prime 2, e) = (divideByTwo z, [(Prime (1 :+ 1), e)]) go z (p, 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 (unPrime p) e z gp' = Prime (abs (conjugate (unPrime gp))) -- | Remove all (1:+1) factors from the argument, -- avoiding complex division. divideByTwo :: GaussianInteger -> GaussianInteger divideByTwo z@(x :+ y) | even x, even y = divideByTwo $ z `quotI` 2 | odd x, odd y = (x - y) `quot` 2 :+ (x + y) `quot` 2 | otherwise = z -- | Remove p and conj p factors from the argument, -- avoiding complex division. divideByPrime :: 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 :: Word -> Word -> GaussianInteger -> (Word, Word, GaussianInteger) go 0 d z = (d, d, z) go c d z | c >= 2 , Just z' <- z `quotEvenI` np = go (c - 2) (d + 1) z' go c d z = (d + d1, d + d2, z'') where (d1, z') = go1 c 0 z d2 = c - d1 z'' = iterate (\g -> fromMaybe err $ (g * unPrime p) `quotEvenI` np) z' !! wordToInt d2 go1 :: Word -> Word -> GaussianInteger -> (Word, GaussianInteger) go1 0 d z = (d, z) go1 c d z | Just z' <- (z * conjugate (unPrime p)) `quotEvenI` np = go1 (c - 1) (d + 1) z' | otherwise = (d, z) err = error $ "divideByPrime: malformed arguments" ++ show (p, np, k) quotI :: GaussianInteger -> Integer -> GaussianInteger quotI (x :+ y) n = x `quot` n :+ y `quot` n quotEvenI :: GaussianInteger -> Integer -> Maybe GaussianInteger quotEvenI (x :+ y) n | xr == 0 , yr == 0 = Just (xq :+ yq) | otherwise = Nothing where (xq, xr) = x `quotRem` n (yq, yr) = y `quotRem` n ------------------------------------------------------------------------------- instance U.UniqueFactorisation GaussianInteger where factorise 0 = [] factorise g = coerce $ factorise g isPrime g = if isPrime g then Just (Prime g) else Nothing arithmoi-0.12.1.0/Math/NumberTheory/Recurrences.hs0000644000000000000000000000105107346545000020063 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Recurrences -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- 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) arithmoi-0.12.1.0/Math/NumberTheory/Recurrences/0000755000000000000000000000000007346545000017532 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Recurrences/Bilinear.hs0000644000000000000000000003317407346545000021623 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Recurrences.Bilinear -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- 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 -- -- >>> binomial !! 1000 !! 1000 :: Integer -- (0.01 secs, 1,385,512 bytes) -- 1 -- >>> binomial !! 1000 !! 1000 :: Integer -- (0.01 secs, 1,381,616 bytes) -- 1 -- -- against -- -- >>> let binomial' = binomial :: [[Integer]] -- >>> binomial' !! 1000 !! 1000 :: Integer -- (0.01 secs, 1,381,696 bytes) -- 1 -- >>> binomial' !! 1000 !! 1000 :: Integer -- (0.01 secs, 391,152 bytes) -- 1 {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Recurrences.Bilinear ( -- * Pascal triangle binomial , binomialRotated , binomialLine , binomialDiagonal , binomialFactors -- * Other recurrences , stirling1 , stirling2 , lah , eulerian1 , eulerian2 , bernoulli , euler , eulerPolyAt1 , faulhaberPoly ) where import Data.Euclidean (GcdDomain(..)) import Data.List (scanl', zipWith4) import Data.Maybe import Data.Ratio import Data.Semiring (Semiring(..)) import Numeric.Natural import Math.NumberTheory.Recurrences.Linear (factorial) import Math.NumberTheory.Primes -- | Infinite zero-based table of binomial coefficients (also known as Pascal triangle). -- -- > binomial !! n !! k == n! / k! / (n - k)! -- -- Note that 'binomial' !! n !! k is asymptotically slower -- than 'binomialLine' n !! k, -- but imposes only 'Semiring' constraint. -- -- >>> take 6 binomial :: [[Int]] -- [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1]] binomial :: Semiring a => [[a]] binomial = iterate (\l -> zipWith plus (l ++ [zero]) (zero : l)) [one] {-# SPECIALIZE binomial :: [[Int]] #-} {-# SPECIALIZE binomial :: [[Word]] #-} {-# SPECIALIZE binomial :: [[Integer]] #-} {-# SPECIALIZE binomial :: [[Natural]] #-} -- | Pascal triangle, rotated by 45 degrees. -- -- > binomialRotated !! n !! k == (n + k)! / n! / k! == binomial !! (n + k) !! k -- -- Note that 'binomialRotated' !! n !! k is asymptotically slower -- than 'binomialDiagonal' n !! k, -- but imposes only 'Semiring' constraint. -- -- >>> take 6 (map (take 6) binomialRotated) :: [[Int]] -- [[1,1,1,1,1,1],[1,2,3,4,5,6],[1,3,6,10,15,21],[1,4,10,20,35,56],[1,5,15,35,70,126],[1,6,21,56,126,252]] binomialRotated :: Semiring a => [[a]] binomialRotated = iterate (tail . scanl' plus zero) (repeat one) {-# SPECIALIZE binomialRotated :: [[Int]] #-} {-# SPECIALIZE binomialRotated :: [[Word]] #-} {-# SPECIALIZE binomialRotated :: [[Integer]] #-} {-# SPECIALIZE binomialRotated :: [[Natural]] #-} -- | The n-th (zero-based) line of 'binomial' -- (and the n-th diagonal of 'binomialRotated'). -- -- >>> binomialLine 5 -- [1,5,10,10,5,1] binomialLine :: (Enum a, GcdDomain a) => a -> [a] binomialLine n = scanl' (\x (k, nk1) -> fromJust $ (x `times` nk1) `divide` k) one (zip [one..n] [n, pred n..one]) {-# SPECIALIZE binomialLine :: Int -> [Int] #-} {-# SPECIALIZE binomialLine :: Word -> [Word] #-} {-# SPECIALIZE binomialLine :: Integer -> [Integer] #-} {-# SPECIALIZE binomialLine :: Natural -> [Natural] #-} -- | The n-th (zero-based) diagonal of 'binomial' -- (and the n-th line of 'binomialRotated'). -- -- >>> take 6 (binomialDiagonal 5) -- [1,6,21,56,126,252] binomialDiagonal :: (Enum a, GcdDomain a) => a -> [a] binomialDiagonal n = scanl' (\x k -> fromJust (x `times` (n `plus` k) `divide` k)) one [one..] {-# SPECIALIZE binomialDiagonal :: Int -> [Int] #-} {-# SPECIALIZE binomialDiagonal :: Word -> [Word] #-} {-# SPECIALIZE binomialDiagonal :: Integer -> [Integer] #-} {-# SPECIALIZE binomialDiagonal :: Natural -> [Natural] #-} -- | Prime factors of a binomial coefficient. -- -- > binomialFactors n k == factorise (binomial !! n !! k) -- -- >>> binomialFactors 10 4 -- [(Prime 2,1),(Prime 3,1),(Prime 5,1),(Prime 7,1)] binomialFactors :: Word -> Word -> [(Prime Word, Word)] binomialFactors n k | n < 2 = [] | otherwise = filter ((/= 0) . snd) $ map (\p -> (p, mult (unPrime p) n - mult (unPrime p) (n - k) - mult (unPrime p) k)) [minBound .. precPrime n] where mult :: Word -> Word -> Word mult p m = go mp mp where mp = m `quot` p go !acc !x | x >= p = let xp = x `quot` p in go (acc + xp) xp | otherwise = acc -- | Infinite zero-based table of . -- -- >>> 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' from package 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 . -- -- >>> 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' from package 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 . -- @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 . -- -- >>> 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 . -- -- >>> 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 , -- computed via -- 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' from package to compute stand-alone values. bernoulli :: Integral a => [Ratio a] bernoulli = helperForBEEP id (map recip [1..]) {-# SPECIALIZE bernoulli :: [Ratio Int] #-} {-# SPECIALIZE bernoulli :: [Rational] #-} -- | . -- -- >>> sum (map (^ 10) [0..100]) -- 959924142434241924250 -- >>> sum $ zipWith (*) (faulhaberPoly 10) (iterate (* 100) 1) -- 959924142434241924250 % 1 faulhaberPoly :: (GcdDomain a, 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 !! (p+1) -- | Infinite zero-based list of . -- The algorithm used was derived from -- by Kwang-Wu Chen, second formula of the Corollary in page 7. -- Sequence 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 $ helperForBEEP 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 -- by Kwang-Wu Chen, third formula of the Corollary in page 7. -- Element-by-element division of sequences -- and 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 $ helperForBEEP 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 -- @helperForBEEP@ as an argument. -- -- Note: This function has a @([Ratio a] -> [Ratio a])@ argument because -- @bernoulli !! n@ will use, for all nonnegative @n@, every element in -- @stirling2 !! n@, while @euler, eulerPolyAt1@ only use -- @tail $ stirling2 !! n@. As such, this argument serves to pass @id@ -- in the former case, and @tail@ in the latter. helperForBEEP :: Integral a => ([Ratio a] -> [Ratio a]) -> [Ratio a] -> [Ratio a] helperForBEEP g xs = map (f . g) stirling2 where f = sum . zipWith4 (\sgn fact x stir -> sgn * fact * x * stir) (cycle [1, -1]) factorial xs {-# SPECIALIZE helperForBEEP :: ([Ratio Int] -> [Ratio Int]) -> [Ratio Int] -> [Ratio Int] #-} {-# SPECIALIZE helperForBEEP :: ([Rational] -> [Rational]) -> [Rational] -> [Rational] #-} arithmoi-0.12.1.0/Math/NumberTheory/Recurrences/Linear.hs0000644000000000000000000001427407346545000021310 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Recurrences.Linear -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Efficient calculation of linear recurrent sequences, including Fibonacci and Lucas sequences. {-# LANGUAGE BangPatterns #-} module Math.NumberTheory.Recurrences.Linear ( factorial , factorialFactors , fibonacci , fibonacciPair , lucas , lucasPair , generalLucas ) where import Data.Bits import Numeric.Natural import Math.NumberTheory.Primes -- | 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] #-} -- | Prime factors of a factorial. -- -- > factorialFactors n == factorise (factorial !! n) -- -- >>> factorialFactors 10 -- [(Prime 2,8),(Prime 3,4),(Prime 5,2),(Prime 7,1)] factorialFactors :: Word -> [(Prime Word, Word)] factorialFactors n | n < 2 = [] | otherwise = map (\p -> (p, mult (unPrime p))) [minBound .. precPrime n] where mult :: Word -> Word mult p = go np np where np = n `quot` p go !acc !x | x >= p = let xp = x `quot` p in go (acc + xp) xp | otherwise = acc -- | @'fibonacci' k@ calculates the @k@-th Fibonacci number in -- /O/(@log (abs k)@) steps. The index may be negative. This -- is efficient for calculating single Fibonacci numbers (with -- 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 (finiteBitSize (0 :: Word) - 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 (finiteBitSize (0 :: Word) - 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 (finiteBitSize (0 :: Word) - 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 arithmoi-0.12.1.0/Math/NumberTheory/Recurrences/Pentagonal.hs0000644000000000000000000000343707346545000022165 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Recurrences.Pentagonal -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- -- Values of . -- {-# LANGUAGE TypeApplications #-} module Math.NumberTheory.Recurrences.Pentagonal ( partition ) where import qualified Data.Chimera as Ch import Data.Vector (Vector) import Numeric.Natural (Natural) -- | Infinite list of generalized pentagonal numbers. -- Example: -- -- >>> take 10 pents -- [0,1,2,5,7,12,15,22,26,35] pents :: (Enum a, Num a) => [a] pents = interleave (scanl (\acc n -> acc + 3 * n - 1) 0 [1..]) (scanl (\acc n -> acc + 3 * n - 2) 1 [2..]) where interleave :: [a] -> [a] -> [a] interleave (n : ns) (m : ms) = n : m : interleave ns ms interleave _ _ = [] -- | @p(n) = p(n-1) + p(n-2) - p(n-5) - p(n-7) + p(n-11) + ...@, where @p(0) = 1@ -- and @p(k) = 0@ for a negative integer @k@. Uses a @Chimera@ from the -- @chimera@ package to memoize previous results. partitionF :: Num a => (Word -> a) -> Word -> a partitionF _ 0 = 1 partitionF f n = sum $ zipWith (*) (cycle [1, 1, -1, -1]) $ map (f . (n -)) $ takeWhile (<= n) $ tail pents -- | Infinite zero-based table of . -- -- >>> take 10 partition -- [1,1,2,3,5,7,11,15,22,30] -- -- >>> :set -XDataKinds -- >>> import Data.Mod -- >>> partition !! 1000 :: Mod 1000 -- (991 `modulo` 1000) partition :: Num a => [a] partition = Ch.toList $ Ch.tabulateFix @Vector partitionF {-# SPECIALIZE partition :: [Int] #-} {-# SPECIALIZE partition :: [Word] #-} {-# SPECIALIZE partition :: [Integer] #-} {-# SPECIALIZE partition :: [Natural] #-} arithmoi-0.12.1.0/Math/NumberTheory/RootsOfUnity.hs0000644000000000000000000000507707346545000020243 0ustar0000000000000000-- | -- Module: Math.NumberTheory.RootsOfUnity -- Copyright: (c) 2018 Bhavik Mehta -- Licence: MIT -- Maintainer: Bhavik Mehta -- -- Implementation of roots of unity -- module Math.NumberTheory.RootsOfUnity ( -- * Roots of unity RootOfUnity (..) -- ** Conversions , toRootOfUnity , toComplex ) where import Data.Complex (Complex(..), cis) import Data.Semigroup (Semigroup(..)) import Data.Ratio ((%), numerator, denominator) -- | A representation of : complex -- numbers \(z\) for which there is \(n\) such that \(z^n=1\). newtype RootOfUnity = RootOfUnity { -- | Every root of unity can be expressed as \(e^{2 \pi i q}\) for some -- rational \(q\) satisfying \(0 \leq q < 1\), this function extracts it. fromRootOfUnity :: Rational } deriving (Eq) instance Show RootOfUnity where show (RootOfUnity q) | n == 0 = "1" | d == 1 = "-1" | n == 1 = "e^(πi/" ++ show d ++ ")" | otherwise = "e^(" ++ show n ++ "πi/" ++ show d ++ ")" where n = numerator (2*q) d = denominator (2*q) -- | Given a rational \(q\), produce the root of unity \(e^{2 \pi i q}\). toRootOfUnity :: Rational -> RootOfUnity toRootOfUnity q = RootOfUnity ((n `rem` d) % d) where n = numerator q d = denominator q -- effectively q `mod` 1 -- This smart constructor ensures that the rational is always in the range 0 <= q < 1. -- | This Semigroup is in fact a group, so @'stimes'@ can be called with a negative first argument. instance Semigroup RootOfUnity where RootOfUnity q1 <> RootOfUnity q2 = toRootOfUnity (q1 + q2) stimes k (RootOfUnity q) = toRootOfUnity (q * (toInteger k % 1)) instance Monoid RootOfUnity where mappend = (<>) mempty = RootOfUnity 0 -- | Convert a root of unity into an inexact complex number. Due to floating point inaccuracies, -- it is recommended to avoid use of this until the end of a calculation. Alternatively, with -- the [cyclotomic](http://hackage.haskell.org/package/cyclotomic-0.5.1) package, one can use -- @[polarRat](https://hackage.haskell.org/package/cyclotomic-0.5.1/docs/Data-Complex-Cyclotomic.html#v:polarRat) -- 1 . @'fromRootOfUnity' to convert to a cyclotomic number. toComplex :: Floating a => RootOfUnity -> Complex a toComplex (RootOfUnity t) | t == 1/2 = (-1) :+ 0 | t == 1/4 = 0 :+ 1 | t == 3/4 = 0 :+ (-1) | otherwise = cis . (2*pi*) . fromRational $ t arithmoi-0.12.1.0/Math/NumberTheory/SmoothNumbers.hs0000644000000000000000000000645207346545000020422 0ustar0000000000000000-- | -- Module: Math.NumberTheory.SmoothNumbers -- Copyright: (c) 2018 Frederick Schneider, 2018-2019 Andrew Lelechenko -- Licence: MIT -- Maintainer: Frederick Schneider -- -- A -- is an number, which can be represented as a product of powers of elements -- from a given set (smooth basis). E. g., 48 = 3 * 4 * 4 is smooth -- over a set {3, 4}, and 24 is not. -- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.SmoothNumbers ( SmoothBasis , unSmoothBasis , fromList , isSmooth , smoothOver , smoothOver' ) where import Prelude hiding (div, mod, gcd, (+)) import Data.Euclidean import Data.List (nub) import Data.Maybe import Data.Semiring -- | An abstract representation of a smooth basis. newtype SmoothBasis a = SmoothBasis { unSmoothBasis :: [a] -- ^ Unwrap elements of a smooth basis. } deriving (Show) -- | Build a 'SmoothBasis' from a list of numbers, -- sanitizing it from duplicates, zeros and units. -- -- >>> fromList [2, 3] -- SmoothBasis {unSmoothBasis = [2,3]} -- >>> fromList [2, 2] -- SmoothBasis {unSmoothBasis = [2]} -- >>> fromList [1, 3] -- SmoothBasis {unSmoothBasis = [3]} fromList :: (Eq a, GcdDomain a) => [a] -> SmoothBasis a fromList = SmoothBasis . filter (\x -> not (isZero x) && isNothing (one `divide` x)) . nub -- | A generalization of 'smoothOver', -- suitable for non-'Integral' domains. -- The first argument must be an appropriate -- function, -- like 'Math.NumberTheory.Quadratic.GaussianIntegers.norm' -- or 'Math.NumberTheory.Quadratic.EisensteinIntegers.norm'. -- -- This routine is more efficient than filtering with 'isSmooth'. -- -- >>> import Math.NumberTheory.Quadratic.GaussianIntegers -- >>> take 10 (smoothOver' norm (fromList [1+ι,3])) -- [1,1+ι,2,2+2*ι,3,4,3+3*ι,4+4*ι,6,8] smoothOver' :: (Eq a, Num a, Ord b) => (a -> b) -- ^ -> SmoothBasis a -> [a] smoothOver' norm (SmoothBasis pl) = foldr (\p l -> foldr skipHead [] $ iterate (map (abs . (Prelude.* p))) l) [1] pl where skipHead [] b = b skipHead (h : t) b = h : merge t b merge a [] = a merge [] b = b merge a@(ah : at) b@(bh : bt) | norm bh < norm ah = bh : merge a bt | ah == bh = ah : merge at bt | otherwise = ah : merge at b -- | Generate an infinite ascending list of -- -- over a given smooth basis. -- -- This routine is more efficient than filtering with 'isSmooth'. -- -- >>> take 10 (smoothOver (fromList [2, 5])) -- [1,2,4,5,8,10,16,20,25,32] smoothOver :: Integral a => SmoothBasis a -> [a] smoothOver = smoothOver' abs -- | Check that a given number is smooth under a given 'SmoothBasis'. -- -- >>> isSmooth (fromList [2,3]) 12 -- True -- >>> isSmooth (fromList [2,3]) 15 -- False isSmooth :: (Eq a, GcdDomain a) => SmoothBasis a -> a -> Bool isSmooth prs x = not (isZero x) && go (unSmoothBasis prs) x where go :: (Eq a, GcdDomain a) => [a] -> a -> Bool go [] n = isJust (one `divide` n) go pps@(p:ps) n = case n `divide` p of Nothing -> go ps n Just q -> go pps q || go ps n arithmoi-0.12.1.0/Math/NumberTheory/Utils.hs0000644000000000000000000001744207346545000016716 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Utils -- Copyright: (c) 2011 Daniel Fischer -- Licence: MIT -- Maintainer: Daniel Fischer -- -- Some utilities, mostly for bit twiddling. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} module Math.NumberTheory.Utils ( SomeKnown(..) , shiftToOddCount , shiftToOdd , shiftToOdd# , shiftToOddCount# , shiftToOddCountBigNat , splitOff , splitOff# , mergeBy , recipMod , toWheel30 , fromWheel30 , withSomeKnown , intVal ) where import Prelude hiding (mod, quotRem) import qualified Prelude as P import Data.Bits import Data.Euclidean import Data.Semiring (Semiring(..), isZero) import GHC.Base import GHC.Integer.GMP.Internals import qualified Math.NumberTheory.Utils.FromIntegral as UT import GHC.Natural import GHC.TypeNats import Math.NumberTheory.Utils.FromIntegral (intToWord) -- | Remove factors of @2@ and count them. If -- @n = 2^k*m@ with @m@ odd, the result is @(k, m)@. -- Precondition: argument not @0@ (not checked). {-# RULES "shiftToOddCount/Int" shiftToOddCount = shiftOCInt "shiftToOddCount/Word" shiftToOddCount = shiftOCWord "shiftToOddCount/Integer" shiftToOddCount = shiftOCInteger "shiftToOddCount/Natural" shiftToOddCount = shiftOCNatural #-} {-# INLINE [1] shiftToOddCount #-} shiftToOddCount :: Integral a => a -> (Word, a) shiftToOddCount n = case shiftOCInteger (toInteger n) of (z, o) -> (z, fromInteger o) -- | Specialised version for @'Word'@. -- Precondition: argument strictly positive (not checked). shiftOCWord :: Word -> (Word, Word) shiftOCWord (W# w#) = case shiftToOddCount# w# of (# z# , u# #) -> (W# z#, W# u#) -- | Specialised version for @'Int'@. -- Precondition: argument nonzero (not checked). shiftOCInt :: Int -> (Word, Int) shiftOCInt (I# i#) = case shiftToOddCount# (int2Word# i#) of (# z#, u# #) -> (W# z#, I# (word2Int# u#)) -- | Specialised version for @'Integer'@. -- Precondition: argument nonzero (not checked). shiftOCInteger :: Integer -> (Word, Integer) shiftOCInteger n@(S# i#) = case shiftToOddCount# (int2Word# i#) of (# 0##, _ #) -> (0, n) (# z#, w# #) -> (W# z#, wordToInteger w#) shiftOCInteger n@(Jp# bn#) = case bigNatZeroCount bn# of 0## -> (0, n) z# -> (W# z#, bigNatToInteger (bn# `shiftRBigNat` word2Int# z#)) shiftOCInteger n@(Jn# bn#) = case bigNatZeroCount bn# of 0## -> (0, n) z# -> (W# z#, bigNatToNegInteger (bn# `shiftRBigNat` word2Int# z#)) -- | Specialised version for @'Natural'@. -- Precondition: argument nonzero (not checked). shiftOCNatural :: Natural -> (Word, Natural) shiftOCNatural n@(NatS# i#) = case shiftToOddCount# i# of (# 0##, _ #) -> (0, n) (# z#, w# #) -> (W# z#, NatS# w#) shiftOCNatural n@(NatJ# bn#) = case bigNatZeroCount bn# of 0## -> (0, n) z# -> (W# z#, bigNatToNatural (bn# `shiftRBigNat` word2Int# z#)) shiftToOddCountBigNat :: BigNat -> (Word, BigNat) shiftToOddCountBigNat bn# = case bigNatZeroCount bn# of 0## -> (0, bn#) z# -> (W# z#, bn# `shiftRBigNat` word2Int# z#) -- | Count trailing zeros in a @'BigNat'@. -- Precondition: argument nonzero (not checked, Integer invariant). bigNatZeroCount :: BigNat -> Word# bigNatZeroCount bn# = count 0## 0# where !(W# bitSize#) = intToWord (finiteBitSize (0 :: Word)) count a# i# = case indexBigNat# bn# i# of 0## -> count (a# `plusWord#` bitSize#) (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). {-# RULES "shiftToOdd/Int" shiftToOdd = shiftOInt "shiftToOdd/Word" shiftToOdd = shiftOWord "shiftToOdd/Integer" shiftToOdd = shiftOInteger #-} {-# INLINE [1] shiftToOdd #-} shiftToOdd :: Integral a => a -> a shiftToOdd n = fromInteger (shiftOInteger (toInteger n)) -- | Specialised version for @'Int'@. -- Precondition: argument nonzero (not checked). shiftOInt :: Int -> Int shiftOInt (I# i#) = I# (word2Int# (shiftToOdd# (int2Word# i#))) -- | Specialised version for @'Word'@. -- Precondition: argument nonzero (not checked). shiftOWord :: Word -> Word shiftOWord (W# w#) = W# (shiftToOdd# w#) -- | Specialised version for @'Int'@. -- Precondition: argument nonzero (not checked). shiftOInteger :: Integer -> Integer shiftOInteger (S# i#) = wordToInteger (shiftToOdd# (int2Word# i#)) shiftOInteger n@(Jp# bn#) = case bigNatZeroCount bn# of 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. shiftToOdd# :: Word# -> Word# shiftToOdd# w# = uncheckedShiftRL# w# (word2Int# (ctz# w#)) -- | Like @'shiftToOdd#'@, but count the number of places to shift too. shiftToOddCount# :: Word# -> (# Word#, Word# #) shiftToOddCount# w# = case ctz# w# of k# -> (# k#, uncheckedShiftRL# w# (word2Int# k#) #) splitOff :: (Eq a, GcdDomain a) => a -> a -> (Word, a) splitOff p n | isZero n = (0, zero) -- prevent infinite loop | otherwise = go 0 n where go !k m = case m `divide` p of Just q -> go (k + 1) q _ -> (k, m) {-# INLINABLE splitOff #-} -- | 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# -> (# 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 `plusWord#` 1##) q _ -> (# k, m #) {-# INLINABLE splitOff# #-} -- | Merges two ordered lists into an ordered list. Checks for neither its -- precondition or postcondition. mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] mergeBy cmp = loop where loop [] ys = ys loop xs [] = xs loop (x:xs) (y:ys) = case cmp x y of GT -> y : loop (x:xs) ys _ -> x : loop xs (y:ys) -- | Work around https://ghc.haskell.org/trac/ghc/ticket/14085 recipMod :: Integer -> Integer -> Maybe Integer recipMod x m = case recipModInteger (x `P.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) ------------------------------------------------------------------------------- -- Helpers for dealing with data types parametrised by natural numbers. data SomeKnown (f :: Nat -> Type) where SomeKnown :: KnownNat k => f k -> SomeKnown f withSomeKnown :: (forall k. KnownNat k => f k -> a) -> SomeKnown f -> a withSomeKnown f (SomeKnown x) = f x intVal :: KnownNat k => a k -> Int intVal = UT.naturalToInt . natVal arithmoi-0.12.1.0/Math/NumberTheory/Utils/0000755000000000000000000000000007346545000016352 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Utils/DirichletSeries.hs0000644000000000000000000000646607346545000022004 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Utils.DirichletSeries -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- An abstract representation of a Dirichlet series over a semiring. -- {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} 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.Euclidean import Data.Map (Map) import qualified Data.Map.Strict as M import Data.Maybe import Data.Semiring (Semiring(..)) import Numeric.Natural -- 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 :: (Num a, 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) , isJust (nb `divide` a) ] {-# SPECIALISE timesAndCrop :: Semiring b => Int -> DirichletSeries Int b -> DirichletSeries Int b -> DirichletSeries Int b #-} {-# SPECIALISE timesAndCrop :: Semiring b => Word -> DirichletSeries Word b -> DirichletSeries Word b -> DirichletSeries Word b #-} {-# 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 #-} arithmoi-0.12.1.0/Math/NumberTheory/Utils/FromIntegral.hs0000644000000000000000000000635407346545000021307 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Utils.FromIntegral -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Monomorphic `fromIntegral`. -- {-# LANGUAGE CPP #-} module Math.NumberTheory.Utils.FromIntegral ( wordToInt , wordToInteger , intToWord , intToInt8 , intToInt64 , int8ToInt64 , intToWord8 , intToWord64 , int8ToInt , int64ToInt , word8ToInt , word64ToInt , intToInteger , int16ToInteger , int64ToInteger , word64ToInteger , naturalToInteger , integerToNatural , integerToWord , integerToWord64 , integerToInt , integerToInt64 , intToNatural , naturalToInt , intToDouble , fromIntegral' ) where import Data.Int import Data.Word import Numeric.Natural wordToInt :: Word -> Int wordToInt = fromIntegral {-# INLINE wordToInt #-} wordToInteger :: Word -> Integer wordToInteger = fromIntegral {-# INLINE wordToInteger #-} intToWord :: Int -> Word intToWord = fromIntegral {-# INLINE intToWord #-} intToInt8 :: Int -> Int8 intToInt8 = fromIntegral {-# INLINE intToInt8 #-} intToInt64 :: Int -> Int64 intToInt64 = fromIntegral {-# INLINE intToInt64 #-} int8ToInt64 :: Int8 -> Int64 int8ToInt64 = fromIntegral {-# INLINE int8ToInt64 #-} intToWord8 :: Int -> Word8 intToWord8 = fromIntegral {-# INLINE intToWord8 #-} intToWord64 :: Int -> Word64 intToWord64 = fromIntegral {-# INLINE intToWord64 #-} int8ToInt :: Int8 -> Int int8ToInt = fromIntegral {-# INLINE int8ToInt #-} int64ToInt :: Int64 -> Int int64ToInt = fromIntegral {-# INLINE int64ToInt #-} word8ToInt :: Word8 -> Int word8ToInt = fromIntegral {-# INLINE word8ToInt #-} word64ToInt :: Word64 -> Int word64ToInt = fromIntegral {-# INLINE word64ToInt #-} intToInteger :: Int -> Integer intToInteger = fromIntegral {-# INLINE intToInteger #-} int16ToInteger :: Int16 -> Integer int16ToInteger = fromIntegral {-# INLINE int16ToInteger #-} int64ToInteger :: Int64 -> Integer int64ToInteger = fromIntegral {-# INLINE int64ToInteger #-} word64ToInteger :: Word64 -> Integer word64ToInteger = fromIntegral {-# INLINE word64ToInteger #-} naturalToInteger :: Natural -> Integer naturalToInteger = fromIntegral {-# INLINE naturalToInteger #-} integerToNatural :: Integer -> Natural integerToNatural = fromIntegral' {-# INLINE integerToNatural #-} integerToWord :: Integer -> Word integerToWord = fromIntegral {-# INLINE integerToWord #-} integerToWord64 :: Integer -> Word64 integerToWord64 = fromIntegral {-# INLINE integerToWord64 #-} integerToInt :: Integer -> Int integerToInt = fromIntegral {-# INLINE integerToInt #-} integerToInt64 :: Integer -> Int64 integerToInt64 = fromIntegral {-# INLINE integerToInt64 #-} intToNatural :: Int -> Natural intToNatural = fromIntegral {-# INLINE intToNatural #-} naturalToInt :: Natural -> Int naturalToInt = fromIntegral {-# INLINE naturalToInt #-} intToDouble :: Int -> Double intToDouble = fromIntegral {-# INLINE intToDouble #-} fromIntegral' :: (Integral a, Num b) => a -> b #if __GLASGOW_HASKELL__ == 900 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1 -- Cannot use fromIntegral because of https://gitlab.haskell.org/ghc/ghc/-/issues/19411 fromIntegral' = fromInteger . toInteger #else fromIntegral' = fromIntegral #endif {-# INLINE fromIntegral' #-} arithmoi-0.12.1.0/Math/NumberTheory/Utils/Hyperbola.hs0000644000000000000000000000600207346545000020631 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Utils.Hyperbola -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Highest points under hyperbola. -- module Math.NumberTheory.Utils.Hyperbola ( pointsUnderHyperbola ) where import Data.Bits import Math.NumberTheory.Roots -- | Straightforward computation of -- [ n `quot` x | x <- [hi, hi - 1 .. lo] ]. -- Unfortunately, such list generator performs poor, -- so we fall back to manual recursion. pointsUnderHyperbola0 :: Int -> Int -> Int -> [Int] pointsUnderHyperbola0 n lo hi | n < 0 = error "pointsUnderHyperbola0: first argument must be non-negative" | lo <= 0 = error "pointsUnderHyperbola0: second argument must be positive" | otherwise = go hi where go x | x < lo = [] | otherwise = n `quot` x : go (x - 1) data Bresenham = Bresenham { bresX :: !Int , bresBeta :: !Int , _bresGamma :: !Int , _bresDelta1 :: !Int , _bresEpsilon :: !Int } initBresenham :: Int -> Int -> Bresenham initBresenham n x = Bresenham x beta gamma delta1 epsilon where beta = n `quot` x epsilon = n `rem` x delta1 = n `quot` (x - 1) - beta gamma = beta - (x - 1) * delta1 -- | bresenham(x+1) -> bresenham(x) for x >= (2n)^1/3 stepBack :: Bresenham -> Bresenham stepBack (Bresenham x' beta' gamma' delta1' epsilon') | eps >= x `shiftL` 1 {- delta2 = 2 -} = let delta1 = delta1' + 2 in Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 - x `shiftL` 1) delta1 (eps - x `shiftL` 1) | eps >= x {- delta1 = 1 -} = let delta1 = delta1' + 1 in Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 - x) delta1 (eps - x) | eps >= 0 {- delta2 = 0 -} = Bresenham x (beta' + delta1') (gamma' + delta1' `shiftL` 1) delta1' eps | otherwise {- delta2 = -1 -} = let delta1 = delta1' - 1 in Bresenham x (beta' + delta1) (gamma' + delta1 `shiftL` 1 + x) delta1 (eps + x) where x = x' - 1 eps = epsilon' + gamma' {-# INLINE stepBack #-} -- | Division-free computation of -- [ n `quot` x | x <- [hi, hi - 1 .. lo] ]. -- In other words, we compute y-coordinates of highest integral points -- under hyperbola @x * y = n@ between @x = lo@ and @x = hi@ in reverse order. -- -- The implementation follows section 5 of -- by R. Sladkey. -- It is 2x faster than a trivial implementation for 'Int'. pointsUnderHyperbola :: Int -> Int -> Int -> [Int] pointsUnderHyperbola n lo hi | n < 0 = error "pointsUnderHyperbola: first argument must be non-negative" | lo <= 0 = error "pointsUnderHyperbola: second argument must be positive" | hi < lo = [] | hi == lo = [n `quot` lo] | otherwise = go (initBresenham n hi) where mid = (integerCubeRoot (2 * n) + 1) `max` lo go h | bresX h < mid = pointsUnderHyperbola0 n lo ((mid - 1) `min` hi) | otherwise = bresBeta h : go (stepBack h) arithmoi-0.12.1.0/Math/NumberTheory/Zeta.hs0000644000000000000000000000113607346545000016512 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Zeta -- Copyright: (c) 2018 Alexandre Rodrigues Baldé, Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Numeric evaluation of various zeta-functions. {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Zeta ( -- * Riemann zeta-function zetas , zetasEven -- * Dirichlet beta-function , betas , betasOdd -- * Hurwitz zeta-functions , zetaHurwitz ) where import Math.NumberTheory.Zeta.Dirichlet import Math.NumberTheory.Zeta.Hurwitz import Math.NumberTheory.Zeta.Riemann arithmoi-0.12.1.0/Math/NumberTheory/Zeta/0000755000000000000000000000000007346545000016155 5ustar0000000000000000arithmoi-0.12.1.0/Math/NumberTheory/Zeta/Dirichlet.hs0000644000000000000000000000502607346545000020423 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Zeta.Dirichlet -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- -- Dirichlet beta-function. {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Zeta.Dirichlet ( betas , betasEven , betasOdd ) where import Data.ExactPi import Data.List (zipWith4) import Data.Ratio ((%)) 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)@. -- -- >>> import Data.ExactPi -- >>> approximateValue (betasOdd !! 25) :: Double -- 0.9999999999999987 -- >>> import Data.Number.Fixed -- >>> approximateValue (betasOdd !! 25) :: Fixed Prec50 -- 0.99999999999999999999999960726927497384196726751694 betasOdd :: [ExactPi] betasOdd = zipWith Exact [1, 3 ..] $ zipWith4 (\sgn denom eul twos -> sgn * (eul % (twos * denom))) (cycle [1, -1]) (skipOdds factorial) (skipOdds euler) (iterate (4 *) 4) -- | Infinite sequence of approximate values of the Dirichlet @β@ function at -- positive even integer arguments, starting with @β(0)@. betasEven :: forall a. (Floating a, Ord a) => a -> [a] betasEven eps = (1 / 2) : hurwitz where 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)@. -- -- >>> 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 = 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 -- A similar method is used in @Math.NumberTheory.Zeta.Riemann.zetas@. f x y = 1 `min` (y `max` (1 + (x - 1) / 2)) arithmoi-0.12.1.0/Math/NumberTheory/Zeta/Hurwitz.hs0000644000000000000000000001143307346545000020167 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Zeta.Hurwitz -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- -- 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)@ for @s ∈ [0, 1 ..]@. -- -- The algorithm used was based on the Euler-Maclaurin formula and was derived -- from -- 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 + fromInteger 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 map (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 = map (sum . zipWith (\s p -> s * fromInteger p) 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 arithmoi-0.12.1.0/Math/NumberTheory/Zeta/Riemann.hs0000644000000000000000000000441407346545000020105 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Zeta.Riemann -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Riemann zeta-function. {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Zeta.Riemann ( zetas , zetasEven , zetasOdd ) where import Data.ExactPi import Data.Ratio ((%)) import Math.NumberTheory.Recurrences (bernoulli) import Math.NumberTheory.Zeta.Hurwitz (zetaHurwitz) import Math.NumberTheory.Zeta.Utils (intertwine, skipEvens, skipOdds) -- | Infinite sequence of exact values of Riemann zeta-function at even arguments, starting with @ζ(0)@. -- Note that due to numerical errors conversion to 'Double' may return values below 1: -- -- >>> approximateValue (zetasEven !! 25) :: Double -- 0.9999999999999996 -- -- Use your favorite type for long-precision arithmetic. For instance, 'Data.Number.Fixed.Fixed' works fine: -- -- >>> import Data.Number.Fixed -- >>> approximateValue (zetasEven !! 25) :: Fixed Prec50 -- 1.00000000000000088817842111574532859293035196051773 -- zetasEven :: [ExactPi] zetasEven = zipWith Exact [0, 2 ..] $ zipWith (*) (skipOdds bernoulli) cs where cs = (- 1 % 2) : zipWith (\i f -> i * (-4) / fromInteger (2 * f * (2 * f - 1))) cs [1..] -- | Infinite sequence of approximate values of Riemann zeta-function -- at odd arguments, starting with @ζ(1)@. zetasOdd :: forall a. (Floating a, Ord a) => a -> [a] zetasOdd eps = (1 / 0) : tail (skipEvens $ zetaHurwitz eps 1) -- | Infinite sequence of approximate (up to given precision) -- values of Riemann zeta-function at integer arguments, starting with @ζ(0)@. -- -- >>> take 5 (zetas 1e-14) :: [Double] -- [-0.5,Infinity,1.6449340668482264,1.2020569031595942,1.0823232337111381] -- -- Beware to force evaluation of @zetas !! 1@ if the type @a@ does not support infinite values -- (for instance, 'Data.Number.Fixed.Fixed'). -- zetas :: (Floating a, Ord a) => a -> [a] zetas eps = e : o : scanl1 f (intertwine es os) where e : es = map (getRationalLimit (\a b -> abs (a - b) < eps) . rationalApproximations) zetasEven o : os = zetasOdd eps -- Cap-and-floor to improve numerical stability: -- 0 < zeta(n + 1) - 1 < (zeta(n) - 1) / 2 f x y = 1 `max` (y `min` (1 + (x - 1) / 2)) arithmoi-0.12.1.0/Math/NumberTheory/Zeta/Utils.hs0000644000000000000000000000211607346545000017611 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Zeta.Utils -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- -- Shared utilities used by functions from @Math.NumberTheory.Zeta@. module Math.NumberTheory.Zeta.Utils ( intertwine , skipEvens , skipOdds ) where -- | Joins two lists element-by-element together into one, starting with the -- first one provided as argument. -- -- >>> take 10 (intertwine [0, 2 ..] [1, 3 ..]) -- [0,1,2,3,4,5,6,7,8,9] intertwine :: [a] -> [a] -> [a] intertwine [] ys = ys intertwine (x : xs) ys = x : intertwine ys xs -- | Skips every odd-indexed element from an infinite list. -- Do NOT use with finite lists. -- -- >>> take 10 (skipOdds [0, 1 ..]) -- [0,2,4,6,8,10,12,14,16,18] skipOdds :: [a] -> [a] skipOdds (x : _ : xs) = x : skipOdds xs skipOdds xs = xs -- | Skips every even-indexed element from an infinite list. -- Do NOT use with finite lists. -- -- >>> take 10 (skipEvens [0, 1 ..]) -- [1,3,5,7,9,11,13,15,17,19] skipEvens :: [a] -> [a] skipEvens = skipOdds . tail arithmoi-0.12.1.0/app/0000755000000000000000000000000007346545000012516 5ustar0000000000000000arithmoi-0.12.1.0/app/SequenceModel.hs0000644000000000000000000000574707346545000015620 0ustar0000000000000000-- Model fitting to derive coefficients in -- Math.NumberTheory.Primes.Sequence.chooseAlgorithm module Main where import Numeric.GSL.Fitting -- | Benchmarks Sequence/filterIsPrime -- ([start, length], ([time in microseconds], weight)) filterIsPrimeBenchData :: [([Double], ([Double], Double))] filterIsPrimeBenchData = [ ([100000, 1000], ([777], 0.1)) , ([100000, 10000], ([8523], 0.1)) , ([1000000, 1000], ([813], 0.1)) , ([1000000, 10000], ([8247], 0.1)) , ([1000000, 100000], ([78600], 0.1)) , ([10000000, 1000], ([765], 0.1)) , ([10000000, 10000], ([7685], 0.1)) , ([10000000, 100000], ([78900], 0.1)) , ([10000000, 1000000], ([785000], 0.1)) , ([100000000, 1000], ([792], 0.1)) , ([100000000, 10000], ([8094], 0.1)) , ([100000000, 100000], ([79280], 0.1)) , ([100000000, 1000000], ([771600], 0.1)) , ([100000000, 10000000], ([7670000], 0.1)) ] filterIsPrimeBenchModel :: [(Double, Double)] filterIsPrimeBenchModel = sol where model [d] [from, len] = [len * d] modelDer [d] [from, len] = [[len]] (sol, _) = fitModelScaled 1E-10 1E-10 20 (model, modelDer) filterIsPrimeBenchData [1] filterIsPrimeBenchApprox :: ([Double], ([Double], Double)) -> [Double] filterIsPrimeBenchApprox ([from, len], ([exact], _)) = [from, len, exact, fromInteger (floor (appr / exact * 1000)) / 1000] where [(d, _)] = filterIsPrimeBenchModel appr = len * d -- | Benchmarks Sequence/eratosthenes -- ([start, length], ([time in microseconds], weight)) eratosthenesData :: [([Double], ([Double], Double))] eratosthenesData = [ ([10000000000,1000000], ([21490], 0.1)) , ([10000000000,10000000], ([103200], 0.1)) , ([10000000000,100000000], ([956800], 0.1)) , ([10000000000,1000000000], ([9473000], 0.1)) , ([100000000000,10000000], ([107000], 0.1)) , ([1000000000000,10000000], ([129900], 0.1)) , ([10000000000000,10000000], ([202900], 0.1)) , ([100000000000000,10000000], ([420400], 0.1)) , ([1000000000000000,10000000], ([1048000], 0.1)) , ([10000000000000000,10000000], ([2940000], 0.1)) , ([100000000000000000,10000000], ([8763000], 0.1)) ] eratosthenesModel :: [(Double, Double)] eratosthenesModel = sol where model [a, b, c] [from, len] = [a * len + b * sqrt from + c] modelDer [a, b, c] [from, len] = [[len, sqrt from, 1]] (sol, _) = fitModelScaled 1E-10 1E-10 20 (model, modelDer) eratosthenesData [1,0,0] eratosthenesApprox :: ([Double], ([Double], Double)) -> [Double] eratosthenesApprox ([from, len], ([exact], _)) = [from, len, exact, fromInteger (floor (appr / exact * 1000)) / 1000] where [(a, _), (b, _), (c, _)] = eratosthenesModel appr = a * len + b * sqrt from + c coeffs :: (Double, Double) coeffs = (b / (d - a), c / (d - a)) where [(a, _), (b, _), (c, _)] = eratosthenesModel [(d, _)] = filterIsPrimeBenchModel main :: IO () main = do print filterIsPrimeBenchModel mapM_ (print . filterIsPrimeBenchApprox) filterIsPrimeBenchData print eratosthenesModel mapM_ (print . eratosthenesApprox) eratosthenesData print coeffs arithmoi-0.12.1.0/arithmoi.cabal0000644000000000000000000001656207346545000014550 0ustar0000000000000000name: arithmoi version: 0.12.1.0 cabal-version: 2.0 build-type: Simple license: MIT license-file: LICENSE copyright: (c) 2016-2021 Andrew Lelechenko, 2016-2019 Carter Schonwald, 2011 Daniel Fischer maintainer: Andrew Lelechenko homepage: https://github.com/Bodigrim/arithmoi bug-reports: https://github.com/Bodigrim/arithmoi/issues synopsis: Efficient basic number-theoretic functions. description: A library of basic functionality needed for number-theoretic calculations. The aim of this library is to provide efficient implementations of the functions. Primes and related things (totients, factorisation), powers (integer roots and tests, modular exponentiation). category: Math, Algorithms, Number Theory author: Andrew Lelechenko, Daniel Fischer tested-with: GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.7 GHC ==9.0.2 GHC ==9.2.5 GHC ==9.4.4 GHC ==9.6.1 extra-source-files: changelog.md source-repository head type: git location: https://github.com/Bodigrim/arithmoi library build-depends: base >=4.10 && <5, array >=0.5 && <0.6, containers >=0.5.8 && <0.7, chimera >=0.3, constraints, deepseq, exact-pi >=0.5, integer-gmp <1.2, integer-logarithms >=1.0, integer-roots >=1.0, mod, random >=1.0 && <1.3, transformers >=0.4 && <0.7, semirings >=0.5.2, vector >=0.12 exposed-modules: Math.NumberTheory.ArithmeticFunctions Math.NumberTheory.ArithmeticFunctions.Inverse Math.NumberTheory.ArithmeticFunctions.Mertens Math.NumberTheory.ArithmeticFunctions.NFreedom Math.NumberTheory.ArithmeticFunctions.Moebius Math.NumberTheory.ArithmeticFunctions.SieveBlock Math.NumberTheory.Curves.Montgomery Math.NumberTheory.Diophantine Math.NumberTheory.DirichletCharacters Math.NumberTheory.Euclidean.Coprimes Math.NumberTheory.Moduli Math.NumberTheory.Moduli.Chinese Math.NumberTheory.Moduli.Class Math.NumberTheory.Moduli.Cbrt Math.NumberTheory.Moduli.Equations Math.NumberTheory.Moduli.Multiplicative Math.NumberTheory.Moduli.Singleton Math.NumberTheory.Moduli.Sqrt Math.NumberTheory.MoebiusInversion Math.NumberTheory.Powers.Modular Math.NumberTheory.Prefactored Math.NumberTheory.Primes Math.NumberTheory.Primes.Counting Math.NumberTheory.Primes.IntSet Math.NumberTheory.Primes.Testing Math.NumberTheory.Quadratic.GaussianIntegers Math.NumberTheory.Quadratic.EisensteinIntegers Math.NumberTheory.Recurrences Math.NumberTheory.Recurrences.Bilinear Math.NumberTheory.Recurrences.Linear Math.NumberTheory.SmoothNumbers Math.NumberTheory.Zeta other-modules: Math.NumberTheory.ArithmeticFunctions.Class Math.NumberTheory.ArithmeticFunctions.Standard Math.NumberTheory.Moduli.Internal Math.NumberTheory.Moduli.JacobiSymbol Math.NumberTheory.Moduli.SomeMod Math.NumberTheory.Primes.Counting.Approximate Math.NumberTheory.Primes.Counting.Impl Math.NumberTheory.Primes.Factorisation.Montgomery Math.NumberTheory.Primes.Factorisation.TrialDivision Math.NumberTheory.Primes.Sieve.Eratosthenes Math.NumberTheory.Primes.Sieve.Indexing Math.NumberTheory.Primes.Small Math.NumberTheory.Primes.Testing.Certified Math.NumberTheory.Primes.Testing.Probabilistic Math.NumberTheory.Primes.Types Math.NumberTheory.Recurrences.Pentagonal Math.NumberTheory.RootsOfUnity Math.NumberTheory.Utils Math.NumberTheory.Utils.DirichletSeries Math.NumberTheory.Utils.FromIntegral Math.NumberTheory.Utils.Hyperbola Math.NumberTheory.Zeta.Dirichlet Math.NumberTheory.Zeta.Hurwitz Math.NumberTheory.Zeta.Riemann Math.NumberTheory.Zeta.Utils default-language: Haskell2010 ghc-options: -Wall -Widentities -Wcompat -Wno-deprecations test-suite arithmoi-tests build-depends: base >=4.10 && <5, arithmoi, containers, exact-pi >=0.4.1.1, integer-gmp <1.2, integer-roots >=1.0, mod, QuickCheck >=2.10, quickcheck-classes >=0.6.3, random >=1.0 && <1.3, semirings >=0.2, smallcheck >=1.2 && <1.3, tasty >=0.10, tasty-hunit >=0.9 && <0.11, tasty-quickcheck >=0.9 && <0.11, tasty-rerun >=1.1.17, tasty-smallcheck >=0.8 && <0.9, transformers >=0.5, vector other-modules: Math.NumberTheory.ArithmeticFunctionsTests Math.NumberTheory.ArithmeticFunctions.InverseTests Math.NumberTheory.ArithmeticFunctions.MertensTests Math.NumberTheory.ArithmeticFunctions.SieveBlockTests Math.NumberTheory.CurvesTests Math.NumberTheory.DiophantineTests Math.NumberTheory.DirichletCharactersTests Math.NumberTheory.EisensteinIntegersTests Math.NumberTheory.GaussianIntegersTests Math.NumberTheory.EuclideanTests Math.NumberTheory.Moduli.ChineseTests Math.NumberTheory.Moduli.DiscreteLogarithmTests Math.NumberTheory.Moduli.ClassTests Math.NumberTheory.Moduli.CbrtTests Math.NumberTheory.Moduli.EquationsTests Math.NumberTheory.Moduli.JacobiTests Math.NumberTheory.Moduli.PrimitiveRootTests Math.NumberTheory.Moduli.SingletonTests Math.NumberTheory.Moduli.SqrtTests Math.NumberTheory.MoebiusInversionTests Math.NumberTheory.PrefactoredTests Math.NumberTheory.Primes.CountingTests Math.NumberTheory.Primes.FactorisationTests -- Math.NumberTheory.Primes.LinearAlgebraTests -- Math.NumberTheory.Primes.QuadraticSieveTests Math.NumberTheory.Primes.SequenceTests Math.NumberTheory.Primes.SieveTests Math.NumberTheory.Primes.TestingTests Math.NumberTheory.PrimesTests Math.NumberTheory.Recurrences.PentagonalTests Math.NumberTheory.Recurrences.BilinearTests Math.NumberTheory.Recurrences.LinearTests Math.NumberTheory.RootsOfUnityTests Math.NumberTheory.SmoothNumbersTests Math.NumberTheory.TestUtils Math.NumberTheory.TestUtils.MyCompose Math.NumberTheory.TestUtils.Wrappers Math.NumberTheory.UniqueFactorisationTests Math.NumberTheory.Zeta.DirichletTests Math.NumberTheory.Zeta.RiemannTests type: exitcode-stdio-1.0 main-is: Test.hs default-language: Haskell2010 hs-source-dirs: test-suite ghc-options: -Wall -Widentities -Wcompat -threaded benchmark arithmoi-bench build-depends: base, arithmoi, array, constraints, containers, deepseq, integer-logarithms, mod, random, semirings, tasty-bench, vector other-modules: Math.NumberTheory.ArithmeticFunctionsBench Math.NumberTheory.DiscreteLogarithmBench Math.NumberTheory.EisensteinIntegersBench Math.NumberTheory.GaussianIntegersBench Math.NumberTheory.InverseBench Math.NumberTheory.JacobiBench Math.NumberTheory.MertensBench Math.NumberTheory.PrimesBench Math.NumberTheory.PrimitiveRootsBench Math.NumberTheory.RecurrencesBench Math.NumberTheory.SequenceBench Math.NumberTheory.SieveBlockBench Math.NumberTheory.SmoothNumbersBench Math.NumberTheory.ZetaBench type: exitcode-stdio-1.0 main-is: Bench.hs default-language: Haskell2010 hs-source-dirs: benchmark ghc-options: -Wall -Widentities -Wcompat benchmark arithmoi-sequence-model build-depends: base, arithmoi, containers, hmatrix-gsl buildable: False type: exitcode-stdio-1.0 main-is: SequenceModel.hs default-language: Haskell2010 hs-source-dirs: app ghc-options: -Wall -Widentities -Wcompat arithmoi-0.12.1.0/benchmark/0000755000000000000000000000000007346545000013670 5ustar0000000000000000arithmoi-0.12.1.0/benchmark/Bench.hs0000644000000000000000000000232007346545000015240 0ustar0000000000000000module Main where import Test.Tasty.Bench import Math.NumberTheory.ArithmeticFunctionsBench as ArithmeticFunctions import Math.NumberTheory.DiscreteLogarithmBench as DiscreteLogarithm import Math.NumberTheory.EisensteinIntegersBench as Eisenstein import Math.NumberTheory.GaussianIntegersBench as Gaussian import Math.NumberTheory.InverseBench as Inverse import Math.NumberTheory.JacobiBench as Jacobi import Math.NumberTheory.MertensBench as Mertens import Math.NumberTheory.PrimesBench as Primes import Math.NumberTheory.PrimitiveRootsBench as PrimitiveRoots import Math.NumberTheory.RecurrencesBench as Recurrences import Math.NumberTheory.SequenceBench as Sequence import Math.NumberTheory.SieveBlockBench as SieveBlock import Math.NumberTheory.SmoothNumbersBench as SmoothNumbers import Math.NumberTheory.ZetaBench as Zeta main :: IO () main = defaultMain [ ArithmeticFunctions.benchSuite , DiscreteLogarithm.benchSuite , Eisenstein.benchSuite , Gaussian.benchSuite , Inverse.benchSuite , Jacobi.benchSuite , Mertens.benchSuite , Primes.benchSuite , PrimitiveRoots.benchSuite , Recurrences.benchSuite , Sequence.benchSuite , SieveBlock.benchSuite , SmoothNumbers.benchSuite , Zeta.benchSuite ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/0000755000000000000000000000000007346545000017204 5ustar0000000000000000arithmoi-0.12.1.0/benchmark/Math/NumberTheory/ArithmeticFunctionsBench.hs0000644000000000000000000000256007346545000024465 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.ArithmeticFunctionsBench ( benchSuite ) where import Test.Tasty.Bench import Data.Set (Set) import Math.NumberTheory.ArithmeticFunctions as A compareFunctions :: String -> (Integer -> Integer) -> [Integer] -> Benchmark compareFunctions name new range = bench name $ nf (map new) range compareSetFunctions :: String -> (Integer -> Set Integer) -> Benchmark compareSetFunctions name new = bench name $ nf (map new) [1..100000] benchSuite :: Benchmark benchSuite = bgroup "ArithmeticFunctions" [ compareSetFunctions "divisors" A.divisors , bench "divisors/int" $ nf (map A.divisorsSmall) [1 :: Int .. 100000] , compareFunctions "totient" A.totient [1..100000] , compareFunctions "carmichael" A.carmichael [1..100000] , compareFunctions "moebius" (A.runMoebius . A.moebius) [1..100000] , compareFunctions "tau" A.tau [1..100000] , compareFunctions "sigma 1" (A.sigma 1) [1..100000] , compareFunctions "sigma 2" (A.sigma 2) [1..100000] , compareFunctions "ramanujan range" ramanujan [1..2000] , compareFunctions "ramanujan large prime" ramanujan [100003] , compareFunctions "ramanujan prime power" ramanujan [2^3000] ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/DiscreteLogarithmBench.hs0000644000000000000000000000457507346545000024124 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.DiscreteLogarithmBench ( benchSuite , rangeCases , discreteLogarithm' ) where import Test.Tasty.Bench import Control.Monad import Data.Maybe import Data.Mod import GHC.TypeNats (KnownNat, SomeNat(..), someNatVal) import Data.Proxy import Numeric.Natural import Math.NumberTheory.Moduli.Multiplicative import Math.NumberTheory.Moduli.Singleton data Case = forall m. KnownNat m => Case (PrimitiveRoot m) (MultMod m) String instance Show Case where show (Case a b s) = concat [show (unMod a'), "ⁿ == ", show b', " mod ", s] where a' = multElement $ unPrimitiveRoot a b' = unMod $ multElement b makeCase :: (Integer, Integer, Natural, String) -> Maybe Case makeCase (a,b,n,s) = case someNatVal n of SomeNat (_ :: Proxy m) -> Case <$> join (isPrimitiveRoot @Integer <$> cyclicGroup <*> pure a') <*> isMultElement b' <*> pure s where a' = fromInteger a :: Mod m b' = fromInteger b cases :: [Case] cases = mapMaybe makeCase [ (5, 8, 10^9 + 7, "10^9 + 7") , (2, 7, 3^1000, "3^1000") , (2, 3, 10^11 + 3, "10^11 + 3") , (3, 17, 5^700, "5^700") ] rangeCases :: Natural -> Int -> [Case] rangeCases start num = take num $ do n <- [start..] case someNatVal n of SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of Nothing -> [] Just cg -> do a <- take 1 $ mapMaybe (isPrimitiveRoot cg) [2 :: Mod m .. maxBound] b <- take 1 $ filter (/= unPrimitiveRoot a) $ mapMaybe isMultElement [2 .. maxBound] return $ Case a b (show n) discreteLogarithm' :: Case -> Natural discreteLogarithm' (Case a b _) = discreteLogarithm (fromJust cyclicGroup) a b benchSuite :: Benchmark benchSuite = bgroup "Discrete logarithm" [ bgroup "individual case" [ bench (show c) $ nf discreteLogarithm' c | c <- cases] , bgroup "range" [ bench (show num ++ " cases near " ++ show n) $ nf (map discreteLogarithm') $ rangeCases n num | (n, num) <- [(10000, 100), (1000000, 100), (100000000, 100), (10000000000, 100)] ] ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/EisensteinIntegersBench.hs0000644000000000000000000000152507346545000024312 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Math.NumberTheory.EisensteinIntegersBench ( benchSuite ) where import Data.Maybe import Test.Tasty.Bench import Math.NumberTheory.ArithmeticFunctions (tau) import Math.NumberTheory.Primes (isPrime) import Math.NumberTheory.Quadratic.EisensteinIntegers benchFindPrime :: Integer -> Benchmark benchFindPrime n = bench (show n) $ nf findPrime (fromJust (isPrime n)) benchTau :: Integer -> Benchmark benchTau n = bench (show n) $ nf (\m -> sum [tau (x :+ y) | x <- [1..m], y <- [0..m]] :: Word) n benchSuite :: Benchmark benchSuite = bgroup "Eisenstein" [ bgroup "findPrime" $ map benchFindPrime [1000003, 10000141, 100000039, 1000000021, 10000000033, 100000000003, 1000000000039, 10000000000051] , bgroup "tau" $ map benchTau [10, 20, 40, 80] ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/GaussianIntegersBench.hs0000644000000000000000000000144307346545000023755 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.GaussianIntegersBench ( benchSuite ) where import Data.Maybe import Test.Tasty.Bench import Math.NumberTheory.ArithmeticFunctions (tau) import Math.NumberTheory.Primes (isPrime) import Math.NumberTheory.Quadratic.GaussianIntegers benchFindPrime :: Integer -> Benchmark benchFindPrime n = bench (show n) $ nf findPrime (fromJust (isPrime n)) benchTau :: Integer -> Benchmark benchTau n = bench (show n) $ nf (\m -> sum [tau (x :+ y) | x <- [1..m], y <- [0..m]] :: Word) n benchSuite :: Benchmark benchSuite = bgroup "Gaussian" [ bgroup "findPrime" $ map benchFindPrime [1000033, 10000121, 100000037, 1000000009, 10000000033, 100000000057, 1000000000061, 10000000000037] , bgroup "tau" $ map benchTau [10, 20, 40, 80] ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/InverseBench.hs0000644000000000000000000000374207346545000022121 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.InverseBench ( benchSuite ) where import Test.Tasty.Bench import Data.Bits (Bits) import Data.Euclidean import Numeric.Natural import Math.NumberTheory.ArithmeticFunctions.Inverse import Math.NumberTheory.Primes fact :: (Enum a, Num a) => a fact = product [1..13] tens :: Num a => a tens = 10 ^ 18 countInverseTotient :: (Ord a, Integral a, Euclidean a, UniqueFactorisation a) => a -> Word countInverseTotient = inverseTotient (const 1) countInverseSigma :: (Integral a, Euclidean a, UniqueFactorisation a, Enum (Prime a), Bits a) => a -> Word countInverseSigma = inverseSigma (const 1) benchSuite :: Benchmark benchSuite = bgroup "Inverse" [ bgroup "Totient" [ bgroup "factorial" [ bench "Int" $ nf (countInverseTotient @Int) fact , bench "Word" $ nf (countInverseTotient @Word) fact , bench "Integer" $ nf (countInverseTotient @Integer) fact , bench "Natural" $ nf (countInverseTotient @Natural) fact ] , bgroup "power of 10" [ bench "Int" $ nf (countInverseTotient @Int) tens , bench "Word" $ nf (countInverseTotient @Word) tens , bench "Integer" $ nf (countInverseTotient @Integer) tens , bench "Natural" $ nf (countInverseTotient @Natural) tens ] ] , bgroup "Sigma1" [ bgroup "factorial" [ bench "Int" $ nf (countInverseSigma @Int) fact , bench "Word" $ nf (countInverseSigma @Word) fact , bench "Integer" $ nf (countInverseSigma @Integer) fact , bench "Natural" $ nf (countInverseSigma @Natural) fact ] , bgroup "power of 10" [ bench "Int" $ nf (countInverseSigma @Int) tens , bench "Word" $ nf (countInverseSigma @Word) tens , bench "Integer" $ nf (countInverseSigma @Integer) tens , bench "Natural" $ nf (countInverseSigma @Natural) tens ] ] ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/JacobiBench.hs0000644000000000000000000000130407346545000021665 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.JacobiBench ( benchSuite ) where import Test.Tasty.Bench import Numeric.Natural import Math.NumberTheory.Moduli.Sqrt doBench :: Integral a => (a -> a -> JacobiSymbol) -> a -> a doBench func lim = sum [ x + y | y <- [3, 5 .. lim], x <- [0..y], func x y == One ] benchSuite :: Benchmark benchSuite = bgroup "Jacobi" [ bench "jacobi/Int" $ nf (doBench jacobi :: Int -> Int) 2000 , bench "jacobi/Word" $ nf (doBench jacobi :: Word -> Word) 2000 , bench "jacobi/Integer" $ nf (doBench jacobi :: Integer -> Integer) 2000 , bench "jacobi/Natural" $ nf (doBench jacobi :: Natural -> Natural) 2000 ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/MertensBench.hs0000644000000000000000000000057207346545000022121 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.MertensBench ( benchSuite ) where import Test.Tasty.Bench import Math.NumberTheory.ArithmeticFunctions.Mertens mertensBench :: Word -> Benchmark mertensBench n = bench (show n) (nf mertens n) benchSuite :: Benchmark benchSuite = bgroup "Mertens" $ map mertensBench $ take 4 $ iterate (* 10) 10000000 arithmoi-0.12.1.0/benchmark/Math/NumberTheory/PrimesBench.hs0000644000000000000000000000323507346545000021742 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.PrimesBench ( benchSuite ) where import Test.Tasty.Bench import System.Random import Math.NumberTheory.Logarithms (integerLog2) import Math.NumberTheory.Primes (factorise) import Math.NumberTheory.Primes.Testing genInteger :: Int -> Int -> Integer genInteger salt bits = head . dropWhile ((< bits) . integerLog2) . scanl (\a r -> a * 2^31 + abs r) 1 . randoms . mkStdGen $ salt + bits -- | bases by Jim Sinclair, https://miller-rabin.appspot.com fermatBases :: [Integer] fermatBases = [2, 325, 9375, 28178, 450775, 9780504, 1795265022] isStrongFermat :: Integer -> Bool isStrongFermat n = all (isStrongFermatPP n) fermatBases isFermat :: Integer -> Bool isFermat n = all (isFermatPP n) fermatBases comparePrimalityTests :: Int -> Benchmark comparePrimalityTests bits = bgroup ("primality" ++ show bits) [ bench "isPrime" $ nf (map isPrime) ns , bench "millerRabinV 0" $ nf (map $ millerRabinV 0) ns , bench "millerRabinV 10" $ nf (map $ millerRabinV 10) ns , bench "millerRabinV 50" $ nf (map $ millerRabinV 50) ns , bench "isStrongFermatPP" $ nf (map isStrongFermat) ns , bench "isFermatPP" $ nf (map isFermat) ns ] where ns = take bits [genInteger 0 bits ..] compareFactorisation :: Int -> Benchmark compareFactorisation bits = bench ("factorise" ++ show bits) $ nf (map factorise) ns where ns = take (bits `div` 10) [genInteger 0 bits ..] benchSuite :: Benchmark benchSuite = bgroup "Primes" $ map comparePrimalityTests [50, 100, 200, 500, 1000, 2000] ++ map compareFactorisation [50, 60, 70, 80, 90, 100] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/PrimitiveRootsBench.hs0000644000000000000000000000410007346545000023472 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.PrimitiveRootsBench ( benchSuite ) where import Test.Tasty.Bench import Data.Constraint import Data.Maybe import Math.NumberTheory.Moduli.Multiplicative import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes primRootWrap :: Integer -> Word -> Integer -> Bool primRootWrap p k g = case fromJust $ cyclicGroupFromFactors [(p', k)] of Some cg -> case proofFromCyclicGroup cg of Sub Dict -> isJust $ isPrimitiveRoot cg (fromInteger g) where p' = fromJust $ isPrime p primRootWrap2 :: Integer -> Word -> Integer -> Bool primRootWrap2 p k g = case fromJust $ cyclicGroupFromFactors [(two, 1), (p', k)] of Some cg -> case proofFromCyclicGroup cg of Sub Dict -> isJust $ isPrimitiveRoot cg (fromInteger g) where two = fromJust $ isPrime 2 p' = fromJust $ isPrime p cyclicWrap :: Integer -> Maybe (Some (CyclicGroup Integer)) cyclicWrap = cyclicGroupFromModulo benchSuite :: Benchmark benchSuite = bgroup "PrimRoot" [ bgroup "groupFromModulo" [ bench "3^20000" $ nf cyclicWrap (3^20000) -- prime to large power , bench "10000000000000061" $ nf cyclicWrap (10^16 + 61) -- large prime , bench "2*3^20000" $ nf cyclicWrap (2*3^20000) -- twice prime to large power , bench "10000000000000046" $ nf cyclicWrap (10^16 + 46) -- twice large prime , bench "224403121196654400" $ nf cyclicWrap 224403121196654400 -- highly composite ] , bgroup "check prim roots" [ bench "3^20000" $ nf (primRootWrap 3 20000) 2 -- prime to large power , bench "10000000000000061" $ nf (primRootWrap (10^16 + 61) 1) 3 -- large prime , bench "10000000000000061^2" $ nf (primRootWrap (10^16 + 61) 2) 3 -- large prime squared , bench "2*3^20000" $ nf (primRootWrap2 3 20000) 5 -- twice prime to large power , bench "10000000000000046" $ nf (primRootWrap2 (5*10^15 + 23) 1) 5 -- twice large prime ] ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/RecurrencesBench.hs0000644000000000000000000000250207346545000022757 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} module Math.NumberTheory.RecurrencesBench ( benchSuite ) where import Test.Tasty.Bench import Data.Euclidean (GcdDomain) import Math.NumberTheory.Recurrences benchTriangle :: String -> (forall a. (GcdDomain a, Integral a) => [[a]]) -> Int -> Benchmark benchTriangle name triangle n = bgroup name [ benchAt (10 * n) (1 * n) , benchAt (10 * n) (2 * n) , benchAt (10 * n) (5 * n) , benchAt (10 * n) (9 * n) ] where benchAt i j = bench ("!! " ++ show i ++ " !! " ++ show j) $ nf (\(x, y) -> triangle !! x !! y :: Integer) (i, j) benchPartition :: Int -> Benchmark benchPartition n = bgroup "partition" [ benchAt n , benchAt (n * 10) , benchAt (n * 100) ] where benchAt m = bench ("!!" ++ show m) $ nf (\k -> partition !! k :: Integer) m benchSuite :: Benchmark benchSuite = bgroup "Recurrences" [ bgroup "Bilinear" [ benchTriangle "binomial" binomial 100 , benchTriangle "stirling1" stirling1 100 , benchTriangle "stirling2" stirling2 100 , benchTriangle "eulerian1" eulerian1 100 , benchTriangle "eulerian2" eulerian2 100 ] , benchPartition 1000 , bgroup "factorialFactors" [ bench "10000" $ nf factorialFactors 10000 , bench "20000" $ nf factorialFactors 20000 , bench "40000" $ nf factorialFactors 40000 ] ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/SequenceBench.hs0000644000000000000000000000313007346545000022245 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.SequenceBench ( benchSuite ) where import Test.Tasty.Bench import Data.Array.Unboxed import Data.Bits import Math.NumberTheory.Primes (Prime(..), nextPrime, precPrime) import Math.NumberTheory.Primes.Testing filterIsPrime :: (Integer, Integer) -> Integer filterIsPrime (p, q) = sum $ takeWhile (<= q) $ dropWhile (< p) $ filter isPrime (map toPrim [toIdx p .. toIdx q]) eratosthenes :: (Integer, Integer) -> Integer eratosthenes (p, q) = sum (map unPrime [nextPrime p .. precPrime q]) filterIsPrimeBench :: Benchmark filterIsPrimeBench = bgroup "filterIsPrime" $ [ bench (show (10^x, 10^y)) $ nf filterIsPrime (10^x, 10^x + 10^y) | x <- [5..8] , y <- [3..x-1] ] eratosthenesBench :: Benchmark eratosthenesBench = bgroup "eratosthenes" $ [ bench (show (10^x, 10^y)) $ nf eratosthenes (10^x, 10^x + 10^y) | x <- [10..17] , y <- [6..x-1] , x == 10 || y == 7 ] benchSuite :: Benchmark benchSuite = bgroup "Sequence" [ filterIsPrimeBench , eratosthenesBench ] ------------------------------------------------------------------------------- -- Utils copypasted from internal modules rho :: Int -> Int rho i = residues ! i residues :: UArray Int Int residues = listArray (0,7) [7,11,13,17,19,23,29,31] toIdx :: Integral a => a -> Int toIdx n = 8*fromIntegral q+r2 where (q,r) = (n-7) `quotRem` 30 r1 = fromIntegral r `quot` 3 r2 = min 7 (if r1 > 5 then r1-1 else r1) toPrim :: Integral a => Int -> a toPrim ix = 30*fromIntegral k + fromIntegral (rho i) where i = ix .&. 7 k = ix `shiftR` 3 arithmoi-0.12.1.0/benchmark/Math/NumberTheory/SieveBlockBench.hs0000644000000000000000000000464507346545000022537 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.SieveBlockBench ( benchSuite ) where import Test.Tasty.Bench #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Math.NumberTheory.ArithmeticFunctions.Moebius import Math.NumberTheory.ArithmeticFunctions.SieveBlock import Math.NumberTheory.Primes blockLen :: Word blockLen = 1000000 totientHelper :: Word -> Word -> Word totientHelper p 1 = p - 1 totientHelper p 2 = (p - 1) * p totientHelper p k = (p - 1) * p ^ (k - 1) totientBlockConfig :: SieveBlockConfig Word totientBlockConfig = SieveBlockConfig { sbcEmpty = 1 , sbcAppend = (*) , sbcFunctionOnPrimePower = totientHelper . unPrime } carmichaelHelper :: Word -> Word -> Word carmichaelHelper 2 1 = 1 carmichaelHelper 2 2 = 2 carmichaelHelper 2 k = 2 ^ (k - 2) carmichaelHelper p 1 = p - 1 carmichaelHelper p 2 = (p - 1) * p carmichaelHelper p k = (p - 1) * p ^ (k - 1) carmichaelBlockConfig :: SieveBlockConfig Word carmichaelBlockConfig = SieveBlockConfig { sbcEmpty = 1 -- There is a specialized 'gcd' for Word, but not 'lcm'. , sbcAppend = \x y -> (x `quot` gcd x y) * y , sbcFunctionOnPrimePower = carmichaelHelper . unPrime } moebiusConfig :: SieveBlockConfig Moebius moebiusConfig = SieveBlockConfig { sbcEmpty = MoebiusP , sbcAppend = (<>) , sbcFunctionOnPrimePower = const $ \case 0 -> MoebiusP 1 -> MoebiusN _ -> MoebiusZ } benchSuite :: Benchmark benchSuite = bgroup "SieveBlock" [ bgroup "totient" [ bench "boxed" $ nf (V.sum . sieveBlock totientBlockConfig 1) blockLen , bench "unboxed" $ nf (U.sum . sieveBlockUnboxed totientBlockConfig 1) blockLen ] , bgroup "carmichael" [ bench "boxed" $ nf (V.sum . sieveBlock carmichaelBlockConfig 1) blockLen , bench "unboxed" $ nf (U.sum . sieveBlockUnboxed carmichaelBlockConfig 1) blockLen ] , bgroup "moebius" [ bench "boxed" $ nf (V.sum . V.map runMoebius . sieveBlock moebiusConfig 1 :: Word -> Int) blockLen , bench "unboxed" $ nf (U.sum . U.map runMoebius . sieveBlockUnboxed moebiusConfig 1 :: Word -> Int) blockLen , bench "special" $ nf (U.sum . U.map runMoebius . sieveBlockMoebius 1 :: Word -> Int) blockLen ] ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/SmoothNumbersBench.hs0000644000000000000000000000100507346545000023301 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.SmoothNumbersBench ( benchSuite ) where import Test.Tasty.Bench import Math.NumberTheory.Primes import Math.NumberTheory.SmoothNumbers doBench :: Int -> Int doBench lim = sum $ take lim $ smoothOver $ fromList $ map unPrime [nextPrime 2 .. precPrime lim] benchSuite :: Benchmark benchSuite = bgroup "SmoothNumbers" [ bench "100" $ nf doBench 100 , bench "1000" $ nf doBench 1000 , bench "10000" $ nf doBench 10000 ] arithmoi-0.12.1.0/benchmark/Math/NumberTheory/ZetaBench.hs0000644000000000000000000000055507346545000021410 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.ZetaBench ( benchSuite ) where import Test.Tasty.Bench import Math.NumberTheory.Zeta benchSuite :: Benchmark benchSuite = bgroup "Zeta" [ bench "riemann zeta" $ nf (sum . take 20 . zetas) (1e-15 :: Double) , bench "dirichlet beta" $ nf (sum . take 20 . betas) (1e-15 :: Double) ] arithmoi-0.12.1.0/changelog.md0000644000000000000000000004330707346545000014216 0ustar0000000000000000# Changelog ## 0.12.1.0 ### Fixed * Fix a grave bug in prime factorisation, lurking since `arithmoi-0.7.0.0`. ## 0.12.0.2 ### Fixed * Compatibility patches for GHC 9.4. ## 0.12.0.1 ### Fixed * Compatibility patches for GHC 9.2. ## 0.12.0.0 ### Added * Define cubic symbol ([#194](https://github.com/Bodigrim/arithmoi/pull/194)). * Add `instance Unbox (Prime a)` and `toPrimeIntegral` helper ([#201](https://github.com/Bodigrim/arithmoi/pull/201)). * Implement Cornacchia's algorithm for Diophantine equations ([#195](https://github.com/Bodigrim/arithmoi/pull/195)). * Define a wrapper `PrimeIntSet` for sets of primes ([#205](https://github.com/Bodigrim/arithmoi/pull/205)). ### Deprecated * Deprecate `Math.NumberTheory.Powers.Modular`, use `Data.Mod` or `Data.Mod.Word` instead. ### Removed * Remove modules and functions, deprecated in the previous release. ## 0.11.0.1 ### Changed * Switch to `smallcheck-1.2.0`. ## 0.11.0.0 ### Added * Brand new machinery to deal with Dirichlet characters ([#180](https://github.com/Bodigrim/arithmoi/pull/180)). * Generate preimages of the Jordan and the sum-of-powers-of-divisors functions ([#148](https://github.com/Bodigrim/arithmoi/pull/148)). * More flexible interface for Pascal triangle: in addition to `binomial` we now provide also `binomialRotated`, `binomialLine` and `binomialDiagonal` ([#151](https://github.com/Bodigrim/arithmoi/pull/151)). There are also `factoriseFactorial` and `factoriseBinomial` ([#152](https://github.com/Bodigrim/arithmoi/pull/152)). * Add `Semiring` instance of `SomeMod` ([#174](https://github.com/Bodigrim/arithmoi/pull/174)). * Generate divisors in range ([#183](https://github.com/Bodigrim/arithmoi/pull/183)). ### Changed * Speed up `partition`, using better container for memoization ([#176](https://github.com/Bodigrim/arithmoi/pull/176)). * Speed up `integerRoot`, using better starting approximation ([#177](https://github.com/Bodigrim/arithmoi/pull/177)). ### Deprecated * Deprecate `Math.NumberTheory.Euclidean`, use `Data.Euclidean` instead. * Deprecate `chineseRemainder`, `chineseRemainder2`, `chineseCoprime`, use `chinese` instead. Deprecate `chineseCoprimeSomeMod`, use `chineseSomeMod`. * Deprecate `Math.NumberTheory.Powers` except `Math.NumberTheory.Powers.Modular`. Use `Math.NumberTheory.Roots` instead. * Deprecate `Math.NumberTheory.Moduli.Jacobi`, use `Math.NumberTheory.Moduli.Sqrt` instead. * Deprecate `Math.NumberTheory.Moduli.{DiscreteLogarithm,PrimitiveRoot}`, use `Math.NumberTheory.Moduli.Multiplicative` instead. ### Removed * Remove modules and functions, deprecated in the previous release. ### Fixed * Fix subtraction of `SomeMod` ([#174](https://github.com/Bodigrim/arithmoi/pull/174)). ## 0.10.0.0 ### Added * The machinery of cyclic groups, primitive roots and discrete logarithms has been completely overhauled and rewritten using singleton types ([#169](https://github.com/Bodigrim/arithmoi/pull/169)). There is also a new singleton type, linking a type-level modulo with a term-level factorisation. It allows both to have a nicely-typed API of `Mod m` and avoid repeating factorisations ([#169](https://github.com/Bodigrim/arithmoi/pull/169)). Refer to a brand new module `Math.NumberTheory.Moduli.Singleton` for details. * Add a new function `factorBack`. * Add `Ord SomeMod` instance ([#165](https://github.com/Bodigrim/arithmoi/pull/165)). * Add `Semiring` and `Ring` instances for Eisenstein and Gaussian integers. ### Changed * Embrace the new `Semiring -> GcdDomain -> Euclidean` hierarchy of classes, refining `Num` and `Integral` constraints. * Reshuffle exports from `Math.NumberTheory.Zeta`, do not advertise its submodules as available to import. * Add a proxy argument storing vector's flavor to `Math.NumberTheory.MoebiusInversion.{generalInversion,totientSum}`. * `solveQuadratic` and `sqrtsMod` require an additional argument: a singleton linking a type-level modulo with a term-level factorisation ([#169](https://github.com/Bodigrim/arithmoi/pull/169)). * Generalize `sieveBlock` to handle any flavor of `Vector` ([#164](https://github.com/Bodigrim/arithmoi/pull/164)). ### Deprecated * Deprecate `Math.NumberTheory.Primes.Factorisation`, use `Math.NumberTheory.Primes.factorise` instead. Deprecate `Math.NumberTheory.Primes.Sieve`, use `Enum` instance instead. * Deprecate `Math.NumberTheory.Primes.Factorisation.Certified` and `Math.NumberTheory.Primes.Testing.Certificates`. * Deprecate `Math.NumberTheory.MoebiusInversion.Int`. * Deprecate `Math.NumberTheory.SmoothNumbers.{fromSet,fromSmoothUpperBound}`. Use `Math.NumberTheory.SmoothNumbers.fromList` instead. * Deprecate `Math.NumberTheory.SmoothNumbers.smoothOverInRange` in favor of `smoothOver` and `Math.NumberTheory.SmoothNumbers.smoothOverInRange` in favor of `isSmooth`. ### Removed * Move `Euclidean` type class to `semirings` package ([#168](https://github.com/Bodigrim/arithmoi/pull/168)). * Remove deprecated earlier `Math.NumberTheory.Recurrencies.*` and `Math.NumberTheory.UniqueFactorisation` modules. Use `Math.NumberTheory.Recurrences.*` and `Math.NumberTheory.Primes` instead. * Remove deprecated earlier an old interface of `Math.NumberTheory.Moduli.Sqrt`. ## 0.9.0.0 ### Added * Introduce `Prime` newtype. This newtype is now used extensively in public API: ```haskell primes :: Integral a => [Prime a] primeList :: Integral a => PrimeSieve -> [Prime a] sieveFrom :: Integer -> [Prime Integer] nthPrime :: Integer -> Prime Integer ``` * New functions `nextPrime` and `precPrime`. Implement an instance of `Enum` for primes ([#153](https://github.com/Bodigrim/arithmoi/pull/153)): ```haskell > [nextPrime 101 .. precPrime 130] [Prime 101,Prime 103,Prime 107,Prime 109,Prime 113,Prime 127] ``` * Add the Hurwitz zeta function on non-negative integer arguments ([#126](https://github.com/Bodigrim/arithmoi/pull/126)). * Implement efficient tests of n-freeness: pointwise and in interval. See `isNFree` and `nFreesBlock` ([#145](https://github.com/Bodigrim/arithmoi/pull/145)). * Generate preimages of the totient and the sum-of-divisors functions ([#142](https://github.com/Bodigrim/arithmoi/pull/142)): ```haskell > inverseTotient 120 :: [Integer] [155,310,183,366,225,450,175,350,231,462,143,286,244,372,396,308,248] ``` * Generate coefficients of Faulhaber polynomials `faulhaberPoly` ([#70](https://github.com/Bodigrim/arithmoi/pull/70)). ### Changed * Support Gaussian and Eisenstein integers in smooth numbers ([#138](https://github.com/Bodigrim/arithmoi/pull/138)). * Change types of `primes`, `primeList`, `sieveFrom`, `nthPrime`, etc., to use `Prime` newtype. * `Math.NumberTheory.Primes.{Factorisation,Testing,Counting,Sieve}` are no longer re-exported from `Math.NumberTheory.Primes`. Merge `Math.NumberTheory.UniqueFactorisation` into `Math.NumberTheory.Primes` ([#135](https://github.com/Bodigrim/arithmoi/pull/135), [#153](https://github.com/Bodigrim/arithmoi/pull/153)). * From now on `Math.NumberTheory.Primes.Factorisation.factorise` and similar functions return `[(Integer, Word)]` instead of `[(Integer, Int)]`. * `sbcFunctionOnPrimePower` now accepts `Prime Word` instead of `Word`. * Better precision for exact values of Riemann zeta and Dirichlet beta functions ([#123](https://github.com/Bodigrim/arithmoi/pull/123)). * Speed up certain cases of modular multiplication ([#160](https://github.com/Bodigrim/arithmoi/pull/160)). * Extend Chinese theorem to non-coprime moduli ([#71](https://github.com/Bodigrim/arithmoi/pull/71)). ### Deprecated * Deprecate `Math.NumberTheory.Recurrencies.*`. Use `Math.NumberTheory.Recurrences.*` instead ([#146](https://github.com/Bodigrim/arithmoi/pull/146)). ### Removed * Remove `Prime` type family. * Remove deprecated `Math.NumberTheory.GCD` and `Math.NumberTheory.GCD.LowLevel`. ## 0.8.0.0 ### Added * A new interface for `Math.NumberTheory.Moduli.Sqrt`, more robust and type safe ([#87](https://github.com/Bodigrim/arithmoi/pull/87), [#108](https://github.com/Bodigrim/arithmoi/pull/108)). * Implement Ramanujan tau function ([#112](https://github.com/Bodigrim/arithmoi/pull/112)): ```haskell > map ramanujan [1..10] [1,-24,252,-1472,4830,-6048,-16744,84480,-113643,-115920] ``` * Implement partition function ([#115](https://github.com/Bodigrim/arithmoi/pull/115)): ```haskell > take 10 partition [1,1,2,3,5,7,11,15,22,30] ``` * Add the Dirichlet beta function on non-negative integer arguments ([#120](https://github.com/Bodigrim/arithmoi/pull/120)). E. g., ```haskell > take 5 $ Math.NumberTheory.Zeta.Dirichlet.betas 1e-15 [0.5,0.7853981633974483,0.9159655941772191,0.9689461462593693,0.9889445517411055] ``` * Solve linear and quadratic congruences ([#129](https://github.com/Bodigrim/arithmoi/pull/129)). * Support Eisenstein integers ([#121](https://github.com/Bodigrim/arithmoi/pull/121)). * Implement discrete logarithm ([#88](https://github.com/Bodigrim/arithmoi/pull/88)). ### Changed * Stop reporting units (1, -1, i, -i) as a part of factorisation for integers and Gaussian integers ([#101](https://github.com/Bodigrim/arithmoi/pull/101)). Now `factorise (-2)` is `[(2, 1)]` and not `[(-1, 1), (2, 1)]`. * Move `splitIntoCoprimes` to `Math.NumberTheory.Euclidean.Coprimes`. * Change types of `splitIntoCoprimes`, `fromFactors` and `prefFactors` using newtype `Coprimes` ([#89](https://github.com/Bodigrim/arithmoi/pull/89)). * Sort Gaussian primes by norm ([#124](https://github.com/Bodigrim/arithmoi/pull/124)). * Make return type of `primes` and `primeList` polymorphic instead of being limited to `Integer` only ([#109](https://github.com/Bodigrim/arithmoi/pull/109)). * Speed up factorisation of Gaussian integers ([#116](https://github.com/Bodigrim/arithmoi/pull/116)). * Speed up computation of primitive roots for prime powers ([#127](https://github.com/Bodigrim/arithmoi/pull/127)). ### Deprecated * Deprecate an old interface of `Math.NumberTheory.Moduli.Sqrt`. * Deprecate `Math.NumberTheory.GCD` and `Math.NumberTheory.GCD.LowLevel` ([#80](https://github.com/Bodigrim/arithmoi/pull/80)). Use `Math.NumberTheory.Euclidean` instead ([#128](https://github.com/Bodigrim/arithmoi/pull/128)). * Deprecate `jacobi'` ([#103](https://github.com/Bodigrim/arithmoi/pull/103)). * Deprecate `Math.NumberTheory.GaussianIntegers` in favor of `Math.NumberTheory.Quadratic.GaussianIntegers`. ## 0.7.0.0 ### Added * A general framework for bulk evaluation of arithmetic functions ([#77](https://github.com/Bodigrim/arithmoi/pull/77)): ```haskell > runFunctionOverBlock carmichaelA 1 10 [1,1,2,2,4,2,6,2,6,4] ``` * Implement a sublinear algorithm for Mertens function ([#90](https://github.com/Bodigrim/arithmoi/pull/90)): ```haskell > map (mertens . (10 ^)) [0..9] [1,-1,1,2,-23,-48,212,1037,1928,-222] ``` * Add basic support for cyclic groups and primitive roots ([#86](https://github.com/Bodigrim/arithmoi/pull/86)). * Implement an efficient modular exponentiation ([#86](https://github.com/Bodigrim/arithmoi/pull/86)). * Write routines for lazy generation of smooth numbers ([#91](https://github.com/Bodigrim/arithmoi/pull/91)). ```haskell > smoothOverInRange (fromJust (fromList [3,5,7])) 1000 2000 [1029,1125,1215,1225,1323,1575,1701,1715,1875] ``` ### Changed * Now `moebius` returns not a number, but a value of `Moebius` type ([#90](https://github.com/Bodigrim/arithmoi/pull/90)). * Now factorisation of large integers and Gaussian integers produces factors as lazy as possible ([#72](https://github.com/Bodigrim/arithmoi/pull/72), [#76](https://github.com/Bodigrim/arithmoi/pull/76)). ### Deprecated * Deprecate `Math.NumberTheory.Primes.Heap`. Use `Math.NumberTheory.Primes.Sieve` instead. * Deprecate `FactorSieve`, `TotientSieve`, `CarmichaelSieve` and accompanying functions. Use new general approach for bulk evaluation of arithmetic functions instead ([#77](https://github.com/Bodigrim/arithmoi/pull/77)). ### Removed * Remove `Math.NumberTheory.Powers.Integer`, deprecated in 0.5.0.0. ## 0.6.0.1 ### Changed * Switch to `smallcheck-1.1.3`. ## 0.6.0.0 ### Added * Brand new `Math.NumberTheory.Moduli.Class` ([#56](https://github.com/Bodigrim/arithmoi/pull/56)), providing flexible and type safe modular arithmetic. Due to use of GMP built-ins it is also significantly faster. * New function `divisorsList`, which is lazier than `divisors` and does not require `Ord` constraint ([#64](https://github.com/Bodigrim/arithmoi/pull/64)). Thus, it can be used for `GaussianInteger`. ### Changed * `Math.NumberTheory.Moduli` was split into `Math.NumberTheory.Moduli.{Chinese,Class,Jacobi,Sqrt}`. * Functions `jacobi` and `jacobi'` return `JacobiSymbol` instead of `Int`. * Speed up factorisation over elliptic curve up to 15x ([#65](https://github.com/Bodigrim/arithmoi/pull/65)). * Polymorphic `fibonacci` and `lucas` functions, which previously were restricted to `Integer` only ([#63](https://github.com/Bodigrim/arithmoi/pull/63)). This is especially useful for modular computations, e. g., `map fibonacci [1..10] :: [Mod 7]`. * Make `totientSum` more robust and idiomatic ([#58](https://github.com/Bodigrim/arithmoi/pull/58)). ### Removed * Functions `invertMod`, `powerMod` and `powerModInteger` were removed, as well as their unchecked counterparts. Use new interface to modular computations, provided by `Math.NumberTheory.Moduli.Class`. ## 0.5.0.1 ### Changed Switch to `QuickCheck-2.10`. ## 0.5.0.0 ### Added * Add basic combinatorial sequences: binomial coefficients, Stirling numbers of both kinds, Eulerian numbers of both kinds, Bernoulli numbers ([#39](https://github.com/Bodigrim/arithmoi/pull/39)). E. g., ```haskell > take 10 $ Math.NumberTheory.Recurrencies.Bilinear.bernoulli [1 % 1,(-1) % 2,1 % 6,0 % 1,(-1) % 30,0 % 1,1 % 42,0 % 1,(-1) % 30,0 % 1] ``` * Add the Riemann zeta function on non-negative integer arguments ([#44](https://github.com/Bodigrim/arithmoi/pull/44)). E. g., ```haskell > take 5 $ Math.NumberTheory.Zeta.zetas 1e-15 [-0.5,Infinity,1.6449340668482262,1.2020569031595945,1.0823232337111381] ``` ### Changed * Rename `Math.NumberTheory.Lucas` to `Math.NumberTheory.Recurrencies.Linear`. * Speed up `isPrime` twice; rework `millerRabinV` and `isStrongFermatPP` ([#22](https://github.com/Bodigrim/arithmoi/pull/22), [#25](https://github.com/Bodigrim/arithmoi/pull/25)). ### Deprecated * Deprecate `integerPower` and `integerWordPower` from `Math.NumberTheory.Powers.Integer`. Use `(^)` instead ([#51](https://github.com/Bodigrim/arithmoi/pull/51)). ### Removed * Remove deprecated interface to arithmetic functions (`divisors`, `tau`, `sigma`, `totient`, `jordan`, `moebius`, `liouville`, `smallOmega`, `bigOmega`, `carmichael`, `expMangoldt`). New interface is exposed via `Math.NumberTheory.ArithmeticFunctions` ([#30](https://github.com/Bodigrim/arithmoi/pull/30)). * `Math.NumberTheory.Logarithms` has been moved to the separate package `integer-logarithms` ([#51](https://github.com/Bodigrim/arithmoi/pull/51)). ## 0.4.3.0 ### Added * Add `Math.NumberTheory.ArithmeticFunctions` with brand-new machinery for arithmetic functions: `divisors`, `tau`, `sigma`, `totient`, `jordan`, `moebius`, `liouville`, `smallOmega`, `bigOmega`, `carmichael`, `expMangoldt` ([#30](https://github.com/Bodigrim/arithmoi/pull/30)). Old implementations (exposed via `Math.NumberTheory.Primes.Factorisation` and `Math.NumberTheory.Powers.Integer`) are deprecated and will be removed in the next major release. * Add Karatsuba sqrt algorithm, improving performance on large integers ([#6](https://github.com/Bodigrim/arithmoi/pull/6)). ### Fixed * Fix incorrect indexing of `FactorSieve` ([#35](https://github.com/Bodigrim/arithmoi/pull/35)). ## 0.4.2.0 ### Added * Add new cabal flag `check-bounds`, which replaces all unsafe array functions with safe ones. * Add basic functions on Gaussian integers. * Add Möbius mu-function. ### Changed * Forbid non-positive moduli in `Math.NumberTheory.Moduli`. ### Fixed * Fix out-of-bounds errors in `Math.NumberTheory.Primes.Heap`, `Math.NumberTheory.Primes.Sieve` and `Math.NumberTheory.MoebiusInversion`. * Fix 32-bit build. * Fix `binaryGCD` on negative numbers. * Fix `highestPower` (various issues). ## 0.4.1.0 ### Added * Add `integerLog10` variants at Bas van Dijk's request and expose `Math.NumberTheory.Powers.Integer`, with an added `integerWordPower`. ## 0.4.0.4 ### Fixed * Update for GHC 7.8, the type of some primops changed, they return `Int#` now instead of `Bool`. * Fixed bugs in modular square roots and factorisation. ## 0.4.0.3 ### Changed * Relaxed dependencies on mtl and containers. ### Fixed * Fixed warnings from GHC 7.5, `Word(..)` moved to `GHC.Types`. * Removed `SPECIALISE` pragma from inline function (warning from GHC 7.5, probably pointless anyway). ## 0.4.0.2 ### Changed * Sped up factor sieves. They need more space now, but the speedup is worth it, IMO. * Raised spec-constr limit in `MoebiusInversion.Int`. ## 0.4.0.1 ### Fixed * Fixed Haddock bug. ## 0.4.0.0 ### Added * Added generalised Möbius inversion, to be continued. ## 0.3.0.0 ### Added * Added modular square roots and Chinese remainder theorem. ## 0.2.0.6 ### Changed * Performance tweaks for `powerModInteger` (~10%) and `invertMod` (~25%). ## 0.2.0.5 ### Fixed * Fix bug in `psieveFrom`. ## 0.2.0.4 ### Fixed * Fix bug in `nthPrime`. ## 0.2.0.3 ### Fixed * Fix bug in `powerMod`. ## 0.2.0.2 ### Changed * Relax bounds on `array` dependency for GHC 7.4. ## 0.2.0.1 ### Fixed * Fix copy-pasto (only relevant for GHC 7.3). * Fix imports for GHC 7.3. ## 0.2.0.0 ### Added * Added certificates and certified testing/factorisation ## 0.1.0.2 ### Fixed * Fixed doc bugs ## 0.1.0.1 ### Changed * Elaborate on overflow, work more on native `Ints` in Eratosthenes. ## 0.1.0.0 ### Added * First release. arithmoi-0.12.1.0/test-suite/Math/NumberTheory/ArithmeticFunctions/0000755000000000000000000000000007346545000023342 5ustar0000000000000000arithmoi-0.12.1.0/test-suite/Math/NumberTheory/ArithmeticFunctions/InverseTests.hs0000644000000000000000000002420307346545000026335 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.InverseTests -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- Stability: Provisional -- -- Tests for Math.NumberTheory.ArithmeticFunctions.Inverse -- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.ArithmeticFunctions.InverseTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.SmallCheck as SC hiding (test) import Test.Tasty.QuickCheck as QC hiding (Positive) import Data.Bits (Bits) import Data.Euclidean import Data.Semiring (Semiring) import qualified Data.Set as S import Numeric.Natural (Natural) import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.ArithmeticFunctions.Inverse import Math.NumberTheory.Primes import Math.NumberTheory.Recurrences import Math.NumberTheory.TestUtils ------------------------------------------------------------------------------- -- Totient totientProperty1 :: forall a. (Euclidean a, Integral a, UniqueFactorisation a) => Positive a -> Bool totientProperty1 (Positive x) = x `S.member` asSetOfPreimages inverseTotient (totient x) jordanProperty1 :: (Euclidean a, Integral a, UniqueFactorisation a) => Power Word -> Positive a -> Bool jordanProperty1 (Power k') (Positive x) = -- 'k' shouldn't be large to avoid slow tests. let k = 2 + k' `Prelude.mod` 20 in x `S.member` asSetOfPreimages (inverseJordan k) (jordan k x) totientProperty2 :: (Euclidean a, Integral a, UniqueFactorisation a) => Positive a -> Bool totientProperty2 (Positive x) = all (== x) (S.map totient (asSetOfPreimages inverseTotient x)) jordanProperty2 :: (Euclidean a, Integral a, UniqueFactorisation a, Ord a) => Power Word -> Positive a -> Bool jordanProperty2 (Power k') (Positive x) = let k = 2 + k' `Prelude.mod` 20 in all (== x) (S.map (jordan k) (asSetOfPreimages (inverseJordan k) x)) -- | http://oeis.org/A055506 totientCountFactorial :: [Word] totientCountFactorial = [ 2 , 3 , 4 , 10 , 17 , 49 , 93 , 359 , 1138 , 3802 , 12124 , 52844 , 182752 , 696647 , 2852886 , 16423633 , 75301815 , 367900714 ] totientSpecialCases1 :: [Assertion] totientSpecialCases1 = zipWith mkAssert (tail factorial) totientCountFactorial where mkAssert n m = assertEqual "should be equal" m (totientCount n) totientCount :: Word -> Word totientCount = inverseTotient (const 1) -- | http://oeis.org/A055487 totientMinFactorial :: [Word] totientMinFactorial = [ 1 , 3 , 7 , 35 , 143 , 779 , 5183 , 40723 , 364087 , 3632617 , 39916801 , 479045521 , 6227180929 , 87178882081 , 1307676655073 , 20922799053799 , 355687465815361 , 6402373865831809 ] totientSpecialCases2 :: [Assertion] totientSpecialCases2 = zipWith mkAssert (tail factorial) totientMinFactorial where mkAssert n m = assertEqual "should be equal" m (totientMin n) totientMin :: Word -> Word totientMin = unMinWord . inverseTotient MinWord -- | http://oeis.org/A165774 totientMaxFactorial :: [Word] totientMaxFactorial = [ 2 , 6 , 18 , 90 , 462 , 3150 , 22050 , 210210 , 1891890 , 19969950 , 219669450 , 2847714870 , 37020293310 , 520843112790 , 7959363061650 , 135309172048050 , 2300255924816850 , 41996101027370490 ] totientSpecialCases3 :: [Assertion] totientSpecialCases3 = zipWith mkAssert (tail factorial) totientMaxFactorial where mkAssert n m = assertEqual "should be equal" m (totientMax n) totientMax :: Word -> Word totientMax = unMaxWord . inverseTotient MaxWord jordans5 :: [Word] jordans5 = [ 1 , 31 , 242 , 992 , 3124 , 7502 , 16806 , 31744 , 58806 , 96844 , 161050 , 240064 , 371292 , 520986 , 756008 , 1015808 , 1419856 , 1822986 , 2476098 , 3099008 , 4067052 , 4992550 , 6436342 , 7682048 , 9762500 , 11510052 , 14289858 , 16671552 , 20511148 ] jordanSpecialCase1 :: [Assertion] jordanSpecialCase1 = zipWith mkAssert ixs jordans5 where mkAssert a b = assertEqual "should be equal" (S.singleton a) (asSetOfPreimages (inverseJordan 5) b) ixs = [1 .. 29] ------------------------------------------------------------------------------- -- Sigma sigmaProperty1 :: forall a. (Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a) => Positive a -> Bool sigmaProperty1 (Positive x) = x `S.member` asSetOfPreimages inverseSigma (sigma 1 x) sigmaKProperty1 :: forall a . (Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a) => Power Word -> Positive a -> Bool sigmaKProperty1 (Power k') (Positive x) = -- 'k' shouldn't be large to avoid slow tests. let k = 2 + k' `Prelude.mod` 20 in x `S.member` asSetOfPreimages (inverseSigmaK k) (sigma k x) sigmaProperty2 :: (Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a) => Positive a -> Bool sigmaProperty2 (Positive x) = all (== x) (S.map (sigma 1) (asSetOfPreimages inverseSigma x)) sigmaKProperty2 :: (Euclidean a, UniqueFactorisation a, Integral a, Enum (Prime a), Bits a) => Power Word -> Positive a -> Bool sigmaKProperty2 (Power k') (Positive x) = let k = 2 + k' `Prelude.mod` 20 in all (== x) (S.map (sigma k) (asSetOfPreimages (inverseSigmaK k) x)) -- | http://oeis.org/A055486 sigmaCountFactorial :: [Word] sigmaCountFactorial = [ 1 , 0 , 1 , 3 , 4 , 15 , 33 , 111 , 382 , 1195 , 3366 , 14077 , 53265 , 229603 , 910254 , 4524029 , 18879944 , 91336498 ] sigmaSpecialCases1 :: [Assertion] sigmaSpecialCases1 = zipWith mkAssert (tail factorial) sigmaCountFactorial where mkAssert n m = assertEqual "should be equal" m (sigmaCount n) sigmaCount :: Word -> Word sigmaCount = inverseSigma (const 1) -- | http://oeis.org/A055488 sigmaMinFactorial :: [Word] sigmaMinFactorial = [ 5 , 14 , 54 , 264 , 1560 , 10920 , 97440 , 876960 , 10263240 , 112895640 , 1348827480 , 18029171160 , 264370186080 , 3806158356000 , 62703141621120 , 1128159304272000 ] sigmaSpecialCases2 :: [Assertion] sigmaSpecialCases2 = zipWith mkAssert (drop 3 factorial) sigmaMinFactorial where mkAssert n m = assertEqual "should be equal" m (sigmaMin n) sigmaMin :: Word -> Word sigmaMin = unMinWord . inverseSigma MinWord -- | http://oeis.org/A055489 sigmaMaxFactorial :: [Word] sigmaMaxFactorial = [ 5 , 23 , 95 , 719 , 5039 , 39917 , 361657 , 3624941 , 39904153 , 479001599 , 6226862869 , 87178291199 , 1307672080867 , 20922780738961 , 355687390376431 , 6402373545694717 ] sigmaSpecialCases3 :: [Assertion] sigmaSpecialCases3 = zipWith mkAssert (drop 3 factorial) sigmaMaxFactorial where mkAssert n m = assertEqual "should be equal" m (sigmaMax n) sigmaMax :: Word -> Word sigmaMax = unMaxWord . inverseSigma MaxWord sigmaSpecialCase4 :: Assertion sigmaSpecialCase4 = assertBool "200 should be in inverseSigma(sigma(200))" $ sigmaProperty1 $ Positive (200 :: Word) sigmas5 :: [Word] sigmas5 = [ 1 , 33 , 244 , 1057 , 3126 , 8052 , 16808 , 33825 , 59293 , 103158 , 161052 , 257908 , 371294 , 554664 , 762744 , 1082401 , 1419858 , 1956669 , 2476100 , 3304182 , 4101152 , 5314716 , 6436344 , 8253300 , 9768751 , 12252702 , 14408200 , 17766056 , 20511150 ] sigmaSpecialCase5 :: [Assertion] sigmaSpecialCase5 = zipWith mkAssert ixs sigmas5 where mkAssert a b = assertEqual "should be equal" (S.singleton a) (asSetOfPreimages (inverseSigmaK 5) b) ixs = [1 .. 29] ------------------------------------------------------------------------------- -- TestTree -- Tests for 'Int', 'Word' are omitted because 'inverseSigmaK/inverseJordan' -- tests would quickly oveflow in these types. testIntegralPropertyNoLargeInverse :: forall bool. (SC.Testable IO bool, QC.Testable bool) => String -> (forall a. (Euclidean a, Semiring a, Integral a, Bits a, UniqueFactorisation a, Show a, Enum (Prime a)) => Power Word -> Positive a -> bool) -> TestTree testIntegralPropertyNoLargeInverse name f = testGroup name [ SC.testProperty "smallcheck Integer" (f :: Power Word -> Positive Integer -> bool) , SC.testProperty "smallcheck Natural" (f :: Power Word -> Positive Natural -> bool) , QC.testProperty "quickcheck Integer" (f :: Power Word -> Positive Integer -> bool) , QC.testProperty "quickcheck Natural" (f :: Power Word -> Positive Natural -> bool) ] testSuite :: TestTree testSuite = testGroup "Inverse" [ testGroup "Totient" [ testIntegralPropertyNoLarge "forward" totientProperty1 , testIntegralPropertyNoLarge "backward" totientProperty2 , testGroup "count" (zipWith (\i a -> testCase ("factorial " ++ show i) a) [1..] totientSpecialCases1) , testGroup "min" (zipWith (\i a -> testCase ("factorial " ++ show i) a) [1..] totientSpecialCases2) , testGroup "max" (zipWith (\i a -> testCase ("factorial " ++ show i) a) [1..] totientSpecialCases3) ] , testGroup "Sigma1" [ testIntegralPropertyNoLarge "forward" sigmaProperty1 , testIntegralPropertyNoLarge "backward" sigmaProperty2 , testCase "200" sigmaSpecialCase4 , testGroup "count" (zipWith (\i a -> testCase ("factorial " ++ show i) a) [1..] sigmaSpecialCases1) , testGroup "min" (zipWith (\i a -> testCase ("factorial " ++ show i) a) [1..] sigmaSpecialCases2) , testGroup "max" (zipWith (\i a -> testCase ("factorial " ++ show i) a) [1..] sigmaSpecialCases3) ] , testGroup "Jordan" [ testIntegralPropertyNoLargeInverse "forward" jordanProperty1 , testIntegralPropertyNoLargeInverse "backward" jordanProperty2 , testGroup "inverseJordan" (zipWith (\i test -> testCase ("inverseJordan 5" ++ show i) test) jordans5 jordanSpecialCase1) ] , testGroup "SigmaK" [ testIntegralPropertyNoLargeInverse "forward" sigmaKProperty1 , testIntegralPropertyNoLargeInverse "backward" sigmaKProperty2 , testGroup "inverseSigma" (zipWith (\i test -> testCase ("inverseSigma 5" ++ show i) test) sigmas5 sigmaSpecialCase5) ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/ArithmeticFunctions/MertensTests.hs0000644000000000000000000000435007346545000026340 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.MertensTests -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.ArithmeticFunctions.Mertens -- {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.ArithmeticFunctions.MertensTests ( testSuite ) where import Test.Tasty #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.ArithmeticFunctions.Mertens import Math.NumberTheory.ArithmeticFunctions.SieveBlock import Math.NumberTheory.TestUtils moebiusConfig :: SieveBlockConfig Moebius moebiusConfig = SieveBlockConfig { sbcEmpty = MoebiusP , sbcAppend = (<>) , sbcFunctionOnPrimePower = const $ \case 0 -> MoebiusP 1 -> MoebiusN _ -> MoebiusZ } mertensDiffPointwise :: Word -> Word -> Int mertensDiffPointwise lo len = sum $ map (runMoebius . moebius) [lo + 1 .. lo + len] mertensDiffBlockSpecial :: Word -> Word -> Int mertensDiffBlockSpecial lo len = U.sum $ U.map runMoebius $ sieveBlockMoebius (lo + 1) len mertensDiffBlockUnboxed :: Word -> Word -> Int mertensDiffBlockUnboxed lo len = U.sum $ U.map runMoebius $ sieveBlockUnboxed moebiusConfig (lo + 1) len mertensDiffBlockBoxed :: Word -> Word -> Int mertensDiffBlockBoxed lo len = V.sum $ V.map runMoebius $ sieveBlock moebiusConfig (lo + 1) len mertensDiff :: Word -> Word -> Int mertensDiff lo len = mertens (lo + len) - mertens lo propertyCompare :: (Word -> Word -> Int) -> Word -> Word -> Bool propertyCompare func lo' len' = mertensDiff lo len == func lo len where lo = lo' `rem` 10000000 len = len' `rem` 1000 testSuite :: TestTree testSuite = testGroup "Mertens" [ testSmallAndQuick "pointwise" $ propertyCompare mertensDiffPointwise , testSmallAndQuick "block special" $ propertyCompare mertensDiffBlockSpecial , testSmallAndQuick "block unboxed" $ propertyCompare mertensDiffBlockUnboxed , testSmallAndQuick "block boxed" $ propertyCompare mertensDiffBlockBoxed ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/ArithmeticFunctions/SieveBlockTests.hs0000644000000000000000000000473107346545000026754 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctions.SieveBlockTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.ArithmeticFunctions.SieveBlock -- {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.ArithmeticFunctions.SieveBlockTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import qualified Data.Vector as V import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.ArithmeticFunctions.SieveBlock pointwiseTest :: (Eq a, Show a) => ArithmeticFunction Word a -> Word -> Word -> IO () pointwiseTest f lowIndex len = assertEqual "pointwise" (runFunctionOverBlock f lowIndex len) (V.generate (fromIntegral len) (runFunction f . (+ lowIndex) . fromIntegral)) moebiusTest :: Word -> Word -> Bool moebiusTest m n = m == 0 || sieveBlockUnboxed moebiusConfig m n == sieveBlockMoebius m n moebiusSpecialCases :: [TestTree] moebiusSpecialCases = map (uncurry pairToTest) [ (1, 1) , (1, 2) , (208, 298) , (1, 12835) , (10956, 4430) , (65, 16171) , (120906, 19456) , (33800000, 27002) , (17266222643, 5051) , (1000158, 48758) , (1307265, 3725) , (2600000, 14686) , (4516141422507 - 100000, 100001) , (1133551497049257 - 100000, 100001) -- too long for regular runs -- , (1157562178759482171 - 100000, 100001) ] where pairToTest :: Word -> Word -> TestTree pairToTest m n = testCase (show m ++ "," ++ show n) $ assertBool "should be equal" $ moebiusTest m n moebiusConfig :: SieveBlockConfig Moebius moebiusConfig = SieveBlockConfig { sbcEmpty = MoebiusP , sbcAppend = (<>) , sbcFunctionOnPrimePower = const $ \case 0 -> MoebiusP 1 -> MoebiusN _ -> MoebiusZ } testSuite :: TestTree testSuite = testGroup "SieveBlock" [ testGroup "pointwise" [ testCase "divisors" $ pointwiseTest divisorsA 1 1000 , testCase "tau" $ pointwiseTest tauA 1 1000 , testCase "totient" $ pointwiseTest totientA 1 1000 , testCase "moebius" $ pointwiseTest moebiusA 1 1000 , testCase "smallOmega" $ pointwiseTest smallOmegaA 1 1000 , testCase "bigOmega" $ pointwiseTest bigOmegaA 1 1000 , testCase "carmichael" $ pointwiseTest carmichaelA 1 1000 ] , testGroup "special moebius" moebiusSpecialCases ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/0000755000000000000000000000000007346545000017360 5ustar0000000000000000arithmoi-0.12.1.0/test-suite/Math/NumberTheory/ArithmeticFunctionsTests.hs0000644000000000000000000004274307346545000024733 0ustar0000000000000000-- | -- Module: Math.NumberTheory.ArithmeticFunctionsTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.ArithmeticFunctions -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.ArithmeticFunctionsTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Data.List (sort) import qualified Data.Set as S import qualified Data.IntSet as IS import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.Primes (UniqueFactorisation (factorise)) import Math.NumberTheory.TestUtils import Math.NumberTheory.Zeta (zetas) import Numeric.Natural oeisAssertion :: (Eq a, Show a) => String -> ArithmeticFunction Natural a -> [a] -> Assertion oeisAssertion name f baseline = assertEqual name baseline (map (runFunction f) [1 .. fromIntegral (length baseline)]) wolframAlphaAssertion :: (Eq a, Show a) => String -> ArithmeticFunction Integer a -> [Integer] -> [a] -> Assertion wolframAlphaAssertion name f domain baseline = assertEqual name baseline (map (runFunction f) domain) -- | tau(n) equals to a number of divisors. divisorsProperty1 :: NonZero Natural -> Bool divisorsProperty1 (NonZero n) = S.size (runFunction divisorsA n) == runFunction tauA n -- | sigma(n) equals to a number of divisors. divisorsProperty2 :: NonZero Natural -> Bool divisorsProperty2 (NonZero n) = sum (runFunction divisorsA n) == runFunction (sigmaA 1) n -- | All divisors of n truly divides n. divisorsProperty3 :: NonZero Natural -> Bool divisorsProperty3 (NonZero n) = all (\d -> n `rem` d == 0) (runFunction divisorsA n) -- | 'divisorsA' matches 'divisorsSmallA' divisorsProperty4 :: NonZero Int -> Bool divisorsProperty4 (NonZero n) = S.toAscList (runFunction divisorsA n) == IS.toAscList (runFunction divisorsSmallA n) -- | 'divisorsA' matches 'divisorsListA' divisorsProperty5 :: NonZero Int -> Bool divisorsProperty5 (NonZero n) = S.toAscList (runFunction divisorsA n) == sort (runFunction divisorsListA n) -- | 'divisorsTo' matches 'divisorsA' with a filter divisorsProperty6 :: Positive Int -> NonNegative Int -> Bool divisorsProperty6 (Positive a) (NonNegative b) = runFunction (divisorsToA to) n == expected where to = a n = to + b expected = S.filter (<=to) (runFunction divisorsA n) -- | tau matches baseline from OEIS. tauOeis :: Assertion tauOeis = oeisAssertion "A000005" tauA [ 1, 2, 2, 3, 2, 4, 2, 4, 3, 4, 2, 6, 2, 4, 4, 5, 2, 6, 2, 6, 4, 4, 2, 8 , 3, 4, 4, 6, 2, 8, 2, 6, 4, 4, 4, 9, 2, 4, 4, 8, 2, 8, 2, 6, 6, 4, 2, 10 , 3, 6, 4, 6, 2, 8, 4, 8, 4, 4, 2, 12, 2, 4, 6, 7, 4, 8, 2, 6, 4, 8, 2 , 12, 2, 4, 6, 6, 4, 8, 2, 10, 5, 4, 2, 12, 4, 4, 4, 8, 2, 12, 4, 6, 4, 4 , 4, 12, 2, 6, 6, 9, 2, 8, 2, 8 ] -- | sigma_0 coincides with tau by definition sigmaProperty1 :: NonZero Natural -> Bool sigmaProperty1 (NonZero n) = runFunction tauA n == (runFunction (sigmaA 0) n :: Natural) -- | value of totient is bigger than argument sigmaProperty2 :: NonZero Natural -> Bool sigmaProperty2 (NonZero n) = n <= 1 || runFunction (sigmaA 1) n > n -- | sigma_1 matches baseline from OEIS. sigma1Oeis :: Assertion sigma1Oeis = oeisAssertion "A000203" (sigmaA 1) [ 1, 3, 4, 7, 6, 12, 8, 15, 13, 18, 12, 28, 14, 24, 24, 31, 18, 39, 20 , 42, 32, 36, 24, 60, 31, 42, 40, 56, 30, 72, 32, 63, 48, 54, 48, 91, 38 , 60, 56, 90, 42, 96, 44, 84, 78, 72, 48, 124, 57, 93, 72, 98, 54, 120 , 72, 120, 80, 90, 60, 168, 62, 96, 104, 127, 84, 144, 68, 126, 96, 144 :: Natural ] -- | sigma_2 matches baseline from OEIS. sigma2Oeis :: Assertion sigma2Oeis = oeisAssertion "A001157" (sigmaA 2) [ 1, 5, 10, 21, 26, 50, 50, 85, 91, 130, 122, 210, 170, 250, 260, 341, 290 , 455, 362, 546, 500, 610, 530, 850, 651, 850, 820, 1050, 842, 1300, 962 , 1365, 1220, 1450, 1300, 1911, 1370, 1810, 1700, 2210, 1682, 2500, 1850 , 2562, 2366, 2650, 2210, 3410, 2451, 3255 :: Natural ] -- | value of totient if even, except totient(1) and totient(2) totientProperty1 :: NonZero Natural -> Bool totientProperty1 (NonZero n) = n <= 2 || even (runFunction totientA n) -- | value of totient is smaller than argument totientProperty2 :: NonZero Natural -> Bool totientProperty2 (NonZero n) = n <= 1 || runFunction totientA n < n -- | totient matches baseline from OEIS. totientOeis :: Assertion totientOeis = oeisAssertion "A000010" totientA [ 1, 1, 2, 2, 4, 2, 6, 4, 6, 4, 10, 4, 12, 6, 8, 8, 16, 6, 18, 8, 12, 10 , 22, 8, 20, 12, 18, 12, 28, 8, 30, 16, 20, 16, 24, 12, 36, 18, 24, 16, 40 , 12, 42, 20, 24, 22, 46, 16, 42, 20, 32, 24, 52, 18, 40, 24, 36, 28, 58 , 16, 60, 30, 36, 32, 48, 20, 66, 32, 44 ] -- | jordan_0 is zero for argument > 1 jordanProperty1 :: NonZero Natural -> Bool jordanProperty1 (NonZero n) = n <= 1 || runFunction (jordanA 0) n == 0 -- | jordan_1 coincides with totient by definition jordanProperty2 :: NonZero Natural -> Bool jordanProperty2 (NonZero n) = runFunction totientA n == runFunction (jordanA 1) n -- | jordan_2 matches baseline from OEIS. jordan2Oeis :: Assertion jordan2Oeis = oeisAssertion "A007434" (jordanA 2) [ 1, 3, 8, 12, 24, 24, 48, 48, 72, 72, 120, 96, 168, 144, 192, 192, 288 , 216, 360, 288, 384, 360, 528, 384, 600, 504, 648, 576, 840, 576, 960 , 768, 960, 864, 1152, 864, 1368, 1080, 1344, 1152, 1680, 1152, 1848, 1440 , 1728, 1584, 2208, 1536 ] -- | congruences 1,2,3,4 from https://en.wikipedia.org/wiki/Ramanujan_tau_function ramanujanCongruence1 :: NonZero Natural -> Bool ramanujanCongruence1 (NonZero n) | k == 1 = (ramanujan n' - sigma 11 n') `rem` (2^11) == 0 | k == 3 = (ramanujan n' - 1217 * sigma 11 n') `rem` (2^13) == 0 | k == 5 = (ramanujan n' - 1537 * sigma 11 n') `rem` (2^12) == 0 | k == 7 = (ramanujan n' - 705 * sigma 11 n') `rem` (2^14) == 0 | otherwise = True where k = n `mod` 8 n' = fromIntegral n :: Integer -- | congruences 8,9 from https://en.wikipedia.org/wiki/Ramanujan_tau_function ramanujanCongruence2 :: NonZero Natural -> Bool ramanujanCongruence2 (NonZero n) | (n `mod` 7) `elem` [0,1,2,4] = m `rem` 7 == 0 | otherwise = m `rem` 49 == 0 where m = ramanujan n' - n' * sigma 9 n' n' = fromIntegral n :: Integer -- | ramanujan matches baseline from wolframAlpha: https://www.wolframalpha.com/input/?i=RamanujanTau%5BRange%5B100%5D%5D ramanujanRange :: Assertion ramanujanRange = wolframAlphaAssertion "A000594" ramanujanA [1..100] [ 1, -24, 252, -1472, 4830, -6048, -16744, 84480, -113643, -115920 , 534612, -370944, -577738, 401856, 1217160, 987136, -6905934, 2727432 , 10661420, -7109760, -4219488, -12830688, 18643272, 21288960, -25499225 , 13865712, -73279080, 24647168, 128406630, -29211840, -52843168 , -196706304, 134722224, 165742416, -80873520, 167282496, -182213314 , -255874080, -145589976, 408038400, 308120442, 101267712, -17125708 , -786948864, -548895690, -447438528, 2687348496, 248758272, -1696965207 , 611981400, -1740295368, 850430336, -1596055698, 1758697920, 2582175960 , -1414533120, 2686677840, -3081759120, -5189203740, -1791659520, 6956478662 , 1268236032, 1902838392, 2699296768, -2790474540, -3233333376, -15481826884 , 10165534848, 4698104544, 1940964480, 9791485272, -9600560640, 1463791322 , 4373119536, -6425804700, -15693610240, -8951543328, 3494159424, 38116845680 , 4767866880, 1665188361, -7394890608, -29335099668, 6211086336, -33355661220 , 411016992, 32358470760, 45164021760, -24992917110, 13173496560, 9673645072 , -27442896384, -13316478336, -64496363904, 51494658600, -49569988608 , 75013568546, 40727164968, -60754911516, 37534859200 ] -- | ramanujan matches baseline from wolframAlpha: https://www.wolframalpha.com/input/?i=RamanujanTau%5B2%5ERange%5B20%5D%5D ramanujanPowers2 :: Assertion ramanujanPowers2 = wolframAlphaAssertion "wolframAlpha2^n" ramanujanA [2^n | n <- [1..20]] [ -24, -1472, 84480, 987136, -196706304, 2699296768, 338071388160 , -13641873096704, -364965248630784, 36697722069188608, -133296500464680960 , -71957818786545926144, 1999978883828768833536, 99370119662955604738048 , -6480839625992253084794880, -47969854045919004468445184 , 14424036051134190424902598656, -247934604141178449046286630912 , -23589995333334539213089642905600, 1073929957281162404760946449842176 ] -- | ramanujan matches baseline from wolframAlpha: https://www.wolframalpha.com/input/?i=RamanujanTau%5B3%5ERange%5B20%5D%5D ramanujanPowers3 :: Assertion ramanujanPowers3 = wolframAlphaAssertion "wolframAlpha3^n" ramanujanA [3^n | n <- [1..20]] [ 252, -113643, -73279080, 1665188361, 13400796651732, 3082017633650397 , -1597242480784468560, -948475282905952954479, 43930942451226107469612 , 179090148438649827109433637, 37348482744132405171657919560 , -22313464873940134819697044764519, -12239164820907737153507340756954108 , 868493827155123300221022518147812077, 2386991774972433985188062567645398013280 , 447670851294004737003138291024309833342241 , -310035377434952569449318870332553243856267428 , -157432463407787104647123294163886831498857358283 , 15248856227707192449163419793501327951694151780600 , 31731400364681474724113131979212395183355010696469801 ] -- | moebius does not require full factorisation moebiusLazy :: Assertion moebiusLazy = assertEqual "moebius" MoebiusZ (runFunction moebiusA (2^2 * (2^100000-1) :: Natural)) -- | moebius matches baseline from OEIS. moebiusOeis :: Assertion moebiusOeis = oeisAssertion "A008683" moebiusA [ MoebiusP, MoebiusN, MoebiusN, MoebiusZ, MoebiusN, MoebiusP, MoebiusN, MoebiusZ, MoebiusZ, MoebiusP, MoebiusN, MoebiusZ, MoebiusN, MoebiusP, MoebiusP, MoebiusZ, MoebiusN, MoebiusZ, MoebiusN, MoebiusZ, MoebiusP, MoebiusP, MoebiusN , MoebiusZ, MoebiusZ, MoebiusP, MoebiusZ, MoebiusZ, MoebiusN, MoebiusN, MoebiusN, MoebiusZ, MoebiusP, MoebiusP, MoebiusP, MoebiusZ, MoebiusN, MoebiusP, MoebiusP, MoebiusZ, MoebiusN, MoebiusN, MoebiusN, MoebiusZ, MoebiusZ, MoebiusP , MoebiusN, MoebiusZ, MoebiusZ, MoebiusZ, MoebiusP, MoebiusZ, MoebiusN, MoebiusZ, MoebiusP, MoebiusZ, MoebiusP, MoebiusP, MoebiusN, MoebiusZ, MoebiusN, MoebiusP, MoebiusZ, MoebiusZ, MoebiusP, MoebiusN, MoebiusN, MoebiusZ, MoebiusP , MoebiusN, MoebiusN, MoebiusZ, MoebiusN, MoebiusP, MoebiusZ, MoebiusZ, MoebiusP ] -- | liouville values are [-1, 1] liouvilleProperty1 :: NonZero Natural -> Bool liouvilleProperty1 (NonZero n) = runFunction liouvilleA n `elem` [-1, 1] -- | moebius is zero or equal to liouville liouvilleProperty2 :: NonZero Natural -> Bool liouvilleProperty2 (NonZero n) = m == MoebiusZ || l == runMoebius m where l = runFunction liouvilleA n m = runFunction moebiusA n -- | liouville matches baseline from OEIS. liouvilleOeis :: Assertion liouvilleOeis = oeisAssertion "A008836" liouvilleA [ 1, -1, -1, 1, -1, 1, -1, -1, 1, 1, -1, -1, -1, 1, 1, 1, -1, -1, -1, -1, 1, 1 , -1, 1, 1, 1, -1, -1, -1, -1, -1, -1, 1, 1, 1, 1, -1, 1, 1, 1, -1, -1, -1, -1 , -1, 1, -1, -1, 1, -1, 1, -1, -1, 1, 1, 1, 1, 1, -1, 1, -1, 1, -1, 1, 1, -1 , -1, -1, 1, -1, -1, -1, -1, 1, -1, -1, 1, -1, -1, -1, 1, 1, -1, 1, 1, 1, 1, 1 , -1, 1, 1, -1, 1, 1, 1, 1, -1, -1, -1, 1, -1 ] -- | carmichaeil divides totient carmichaelProperty1 :: NonZero Natural -> Bool carmichaelProperty1 (NonZero n) = runFunction totientA n `rem` runFunction carmichaelA n == 0 -- | carmichael matches baseline from OEIS. carmichaelOeis :: Assertion carmichaelOeis = oeisAssertion "A002322" carmichaelA [ 1, 1, 2, 2, 4, 2, 6, 2, 6, 4, 10, 2, 12, 6, 4, 4, 16, 6, 18, 4, 6, 10, 22, 2 , 20, 12, 18, 6, 28, 4, 30, 8, 10, 16, 12, 6, 36, 18, 12, 4, 40, 6, 42, 10, 12 , 22, 46, 4, 42, 20, 16, 12, 52, 18, 20, 6, 18, 28, 58, 4, 60, 30, 6, 16, 12 , 10, 66, 16, 22, 12, 70, 6, 72, 36, 20, 18, 30, 12, 78, 4, 54 ] -- | smallOmega is smaller than bigOmega omegaProperty1 :: NonZero Natural -> Bool omegaProperty1 (NonZero n) = runFunction smallOmegaA n <= runFunction bigOmegaA n -- | smallOmega matches baseline from OEIS. smallOmegaOeis :: Assertion smallOmegaOeis = oeisAssertion "A001221" smallOmegaA [ 0, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 2, 1, 2, 2, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1, 2 , 1, 2, 1, 3, 1, 1, 2, 2, 2, 2, 1, 2, 2, 2, 1, 3, 1, 2, 2, 2, 1, 2, 1, 2, 2, 2 , 1, 2, 2, 2, 2, 2, 1, 3, 1, 2, 2, 1, 2, 3, 1, 2, 2, 3, 1, 2, 1, 2, 2, 2, 2, 3 , 1, 2, 1, 2, 1, 3, 2, 2, 2, 2, 1, 3, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 1, 3, 1, 2 , 3, 2, 1, 2, 1, 3, 2 ] -- | bigOmega matches baseline from OEIS. bigOmegaOeis :: Assertion bigOmegaOeis = oeisAssertion "A001222" bigOmegaA [ 0, 1, 1, 2, 1, 2, 1, 3, 2, 2, 1, 3, 1, 2, 2, 4, 1, 3, 1, 3, 2, 2, 1, 4, 2, 2 , 3, 3, 1, 3, 1, 5, 2, 2, 2, 4, 1, 2, 2, 4, 1, 3, 1, 3, 3, 2, 1, 5, 2, 3, 2, 3 , 1, 4, 2, 4, 2, 2, 1, 4, 1, 2, 3, 6, 2, 3, 1, 3, 2, 3, 1, 5, 1, 2, 3, 3, 2, 3 , 1, 5, 4, 2, 1, 4, 2, 2, 2, 4, 1, 4, 2, 3, 2, 2, 2, 6, 1, 3, 3, 4, 1, 3, 1, 4 , 3, 2, 1, 5, 1, 3, 2 ] -- | expMangoldt matches baseline from OEIS. mangoldtOeis :: Assertion mangoldtOeis = oeisAssertion "A014963" expMangoldtA [ 1, 2, 3, 2, 5, 1, 7, 2, 3, 1, 11, 1, 13, 1, 1, 2, 17, 1, 19, 1, 1, 1, 23, 1 , 5, 1, 3, 1, 29, 1, 31, 2, 1, 1, 1, 1, 37, 1, 1, 1, 41, 1, 43, 1, 1, 1, 47, 1 , 7, 1, 1, 1, 53, 1, 1, 1, 1, 1, 59, 1, 61, 1, 1, 2, 1, 1, 67, 1, 1, 1, 71, 1 , 73, 1, 1, 1, 1, 1, 79, 1, 3, 1, 83, 1, 1, 1, 1, 1, 89, 1, 1, 1, 1, 1, 1 ] nFreedomProperty1 :: Word -> NonZero Natural -> Bool nFreedomProperty1 n (NonZero m) = isNFree n m == (all ((< n) . snd) . factorise) m nFreedomProperty2 :: Power Word -> NonNegative Int -> Bool nFreedomProperty2 (Power n) (NonNegative m) = let n' | n == maxBound = n | otherwise = n + 1 in take m (filter (isNFree n') [1 ..]) == take m (nFrees n' :: [Integer]) nFreedomProperty3 :: Power Word -> Positive Int -> Bool nFreedomProperty3 (Power n) (Positive m) = let n' | n == maxBound = n | otherwise = n + 1 zet = 1 / zetas 1e-14 !! fromIntegral n' :: Double m' = 100 * m nfree = fromIntegral m' / fromIntegral (head (drop (m' - 1) $ nFrees n' :: [Integer])) in 1 / fromIntegral m >= abs (zet - nfree) -- | -- * Using a bounded integer type like @Int@ instead of @Integer@ here means -- even a relatively low value of @n@, e.g. 20 may cause out-of-bounds memory -- accesses in @nFreesBlock@. -- * Using @Integer@ prevents this, so that is the numeric type used here. nFreesBlockProperty1 :: Power Word -> Positive Integer -> Word -> Bool nFreesBlockProperty1 (Power n) (Positive lo) w = let block = nFreesBlock n lo w len = length block blk = take len . dropWhile (< lo) . nFrees $ n in block == blk nFreedomAssertion1 :: Assertion nFreedomAssertion1 = assertEqual "1 is the sole 0-free number" (nFrees 0) ([1] :: [Int]) nFreedomAssertion2 :: Assertion nFreedomAssertion2 = assertEqual "1 is the sole 1-free number" (nFrees 1) ([1] :: [Int]) testSuite :: TestTree testSuite = testGroup "ArithmeticFunctions" [ testGroup "Divisors" [ testSmallAndQuick "length . divisors = tau" divisorsProperty1 , testSmallAndQuick "sum . divisors = sigma_1" divisorsProperty2 , testSmallAndQuick "matches definition" divisorsProperty3 , testSmallAndQuick "divisors = divisorsSmall" divisorsProperty4 , testSmallAndQuick "divisors = divisorsList" divisorsProperty5 , testSmallAndQuick "divisors = divisorsTo" divisorsProperty6 ] , testGroup "Tau" [ testCase "OEIS" tauOeis ] , testGroup "Sigma" [ testSmallAndQuick "sigma_0 = tau" sigmaProperty1 , testSmallAndQuick "sigma_1 n > n" sigmaProperty2 , testCase "OEIS sigma_1" sigma1Oeis , testCase "OEIS sigma_2" sigma2Oeis ] , testGroup "Totient" [ testSmallAndQuick "totient is even" totientProperty1 , testSmallAndQuick "totient n < n" totientProperty2 , testCase "OEIS" totientOeis ] , testGroup "Jordan" [ testSmallAndQuick "jordan_0 = [== 1]" jordanProperty1 , testSmallAndQuick "jordan_1 = totient" jordanProperty2 , testCase "OEIS jordan_2" jordan2Oeis ] , testGroup "Ramanujan" [ testSmallAndQuick "ramanujan mod 8 congruences" ramanujanCongruence1 , testSmallAndQuick "ramanujan mod 7 congruences" ramanujanCongruence2 , testCase "baseline ramanujan range" ramanujanRange , testCase "baseline ramanujan powers2" ramanujanPowers2 , testCase "baseline ramanujan powers3" ramanujanPowers3 ] , testGroup "Moebius" [ testCase "OEIS" moebiusOeis , testCase "Lazy" moebiusLazy ] , testGroup "Liouville" [ testSmallAndQuick "liouville values" liouvilleProperty1 , testSmallAndQuick "liouville matches moebius" liouvilleProperty2 , testCase "OEIS" liouvilleOeis ] , testGroup "Carmichael" [ testSmallAndQuick "carmichael divides totient" carmichaelProperty1 , testCase "OEIS" carmichaelOeis ] , testGroup "Omegas" [ testSmallAndQuick "smallOmega <= bigOmega" omegaProperty1 , testCase "OEIS smallOmega" smallOmegaOeis , testCase "OEIS bigOmega" bigOmegaOeis ] , testGroup "Mangoldt" [ testCase "OEIS" mangoldtOeis ] , testGroup "N-freedom" [ testSmallAndQuick "`isNFree` matches the definition" nFreedomProperty1 , testSmallAndQuick "numbers produces by `nFrees`s are `n`-free" nFreedomProperty2 , testSmallAndQuick "distribution of n-free numbers matches expected" nFreedomProperty3 , testSmallAndQuick "nFreesBlock matches nFrees" nFreesBlockProperty1 , testCase "`1` is the only 0-free number" nFreedomAssertion1 , testCase "`1` is the only 1-free number" nFreedomAssertion2 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/CurvesTests.hs0000644000000000000000000000735107346545000022214 0ustar0000000000000000-- | -- Module: Math.NumberTheory.CurvesTests -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Curves -- {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.CurvesTests where import Test.Tasty import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..)) import GHC.TypeNats (KnownNat) import Math.NumberTheory.Curves.Montgomery import Math.NumberTheory.TestUtils (==>?) :: Maybe a -> (a -> Property) -> Property x ==>? f = maybe discard f x isValid :: KnownNat n => Point a24 n -> Property isValid p = counterexample "x is not reduced by modulo" (x >= 0 && x < n) .&&. counterexample "z is not reduced by modulo" (z >= 0 && z < n) where n = pointN p x = pointX p z = pointZ p isValid' :: KnownNat n => Point a24 n -> Bool isValid' p = (x >= 0 && x < n) && (z >= 0 && z < n) where n = pointN p x = pointX p z = pointZ p newPointRangeProperty :: Shrink2 (Positive Integer) -> Shrink2 (Positive Integer) -> Property newPointRangeProperty (Shrink2 (Positive s)) (Shrink2 (Positive n)) = newPoint s n ==>? \case SomePoint p -> isValid p multiplyRangeProperty :: Shrink2 (Positive Integer) -> Shrink2 (Positive Integer) -> Shrink2 Word -> Property multiplyRangeProperty (Shrink2 (Positive s)) (Shrink2 (Positive n)) (Shrink2 k) = newPoint s n ==>? \case SomePoint p -> isValid' p ==> isValid (multiply k p) doubleRangeProperty :: Shrink2 (Positive Integer) -> Shrink2 (Positive Integer) -> Shrink2 Word -> Property doubleRangeProperty (Shrink2 (Positive s)) (Shrink2 (Positive n)) (Shrink2 k) = newPoint s n ==>? \case SomePoint p -> isValid' p ==> isValid' kp ==> isValid (double kp) where kp = multiply k p addRangeProperty :: Shrink2 (Positive Integer) -> Shrink2 (Positive Integer) -> Shrink2 Word -> Shrink2 Word -> Property addRangeProperty (Shrink2 (Positive s)) (Shrink2 (Positive n)) (Shrink2 k) (Shrink2 l) = newPoint s n ==>? \case SomePoint p -> isValid' p ==> isValid' kp ==> isValid' lp ==> isValid' klp ==> isValid (add kp lp klp) where kp = multiply k p lp = multiply l p klp = multiply (k + l) p doubleAndMultiplyProperty :: Shrink2 (Positive Integer) -> Shrink2 (Positive Integer) -> Shrink2 Word -> Property doubleAndMultiplyProperty (Shrink2 (Positive s)) (Shrink2 (Positive n)) (Shrink2 k) = newPoint s n ==>? \case SomePoint p -> k < maxBound `div` 2 ==> double (multiply k p) === multiply (2 * k) p addAndMultiplyProperty :: Shrink2 (Positive Integer) -> Shrink2 (Positive Integer) -> Shrink2 Word -> Shrink2 Word -> Property addAndMultiplyProperty (Shrink2 (Positive s)) (Shrink2 (Positive n)) (Shrink2 k) (Shrink2 l) = newPoint s n ==>? \case SomePoint p -> k < maxBound `div` 3 && l < maxBound `div` 3 && pointX kp /= 0 && gcd n (pointZ kp) == 1 && gcd n (pointZ lp) == 1 && gcd n (pointZ klp) == 1 ==> add kp lp klp === k2lp where kp = multiply k p lp = multiply l p klp = multiply (k + l) p k2lp = multiply (k + 2 * l) p testSuite :: TestTree testSuite = localOption (QuickCheckMaxRatio 100) $ localOption (QuickCheckTests 1000) $ testGroup "Montgomery" [ QC.testProperty "range of newPoint" newPointRangeProperty , QC.testProperty "range of double" doubleRangeProperty , QC.testProperty "range of add" addRangeProperty , QC.testProperty "range of multiply" multiplyRangeProperty , QC.testProperty "double matches multiply" doubleAndMultiplyProperty , QC.testProperty "add matches multiply" addAndMultiplyProperty ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/DiophantineTests.hs0000644000000000000000000000252607346545000023206 0ustar0000000000000000-- Tests for Math.NumberTheory.Diophantine {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.DiophantineTests ( testSuite ) where import Data.List (sort) import Test.Tasty import Math.NumberTheory.Diophantine import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.TestUtils cornacchiaTest :: Positive Integer -> Positive Integer -> Bool cornacchiaTest (Positive d) (Positive a) = gcd d m /= 1 || all checkSoln (cornacchia d m) where m = d + a checkSoln (x, y) = x*x + d*y*y == m -- Testing against a slower reference implementation on coprime inputs cornacchiaBruteForce :: Positive Integer -> Positive Integer -> Bool cornacchiaBruteForce (Positive d) (Positive a) = gcd d m /= 1 || findSolutions [] 1 == sort (cornacchia d m) where m = d + a -- Simple O(sqrt (m/d)) brute force by considering all possible y values findSolutions acc y | x2 <= 0 = acc | x*x == x2 = findSolutions ((x,y) : acc) (y+1) | otherwise = findSolutions acc (y+1) where x2 = m - d*y*y x = integerSquareRoot x2 testSuite :: TestTree testSuite = testGroup "Diophantine" [ testSmallAndQuick "Cornacchia correct" cornacchiaTest , testSmallAndQuick "Cornacchia same solutions as brute force" cornacchiaBruteForce ]arithmoi-0.12.1.0/test-suite/Math/NumberTheory/DirichletCharactersTests.hs0000644000000000000000000002571707346545000024662 0ustar0000000000000000-- | -- Module: Math.NumberTheory.DirichletCharactersTests -- Copyright: (c) 2018 Bhavik Mehta -- License: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.DirichletCharacters -- {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} module Math.NumberTheory.DirichletCharactersTests where import Test.Tasty import Data.Complex import Data.List (genericLength) import Data.Maybe (isJust, mapMaybe) import Data.Proxy import Data.Semigroup import qualified Data.Vector as V import Numeric.Natural import GHC.TypeNats (SomeNat(..), someNatVal, KnownNat, natVal, sameNat) import Data.Type.Equality import Math.NumberTheory.ArithmeticFunctions (totient, divisorsList) import Math.NumberTheory.DirichletCharacters import qualified Math.NumberTheory.Moduli.Sqrt as J import Math.NumberTheory.Moduli.Class (SomeMod(..), modulo) import Math.NumberTheory.TestUtils (testSmallAndQuick, Positive(..)) -- | This tests property 6 from https://en.wikipedia.org/wiki/Dirichlet_character#Axiomatic_definition dirCharOrder :: forall n. KnownNat n => DirichletCharacter n -> Bool dirCharOrder chi = isPrincipal (totient n `stimes` chi) where n = natVal @n Proxy -- | Tests wikipedia's property 3 (note 1,2,5 are essentially enforced by the type system). testMultiplicative :: KnownNat n => DirichletCharacter n -> Natural -> Natural -> Bool testMultiplicative chi (fromIntegral -> a) (fromIntegral -> b) = chiAB == chiAchiB where chi' = evalGeneral chi chiAB = chi' (a*b) chiAchiB = (<>) <$> chi' a <*> chi' b -- | Test property 4 from wikipedia testAtOne :: KnownNat n => DirichletCharacter n -> Bool testAtOne chi = eval chi mempty == mempty dirCharProperty :: (forall n. KnownNat n => DirichletCharacter n -> a) -> Positive Natural -> Natural -> a dirCharProperty test (Positive n) i = case someNatVal n of SomeNat (Proxy :: Proxy n) -> test chi where chi = indexToChar @n (i `mod` totient n) realCharProperty :: (forall n. KnownNat n => RealCharacter n -> a) -> Positive Natural -> Int -> a realCharProperty test (Positive n) i = case someNatVal n of SomeNat (Proxy :: Proxy n) -> test chi where chi = chars !! (i `mod` length chars) chars = mapMaybe isRealCharacter [principalChar @n .. maxBound] -- | There should be totient(n) characters countCharacters :: Positive Natural -> Bool countCharacters (Positive n) = case someNatVal n of SomeNat (Proxy :: Proxy n) -> genericLength (allChars @n) == totient n -- | The principal character should be 1 if gcd k n is 1 and 0 otherwise principalCase :: Positive Natural -> Positive Integer -> Bool principalCase (Positive n) (Positive k) = case k `modulo` n of SomeMod a -> evalGeneral chi a == if gcd k (fromIntegral n) > 1 then Zero else mempty where chi = principalChar InfMod{} -> False -- | Test the orthogonality relations https://en.wikipedia.org/wiki/Dirichlet_character#Character_orthogonality orthogonality1 :: forall n. KnownNat n => DirichletCharacter n -> Bool orthogonality1 chi = magnitude (total - correct) < (1e-13 :: Double) where n = natVal @n Proxy total = sum [orZeroToNum toComplex (evalGeneral chi a) | a <- [0 .. maxBound]] correct = if isPrincipal chi then fromIntegral $ totient n else 0 orthogonality2 :: Positive Natural -> Integer -> Bool orthogonality2 (Positive n) a = case a `modulo` n of SomeMod a' -> magnitude (total - correct) < (1e-13 :: Double) where total = sum [orZeroToNum toComplex (evalGeneral chi a') | chi <- allChars] correct = if a' == 1 then fromIntegral $ totient n else 0 InfMod {} -> False -- | Manually confirm isRealCharacter is correct (in both directions) realityCheck :: KnownNat n => DirichletCharacter n -> Bool realityCheck chi = isJust (isRealCharacter chi) == isReal' where isReal' = and [real (evalGeneral chi t) | t <- [minBound..maxBound]] real Zero = True real (NonZero t) = t <> t == mempty -- | Check real character evaluation matches normal evaluation realEvalCheck :: KnownNat n => RealCharacter n -> Int -> Bool realEvalCheck chi i' = fromIntegral (toRealFunction chi i) == (orZeroToNum toComplex (evalGeneral (getRealChar chi) i) :: Complex Double) where i = fromIntegral i' -- | The jacobi character agrees with the jacobi symbol jacobiCheck :: Positive Natural -> Bool jacobiCheck (Positive n) = case someNatVal (2*n+1) of SomeNat (Proxy :: Proxy n) -> case jacobiCharacter @n of Just chi -> and [toRealFunction chi (fromIntegral j) == J.symbolToNum (J.jacobi j (2*n+1)) | j <- [0..2*n]] _ -> False -- | Bulk evaluation agrees with pointwise evaluation evalAllCheck :: forall n. KnownNat n => DirichletCharacter n -> Bool evalAllCheck chi = V.generate (fromIntegral $ natVal @n Proxy) (evalGeneral chi . fromIntegral) == evalAll chi -- | Induced characters agree with the original character. -- (Except for when d=1, where chi(0) = 1, which is true for no other d) inducedCheck :: forall d. KnownNat d => DirichletCharacter d -> Positive Natural -> Bool inducedCheck chi (Positive k) = case someNatVal (d*k) of SomeNat (Proxy :: Proxy n) -> case induced @n chi of Just chi2 -> and (V.izipWith matchedValue (V.concat (replicate (fromIntegral k) (evalAll chi))) (evalAll chi2)) Nothing -> False where d = natVal @d Proxy matchedValue i x1 x2 = if gcd (fromIntegral i) (d*k) > 1 then x2 == Zero else x2 == x1 -- | Primitive checker is correct (in both directions) primitiveCheck :: forall n. KnownNat n => DirichletCharacter n -> Bool primitiveCheck chi = isJust (isPrimitive chi) == isPrimitive' where isPrimitive' = all testModulus possibleModuli n = fromIntegral (natVal @n Proxy) :: Int possibleModuli = init (divisorsList n) table = evalAll chi testModulus d = not $ null [a | a <- [1..n-1], gcd a n == 1, a `mod` d == 1 `mod` d, table V.! a /= mempty] -- | Ensure that makePrimitive gives primitive characters makePrimitiveCheck :: DirichletCharacter n -> Bool makePrimitiveCheck chi = case makePrimitive chi of WithNat chi' -> isJust (isPrimitive (getPrimitiveChar chi')) -- | sameNat also ensures the two new moduli are the same makePrimitiveIdem :: DirichletCharacter n -> Bool makePrimitiveIdem chi = case makePrimitive chi of WithNat (chi' :: PrimitiveCharacter n') -> case makePrimitive (getPrimitiveChar chi') of WithNat (chi'' :: PrimitiveCharacter n'') -> case sameNat (Proxy :: Proxy n') (Proxy :: Proxy n'') of Just Refl -> chi' == chi'' Nothing -> False orderCheck :: DirichletCharacter n -> Bool orderCheck chi = isPrincipal (n `stimes` chi) && and [not (isPrincipal (i `stimes` chi)) | i <- [1..n-1]] where n = orderChar chi fromTableCheck :: forall n. KnownNat n => DirichletCharacter n -> Bool fromTableCheck chi = isJust (fromTable @n (evalAll chi)) -- A bunch of functions making sure that every function which can produce a character (in -- particular by fiddling internal representation) produces a valid character indexToCharValid :: KnownNat n => DirichletCharacter n -> Bool indexToCharValid = validChar principalCharValid :: Positive Natural -> Bool principalCharValid (Positive n) = case someNatVal n of SomeNat (Proxy :: Proxy n) -> validChar (principalChar @n) mulCharsValid :: KnownNat n => DirichletCharacter n -> DirichletCharacter n -> Bool mulCharsValid chi1 chi2 = validChar (chi1 <> chi2) mulCharsValid' :: Positive Natural -> Natural -> Natural -> Bool mulCharsValid' (Positive n) i j = case someNatVal n of SomeNat (Proxy :: Proxy n) -> mulCharsValid (indexToChar @n (i `mod` totient n)) (indexToChar @n (j `mod` totient n)) stimesCharValid :: KnownNat n => DirichletCharacter n -> Int -> Bool stimesCharValid chi n = validChar (n `stimes` chi) succValid :: KnownNat n => DirichletCharacter n -> Bool succValid = validChar . succ inducedValid :: forall d. KnownNat d => DirichletCharacter d -> Positive Natural -> Bool inducedValid chi (Positive k) = case someNatVal (natVal @d Proxy * k) of SomeNat (Proxy :: Proxy n) -> maybe False validChar (induced @n chi) jacobiValid :: Positive Natural -> Bool jacobiValid (Positive n) = case someNatVal (2*n+1) of SomeNat (Proxy :: Proxy n) -> case jacobiCharacter @n of Just chi -> validChar (getRealChar chi) _ -> False makePrimitiveValid :: DirichletCharacter n -> Bool makePrimitiveValid chi = case makePrimitive chi of WithNat chi' -> validChar (getPrimitiveChar chi') testSuite :: TestTree testSuite = testGroup "DirichletCharacters" [ testSmallAndQuick "Dirichlet characters divide the right order" (dirCharProperty dirCharOrder) , testSmallAndQuick "Dirichlet characters are multiplicative" (dirCharProperty testMultiplicative) , testSmallAndQuick "Dirichlet characters are 1 at 1" (dirCharProperty testAtOne) , testSmallAndQuick "Right number of Dirichlet characters" countCharacters , testSmallAndQuick "Principal character behaves as expected" principalCase , testSmallAndQuick "Orthogonality relation 1" (dirCharProperty orthogonality1) , testSmallAndQuick "Orthogonality relation 2" orthogonality2 , testSmallAndQuick "Real character checking is correct" (dirCharProperty realityCheck) , testSmallAndQuick "Real character evaluation is accurate" (realCharProperty realEvalCheck) , testSmallAndQuick "Jacobi character matches symbol" jacobiCheck , testSmallAndQuick "Bulk evaluation matches pointwise" (dirCharProperty evalAllCheck) , testSmallAndQuick "Induced character is correct" (dirCharProperty inducedCheck) , testSmallAndQuick "Primitive character checking is correct" (dirCharProperty primitiveCheck) , testSmallAndQuick "makePrimitive produces primitive character" (dirCharProperty makePrimitiveCheck) , testSmallAndQuick "makePrimitive is idempotent" (dirCharProperty makePrimitiveIdem) , testSmallAndQuick "Calculates correct order" (dirCharProperty orderCheck) , testSmallAndQuick "Can construct from table" (dirCharProperty fromTableCheck) , testGroup "Creates valid characters" [ testSmallAndQuick "indexToChar" (dirCharProperty indexToCharValid) , testSmallAndQuick "principalChar" principalCharValid , testSmallAndQuick "mulChars" mulCharsValid' , testSmallAndQuick "stimesChar" (dirCharProperty stimesCharValid) , testSmallAndQuick "succ" (dirCharProperty succValid) , testSmallAndQuick "induced" (dirCharProperty inducedValid) , testSmallAndQuick "jacobi" jacobiValid , testSmallAndQuick "makePrimitive" (dirCharProperty makePrimitiveValid) ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/EisensteinIntegersTests.hs0000644000000000000000000001663507346545000024561 0ustar0000000000000000-- | -- Module: Math.NumberTheory.EisensteinIntegersTests -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé Bool signumAbsProperty z = z == signum z * abs z -- | Check that @abs@ maps an @EisensteinInteger@ to its associate in first -- sextant. absProperty :: E.EisensteinInteger -> Bool absProperty z = isOrigin || (inFirstSextant && isAssociate) where z'@(x' E.:+ y') = abs z isOrigin = z' == 0 && z == 0 -- The First sextant includes the positive real axis, but not the origin -- or the line defined by the linear equation @y = (sqrt 3) * x@ in the -- Cartesian plane. inFirstSextant = x' > y' && y' >= 0 isAssociate = z' `elem` map (\e -> z * (1 E.:+ 1) ^ e) [0 .. 5] -- | Verify that @rem@ produces a remainder smaller than the divisor with -- regards to the Euclidean domain's function. remProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool remProperty1 x y = (y == 0) || E.norm (x `rem` y) < E.norm y -- | Verify that @quot@ and @rem@ are what `quotRem` produces. quotRemProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool quotRemProperty1 x y = (y == 0) || q == q' && r == r' where (q, r) = quotRem x y q' = quot x y r' = rem x y -- | Verify that @quotRemE@ produces the right quotient and remainder. quotRemProperty2 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool quotRemProperty2 x y = (y == 0) || (x `quot` y) * y + (x `rem` y) == x -- | Verify that @gcd z1 z2@ always divides @z1@ and @z2@. gcdEProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool gcdEProperty1 z1 z2 = z1 == 0 && z2 == 0 || z1 `rem` z == 0 && z2 `rem` z == 0 where z = gcd z1 z2 -- | Verify that a common divisor of @z1, z2@ is a always divisor of @gcd z1 z2@. gcdEProperty2 :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool gcdEProperty2 z z1 z2 = z == 0 || gcd z1' z2' `rem` z == 0 where z1' = z * z1 z2' = z * z2 -- | A special case that tests rounding/truncating in GCD. gcdESpecialCase1 :: Assertion gcdESpecialCase1 = assertEqual "gcd" (1 E.:+ 1) $ gcd (12 E.:+ 23) (23 E.:+ 34) findPrimesProperty1 :: Positive Int -> Bool findPrimesProperty1 (Positive index) = let -- Only retain primes that are of the form @6k + 1@, for some nonzero natural @k@. prop prime = unPrime prime `mod` 6 == 1 p = (!! index) $ filter prop $ drop 3 primes in isJust (isPrime (unPrime (E.findPrime p) :: E.EisensteinInteger)) -- | Checks that the @norm@ of the Euclidean domain of Eisenstein integers -- is multiplicative i.e. -- @forall e1 e2 in Z[ω] . norm(e1 * e2) == norm(e1) * norm(e2)@. euclideanDomainProperty1 :: E.EisensteinInteger -> E.EisensteinInteger -> Bool euclideanDomainProperty1 e1 e2 = E.norm (e1 * e2) == E.norm e1 * E.norm e2 -- | Checks that the numbers produced by @primes@ are actually Eisenstein -- primes. primesProperty1 :: Positive Int -> Bool primesProperty1 (Positive index) = all (isJust . isPrime . (unPrime :: Prime E.EisensteinInteger -> E.EisensteinInteger)) $ take index E.primes -- | Checks that the infinite list of Eisenstein primes @primes@ is ordered -- by the numbers' norm. primesProperty2 :: Positive Int -> Bool primesProperty2 (Positive index) = let isOrdered :: [Prime E.EisensteinInteger] -> Bool isOrdered xs = all (\(x, y) -> E.norm (unPrime x) <= E.norm (unPrime y)) . zip xs $ tail xs in isOrdered $ take index E.primes -- | Checks that the numbers produced by @primes@ are all in the first -- sextant. primesProperty3 :: Positive Int -> Bool primesProperty3 (Positive index) = all (\e -> abs (unPrime e) == (unPrime e :: E.EisensteinInteger)) $ take index E.primes -- | An Eisenstein integer is either zero or associated (i.e. equal up to -- multiplication by a unit) to the product of its factors raised to their -- respective exponents. factoriseProperty1 :: E.EisensteinInteger -> Bool factoriseProperty1 g = g == 0 || abs g == abs g' where factors = factorise g g' = product $ map (\(p, k) -> unPrime p ^ k) factors -- | Check that there are no factors with exponent @0@ in the factorisation. factoriseProperty2 :: E.EisensteinInteger -> Bool factoriseProperty2 z = z == 0 || all ((> 0) . snd) (factorise z) -- | Check that no factor produced by @factorise@ is a unit. factoriseProperty3 :: E.EisensteinInteger -> Bool factoriseProperty3 z = z == 0 || all ((> 1) . E.norm . unPrime . fst) (factorise z) factoriseSpecialCase1 :: Assertion factoriseSpecialCase1 = assertEqual "should be equal" [ (fromJust $ isPrime $ 2 E.:+ 1, 3) , (fromJust $ isPrime $ 3 E.:+ 1, 1) ] (factorise (15 E.:+ 12)) testSuite :: TestTree testSuite = testGroup "EisensteinIntegers" [ testSmallAndQuick "forall z . z == signum z * abs z" signumAbsProperty , testSmallAndQuick "abs z rotates to the first sextant" absProperty , testGroup "Division" [ testSmallAndQuick "The remainder's norm is smaller than the divisor's" remProperty1 , testSmallAndQuick "quotE and remE work properly" quotRemProperty1 , testSmallAndQuick "quotRemE works properly" quotRemProperty2 ] , testGroup "g.c.d." [ testSmallAndQuick "The g.c.d. of two Eisenstein integers divides them" gcdEProperty1 -- smallcheck takes too long , QC.testProperty "Common divisor divides gcd" gcdEProperty2 , testCase "g.c.d. (12 :+ 23) (23 :+ 34)" gcdESpecialCase1 ] , testSmallAndQuick "The Eisenstein norm function is multiplicative" euclideanDomainProperty1 , testGroup "Primality" [ testSmallAndQuick "findPrime returns prime" findPrimesProperty1 , testSmallAndQuick "primes are actually prime" primesProperty1 , testSmallAndQuick "primes is ordered" primesProperty2 , testSmallAndQuick "primes are in the first sextant" primesProperty3 ] , testGroup "Factorisation" [ testSmallAndQuick "factorise produces correct results" factoriseProperty1 , testSmallAndQuick "factorise produces no factors with exponent 0" factoriseProperty2 , testSmallAndQuick "factorise produces no unit factors" factoriseProperty3 , testCase "factorise 15:+12" factoriseSpecialCase1 ] , lawsToTest $ gcdDomainLaws (Proxy :: Proxy E.EisensteinInteger) , lawsToTest $ euclideanLaws (Proxy :: Proxy E.EisensteinInteger) ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/EuclideanTests.hs0000644000000000000000000001545407346545000022641 0ustar0000000000000000-- | -- Module: Math.NumberTheory.EuclideanTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Euclidean.Coprimes -- {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} module Math.NumberTheory.EuclideanTests ( testSuite ) where import Prelude hiding (gcd) import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonZero(..)) import Control.Arrow import Data.Bits import Data.Euclidean import Data.Maybe import Data.Semigroup import Data.List (tails, sort) import Numeric.Natural import Math.NumberTheory.Euclidean.Coprimes import Math.NumberTheory.Quadratic.GaussianIntegers import Math.NumberTheory.TestUtils -- | Check that numbers are coprime iff their gcd equals to 1. coprimeProperty :: (Eq a, Num a, GcdDomain a, Euclidean a) => AnySign a -> AnySign a -> Bool coprimeProperty (AnySign a) (AnySign b) = coprime a b == (gcd a b == 1) splitIntoCoprimesProperty1 :: (Eq a, Num a, GcdDomain a) => [(a, Power Word)] -> Bool splitIntoCoprimesProperty1 fs' = factorback fs == factorback (unCoprimes $ splitIntoCoprimes fs) where fs = map (second getPower) fs' factorback = abs . product . map (uncurry (^)) splitIntoCoprimesProperty2 :: (Eq a, Num a, GcdDomain a) => [(NonZero a, Power Word)] -> Bool splitIntoCoprimesProperty2 fs' = multiplicities fs <= multiplicities (unCoprimes $ splitIntoCoprimes fs) where fs = map (getNonZero *** getPower) fs' multiplicities = sum . map snd . filter ((/= 1) . abs . fst) splitIntoCoprimesProperty3 :: (Eq a, Num a, GcdDomain a) => [(a, Power Word)] -> Bool splitIntoCoprimesProperty3 fs' = and [ coprime x y | (x : xs) <- tails fs, y <- xs ] where fs = map fst $ unCoprimes $ splitIntoCoprimes $ map (second getPower) fs' -- | Check that evaluation never freezes. splitIntoCoprimesProperty4 :: (Eq a, Num a, GcdDomain a) => [(a, Word)] -> Bool splitIntoCoprimesProperty4 fs' = fs == fs where fs = splitIntoCoprimes fs' splitIntoCoprimesProperty5 :: (Eq a, Num a, GcdDomain a) => [(a, Word)] -> Bool splitIntoCoprimesProperty5 = all ((/= 1) . abs . fst) . unCoprimes . splitIntoCoprimes -- | This is an undefined behaviour, but at least it should not -- throw exceptions or loop forever. splitIntoCoprimesSpecialCase1 :: Assertion splitIntoCoprimesSpecialCase1 = assertBool "should not fail" $ splitIntoCoprimesProperty4 @Integer [(0, 0), (0, 0)] -- | This is an undefined behaviour, but at least it should not -- throw exceptions or loop forever. splitIntoCoprimesSpecialCase2 :: Assertion splitIntoCoprimesSpecialCase2 = assertBool "should not fail" $ splitIntoCoprimesProperty4 @Integer [(0, 1), (-2, 0)] toListReturnsCorrectValues :: Assertion toListReturnsCorrectValues = assertEqual "should be equal" (sort $ unCoprimes $ splitIntoCoprimes [(140, 1), (165, 1)]) ([(5,2),(28,1),(33,1)] :: [(Integer, Word)]) unionReturnsCorrectValues :: Assertion unionReturnsCorrectValues = assertEqual "should be equal" expected actual where a :: Coprimes Integer Word a = splitIntoCoprimes [(700, 1), (165, 1)] -- [(5,3),(28,1),(33,1)] b = splitIntoCoprimes [(360, 1), (210, 1)] -- [(2,4),(3,3),(5,2),(7,1)] expected = [(2,6),(3,4),(5,5),(7,2),(11,1)] actual = sort $ unCoprimes (a <> b) insertReturnsCorrectValuesWhenCoprimeBase :: Assertion insertReturnsCorrectValuesWhenCoprimeBase = let a = insert 5 2 (singleton 4 3) expected = [(4,3), (5,2)] actual = sort $ unCoprimes a :: [(Int, Int)] in assertEqual "should be equal" expected actual insertReturnsCorrectValuesWhenNotCoprimeBase :: Assertion insertReturnsCorrectValuesWhenNotCoprimeBase = let a = insert 2 4 (insert 7 1 (insert 5 2 (singleton 4 3))) actual = sort $ unCoprimes a :: [(Int, Int)] expected = [(2,10), (5,2), (7,1)] in assertEqual "should be equal" expected actual unionProperty1 :: (Ord a, GcdDomain a) => [(a, Power Word)] -> [(a, Power Word)] -> Bool unionProperty1 xs ys = sort (unCoprimes (splitIntoCoprimes (xs' <> ys'))) == sort (unCoprimes (splitIntoCoprimes xs' <> splitIntoCoprimes ys')) where xs' = map (second getPower) xs ys' = map (second getPower) ys testSuite :: TestTree testSuite = testGroup "Euclidean" [ testSameIntegralProperty "coprime" coprimeProperty , testGroup "splitIntoCoprimes" [ testGroup "preserves product of factors" [ testSmallAndQuick "Natural" (splitIntoCoprimesProperty1 @Natural) , testSmallAndQuick "Integer" (splitIntoCoprimesProperty1 @Integer) , testSmallAndQuick "Gaussian" (splitIntoCoprimesProperty1 @GaussianInteger) ] , testGroup "number of factors is non-decreasing" [ testSmallAndQuick "Natural" (splitIntoCoprimesProperty2 @Natural) , testSmallAndQuick "Integer" (splitIntoCoprimesProperty2 @Integer) , testSmallAndQuick "Gaussian" (splitIntoCoprimesProperty2 @GaussianInteger) ] , testGroup "output factors are coprime" [ testSmallAndQuick "Natural" (splitIntoCoprimesProperty3 @Natural) , testSmallAndQuick "Integer" (splitIntoCoprimesProperty3 @Integer) , testSmallAndQuick "Gaussian" (splitIntoCoprimesProperty3 @GaussianInteger) ] , testGroup "does not freeze" [ testCase "case 1" splitIntoCoprimesSpecialCase1 , testCase "case 2" splitIntoCoprimesSpecialCase2 , testSmallAndQuick "Natural" (splitIntoCoprimesProperty4 @Natural) -- smallcheck for Integer and GaussianInteger takes too long , QC.testProperty "Integer" (splitIntoCoprimesProperty4 @Integer) , QC.testProperty "Gaussian" (splitIntoCoprimesProperty4 @GaussianInteger) ] , testGroup "output factors are non-unit" [ testSmallAndQuick "Natural" (splitIntoCoprimesProperty5 @Natural) -- smallcheck for Integer and GaussianInteger takes too long , QC.testProperty "Integer" (splitIntoCoprimesProperty5 @Integer) , QC.testProperty "Gaussian" (splitIntoCoprimesProperty5 @GaussianInteger) ] ] , testGroup "Coprimes" [ testCase "test equality" toListReturnsCorrectValues , testCase "test union" unionReturnsCorrectValues , testCase "test insert with coprime base" insertReturnsCorrectValuesWhenCoprimeBase , testCase "test insert with non-coprime base" insertReturnsCorrectValuesWhenNotCoprimeBase , testGroup "property union" [ testSmallAndQuick "Natural" (unionProperty1 @Natural) -- smallcheck for Integer takes too long , QC.testProperty "Integer" (unionProperty1 @Integer) ] ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/GaussianIntegersTests.hs0000644000000000000000000001624007346545000024215 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | -- Module: Math.NumberTheory.GaussianIntegersTests -- Copyright: (c) 2016 Chris Fredrickson, Google Inc. -- Licence: MIT -- Maintainer: Chris Fredrickson -- -- Tests for Math.NumberTheory.GaussianIntegers -- module Math.NumberTheory.GaussianIntegersTests ( testSuite ) where import Prelude hiding (gcd, rem) import Control.Monad (zipWithM_) import Data.Euclidean import Data.List (groupBy, sort) import Data.Maybe (fromJust, mapMaybe) import Data.Proxy import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..)) import Test.QuickCheck.Classes import Test.Tasty import Test.Tasty.HUnit import Math.NumberTheory.Quadratic.GaussianIntegers import Math.NumberTheory.Moduli.Sqrt import Math.NumberTheory.Roots (integerSquareRoot) import Math.NumberTheory.Primes (Prime, unPrime, UniqueFactorisation(..)) import Math.NumberTheory.TestUtils lazyCases :: [(GaussianInteger, [(Prime GaussianInteger, Word)])] lazyCases = [ ( 14145130733 * 10000000000000000000000000000000000000121 * 100000000000000000000000000000000000000000000000447 , [(fromJust $ isPrime $ 117058 :+ 21037, 1), (fromJust $ isPrime $ 21037 :+ 117058, 1)] ) ] -- | Number is zero or is equal to the product of its factors. factoriseProperty1 :: GaussianInteger -> Bool factoriseProperty1 g = g == 0 || abs g == abs g' where factors = factorise g g' = product $ map (\(p, k) -> unPrime p ^ k) factors factoriseProperty2 :: GaussianInteger -> Bool factoriseProperty2 z = z == 0 || all ((> 0) . snd) (factorise z) factoriseProperty3 :: GaussianInteger -> Bool factoriseProperty3 z = z == 0 || all ((> 1) . norm . unPrime . fst) (factorise z) factoriseSpecialCase1 :: Assertion factoriseSpecialCase1 = assertEqual "should be equal" [ (fromJust $ isPrime $ 3 :+ 0, 2) , (fromJust $ isPrime $ 1 :+ 2, 1) , (fromJust $ isPrime $ 2 :+ 3, 1) ] (factorise (63 :+ 36)) factoriseSpecialCase2 :: (GaussianInteger, [(Prime GaussianInteger, Word)]) -> Assertion factoriseSpecialCase2 (n, fs) = zipWithM_ (assertEqual (show n)) fs (factorise n) findPrimeReference :: Prime Integer -> GaussianInteger findPrimeReference p = let c : _ = sqrtsModPrime (-1) p k = integerSquareRoot (unPrime p) bs = [1 .. k] asbs = map (\b' -> ((b' * c) `mod` unPrime p, b')) bs (a, b) = head [ (a', b') | (a', b') <- asbs, a' <= k] in a :+ b findPrimeProperty1 :: Prime Integer -> Bool findPrimeProperty1 p = unPrime p `mod` 4 /= (1 :: Integer) || p1 == p2 || abs (p1 * p2) == fromInteger (unPrime p) where p1 = findPrimeReference p p2 = unPrime (findPrime p) -- | Number is prime iff it is non-zero -- and has exactly one (non-unit) factor. isPrimeProperty :: GaussianInteger -> Bool isPrimeProperty 0 = True isPrimeProperty g = case isPrime g of Nothing -> n /= 1 Just{} -> n == 1 where factors = factorise g -- Count factors taking into account multiplicity n = sum $ map snd factors primesSpecialCase1 :: Assertion primesSpecialCase1 = assertEqual "primes" (f $ mapMaybe isPrime [1+ι,2+ι,1+2*ι,3,3+2*ι,2+3*ι,4+ι,1+4*ι,5+2*ι,2+5*ι,6+ι,1+6*ι,5+4*ι,4+5*ι,7,7+2*ι,2+7*ι,6+5*ι,5+6*ι,8+3*ι,3+8*ι,8+5*ι,5+8*ι,9+4*ι,4+9*ι,10+ι,1+10*ι,10+3*ι,3+10*ι,8+7*ι,7+8*ι,11,11+4*ι,4+11*ι,10+7*ι,7+10*ι,11+6*ι,6+11*ι,13+2*ι,2+13*ι,10+9*ι,9+10*ι,12+7*ι,7+12*ι,14+ι,1+14*ι,15+2*ι,2+15*ι,13+8*ι,8+13*ι,15+4*ι]) (f $ take 51 primes) where f :: [Prime GaussianInteger] -> [[Prime GaussianInteger]] f = map sort . groupBy (\g1 g2 -> norm (unPrime g1) == norm (unPrime g2)) -- | The list of primes should include only primes. primesGeneratesPrimesProperty :: NonNegative Int -> Bool primesGeneratesPrimesProperty (NonNegative i) = case isPrime (unPrime (primes !! i) :: GaussianInteger) of Nothing -> False Just{} -> True -- | Check that primes generates the primes in order. orderingPrimes :: Assertion orderingPrimes = assertBool "primes are ordered" (and $ zipWith (<=) xs (tail xs)) where xs = map (norm . unPrime) $ take 1000 primes numberOfPrimes :: Assertion numberOfPrimes = assertEqual "counting primes: OEIS A091100" [16,100,668,4928,38404,313752] [4 * length (takeWhile ((<= 10^n) . norm . unPrime) primes) | n <- [1..6]] -- | signum and abs should satisfy: z == signum z * abs z signumAbsProperty :: GaussianInteger -> Bool signumAbsProperty z = z == signum z * abs z -- | abs maps a Gaussian integer to its associate in first quadrant. absProperty :: GaussianInteger -> Bool absProperty z = isOrigin || (inFirstQuadrant && isAssociate) where z'@(x' :+ y') = abs z isOrigin = z' == 0 && z == 0 inFirstQuadrant = x' > 0 && y' >= 0 -- first quadrant includes the positive real axis, but not the origin or the positive imaginary axis isAssociate = z' `elem` map (\e -> z * (0 :+ 1) ^ e) [0 .. 3] -- | Verify that @rem@ produces a remainder smaller than the divisor with -- regards to the Euclidean domain's function. remProperty :: GaussianInteger -> GaussianInteger -> Bool remProperty x y = (y == 0) || norm (x `rem` y) < norm y gcdGProperty1 :: GaussianInteger -> GaussianInteger -> Bool gcdGProperty1 z1 z2 = z1 == 0 && z2 == 0 || z1 `rem` z == 0 && z2 `rem` z == 0 where z = gcd z1 z2 gcdGProperty2 :: GaussianInteger -> GaussianInteger -> GaussianInteger -> Bool gcdGProperty2 z z1 z2 = z == 0 || gcd z1' z2' `rem` z == 0 where z1' = z * z1 z2' = z * z2 -- | a special case that tests rounding/truncating in GCD. gcdGSpecialCase1 :: Assertion gcdGSpecialCase1 = assertEqual "gcdG" (-1) $ gcd (12 :+ 23) (23 :+ 34) gcdGSpecialCase2 :: Assertion gcdGSpecialCase2 = assertEqual "gcdG" (0 :+ (-1)) $ gcd (0 :+ 3) (2 :+ 2) testSuite :: TestTree testSuite = testGroup "GaussianIntegers" [ testGroup "factorise" ( [ testSmallAndQuick "factor back" factoriseProperty1 , testSmallAndQuick "powers are > 0" factoriseProperty2 , testSmallAndQuick "factors are > 1" factoriseProperty3 , testCase "factorise 63:+36" factoriseSpecialCase1 ] ++ map (testCase "laziness" . factoriseSpecialCase2) lazyCases) , testSmallAndQuick "findPrime'" findPrimeProperty1 , testSmallAndQuick "isPrime" isPrimeProperty , testCase "primes matches reference" primesSpecialCase1 , testSmallAndQuick "primes" primesGeneratesPrimesProperty , testCase "primes are ordered" orderingPrimes , testCase "counting primes" numberOfPrimes , testSmallAndQuick "signumAbsProperty" signumAbsProperty , testSmallAndQuick "absProperty" absProperty , testSmallAndQuick "remProperty" remProperty , testGroup "gcd" [ testSmallAndQuick "is divisor" gcdGProperty1 -- smallcheck takes too long , QC.testProperty "is greatest" gcdGProperty2 , testCase "(12 :+ 23) (23 :+ 34)" gcdGSpecialCase1 , testCase "(0 :+ 3) (2 :+ 2)" gcdGSpecialCase2 ] , lawsToTest $ gcdDomainLaws (Proxy :: Proxy GaussianInteger) , lawsToTest $ euclideanLaws (Proxy :: Proxy GaussianInteger) ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/0000755000000000000000000000000007346545000020611 5ustar0000000000000000arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/CbrtTests.hs0000644000000000000000000000764207346545000023073 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.Cbrt -- Copyright: (c) 2020 Federico Bongiorno -- Licence: MIT -- Maintainer: Federico Bongiorno -- -- Test for Math.NumberTheory.Moduli.Cbrt -- {-# LANGUAGE CPP #-} module Math.NumberTheory.Moduli.CbrtTests ( testSuite ) where import Math.NumberTheory.Moduli.Cbrt import Math.NumberTheory.Quadratic.EisensteinIntegers import Math.NumberTheory.Primes import qualified Data.Euclidean as A import Data.List (genericReplicate) #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Test.Tasty import Math.NumberTheory.TestUtils -- Checks multiplicative property of numerators. In details, -- @cubicSymbol1 alpha1 alpha2 beta@ checks that -- @(cubicSymbol alpha1 beta) <> (cubicSymbol alpha2 beta) == (cubicSymbol alpha1*alpha2 beta)@ cubicSymbol1 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbol1 alpha1 alpha2 beta = isBadDenominator beta || cubicSymbolNumerator alpha1 alpha2 beta cubicSymbolNumerator :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbolNumerator alpha1 alpha2 beta = (symbol1 <> symbol2) == symbolProduct where symbol1 = cubicSymbol alpha1 beta symbol2 = cubicSymbol alpha2 beta symbolProduct = cubicSymbol alphaProduct beta alphaProduct = alpha1 * alpha2 -- Checks multiplicative property of denominators. In details, -- @cubicSymbol2 alpha beta1 beta2@ checks that -- @(cubicSymbol alpha beta1) <> (cubicSymbol alpha beta2) == (cubicSymbol alpha beta1*beta2)@ cubicSymbol2 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbol2 alpha beta1 beta2 = isBadDenominator beta1 || isBadDenominator beta2 || cubicSymbolDenominator alpha beta1 beta2 cubicSymbolDenominator :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct where symbol1 = cubicSymbol alpha beta1 symbol2 = cubicSymbol alpha beta2 symbolProduct = cubicSymbol alpha betaProduct betaProduct = beta1 * beta2 -- Checks that `cubicSymbol` agrees with the computational definition -- -- when the denominator is prime. cubicSymbol3 :: EisensteinInteger -> Prime EisensteinInteger -> Bool cubicSymbol3 alpha prime = isBadDenominator beta || cubicSymbol alpha beta == cubicSymbolPrime alpha beta where beta = unPrime prime cubicSymbolPrime :: EisensteinInteger -> EisensteinInteger -> CubicSymbol cubicSymbolPrime alpha beta = findCubicSymbol residue beta where residue = foldr f 1 listOfAlphas f x y = (x * y) `A.rem` beta listOfAlphas = genericReplicate alphaExponent alpha -- Exponent is defined to be 1/3*(@betaNorm@ - 1). alphaExponent = betaNorm `div` 3 betaNorm = norm beta isBadDenominator :: EisensteinInteger -> Bool isBadDenominator x = modularNorm == 0 where modularNorm = norm x `mod` 3 -- This complication is necessary because it may happen that the residue field -- of @beta@ has characteristic two. In this case 1=-1 and the Euclidean algorithm -- can return both. Therefore it is not enough to pattern match for the values -- which give a well defined @cubicSymbol@. findCubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol findCubicSymbol residue beta | residue `A.rem` beta == 0 = Zero | (residue - ω) `A.rem` beta == 0 = Omega | (residue + 1 + ω) `A.rem` beta == 0 = OmegaSquare | (residue - 1) `A.rem` beta == 0 = One | otherwise = error "Math.NumberTheory.Moduli.Cbrt: invalid EisensteinInteger." testSuite :: TestTree testSuite = testGroup "CubicSymbol" [ testSmallAndQuick "multiplicative property of numerators" cubicSymbol1 , testSmallAndQuick "multiplicative property of denominators" cubicSymbol2 , testSmallAndQuick "cubic residue with prime denominator" cubicSymbol3 ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/ChineseTests.hs0000644000000000000000000000155107346545000023550 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.ChineseTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Moduli.Chinese -- module Math.NumberTheory.Moduli.ChineseTests ( testSuite ) where import Test.Tasty import Math.NumberTheory.Moduli (chinese) import Math.NumberTheory.TestUtils chineseProperty :: Integer -> Positive Integer -> Integer -> Positive Integer -> Bool chineseProperty n1 (Positive m1) n2 (Positive m2) = not compatible || case chinese (n1, m1) (n2, m2) of Nothing -> not compatible Just (n, m) -> compatible && (n - n1) `rem` m1 == 0 && (n - n2) `rem` m2 == 0 && m == lcm m1 m2 where g = gcd m1 m2 compatible = (n1 - n2) `rem` g == 0 testSuite :: TestTree testSuite = testSmallAndQuick "chinese" chineseProperty arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/ClassTests.hs0000644000000000000000000001612407346545000023241 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.ClassTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Moduli.Class -- {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Moduli.ClassTests ( testSuite ) where import Test.Tasty import qualified Test.Tasty.QuickCheck as QC import Data.Maybe import Numeric.Natural import Math.NumberTheory.Moduli hiding (invertMod) import Math.NumberTheory.TestUtils invertMod :: Integer -> Integer -> Maybe SomeMod invertMod x m = invertSomeMod (x `modulo` fromInteger m) powerMod :: Integral a => Integer -> a -> Integer -> SomeMod powerMod b e m = (b `modulo` fromInteger m) ^ e -- | Check that 'invertMod' inverts numbers modulo. invertModProperty :: AnySign Integer -> Positive Integer -> Bool invertModProperty (AnySign k) (Positive m) = case invertMod k m of Nothing -> k `rem` m == 0 || gcd k m > 1 Just InfMod{} -> False Just (SomeMod inv) -> gcd k m == 1 && k * getVal inv `mod` m == 1 -- | Check that 'powerMod' is multiplicative by first argument. powerModProperty2 :: (Integral a) => NonNegative a -> AnySign Integer -> AnySign Integer -> Positive Integer -> Bool powerModProperty2 (NonNegative e) (AnySign b1) (AnySign b2) (Positive m) = e < 0 && (isNothing (invertMod b1 m) || isNothing (invertMod b2 m)) || pm1 * pm2 == pm12 where pm1 = powerMod b1 e m pm2 = powerMod b2 e m pm12 = powerMod (b1 * b2) e m -- | Check that 'powerMod' is additive by second argument. powerModProperty3 :: (Integral a) => NonNegative a -> NonNegative a -> AnySign Integer -> Positive Integer -> Bool powerModProperty3 (NonNegative e1) (NonNegative e2) (AnySign b) (Positive m) = (e1 < 0 || e2 < 0) && isNothing (invertMod b m) || e2 >= 0 && e1 + e2 < e1 -- check overflow || e1 >= 0 && e1 + e2 < e2 -- check overflow || e2 <= 0 && e1 + e2 > e1 -- check overflow || e1 <= 0 && e1 + e2 > e2 -- check overflow || pm1 * pm2 == pm12 where pm1 = powerMod b e1 m pm2 = powerMod b e2 m pm12 = powerMod b (e1 + e2) m -- | Specialized to trigger 'powerModInteger'. powerModProperty2_Integer :: NonNegative Integer -> AnySign Integer -> AnySign Integer -> Positive Integer -> Bool powerModProperty2_Integer = powerModProperty2 -- | Specialized to trigger 'powerModInteger'. powerModProperty3_Integer :: NonNegative Integer -> NonNegative Integer -> AnySign Integer -> Positive Integer -> Bool powerModProperty3_Integer = powerModProperty3 someModAddProperty :: Integer -> Positive Natural -> Integer -> Positive Natural -> Bool someModAddProperty x1 (Positive m1) x2 (Positive m2) = case x1 `modulo` m1 + x2 `modulo` m2 of SomeMod z -> getMod z == m3 && getVal z == x3 InfMod{} -> False where m3 = toInteger $ m1 `gcd` m2 x3 = (x1 + x2) `mod` m3 someModSubProperty :: Integer -> Positive Natural -> Integer -> Positive Natural -> Bool someModSubProperty x1 (Positive m1) x2 (Positive m2) = case x1 `modulo` m1 - x2 `modulo` m2 of SomeMod z -> getMod z == m3 && getVal z == x3 InfMod{} -> False where m3 = toInteger $ m1 `gcd` m2 x3 = (x1 - x2) `mod` m3 someModMulProperty :: Integer -> Positive Natural -> Integer -> Positive Natural -> Bool someModMulProperty x1 (Positive m1) x2 (Positive m2) = case (x1 `modulo` m1) * (x2 `modulo` m2) of SomeMod z -> getMod z == m3 && getVal z == x3 InfMod{} -> False where m3 = toInteger $ m1 `gcd` m2 x3 = (x1 * x2) `mod` m3 sameSomeModMulProperty :: Integer -> Integer -> Positive Natural -> Bool sameSomeModMulProperty x1 x2 (Positive m) = case (x1 `modulo` m) * (x2 `modulo` m) of SomeMod z -> getMod z == toInteger m && getVal z == x3 InfMod{} -> False where x3 = (x1 * x2) `mod` toInteger m sameSomeModMulHugeProperty :: Integer -> Integer -> Positive (Huge Natural) -> Bool sameSomeModMulHugeProperty x1 x2 (Positive (Huge m)) = case (x1 `modulo` m) * (x2 `modulo` m) of SomeMod z -> getMod z == toInteger m && getVal z == x3 InfMod{} -> False where x3 = (x1 * x2) `mod` toInteger m sameSomeModMulHugeAllProperty :: Huge Integer -> Huge Integer -> Positive (Huge Natural) -> Bool sameSomeModMulHugeAllProperty (Huge x1) (Huge x2) (Positive (Huge m)) = case (x1 `modulo` m) * (x2 `modulo` m) of SomeMod z -> getMod z == toInteger m && getVal z == x3 InfMod{} -> False where x3 = (x1 * x2) `mod` toInteger m someModNegProperty :: Integer -> Positive Natural -> Bool someModNegProperty x1 (Positive m1) = case negate (x1 `modulo` m1) of SomeMod z -> getMod z == m3 && getVal z == x3 InfMod{} -> False where m3 = toInteger m1 x3 = negate x1 `mod` m3 someModAbsSignumProperty :: Integer -> Positive Natural -> Bool someModAbsSignumProperty x (Positive m) = z == abs z * signum z where z = x `modulo` m infModAddProperty :: Integer -> Positive Natural -> Integer -> Bool infModAddProperty x1 (Positive m1) x2 = case x1 `modulo` m1 + fromInteger x2 of SomeMod z -> getMod z == m3 && getVal z == x3 InfMod{} -> False where m3 = toInteger m1 x3 = (x1 + x2) `mod` m3 infModSubProperty :: Integer -> Positive Natural -> Integer -> Bool infModSubProperty x1 (Positive m1) x2 = case x1 `modulo` m1 - fromInteger x2 of SomeMod z -> getMod z == m3 && getVal z == x3 InfMod{} -> False where m3 = toInteger m1 x3 = (x1 - x2) `mod` m3 infModMulProperty :: Integer -> Positive Natural -> Integer -> Bool infModMulProperty x1 (Positive m1) x2 = case x1 `modulo` m1 * fromInteger x2 of SomeMod z -> getMod z == m3 && getVal z == x3 InfMod{} -> False where m3 = toInteger m1 x3 = (x1 * x2) `mod` m3 getValModProperty :: Integer -> Positive Natural -> Bool getValModProperty x (Positive m) = case z of SomeMod t -> z == getVal t `modulo` getNatMod t && z == toInteger (getNatVal t) `modulo` fromInteger (getMod t) InfMod{} -> False where z = x `modulo` m testSuite :: TestTree testSuite = testGroup "Class" [ testSmallAndQuick "invertMod" invertModProperty , testGroup "powerMod" [ testGroup "generic" [ testIntegralProperty "multiplicative by base" powerModProperty2 , testSameIntegralProperty "additive by exponent" powerModProperty3 ] , testGroup "Integer" [ testSmallAndQuick "multiplicative by base" powerModProperty2_Integer , testSmallAndQuick "additive by exponent" powerModProperty3_Integer ] ] , testGroup "Same SomeMod" [ testSmallAndQuick "mul" sameSomeModMulProperty , QC.testProperty "mul huge" sameSomeModMulHugeProperty , QC.testProperty "mul huge all" sameSomeModMulHugeAllProperty ] , testGroup "SomeMod" [ testSmallAndQuick "add" someModAddProperty , testSmallAndQuick "sub" someModSubProperty , testSmallAndQuick "mul" someModMulProperty , testSmallAndQuick "neg" someModNegProperty , testSmallAndQuick "abs" someModAbsSignumProperty ] , testGroup "InfMod" [ testSmallAndQuick "add" infModAddProperty , testSmallAndQuick "sub" infModSubProperty , testSmallAndQuick "mul" infModMulProperty ] , testSmallAndQuick "getVal/getMod" getValModProperty ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/DiscreteLogarithmTests.hs0000644000000000000000000000507507346545000025610 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Moduli.DiscreteLogarithmTests ( testSuite ) where import Test.Tasty import Data.Maybe import Data.Mod import Data.Proxy import Data.Semigroup import GHC.TypeNats (SomeNat(..), KnownNat, someNatVal) import Numeric.Natural import Math.NumberTheory.ArithmeticFunctions (totient) import Math.NumberTheory.Moduli.Multiplicative import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes import Math.NumberTheory.TestUtils nextPrimitiveRoot :: (KnownNat m, UniqueFactorisation a, Integral a) => CyclicGroup a m -> Mod m -> Maybe (PrimitiveRoot m) nextPrimitiveRoot cg g = listToMaybe $ mapMaybe (isPrimitiveRoot cg) [g..g+100] nextMultElement :: KnownNat m => Mod m -> Maybe (MultMod m) nextMultElement g = listToMaybe $ mapMaybe isMultElement [g..g+100] -- | Ensure 'discreteLogarithm' returns in the appropriate range. discreteLogRange :: Positive Natural -> Integer -> Integer -> Bool discreteLogRange (Positive m) a b = case someNatVal m of SomeNat (_ :: Proxy m) -> (/= Just False) $ do cg <- cyclicGroup :: Maybe (CyclicGroup Integer m) a' <- nextPrimitiveRoot cg (fromInteger a) b' <- nextMultElement (fromInteger b) return $ discreteLogarithm cg a' b' < totient m -- | Check that 'discreteLogarithm' inverts exponentiation. discreteLogarithmProperty :: Positive Natural -> Integer -> Integer -> Bool discreteLogarithmProperty (Positive m) a b = case someNatVal m of SomeNat (_ :: Proxy m) -> (/= Just False) $ do cg <- cyclicGroup :: Maybe (CyclicGroup Integer m) a' <- nextPrimitiveRoot cg (fromInteger a) b' <- nextMultElement (fromInteger b) return $ discreteLogarithm cg a' b' `stimes` unPrimitiveRoot a' == b' -- | Check that 'discreteLogarithm' inverts exponentiation in the other direction. discreteLogarithmProperty' :: Positive Natural -> Integer -> Natural -> Bool discreteLogarithmProperty' (Positive m) a k = case someNatVal m of SomeNat (_ :: Proxy m) -> (/= Just False) $ do cg <- cyclicGroup :: Maybe (CyclicGroup Integer m) a'' <- nextPrimitiveRoot cg (fromInteger a) let a' = unPrimitiveRoot a'' return $ discreteLogarithm cg a'' (k `stimes` a') == k `mod` totient m testSuite :: TestTree testSuite = testGroup "Discrete logarithm" [ testSmallAndQuick "output is correct range" discreteLogRange , testSmallAndQuick "a^(log_a b) == b" discreteLogarithmProperty , testSmallAndQuick "log_a a^k == k" discreteLogarithmProperty' ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/EquationsTests.hs0000644000000000000000000000352707346545000024147 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.EquationsTests -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- {-# LANGUAGE ScopedTypeVariables #-} module Math.NumberTheory.Moduli.EquationsTests ( testSuite ) where import Test.Tasty import Data.List (sort) import Data.Mod import Data.Proxy import GHC.TypeNats (KnownNat, SomeNat(..), someNatVal) import Numeric.Natural import Math.NumberTheory.Moduli (SomeMod(..)) import Math.NumberTheory.Moduli.Equations import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.TestUtils wrapSome :: KnownNat m => ([Mod m], [Mod m]) -> ([SomeMod], [SomeMod]) wrapSome (xs, ys) = (map SomeMod xs, map SomeMod ys) solveLinearProp :: KnownNat m => Mod m -> Mod m -> ([Mod m], [Mod m]) solveLinearProp a b = ( sort (solveLinear a b) , filter (\x -> a * x + b == 0) [minBound .. maxBound] ) solveLinearProperty1 :: (Positive Natural, Integer, Integer) -> ([SomeMod], [SomeMod]) solveLinearProperty1 (Positive m, a, b) = case someNatVal m of SomeNat (_ :: Proxy t) -> wrapSome $ solveLinearProp (fromInteger a :: Mod t) (fromInteger b) solveQuadraticProp :: KnownNat m => Mod m -> Mod m -> Mod m -> ([Mod m], [Mod m]) solveQuadraticProp a b c = ( sort (solveQuadratic sfactors a b c) , filter (\x -> a * x * x + b * x + c == 0) [minBound .. maxBound] ) solveQuadraticProperty1 :: (Positive Natural, Integer, Integer, Integer) -> ([SomeMod], [SomeMod]) solveQuadraticProperty1 (Positive m, a, b, c) = case someNatVal m of SomeNat (_ :: Proxy t) -> wrapSome $ solveQuadraticProp (fromInteger a :: Mod t) (fromInteger b) (fromInteger c) testSuite :: TestTree testSuite = testGroup "Equations" [ testEqualSmallAndQuick "solveLinear" solveLinearProperty1 , testEqualSmallAndQuick "solveQuadratic" solveQuadraticProperty1 ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/JacobiTests.hs0000644000000000000000000001011607346545000023356 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.JacobiTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Moduli.Jacobi -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Moduli.JacobiTests ( testSuite ) where import Test.Tasty import Data.Bits #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Math.NumberTheory.Moduli.Sqrt import Math.NumberTheory.TestUtils -- https://en.wikipedia.org/wiki/Jacobi_symbol#Properties, item 2 jacobiProperty2 :: (Integral a, Bits a) => AnySign a -> (MyCompose Positive Odd) a -> Bool jacobiProperty2 (AnySign a) (MyCompose (Positive (Odd n))) = a + n < a -- check overflow || jacobi a n == jacobi (a + n) n -- https://en.wikipedia.org/wiki/Jacobi_symbol#Properties, item 3 jacobiProperty3 :: (Integral a, Bits a) => AnySign a -> (MyCompose Positive Odd) a -> Bool jacobiProperty3 (AnySign a) (MyCompose (Positive (Odd n))) = case jacobi a n of MinusOne -> a `gcd` n == 1 Zero -> a `gcd` n /= 1 One -> a `gcd` n == 1 doesProductOverflow :: Integral a => a -> a -> Bool doesProductOverflow x y = abs (toInteger (x * y)) < abs (toInteger x * toInteger y) -- https://en.wikipedia.org/wiki/Jacobi_symbol#Properties, item 4 jacobiProperty4 :: (Integral a, Bits a) => AnySign a -> AnySign a -> (MyCompose Positive Odd) a -> Bool jacobiProperty4 (AnySign a) (AnySign b) (MyCompose (Positive (Odd n))) = doesProductOverflow a b || jacobi (a * b) n == jacobi a n <> jacobi b n -- https://en.wikipedia.org/wiki/Jacobi_symbol#Properties, item 5 jacobiProperty5 :: (Integral a, Bits a) => AnySign a -> (MyCompose Positive Odd) a -> (MyCompose Positive Odd) a -> Bool jacobiProperty5 (AnySign a) (MyCompose (Positive (Odd m))) (MyCompose (Positive (Odd n))) = doesProductOverflow m n || jacobi a (m * n) == jacobi a m <> jacobi a n -- https://en.wikipedia.org/wiki/Jacobi_symbol#Properties, item 6 jacobiProperty6 :: (Integral a, Bits a) => (MyCompose Positive Odd) a -> (MyCompose Positive Odd) a -> Bool jacobiProperty6 (MyCompose (Positive (Odd m))) (MyCompose (Positive (Odd n))) = gcd m n /= 1 || jacobi m n <> jacobi n m == (if m `mod` 4 == 1 || n `mod` 4 == 1 then One else MinusOne) -- https://en.wikipedia.org/wiki/Jacobi_symbol#Properties, item 7 jacobiProperty7 :: (Integral a, Bits a) => (MyCompose Positive Odd) a -> Bool jacobiProperty7 (MyCompose (Positive (Odd n))) = jacobi (-1) n == if n `mod` 4 == 1 then One else MinusOne jacobiProperty7_Int :: (MyCompose Positive Odd) Int -> Bool jacobiProperty7_Int = jacobiProperty7 jacobiProperty7_Integer :: (MyCompose Positive Odd) Integer -> Bool jacobiProperty7_Integer = jacobiProperty7 -- https://en.wikipedia.org/wiki/Jacobi_symbol#Properties, item 8 jacobiProperty8 :: (Integral a, Bits a) => (MyCompose Positive Odd) a -> Bool jacobiProperty8 (MyCompose (Positive (Odd n))) = even n || jacobi 2 n == if n `mod` 8 == 1 || n `mod` 8 == 7 then One else MinusOne jacobiProperty9 :: (Integral a, Bits a, Bounded a) => (MyCompose Positive Odd) a -> Bool jacobiProperty9 (MyCompose (Positive (Odd n))) = jacobi m n == jacobi (toInteger m) (toInteger n) where m = minBound jacobiProperty9_Int :: (MyCompose Positive Odd) Int -> Bool jacobiProperty9_Int = jacobiProperty9 testSuite :: TestTree testSuite = testGroup "Jacobi" [ testSameIntegralProperty "same modulo n" jacobiProperty2 , testSameIntegralProperty "consistent with gcd" jacobiProperty3 , testSameIntegralProperty3 "multiplicative 1" jacobiProperty4 , testSameIntegralProperty3 "multiplicative 2" jacobiProperty5 , testSameIntegralProperty "law of quadratic reciprocity" jacobiProperty6 , testSmallAndQuick "-1 Int" jacobiProperty7_Int , testSmallAndQuick "-1 Integer" jacobiProperty7_Integer , testIntegralProperty "2" jacobiProperty8 , testSmallAndQuick "minBound Int" jacobiProperty9_Int ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/PrimitiveRootTests.hs0000644000000000000000000001225307346545000025007 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.PrimitiveRootTests -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Moduli.PrimitiveRoot -- {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Moduli.PrimitiveRootTests ( testSuite ) where import Prelude hiding (gcd) import Test.Tasty import Test.Tasty.HUnit import Data.Euclidean import Data.List (genericTake, genericLength) import Data.Maybe (isJust, isNothing, mapMaybe) import Data.Mod import Data.Proxy import qualified Data.Set as S import GHC.TypeNats (SomeNat(..), someNatVal) import Numeric.Natural import Math.NumberTheory.ArithmeticFunctions (totient) import Math.NumberTheory.Moduli.Multiplicative import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes import Math.NumberTheory.TestUtils cyclicGroupProperty1 :: (Euclidean a, Integral a, UniqueFactorisation a) => Positive a -> Bool cyclicGroupProperty1 (Positive n) = case cyclicGroupFromModulo n of Nothing -> True Just (Some cg) -> factorBack (unSFactors (cyclicGroupToSFactors cg)) == n -- | Multiplicative groups modulo primes are always cyclic. cyclicGroupProperty2 :: (Integral a, UniqueFactorisation a) => Positive a -> Bool cyclicGroupProperty2 (Positive n) = case isPrime n of Nothing -> True Just _ -> isJust (cyclicGroupFromModulo n) -- | Multiplicative groups modulo double primes are always cyclic. cyclicGroupProperty3 :: (Integral a, UniqueFactorisation a) => Positive a -> Bool cyclicGroupProperty3 (Positive n) = case isPrime n of Nothing -> True Just _ -> 2 * n < n {- overflow check -} || isJust (cyclicGroupFromModulo n) cyclicGroupSpecialCase1 :: Assertion cyclicGroupSpecialCase1 = assertBool "should be non-cyclic" $ isNothing $ cyclicGroupFromModulo (8 :: Integer) allUnique :: Ord a => [a] -> Bool allUnique = go S.empty where go _ [] = True go acc (x : xs) = not (x `S.member` acc) && go (S.insert x acc) xs isPrimitiveRoot'Property1 :: forall a. (Euclidean a, Integral a, UniqueFactorisation a) => AnySign a -> Positive Natural -> Bool isPrimitiveRoot'Property1 (AnySign n) (Positive m) = case someNatVal m of SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup a m) of Nothing -> True Just cg -> case isPrimitiveRoot cg (fromIntegral n) of Nothing -> True Just rt -> gcd m (unMod (multElement (unPrimitiveRoot rt))) == 1 isPrimitiveRootProperty1 :: AnySign Integer -> Positive Natural -> Bool isPrimitiveRootProperty1 (AnySign n) (Positive m) = case someNatVal m of SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of Nothing -> True Just cg -> gcd n (toInteger m) == 1 || isNothing (isPrimitiveRoot cg (fromInteger n)) isPrimitiveRootProperty2 :: Positive Natural -> Bool isPrimitiveRootProperty2 (Positive m) = case someNatVal m of SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of Nothing -> True Just cg -> any (isJust . isPrimitiveRoot cg) [minBound..maxBound] isPrimitiveRootProperty3 :: AnySign Integer -> Positive Natural -> Bool isPrimitiveRootProperty3 (AnySign n) (Positive m) = case someNatVal m of SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of Nothing -> True Just cg -> let n' = fromInteger n in isNothing (isPrimitiveRoot cg n') || allUnique (genericTake (totient m - 1) (iterate (* n') 1)) isPrimitiveRootProperty5 :: Positive Natural -> Bool isPrimitiveRootProperty5 (Positive m) = case someNatVal m of SomeNat (_ :: Proxy m) -> case cyclicGroup :: Maybe (CyclicGroup Integer m) of Nothing -> True Just cg -> genericLength (mapMaybe (isPrimitiveRoot cg) [minBound..maxBound]) == totient (totient m) testSuite :: TestTree testSuite = testGroup "Primitive root" [ testGroup "CyclicGroup" [ testIntegralProperty "cyclicGroupFromModulo" cyclicGroupProperty1 , testIntegralProperty "cyclic group mod p" cyclicGroupProperty2 , testIntegralProperty "cyclic group mod 2p" cyclicGroupProperty3 , testCase "cyclic group mod 8" cyclicGroupSpecialCase1 ] , testGroup "isPrimitiveRoot'" [ testGroup "primitive root is coprime with modulo" [ testSmallAndQuick "Integer" (isPrimitiveRoot'Property1 :: AnySign Integer -> Positive Natural -> Bool) , testSmallAndQuick "Natural" (isPrimitiveRoot'Property1 :: AnySign Natural -> Positive Natural -> Bool) , testSmallAndQuick "Int" (isPrimitiveRoot'Property1 :: AnySign Int -> Positive Natural -> Bool) , testSmallAndQuick "Word" (isPrimitiveRoot'Property1 :: AnySign Word -> Positive Natural -> Bool) ] ] , testGroup "isPrimitiveRoot" [ testSmallAndQuick "primitive root is coprime with modulo" isPrimitiveRootProperty1 , testSmallAndQuick "cyclic group has a primitive root" isPrimitiveRootProperty2 , testSmallAndQuick "primitive root generates cyclic group" isPrimitiveRootProperty3 , testSmallAndQuick "cyclic group has right number of primitive roots" isPrimitiveRootProperty5 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/SingletonTests.hs0000644000000000000000000000236307346545000024136 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.SingletonTests -- Copyright: (c) 2019 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Moduli.Singleton -- {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Moduli.SingletonTests ( testSuite ) where import Test.Tasty import qualified Data.Map as M import Math.NumberTheory.Moduli.Singleton import Math.NumberTheory.Primes import Math.NumberTheory.TestUtils someSFactorsProperty1 :: (Ord a, Num a) => [(Prime a, Word)] -> Bool someSFactorsProperty1 xs = case someSFactors xs of Some sm -> unSFactors sm == M.assocs (M.fromListWith (+) xs) cyclicGroupFromModuloProperty1 :: (Integral a, UniqueFactorisation a) => Positive a -> Bool cyclicGroupFromModuloProperty1 (Positive m) = mcg1 == mcg2 where mcg1 = cyclicGroupFromModulo m mcg2 = cyclicGroupFromFactors (factorise m) testSuite :: TestTree testSuite = testGroup "Singleton" [ testSmallAndQuick "unSFactors . someSFactors = id" (someSFactorsProperty1 @Integer) , testIntegralPropertyNoLarge "cyclicGroupFromModulo = cyclicGroupFromFactors . factorise" cyclicGroupFromModuloProperty1 ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Moduli/SqrtTests.hs0000644000000000000000000002502207346545000023122 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Moduli.SqrtTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Moduli.Sqrt -- {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Math.NumberTheory.Moduli.SqrtTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Control.Arrow import Data.List (group, sort) import Data.Maybe (fromJust) import Numeric.Natural import Math.NumberTheory.Moduli hiding (invertMod) import Math.NumberTheory.Primes (unPrime, isPrime, Prime) import Math.NumberTheory.TestUtils unwrapPP :: (Prime Integer, Power Word) -> (Prime Integer, Word) unwrapPP (p, Power e) = (p, e `mod` 5) nubOrd :: Ord a => [a] -> [a] nubOrd = map head . group . sort -- | Check that 'sqrtMod' is defined iff a quadratic residue exists. -- Also check that the result is a solution of input modular equation. sqrtsModPrimeProperty1 :: AnySign Integer -> Prime Integer -> Bool sqrtsModPrimeProperty1 (AnySign n) p'@(unPrime -> p) = case sqrtsModPrime n p' of [] -> jacobi n p == MinusOne rt : _ -> (p == 2 || jacobi n p /= MinusOne) && (rt ^ 2 - n) `rem` p == 0 sqrtsModPrimeProperty2 :: AnySign Integer -> Prime Integer -> Bool sqrtsModPrimeProperty2 (AnySign n) p'@(unPrime -> p) = all (\rt -> (rt ^ 2 - n) `rem` p == 0) (sqrtsModPrime n p') sqrtsModPrimeProperty3 :: AnySign Integer -> Prime Integer -> Bool sqrtsModPrimeProperty3 (AnySign n) p'@(unPrime -> p) = nubOrd rts == sort rts where rts = map (`mod` p) $ sqrtsModPrime n p' sqrtsModPrimeProperty4 :: AnySign Integer -> Prime Integer -> Bool sqrtsModPrimeProperty4 (AnySign n) p'@(unPrime -> p) = all (\rt -> rt >= 0 && rt < p) (sqrtsModPrime n p') tonelliShanksProperty1 :: Positive Integer -> Prime Integer -> Bool tonelliShanksProperty1 (Positive n) p'@(unPrime -> p) = p `mod` 4 /= 1 || jacobi n p /= One || rt ^ 2 `mod` p == n `mod` p where rt : _ = sqrtsModPrime n p' tonelliShanksProperty2 :: Prime Integer -> Bool tonelliShanksProperty2 p'@(unPrime -> p) = p `mod` 4 /= 1 || (rt ^ 2 - n) `rem` p == 0 where n = head $ filter (\s -> jacobi s p == One) [2..p-1] rt : _ = sqrtsModPrime n p' tonelliShanksProperty3 :: Prime Integer -> Bool tonelliShanksProperty3 p'@(unPrime -> p) = p `mod` 4 /= 1 || rt ^ 2 `mod` p == p - 1 where rt : _ = sqrtsModPrime (-1) p' tonelliShanksSpecialCases :: Assertion tonelliShanksSpecialCases = assertEqual "OEIS A002224" [6, 32, 219, 439, 1526, 2987, 22193, 11740, 13854, 91168, 326277, 232059, 3230839, 4379725, 11754394, 32020334, 151024619, 345641931, 373671108, 1857111865, 8110112775, 4184367042] rts where ps :: [Integer] ps = [17, 73, 241, 1009, 2689, 8089, 33049, 53881, 87481, 483289, 515761, 1083289, 3818929, 9257329, 22000801, 48473881, 175244281, 427733329, 898716289, 8114538721, 9176747449, 23616331489] rts = map (head . sqrtsModPrime 2 . fromJust . isPrime) ps sqrtsModPrimePowerProperty1 :: AnySign Integer -> (Prime Integer, Power Word) -> Bool sqrtsModPrimePowerProperty1 (AnySign n) (p'@(unPrime -> p), Power e) = gcd n p > 1 || all (\rt -> (rt ^ 2 - n) `rem` (p ^ e) == 0) (sqrtsModPrimePower n p' e) sqrtsModPrimePowerProperty2 :: AnySign Integer -> Power Word -> Bool sqrtsModPrimePowerProperty2 n e = sqrtsModPrimePowerProperty1 n (fromJust $ isPrime (2 :: Integer), e) sqrtsModPrimePowerProperty3 :: AnySign Integer -> (Prime Integer, Power Word) -> Bool sqrtsModPrimePowerProperty3 (AnySign n) (p'@(unPrime -> p), Power e') = nubOrd rts == sort rts where e = e' `mod` 5 m = p ^ e rts = map (`mod` m) $ sqrtsModPrimePower n p' e sqrtsModPrimePowerProperty4 :: AnySign Integer -> Power Word -> Bool sqrtsModPrimePowerProperty4 n e = sqrtsModPrimePowerProperty3 n (fromJust $ isPrime (2 :: Integer), e) sqrtsModPrimePowerProperty5 :: AnySign Integer -> (Prime Integer, Power Word) -> Bool sqrtsModPrimePowerProperty5 (AnySign n) (p'@(unPrime -> p), Power e') = all (\rt -> rt >= 0 && rt < m) rts where e = e' `mod` 5 m = p ^ e rts = sqrtsModPrimePower n p' e sqrtsModPrimePowerProperty6 :: AnySign Integer -> Power Word -> Bool sqrtsModPrimePowerProperty6 n e = sqrtsModPrimePowerProperty5 n (fromJust $ isPrime (2 :: Integer), e) sqrtsModPrimePowerSpecialCase1 :: Assertion sqrtsModPrimePowerSpecialCase1 = assertEqual "should be equal" [0, 2] (sort (sqrtsModPrimePower 16 (fromJust (isPrime (2 :: Integer))) 2)) sqrtsModPrimePowerSpecialCase2 :: Assertion sqrtsModPrimePowerSpecialCase2 = assertEqual "should be equal" [4, 5] (sort (sqrtsModPrimePower 16 (fromJust (isPrime (3 :: Integer))) 2)) sqrtsModPrimePowerSpecialCase3 :: Assertion sqrtsModPrimePowerSpecialCase3 = assertEqual "should be equal" [0, 3, 6] (sort (sqrtsModPrimePower 0 (fromJust (isPrime (3 :: Integer))) 2)) sqrtsModPrimePowerSpecialCase4 :: Assertion sqrtsModPrimePowerSpecialCase4 = assertEqual "should be equal" [0, 9, 18] (sort (sqrtsModPrimePower 0 (fromJust (isPrime (3 :: Integer))) 3)) sqrtsModPrimePowerSpecialCase5 :: Assertion sqrtsModPrimePowerSpecialCase5 = assertEqual "should be equal" [0, 4, 8, 12] (sort (sqrtsModPrimePower 0 (fromJust (isPrime (2 :: Integer))) 4)) sqrtsModPrimePowerSpecialCase6 :: Assertion sqrtsModPrimePowerSpecialCase6 = assertEqual "should be equal" [3, 6, 12, 15, 21, 24] (sort (sqrtsModPrimePower 9 (fromJust (isPrime (3 :: Integer))) 3)) sqrtsModPrimePowerSpecialCase7 :: Assertion sqrtsModPrimePowerSpecialCase7 = assertEqual "should be equal" [2, 6] (sort (sqrtsModPrimePower 4 (fromJust (isPrime (2 :: Integer))) 3)) sqrtsModPrimePowerSpecialCase8 :: Assertion sqrtsModPrimePowerSpecialCase8 = assertEqual "should be equal" [1, 3] (sort (sqrtsModPrimePower 1 (fromJust (isPrime (2 :: Integer))) 2)) sqrtsModPrimePowerSpecialCase9 :: Assertion sqrtsModPrimePowerSpecialCase9 = assertEqual "should be equal" [] (sort (sqrtsModPrimePower (-1) (fromJust (isPrime (2 :: Integer))) 2)) sqrtsModPrimePowerSpecialCase10 :: Assertion sqrtsModPrimePowerSpecialCase10 = assertEqual "should be equal" [2, 6, 10, 14] (sort (sqrtsModPrimePower 4 (fromJust (isPrime (2 :: Integer))) 4)) sqrtsModPrimePowerSpecialCase11 :: Assertion sqrtsModPrimePowerSpecialCase11 = assertEqual "should be equal" [4,12,20,28,36,44,52,60] (sort (sqrtsModPrimePower 16 (fromJust (isPrime (2 :: Integer))) 6)) sqrtsModFactorisationProperty1 :: AnySign Integer -> [(Prime Integer, Power Word)] -> Bool sqrtsModFactorisationProperty1 (AnySign n) (take 10 . map unwrapPP -> pes'@(map (first unPrime) -> pes)) = nubOrd ps /= sort ps || all (\rt -> all (\(p, e) -> (rt ^ 2 - n) `rem` (p ^ e) == 0) pes) (take 1000 $ sqrtsModFactorisation n pes') where ps = map fst pes sqrtsModFactorisationProperty2 :: AnySign Integer -> [(Prime Integer, Power Word)] -> Bool sqrtsModFactorisationProperty2 (AnySign n) (take 10 . map unwrapPP -> pes'@(map (first unPrime) -> pes)) = nubOrd ps /= sort ps || nubOrd rts == sort rts where ps = map fst pes m = product $ map (uncurry (^)) pes rts = map (`mod` m) $ take 1000 $ sqrtsModFactorisation n pes' sqrtsModFactorisationProperty3 :: AnySign Integer -> [(Prime Integer, Power Word)] -> Bool sqrtsModFactorisationProperty3 (AnySign n) (take 10 . map unwrapPP -> pes'@(map (first unPrime) -> pes)) = nubOrd ps /= sort ps || all (\rt -> rt >= 0 && rt < m) rts where ps = map fst pes m = product $ map (uncurry (^)) pes rts = take 1000 $ sqrtsModFactorisation n pes' sqrtsModFactorisationSpecialCase1 :: Assertion sqrtsModFactorisationSpecialCase1 = assertEqual "should be equal" [0] (sqrtsModFactorisation 0 $ map (first (fromJust . isPrime)) [(2 :: Integer, 1), (3, 1), (5, 1)]) sqrtsModFactorisationSpecialCase2 :: Assertion sqrtsModFactorisationSpecialCase2 = assertEqual "should be equal" [0] (sqrtsModFactorisation 0 $ map (first (fromJust . isPrime)) [(3 :: Integer, 1), (5, 1)]) sqrtsModProperty1 :: AnySign Integer -> Positive Natural -> Bool sqrtsModProperty1 (AnySign n) (Positive m) = case n `modulo` m of SomeMod x -> sort (sqrtsMod sfactors x) == filter (\rt -> rt * rt == x) [minBound .. maxBound] InfMod{} -> True testSuite :: TestTree testSuite = testGroup "Sqrt" [ testGroup "sqrtsModPrime" [ testSmallAndQuick "matches jacobi" sqrtsModPrimeProperty1 , testSmallAndQuick "is residue" sqrtsModPrimeProperty2 , testSmallAndQuick "distinct" sqrtsModPrimeProperty3 , testSmallAndQuick "bounded" sqrtsModPrimeProperty4 ] , testGroup "tonelliShanks" [ testSmallAndQuick "generic" tonelliShanksProperty1 , testSmallAndQuick "smallest residue" tonelliShanksProperty2 , testSmallAndQuick "-1" tonelliShanksProperty3 , testCase "OEIS A002224" tonelliShanksSpecialCases ] , testGroup "sqrtsModPrimePower" [ testSmallAndQuick "generic" sqrtsModPrimePowerProperty1 , testSmallAndQuick "_ 2 _" sqrtsModPrimePowerProperty2 , testSmallAndQuick "distinct" sqrtsModPrimePowerProperty3 , testSmallAndQuick "_ 2 _" sqrtsModPrimePowerProperty4 , testSmallAndQuick "bounded" sqrtsModPrimePowerProperty5 , testSmallAndQuick "_ 2 _" sqrtsModPrimePowerProperty6 , testCase "16 2 2" sqrtsModPrimePowerSpecialCase1 , testCase "16 3 2" sqrtsModPrimePowerSpecialCase2 , testCase "0 3 2" sqrtsModPrimePowerSpecialCase3 , testCase "0 3 3" sqrtsModPrimePowerSpecialCase4 , testCase "0 2 4" sqrtsModPrimePowerSpecialCase5 , testCase "9 3 3" sqrtsModPrimePowerSpecialCase6 , testCase "4 2 3" sqrtsModPrimePowerSpecialCase7 , testCase "1 2 2" sqrtsModPrimePowerSpecialCase8 , testCase "-1 2 2" sqrtsModPrimePowerSpecialCase9 , testCase "4 2 4" sqrtsModPrimePowerSpecialCase10 , testCase "16 2 6" sqrtsModPrimePowerSpecialCase11 ] , testGroup "sqrtsModFactorisation" [ testSmallAndQuick "generic" sqrtsModFactorisationProperty1 , testSmallAndQuick "distinct" sqrtsModFactorisationProperty2 , testSmallAndQuick "bounded" sqrtsModFactorisationProperty3 , testCase "0 [(2,1), (3,1), (5,1)]" sqrtsModFactorisationSpecialCase1 , testCase "0 [(3,1), (5,1)]" sqrtsModFactorisationSpecialCase2 ] , testGroup "sqrtsMod" [ testSmallAndQuick "generic" sqrtsModProperty1 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/MoebiusInversionTests.hs0000644000000000000000000000317607346545000024246 0ustar0000000000000000-- | -- Module: Math.NumberTheory.MoebiusInversionTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.MoebiusInversion -- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.MoebiusInversionTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC hiding (Positive) import Data.Proxy import Data.Vector.Unboxed (Vector) import Math.NumberTheory.MoebiusInversion import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.TestUtils proxy :: Proxy Vector proxy = Proxy totientSumProperty :: AnySign Word -> Bool totientSumProperty (AnySign n) = (totientSum proxy n :: Word) == sum (map totient [1..n]) totientSumSpecialCase1 :: Assertion totientSumSpecialCase1 = assertEqual "totientSum" 4496 (totientSum proxy 121 :: Word) totientSumZero :: Assertion totientSumZero = assertEqual "totientSum" 0 (totientSum proxy 0 :: Word) generalInversionProperty :: (Word -> Word) -> Positive Word -> Bool generalInversionProperty g (Positive n) = g n == sum [f (n `quot` k) | k <- [1 .. n]] && f n == sum [runMoebius (moebius k) * g (n `quot` k) | k <- [1 .. n]] where f = generalInversion proxy g testSuite :: TestTree testSuite = testGroup "MoebiusInversion" [ testGroup "totientSum" [ testSmallAndQuick "matches definitions" totientSumProperty , testCase "special case 1" totientSumSpecialCase1 , testCase "zero" totientSumZero ] , QC.testProperty "generalInversion" generalInversionProperty ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/PrefactoredTests.hs0000644000000000000000000000545407346545000023205 0ustar0000000000000000-- | -- Module: Math.NumberTheory.PrefactoredTests -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Prefactored -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.PrefactoredTests ( testSuite ) where import Test.Tasty import Control.Arrow (second) import Data.Euclidean import Data.List (tails) import Numeric.Natural import Math.NumberTheory.Euclidean.Coprimes import Math.NumberTheory.Prefactored import Math.NumberTheory.TestUtils isValid :: (Eq a, Num a, GcdDomain a, Euclidean a) => Prefactored a -> Bool isValid pref = abs n == abs (product (map (uncurry (^)) fs)) && and [ coprime g h | ((g, _) : gs) <- tails fs, (h, _) <- gs ] where n = prefValue pref fs = unCoprimes $ prefFactors pref fromValueProperty :: Integer -> Bool fromValueProperty n = isValid pref && prefValue pref == n where pref = fromValue n fromFactorsProperty :: [(Integer, Power Word)] -> Bool fromFactorsProperty fs' = isValid pref && abs (prefValue pref) == abs (product (map (uncurry (^)) fs)) where fs = map (second getPower) fs' pref = fromFactors (splitIntoCoprimes fs) plusProperty :: Integer -> Integer -> Bool plusProperty x y = isValid z && prefValue z == x + y where z = fromValue x + fromValue y minusProperty :: Integer -> Integer -> Bool minusProperty x y = isValid z && prefValue z == x - y where z = fromValue x - fromValue y minusNaturalProperty :: Natural -> Natural -> Bool minusNaturalProperty x y = x < y || (isValid z && prefValue z == x - y) where z = fromValue x - fromValue y multiplyProperty :: Integer -> Integer -> Bool multiplyProperty x y = isValid z && prefValue z == x * y where z = fromValue x * fromValue y negateProperty :: Integer -> Bool negateProperty x = isValid z && prefValue z == negate x where z = negate (fromValue x) absSignumProperty :: Integer -> Bool absSignumProperty x = isValid z && prefValue z == x where z = abs (fromValue x) * signum (fromValue x) fromIntegerProperty :: Integer -> Bool fromIntegerProperty n = isValid pref && prefValue pref == n where pref = fromInteger n testSuite :: TestTree testSuite = testGroup "Prefactored" [ testSmallAndQuick "fromValue" fromValueProperty , testSmallAndQuick "fromFactors" fromFactorsProperty , testGroup "Num instance" [ testSmallAndQuick "plus" plusProperty , testSmallAndQuick "minus" minusProperty , testSmallAndQuick "minusNatural" minusNaturalProperty , testSmallAndQuick "multiply" multiplyProperty , testSmallAndQuick "negate" negateProperty , testSmallAndQuick "absSignum" absSignumProperty , testSmallAndQuick "fromInteger" fromIntegerProperty ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Primes/0000755000000000000000000000000007346545000020617 5ustar0000000000000000arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Primes/CountingTests.hs0000644000000000000000000001156707346545000023776 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.CountingTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Primes.Counting -- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Primes.CountingTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Math.NumberTheory.Primes (unPrime) import Math.NumberTheory.Primes.Counting import Math.NumberTheory.Primes.Testing import Math.NumberTheory.TestUtils -- | https://en.wikipedia.org/wiki/Prime-counting_function#Table_of_.CF.80.28x.29.2C_x_.2F_ln_x.2C_and_li.28x.29 table :: [(Integer, Integer)] table = [ (10^1, 4) , (10^2, 25) , (10^3, 168) , (10^4, 1229) , (10^5, 9592) , (10^6, 78498) , (10^7, 664579) , (10^8, 5761455) , (10^9, 50847534) , (10^10, 455052511) , (10^11, 4118054813) , (10^12, 37607912018) -- , (10^13, 346065536839) -- , (10^14, 3204941750802) -- , (10^15, 29844570422669) -- , (10^16, 279238341033925) -- , (10^17, 2623557157654233) -- , (10^18, 24739954287740860) -- , (10^19, 234057667276344607) -- , (10^20, 2220819602560918840) ] -- | Check that values of 'primeCount' are non-negative. primeCountProperty1 :: Integer -> Bool primeCountProperty1 n = n > primeCountMaxArg || n > 0 && primeCount n >= 0 || n <= 0 && primeCount n == 0 -- | Check that 'primeCount' is monotonically increasing function. primeCountProperty2 :: Positive Integer -> Positive Integer -> Bool primeCountProperty2 (Positive n1) (Positive n2) = n1 > primeCountMaxArg || n2 > primeCountMaxArg || n1 <= n2 && p1 <= p2 || n1 > n2 && p1 >= p2 where p1 = primeCount n1 p2 = primeCount n2 -- | Check that 'primeCount' is strictly increasing iff an argument is prime. primeCountProperty3 :: Positive Integer -> Bool primeCountProperty3 (Positive n) = isPrime n && primeCount (n - 1) + 1 == primeCount n || not (isPrime n) && primeCount (n - 1) == primeCount n -- | Check tabulated values. primeCountSpecialCases :: [Assertion] primeCountSpecialCases = map a table where a (n, m) = assertEqual "primeCount" m (primeCount n) -- | Check that values of 'nthPrime' are positive. nthPrimeProperty1 :: Positive Int -> Bool nthPrimeProperty1 (Positive n) = unPrime (nthPrime n) > 0 -- | Check that 'nthPrime' is monotonically increasing function. nthPrimeProperty2 :: Positive Int -> Positive Int -> Bool nthPrimeProperty2 (Positive n1) (Positive n2) = n1 <= n2 && p1 <= p2 || n1 > n2 && p1 >= p2 where p1 = nthPrime n1 p2 = nthPrime n2 -- | Check that values of 'nthPrime' are prime. nthPrimeProperty3 :: Positive Int -> Bool nthPrimeProperty3 (Positive n) = isPrime $ unPrime $ nthPrime n -- | Check tabulated values. nthPrimeSpecialCases :: [Assertion] nthPrimeSpecialCases = map a table where a (n, m) = assertBool "nthPrime" $ n > unPrime (nthPrime (fromInteger m)) -- | Check that values of 'approxPrimeCount' are non-negative. approxPrimeCountProperty1 :: Integral a => AnySign a -> Bool approxPrimeCountProperty1 (AnySign a) = approxPrimeCount a >= 0 -- | Check that 'approxPrimeCount' is consistent with 'approxPrimeCountOverestimateLimit'. approxPrimeCountProperty2 :: Integral a => Positive a -> Bool approxPrimeCountProperty2 (Positive a) = a >= approxPrimeCountOverestimateLimit || toInteger (approxPrimeCount a) >= primeCount (toInteger a) -- | Check that values of 'nthPrimeApprox' are positive. nthPrimeApproxProperty1 :: AnySign Integer -> Bool nthPrimeApproxProperty1 (AnySign a) = nthPrimeApprox a > 0 -- | Check that 'nthPrimeApprox' is consistent with 'nthPrimeApproxUnderestimateLimit'. nthPrimeApproxProperty2 :: Positive Integer -> Bool nthPrimeApproxProperty2 (Positive a) = a >= nthPrimeApproxUnderestimateLimit || nthPrimeApprox a <= unPrime (nthPrime (fromInteger a)) testSuite :: TestTree testSuite = testGroup "Counting" [ testGroup "primeCount" ( testSmallAndQuick "non-negative" primeCountProperty1 : testSmallAndQuick "monotonic" primeCountProperty2 : testSmallAndQuick "increases on primes" primeCountProperty3 : zipWith (\i a -> testCase ("special case " ++ show i) a) [1..] primeCountSpecialCases ) , testGroup "nthPrime" ( testSmallAndQuick "positive" nthPrimeProperty1 : testSmallAndQuick "monotonic" nthPrimeProperty2 : testSmallAndQuick "is prime" nthPrimeProperty3 : zipWith (\i a -> testCase ("special case " ++ show i) a) [1..] nthPrimeSpecialCases ) , testGroup "approxPrimeCount" [ testIntegralProperty "non-negative" approxPrimeCountProperty1 , testIntegralProperty "overestimates primeCount" approxPrimeCountProperty2 ] , testGroup "nthPrimeApprox" [ testSmallAndQuick "positive" nthPrimeApproxProperty1 , testSmallAndQuick "underestimates nthPrime" nthPrimeApproxProperty2 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Primes/FactorisationTests.hs0000644000000000000000000001224707346545000025011 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.FactorisationTests -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Primes.Factorisation -- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Primes.FactorisationTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Control.Arrow import Control.Monad (zipWithM_) import Data.List (nub, sort) import Data.Maybe import Math.NumberTheory.Primes import Math.NumberTheory.TestUtils specialCases :: [(Integer, [(Integer, Word)])] specialCases = [ (35,[(5,1),(7,1)]) , (75,[(3,1),(5,2)]) , (65521^2,[(65521,2)]) , (65537^2,[(65537,2)]) , (2147483647, [(2147483647, 1)]) , (4294967291, [(4294967291, 1)]) , (19000000000000000001, [(19000000000000000001, 1)]) , (3 * 5^2 * 7^21, [(3,1), (5,2), (7, 21)]) , (9223372036854775783, [(9223372036854775783, 1)]) , (18446744073709551557, [(18446744073709551557, 1)]) , (4181339589500970917,[(15034813,1),(278110515209,1)]) , (4181339589500970918,[(2,1),(3,2),(7,1),(2595773,1),(12784336241,1)]) , (2227144715990344929,[(3,1),(317,1),(17381911,1),(134731889,1)]) , (10489674846272137811130167281,[(1312601,1),(9555017,1),(836368815445393,1)]) , (10489674846272137811130167282,[(2,1),(17,1),(577,1),(3863,1),(179347163,1),(771770327021,1)]) , (10489674846272137811130167283,[(3,1),(7,1),(4634410717,1),(107782489838601619,1)]) , (10489674846272137811130167287,[(4122913189601,1),(2544238591472087,1)]) , (6293073306208101456461600748,[(2,2),(3,1),(1613,1),(69973339,1),(4646378436563447,1)]) , (6293073306208101456461600749,[(7,1),(103,1),(4726591,1),(1846628365511484259,1)]) , (6293073306208101456461600750,[(2,1),(5,3),(239,1),(34422804769,1),(3059698456333,1)]) , (6293073306208101456461600751,[(3,1),(13523,1),(1032679,1),(150211485989006401,1)]) , (6293073306208101456461600753,[(19391,1),(372473053129,1),(871300023127,1)]) , (6293073306208101456461600754,[(2,1),(3,2),(11,1),(13,1),(71,1),(2311,1),(22859,1),(7798621,1),(83583569,1)]) , (11999991291828813663324577057,[(14381453,1),(10088205181,1),(82711187849,1)]) , (11999991291828813663324577062,[(2,1),(3,1),(7,1),(3769,1),(634819511,1),(119413997449529,1)]) , (16757651897802863152387219654541878160,[(2,4),(5,1),(12323,1),(1424513,1),(6205871923,1),(1922815011093901,1)]) , (16757651897802863152387219654541878162,[(2,1),(29,1),(78173,1),(401529283,1),(1995634649,1),(4612433663779,1)]) , (16757651897802863152387219654541878163,[(11,1),(31,1),(112160981904206269,1),(438144115295608147,1)]) -- , (16757651897802863152387219654541878166,[(2,1),(23,1),(277,1),(505353699591289,1),(2602436338718275457,1)]) , ((10 ^ 80 - 1) `div` 9, [(11,1),(17,1),(41,1),(73,1),(101,1),(137,1),(271,1),(3541,1),(9091,1),(27961,1), (1676321,1),(5070721,1),(5882353,1),(5964848081,1),(19721061166646717498359681,1)]) , (623506907396924300595652906937, [(300137,1),(825131,2),(1746779,2)]) , (626472835738582668418814215862, [(2,1),(150211,1),(11746151,2),(122939,2)]) , (638396704483535474833679624037, [(3,1),(11,2),(100519,1),(104281,2),(1268419,2)]) ] lazyCases :: [(Integer, [(Integer, Word)])] lazyCases = [ ( 14145130711 * 10000000000000000000000000000000000000121 * 100000000000000000000000000000000000000000000000447 , [(14145130711, 1)] ) ] shortenNumber :: Integer -> String shortenNumber n | l <= 10 = xs | otherwise = take 5 xs ++ "..." ++ drop (l - 5) xs where xs = show n l = length xs factoriseProperty1 :: Assertion factoriseProperty1 = assertEqual "0" [] (factorise (1 :: Int)) factoriseProperty2 :: Positive Integer -> Bool factoriseProperty2 (Positive n) = factorise n == factorise (negate n) factoriseProperty3 :: Positive Integer -> Bool factoriseProperty3 (Positive n) = all (isJust . isPrime . unPrime . fst) (factorise n) factoriseProperty4 :: Positive Integer -> Bool factoriseProperty4 (Positive n) = sort bases == nub (sort bases) where bases = map fst $ factorise n factoriseProperty5 :: Positive Integer -> Bool factoriseProperty5 (Positive n) = product (map (\(p, k) -> unPrime p ^ k) (factorise n)) == n factoriseProperty6 :: (Integer, [(Integer, Word)]) -> Assertion factoriseProperty6 (n, fs) = assertEqual (show n) (sort fs) (sort $ map (first unPrime) $ factorise n) factoriseProperty7 :: (Integer, [(Integer, Word)]) -> Assertion factoriseProperty7 (n, fs) = zipWithM_ (assertEqual (show n)) fs (map (first unPrime) $ factorise n) testSuite :: TestTree testSuite = testGroup "Factorisation" [ testGroup "factorise" $ [ testCase "0" factoriseProperty1 , testSmallAndQuick "negate" factoriseProperty2 , testSmallAndQuick "bases are prime" factoriseProperty3 , testSmallAndQuick "bases are distinct" factoriseProperty4 , testSmallAndQuick "factorback" factoriseProperty5 ] ++ map (\x -> testCase ("special case " ++ shortenNumber (fst x)) (factoriseProperty6 x)) specialCases ++ map (\x -> testCase ("laziness " ++ shortenNumber (fst x)) (factoriseProperty7 x)) lazyCases ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Primes/SequenceTests.hs0000644000000000000000000001263007346545000023750 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Math.NumberTheory.Primes.SequenceTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Data.Bits import Data.Maybe import Data.Proxy import Numeric.Natural import Math.NumberTheory.Primes import Math.NumberTheory.Primes.Counting (nthPrime, primeCount) import Math.NumberTheory.TestUtils nextPrimeProperty :: (Bits a, Integral a, UniqueFactorisation a) => AnySign a -> Bool nextPrimeProperty (AnySign n) = unPrime (nextPrime n) >= n precPrimeProperty :: (Bits a, Integral a, UniqueFactorisation a) => Positive a -> Bool precPrimeProperty (Positive n) = n <= 2 || unPrime (precPrime n) <= n toEnumProperty :: forall a. (Enum (Prime a), Integral a) => Proxy a -> Int -> Bool toEnumProperty _ n = n <= 0 || unPrime (toEnum n :: Prime a) == fromInteger (unPrime (nthPrime n)) fromEnumProperty :: (Enum (Prime a), Integral a) => Prime a -> Bool fromEnumProperty p = fromEnum p == fromInteger (primeCount (toInteger (unPrime p))) succProperty :: (Enum a, Enum (Prime a), Num a, UniqueFactorisation a) => Prime a -> Bool succProperty p = all (isNothing . isPrime) [unPrime p + 1 .. unPrime (succ p) - 1] predProperty :: (Enum a, Enum (Prime a), Ord a, Num a, UniqueFactorisation a) => Prime a -> Bool predProperty p = unPrime p <= 2 || all (isNothing . isPrime) [unPrime (pred p) + 1 .. unPrime p - 1] enumFrom2To2 :: Assertion enumFrom2To2 = assertEqual "should be equal" [two] [two..two] where two = minBound :: Prime Word enumFrom65500To65600 :: Assertion enumFrom65500To65600 = assertEqual "should be equal" [65519, 65521, 65537, 65539, 65543, 65551, 65557, 65563, 65579, 65581, 65587, 65599] (map unPrime [low..high]) where low = nextPrime (65500 :: Word) high = precPrime (65600 :: Word) enumFrom2To100000 :: Assertion enumFrom2To100000 = assertEqual "should be equal" (takeWhile (<= high) [low..]) [low..high] where low = minBound :: Prime Word high = precPrime (100000 :: Word) enumFromProperty :: (Ord a, Enum (Prime a)) => Prime a -> Prime a -> Bool enumFromProperty p q = [p..q] == takeWhile (<= q) [p..] enumFromToProperty :: (Eq a, Enum a, Enum (Prime a), UniqueFactorisation a) => Prime a -> Prime a -> Bool enumFromToProperty p q = [p..q] == mapMaybe isPrime [unPrime p .. unPrime q] enumFromThenProperty :: (Show a, Ord a, Enum (Prime a)) => Prime a -> Prime a -> Prime a -> Bool enumFromThenProperty p q r = case p `compare` q of LT -> enumFromThenTo p q r == takeWhile (<= r) (enumFromThen p q) EQ -> True GT -> enumFromThenTo p q r == takeWhile (>= r) (enumFromThen p q) enumFromThenToProperty :: (Ord a, Enum a, Enum (Prime a), UniqueFactorisation a, Show a) => Prime a -> Prime a -> Prime a -> Bool enumFromThenToProperty p q r | p == q && q <= r = True | otherwise = [p, q .. r] == mapMaybe isPrime [unPrime p, unPrime q .. unPrime r] testSuite :: TestTree testSuite = testGroup "Sequence" [ testIntegralPropertyNoLarge "nextPrime" nextPrimeProperty , testIntegralPropertyNoLarge "precPrime" precPrimeProperty , testGroup "toEnum" [ testSmallAndQuick "Int" (toEnumProperty (Proxy @Int)) , testSmallAndQuick "Word" (toEnumProperty (Proxy @Word)) , testSmallAndQuick "Integer" (toEnumProperty (Proxy @Integer)) , testSmallAndQuick "Natural" (toEnumProperty (Proxy @Natural)) ] , testGroup "fromEnum" [ testSmallAndQuick "Int" (fromEnumProperty @Int) , testSmallAndQuick "Word" (fromEnumProperty @Word) , testSmallAndQuick "Integer" (fromEnumProperty @Integer) , testSmallAndQuick "Natural" (fromEnumProperty @Natural) ] , testGroup "succ" [ testSmallAndQuick "Int" (succProperty @Int) , testSmallAndQuick "Word" (succProperty @Word) , testSmallAndQuick "Integer" (succProperty @Integer) , testSmallAndQuick "Natural" (succProperty @Natural) ] , testGroup "pred" [ testSmallAndQuick "Int" (predProperty @Int) , testSmallAndQuick "Word" (predProperty @Word) , testSmallAndQuick "Integer" (predProperty @Integer) , testSmallAndQuick "Natural" (predProperty @Natural) ] , testCase "[2..2] == [2]" enumFrom2To2 , testCase "[65500..65600]" enumFrom65500To65600 , testCase "[2..100000]" enumFrom2To100000 , testGroup "enumFrom" [ testSmallAndQuick "Int" (enumFromProperty @Int) , testSmallAndQuick "Word" (enumFromProperty @Word) , testSmallAndQuick "Integer" (enumFromProperty @Integer) , testSmallAndQuick "Natural" (enumFromProperty @Natural) ] , testGroup "enumFromTo" [ testSmallAndQuick "Int" (enumFromToProperty @Int) , testSmallAndQuick "Word" (enumFromToProperty @Word) , testSmallAndQuick "Integer" (enumFromToProperty @Integer) , testSmallAndQuick "Natural" (enumFromToProperty @Natural) ] , testGroup "enumFromThen" [ testSmallAndQuick "Int" (enumFromThenProperty @Int) , testSmallAndQuick "Word" (enumFromThenProperty @Word) , testSmallAndQuick "Integer" (enumFromThenProperty @Integer) , testSmallAndQuick "Natural" (enumFromThenProperty @Natural) ] , testGroup "enumFromThenTo" [ testSmallAndQuick "Int" (enumFromThenToProperty @Int) , testSmallAndQuick "Word" (enumFromThenToProperty @Word) , testSmallAndQuick "Integer" (enumFromThenToProperty @Integer) , testSmallAndQuick "Natural" (enumFromThenToProperty @Natural) ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Primes/SieveTests.hs0000644000000000000000000000671107346545000023256 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.SieveTests -- Copyright: (c) 2016-2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Primes.Sieve -- {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Primes.SieveTests ( testSuite ) where import Prelude hiding (words) import Test.Tasty import Test.Tasty.HUnit import Data.Bits import Data.Int import Data.Proxy (Proxy(..)) import Data.Word import Numeric.Natural (Natural) import Math.NumberTheory.Primes (Prime, unPrime, primes, nextPrime, precPrime, UniqueFactorisation) import Math.NumberTheory.Primes.Testing import Math.NumberTheory.TestUtils lim1 :: Num a => a lim1 = 1000000 lim2 :: Num a => a lim2 = 100000 -- | Check that 'primes' matches 'isPrime'. primesProperty1 :: forall a. (Integral a, Show a) => Proxy a -> Assertion primesProperty1 _ = assertEqual "primes matches isPrime" (takeWhile (<= lim1) (map unPrime primes) :: [a]) (filter (isPrime . toInteger) [1..lim1]) primesProperty2 :: forall a. (Integral a, Bounded a, Show a) => Proxy a -> Assertion primesProperty2 _ = assertEqual "primes matches isPrime" (map unPrime primes :: [a]) (filter (isPrime . toInteger) [1..maxBound]) -- | Check that 'primeList' from 'primeSieve' matches truncated 'primes'. primeSieveProperty1 :: AnySign Integer -> Bool primeSieveProperty1 (AnySign highBound') = [nextPrime 2 .. precPrime highBound] == takeWhile (\p -> unPrime p <= highBound) primes where highBound = max 2 (highBound' `rem` lim1) -- | Check that 'primeList' from 'psieveList' matches 'primes'. psieveListProperty1 :: forall a. (Integral a, Show a, Enum (Prime a), Bits a, UniqueFactorisation a) => Proxy a -> Assertion psieveListProperty1 _ = assertEqual "primes == primeList . psieveList" (take lim2 primes :: [Prime a]) (take lim2 [nextPrime 1..]) psieveListProperty2 :: forall a. (Integral a, Bounded a, Show a) => Proxy a -> Assertion psieveListProperty2 _ = assertEqual "primes == primeList . psieveList" (map unPrime primes :: [a]) (filter (isPrime . toInteger) [0..maxBound]) testSuite :: TestTree testSuite = testGroup "Sieve" [ testGroup "primes" [ testCase "Int" (primesProperty1 (Proxy :: Proxy Int)) , testCase "Word" (primesProperty1 (Proxy :: Proxy Word)) , testCase "Integer" (primesProperty1 (Proxy :: Proxy Integer)) , testCase "Natural" (primesProperty1 (Proxy :: Proxy Natural)) , testCase "Int8" (primesProperty2 (Proxy :: Proxy Int8)) , testCase "Int16" (primesProperty2 (Proxy :: Proxy Int16)) , testCase "Word8" (primesProperty2 (Proxy :: Proxy Word8)) , testCase "Word16" (primesProperty2 (Proxy :: Proxy Word16)) ] , testSmallAndQuick "primeSieve" primeSieveProperty1 , testGroup "psieveList" [ testCase "Int" (psieveListProperty1 (Proxy :: Proxy Int)) , testCase "Word" (psieveListProperty1 (Proxy :: Proxy Word)) , testCase "Integer" (psieveListProperty1 (Proxy :: Proxy Integer)) , testCase "Natural" (psieveListProperty1 (Proxy :: Proxy Natural)) , testCase "Int8" (psieveListProperty2 (Proxy :: Proxy Int8)) , testCase "Int16" (psieveListProperty2 (Proxy :: Proxy Int16)) , testCase "Word8" (psieveListProperty2 (Proxy :: Proxy Word8)) , testCase "Word16" (psieveListProperty2 (Proxy :: Proxy Word16)) ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Primes/TestingTests.hs0000644000000000000000000000530107346545000023612 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Primes.TestingTests -- Copyright: (c) 2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Primes.Testing -- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Primes.TestingTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Math.NumberTheory.Primes.Testing import Math.NumberTheory.TestUtils isPrimeProperty1 :: Assertion isPrimeProperty1 = assertEqual "[0..100]" expected actual where expected = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97] actual = filter isPrime [0..100] isPrimeProperty2 :: Integer -> Bool isPrimeProperty2 n = isPrime n == isPrime (negate n) isPrimeProperty3 :: Assertion isPrimeProperty3 = assertBool "Carmichael pseudoprimes" $ not $ any isPrime pseudoprimes where -- OEIS A002997 pseudoprimes = [561, 1105, 1729, 2465, 2821, 6601, 8911, 10585, 15841, 29341, 41041, 46657, 52633, 62745, 63973, 75361, 101101, 115921, 126217, 162401, 172081, 188461, 252601, 278545, 294409, 314821, 334153, 340561, 399001, 410041, 449065, 488881, 512461] isPrimeProperty4 :: Assertion isPrimeProperty4 = assertBool "strong pseudoprimes to base 2" $ not $ any isPrime pseudoprimes where -- OEIS A001262 pseudoprimes = [2047, 3277, 4033, 4681, 8321, 15841, 29341, 42799, 49141, 52633, 65281, 74665, 80581, 85489, 88357, 90751, 104653, 130561, 196093, 220729, 233017, 252601, 253241, 256999, 271951, 280601, 314821, 357761, 390937, 458989, 476971, 486737] isPrimeProperty5 :: Assertion isPrimeProperty5 = assertBool "strong Lucas pseudoprimes" $ not $ any isPrime pseudoprimes where -- OEIS A217255 pseudoprimes = [5459, 5777, 10877, 16109, 18971, 22499, 24569, 25199, 40309, 58519, 75077, 97439, 100127, 113573, 115639, 130139, 155819, 158399, 161027, 162133, 176399, 176471, 189419, 192509, 197801, 224369, 230691, 231703, 243629, 253259, 268349, 288919, 313499, 324899] isStrongFermatPPProperty :: NonNegative Integer -> Integer -> Bool isStrongFermatPPProperty (NonNegative n) b = not (isPrime n) || isStrongFermatPP n b testSuite :: TestTree testSuite = testGroup "Testing" [ testGroup "isPrime" [ testCase "[0..100]" isPrimeProperty1 , testSmallAndQuick "negate" isPrimeProperty2 , testCase "Carmichael pseudoprimes" isPrimeProperty3 , testCase "strong pseudoprimes base 2" isPrimeProperty4 , testCase "strong Lucas pseudoprimes" isPrimeProperty5 ] , testGroup "isStrongFermatPP" [ testSmallAndQuick "matches isPrime" isStrongFermatPPProperty ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/PrimesTests.hs0000644000000000000000000000366607346545000022211 0ustar0000000000000000-- | -- Module: Math.NumberTheory.PrimesTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Primes -- {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.PrimesTests ( testSuite ) where import Test.Tasty import Data.Bits import Data.Int import Data.Proxy #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup #endif import Math.NumberTheory.Primes import qualified Math.NumberTheory.Primes.IntSet as PS import Math.NumberTheory.TestUtils primesSumWonk :: Int -> Int primesSumWonk upto = sum $ map unPrime [nextPrime 2 .. precPrime upto] primesSum :: Int -> Int primesSum upto = sum . takeWhile (<= upto) . map unPrime $ primes primesSumProperty :: NonNegative Int -> Bool primesSumProperty (NonNegative n) = n < 2 || primesSumWonk n == primesSum n symmetricDifferenceProperty :: [Prime Int] -> [Prime Int] -> Bool symmetricDifferenceProperty xs ys = z1 == z2 where x = PS.fromList xs y = PS.fromList ys z1 = (x PS.\\ PS.unPrimeIntSet y) <> (y PS.\\ PS.unPrimeIntSet x) z2 = PS.symmetricDifference x y toPrimeIntegralTest :: forall a b. (Bits a, Integral a, Bits b, Integral b) => Proxy a -> Prime b -> Bool toPrimeIntegralTest _ p = toIntegralSized (unPrime p) == (fmap unPrime (toPrimeIntegral p) :: Maybe a) testSuite :: TestTree testSuite = testGroup "Primes" [ testSmallAndQuick "primesSum" primesSumProperty , testSmallAndQuick "symmetricDifference" symmetricDifferenceProperty , testGroup "toPrimeIntegral" [ testSmallAndQuick "Int -> Integer" $ toPrimeIntegralTest @Integer @Int Proxy , testSmallAndQuick "Int -> Int8" $ toPrimeIntegralTest @Int8 @Int Proxy , testSmallAndQuick "Integer -> Int" $ toPrimeIntegralTest @Int @Integer Proxy ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Recurrences/0000755000000000000000000000000007346545000021640 5ustar0000000000000000arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Recurrences/BilinearTests.hs0000644000000000000000000002515107346545000024750 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Recurrences.BilinearTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Recurrences.Bilinear -- {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Recurrences.BilinearTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Control.Arrow import Data.List (sort) import Data.Ratio import Math.NumberTheory.Primes import Math.NumberTheory.Recurrences.Bilinear import Math.NumberTheory.TestUtils binomialProperty1 :: NonNegative Int -> Bool binomialProperty1 (NonNegative i) = length (binomial @Integer !! i) == i + 1 binomialProperty2 :: NonNegative Int -> Bool binomialProperty2 (NonNegative i) = head (binomial @Integer !! i) == 1 binomialProperty3 :: NonNegative Int -> Bool binomialProperty3 (NonNegative i) = binomial @Integer !! i !! i == 1 binomialProperty4 :: Positive Int -> Positive Int -> Bool binomialProperty4 (Positive i) (Positive j) = j >= i || binomial @Integer !! i !! j == binomial !! (i - 1) !! (j - 1) + binomial !! (i - 1) !! j binomialProperty5 :: Word -> Word -> Bool binomialProperty5 n m' = n > 100000 || sort (map (first unPrime) (factorise (binomial !! fromIntegral n !! fromIntegral m))) == sort (map (first (toInteger . unPrime)) (binomialFactors n m)) where m = m' `mod` (n + 1) binomialProperty6 :: Word -> Word -> Bool binomialProperty6 n m' = n > 100000 || binomial !! fromIntegral n !! fromIntegral m == product (map (\(p, k) -> toInteger (unPrime p) ^ k) (binomialFactors n m)) where m = m' `mod` (n + 1) binomialRotatedProperty2 :: NonNegative Int -> Bool binomialRotatedProperty2 (NonNegative i) = head (binomialRotated @Integer !! i) == 1 binomialRotatedProperty3 :: NonNegative Int -> Bool binomialRotatedProperty3 (NonNegative i) = head (binomialRotated @Integer) !! i == 1 binomialRotatedProperty4 :: Positive Int -> Positive Int -> Bool binomialRotatedProperty4 (Positive i) (Positive j) = binomialRotated @Integer !! i !! j == binomialRotated !! i !! (j - 1) + binomialRotated !! (i - 1) !! j binomialLineProperty1 :: NonNegative Int -> NonNegative Int -> Bool binomialLineProperty1 (NonNegative i) (NonNegative j) = j >= i || binomial @Integer !! i !! j == binomialLine (toInteger i) !! j binomialLineProperty2 :: NonNegative Int -> NonNegative Int -> Bool binomialLineProperty2 (NonNegative i) (NonNegative j) = binomialRotated @Integer !! i !! j == binomialLine (toInteger (i + j)) !! j binomialDiagonalProperty1 :: NonNegative Int -> NonNegative Int -> Bool binomialDiagonalProperty1 (NonNegative i) (NonNegative j) = binomialRotated @Integer !! i !! j == binomialDiagonal (toInteger i) !! j binomialDiagonalProperty2 :: NonNegative Int -> NonNegative Int -> Bool binomialDiagonalProperty2 (NonNegative i) (NonNegative j) = binomial @Integer !! (i + j) !! j == binomialDiagonal (toInteger i) !! j stirling1Property1 :: NonNegative Int -> Bool stirling1Property1 (NonNegative i) = length (stirling1 !! i) == i + 1 stirling1Property2 :: NonNegative Int -> Bool stirling1Property2 (NonNegative i) = head (stirling1 !! i) == if i == 0 then 1 else 0 stirling1Property3 :: NonNegative Int -> Bool stirling1Property3 (NonNegative i) = stirling1 !! i !! i == 1 stirling1Property4 :: Positive Int -> Positive Int -> Bool stirling1Property4 (Positive i) (Positive j) = j >= i || stirling1 !! i !! j == stirling1 !! (i - 1) !! (j - 1) + (toInteger i - 1) * stirling1 !! (i - 1) !! j stirling2Property1 :: NonNegative Int -> Bool stirling2Property1 (NonNegative i) = length (stirling2 !! i) == i + 1 stirling2Property2 :: NonNegative Int -> Bool stirling2Property2 (NonNegative i) = head (stirling2 !! i) == if i == 0 then 1 else 0 stirling2Property3 :: NonNegative Int -> Bool stirling2Property3 (NonNegative i) = stirling2 !! i !! i == 1 stirling2Property4 :: Positive Int -> Positive Int -> Bool stirling2Property4 (Positive i) (Positive j) = j >= i || stirling2 !! i !! j == stirling2 !! (i - 1) !! (j - 1) + toInteger j * stirling2 !! (i - 1) !! j lahProperty1 :: NonNegative Int -> Bool lahProperty1 (NonNegative i) = length (lah !! i) == i + 1 lahProperty2 :: NonNegative Int -> Bool lahProperty2 (NonNegative i) = head (lah !! i) == product [1 .. i+1] lahProperty3 :: NonNegative Int -> Bool lahProperty3 (NonNegative i) = lah !! i !! i == 1 lahProperty4 :: Positive Int -> Positive Int -> Bool lahProperty4 (Positive i) (Positive j) = j >= i || lah !! i !! j == sum [ stirling1 !! (i + 1) !! k * stirling2 !! k !! (j + 1) | k <- [j + 1 .. i + 1] ] eulerian1Property1 :: NonNegative Int -> Bool eulerian1Property1 (NonNegative i) = length (eulerian1 !! i) == i eulerian1Property2 :: Positive Int -> Bool eulerian1Property2 (Positive i) = head (eulerian1 !! i) == 1 eulerian1Property3 :: Positive Int -> Bool eulerian1Property3 (Positive i) = eulerian1 !! i !! (i - 1) == 1 eulerian1Property4 :: Positive Int -> Positive Int -> Bool eulerian1Property4 (Positive i) (Positive j) = j >= i - 1 || eulerian1 !! i !! j == toInteger (i - j) * eulerian1 !! (i - 1) !! (j - 1) + (toInteger j + 1) * eulerian1 !! (i - 1) !! j eulerian2Property1 :: NonNegative Int -> Bool eulerian2Property1 (NonNegative i) = length (eulerian2 !! i) == i eulerian2Property2 :: Positive Int -> Bool eulerian2Property2 (Positive i) = head (eulerian2 !! i) == 1 eulerian2Property3 :: Positive Int -> Bool eulerian2Property3 (Positive i) = eulerian2 !! i !! (i - 1) == product [1 .. toInteger i] eulerian2Property4 :: Positive Int -> Positive Int -> Bool eulerian2Property4 (Positive i) (Positive j) = j >= i - 1 || eulerian2 !! i !! j == toInteger (2 * i - j - 1) * eulerian2 !! (i - 1) !! (j - 1) + (toInteger j + 1) * eulerian2 !! (i - 1) !! j bernoulliSpecialCase1 :: Assertion bernoulliSpecialCase1 = assertEqual "B_0 = 1" (head bernoulli) 1 bernoulliSpecialCase2 :: Assertion bernoulliSpecialCase2 = assertEqual "B_1 = -1/2" (bernoulli !! 1) (- 1 % 2) bernoulliProperty1 :: NonNegative Int -> Bool bernoulliProperty1 (NonNegative m) = case signum (bernoulli !! m) of 1 -> m == 0 || m `mod` 4 == 2 0 -> m /= 1 && odd m -1 -> m == 1 || (m /= 0 && m `rem` 4 == 0) _ -> False bernoulliProperty2 :: NonNegative Int -> Bool bernoulliProperty2 (NonNegative m) = bernoulli !! m == (if m == 0 then 1 else 0) - sum [ bernoulli !! k * (binomial !! m !! k % toInteger (m - k + 1)) | k <- [0 .. m - 1] ] -- | For every odd positive integer @n@, @E_n@ is @0@. eulerProperty1 :: Positive Int -> Bool eulerProperty1 (Positive n) = euler !! (2 * n - 1) == 0 -- | Every positive even index produces a negative result. eulerProperty2 :: NonNegative Int -> Bool eulerProperty2 (NonNegative n) = euler !! (2 + 4 * n) < 0 -- | The Euler number sequence is https://oeis.org/A122045 eulerSpecialCase1 :: Assertion eulerSpecialCase1 = assertEqual "euler" (take 20 euler) [1, 0, -1, 0, 5, 0, -61, 0, 1385, 0, -50521, 0, 2702765, 0, -199360981, 0, 19391512145, 0, -2404879675441, 0] -- | For any even positive integer @n@, @E_n(1)@ is @0@. eulerPAt1Property1 :: Positive Int -> Bool eulerPAt1Property1 (Positive n) = (eulerPolyAt1 !! (2 * n)) == 0 -- | The numerators in this sequence are from https://oeis.org/A198631 while the -- denominators are from https://oeis.org/A006519. eulerPAt1SpecialCase1 :: Assertion eulerPAt1SpecialCase1 = assertEqual "eulerPolyAt1" (take 20 eulerPolyAt1) (zipWith (%) [1, 1, 0, -1, 0, 1, 0, -17, 0, 31, 0, -691, 0, 5461, 0, -929569, 0, 3202291, 0, -221930581] [1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1, 16, 1, 2, 1, 4]) testSuite :: TestTree testSuite = testGroup "Bilinear" [ testGroup "binomial" [ testSmallAndQuick "shape" binomialProperty1 , testSmallAndQuick "left side" binomialProperty2 , testSmallAndQuick "right side" binomialProperty3 , testSmallAndQuick "recurrency" binomialProperty4 , testSmallAndQuick "factorise . binomial = binomialFactors" binomialProperty5 , testSmallAndQuick "binomial = factorBack . binomialFactors" binomialProperty6 , testSmallAndQuick "line" binomialLineProperty1 , testSmallAndQuick "diagonal" binomialDiagonalProperty2 ] , testGroup "binomialRotated" [ testSmallAndQuick "left side" binomialRotatedProperty2 , testSmallAndQuick "right side" binomialRotatedProperty3 , testSmallAndQuick "recurrency" binomialRotatedProperty4 , testSmallAndQuick "line" binomialLineProperty2 , testSmallAndQuick "diagonal" binomialDiagonalProperty1 ] , testGroup "stirling1" [ testSmallAndQuick "shape" stirling1Property1 , testSmallAndQuick "left side" stirling1Property2 , testSmallAndQuick "right side" stirling1Property3 , testSmallAndQuick "recurrency" stirling1Property4 ] , testGroup "stirling2" [ testSmallAndQuick "shape" stirling2Property1 , testSmallAndQuick "left side" stirling2Property2 , testSmallAndQuick "right side" stirling2Property3 , testSmallAndQuick "recurrency" stirling2Property4 ] , testGroup "lah" [ testSmallAndQuick "shape" lahProperty1 , testSmallAndQuick "left side" lahProperty2 , testSmallAndQuick "right side" lahProperty3 , testSmallAndQuick "zip stirlings" lahProperty4 ] , testGroup "eulerian1" [ testSmallAndQuick "shape" eulerian1Property1 , testSmallAndQuick "left side" eulerian1Property2 , testSmallAndQuick "right side" eulerian1Property3 , testSmallAndQuick "recurrency" eulerian1Property4 ] , testGroup "eulerian2" [ testSmallAndQuick "shape" eulerian2Property1 , testSmallAndQuick "left side" eulerian2Property2 , testSmallAndQuick "right side" eulerian2Property3 , testSmallAndQuick "recurrency" eulerian2Property4 ] , testGroup "bernoulli" [ testCase "B_0" bernoulliSpecialCase1 , testCase "B_1" bernoulliSpecialCase2 , testSmallAndQuick "sign" bernoulliProperty1 , testSmallAndQuick "recursive definition" bernoulliProperty2 ] , testGroup "Euler numbers" [ testCase "First 20 elements of E_n are correct" eulerSpecialCase1 , testSmallAndQuick "E_n with n odd is 0" eulerProperty1 , testSmallAndQuick "E_n for n in [2,6,8,12..] is negative" eulerProperty2 ] , testGroup "Euler Polynomial of order N evaluated at 1" [ testCase "First 20 elements of E_n(1) are correct" eulerPAt1SpecialCase1 , testSmallAndQuick "E_n(1) with n in [2,4,6..] is 0" eulerPAt1Property1 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Recurrences/LinearTests.hs0000644000000000000000000001122507346545000024432 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Recurrences.LinearTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Recurrences.Linear -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Recurrences.LinearTests ( testSuite ) where import Test.Tasty import Test.Tasty.HUnit import Control.Arrow import Data.List (sort) import Math.NumberTheory.Primes import Math.NumberTheory.Recurrences.Linear import Math.NumberTheory.TestUtils -- | Check that 'fibonacci' matches the definition of Fibonacci sequence. fibonacciProperty1 :: AnySign Int -> Bool fibonacciProperty1 (AnySign n) = fibonacci n + fibonacci (n + 1) == fibonacci (n +2) -- | Check that 'fibonacci' for negative indices is correctly defined. fibonacciProperty2 :: NonNegative Int -> Bool fibonacciProperty2 (NonNegative n) = fibonacci n == (if even n then negate else id) (fibonacci (- n)) -- | Check that 'fibonacciPair' is a pair of consequent 'fibonacci'. fibonacciPairProperty :: AnySign Int -> Bool fibonacciPairProperty (AnySign n) = fibonacciPair n == (fibonacci n, fibonacci (n + 1)) -- | Check that 'fibonacci 0' is 0. fibonacciSpecialCase0 :: Assertion fibonacciSpecialCase0 = assertEqual "fibonacci" (fibonacci 0) 0 -- | Check that 'fibonacci 1' is 1. fibonacciSpecialCase1 :: Assertion fibonacciSpecialCase1 = assertEqual "fibonacci" (fibonacci 1) 1 -- | Check that 'lucas' matches the definition of Lucas sequence. lucasProperty1 :: AnySign Int -> Bool lucasProperty1 (AnySign n) = lucas n + lucas (n + 1) == lucas (n +2) -- | Check that 'lucas' for negative indices is correctly defined. lucasProperty2 :: NonNegative Int -> Bool lucasProperty2 (NonNegative n) = lucas n == (if odd n then negate else id) (lucas (- n)) -- | Check that 'lucasPair' is a pair of consequent 'lucas'. lucasPairProperty :: AnySign Int -> Bool lucasPairProperty (AnySign n) = lucasPair n == (lucas n, lucas (n + 1)) -- | Check that 'lucas 0' is 2. lucasSpecialCase0 :: Assertion lucasSpecialCase0 = assertEqual "lucas" (lucas 0) 2 -- | Check that 'lucas 1' is 1. lucasSpecialCase1 :: Assertion lucasSpecialCase1 = assertEqual "lucas" (lucas 1) 1 -- | Check that 'generalLucas' matches its definition. generalLucasProperty1 :: AnySign Integer -> AnySign Integer -> NonNegative Int -> Bool generalLucasProperty1 (AnySign p) (AnySign q) (NonNegative n) = un1 == un1' && vn1 == vn1' && un2 == p * un1 - q * un && vn2 == p * vn1 - q * vn where (un, un1, vn, vn1) = generalLucas p q n (un1', un2, vn1', vn2) = generalLucas p q (n + 1) -- | Check that 'generalLucas' 1 (-1) is 'fibonacciPair' plus 'lucasPair'. generalLucasProperty2 :: NonNegative Int -> Bool generalLucasProperty2 (NonNegative n) = (un, un1) == fibonacciPair n && (vn, vn1) == lucasPair n where (un, un1, vn, vn1) = generalLucas 1 (-1) n -- | Check that 'generalLucas' p _ 0 is (0, 1, 2, p). generalLucasProperty3 :: AnySign Integer -> AnySign Integer -> Bool generalLucasProperty3 (AnySign p) (AnySign q) = generalLucas p q 0 == (0, 1, 2, p) factorialProperty1 :: Word -> Bool factorialProperty1 n = n > 100000 || sort (map (first unPrime) (factorise (factorial !! fromIntegral n))) == sort (map (first (toInteger . unPrime)) (factorialFactors n)) factorialProperty2 :: Word -> Bool factorialProperty2 n = n > 100000 || factorial !! fromIntegral n == product (map (\(p, k) -> toInteger (unPrime p) ^ k) (factorialFactors n)) testSuite :: TestTree testSuite = testGroup "Linear" [ testGroup "fibonacci" [ testSmallAndQuick "matches definition" fibonacciProperty1 , testSmallAndQuick "negative indices" fibonacciProperty2 , testSmallAndQuick "pair" fibonacciPairProperty , testCase "fibonacci 0" fibonacciSpecialCase0 , testCase "fibonacci 1" fibonacciSpecialCase1 ] , testGroup "lucas" [ testSmallAndQuick "matches definition" lucasProperty1 , testSmallAndQuick "negative indices" lucasProperty2 , testSmallAndQuick "pair" lucasPairProperty , testCase "lucas 0" lucasSpecialCase0 , testCase "lucas 1" lucasSpecialCase1 ] , testGroup "generalLucas" [ testSmallAndQuick "matches definition" generalLucasProperty1 , testSmallAndQuick "generalLucas 1 (-1)" generalLucasProperty2 , testSmallAndQuick "generalLucas _ _ 0" generalLucasProperty3 ] , testGroup "factorial" [ testSmallAndQuick "factorise . factorial = factorialFactors" factorialProperty1 , testSmallAndQuick "factorial = factorBack . factorialFactors" factorialProperty2 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Recurrences/PentagonalTests.hs0000644000000000000000000000725407346545000025317 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Recurrences.PentagonalTests -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- -- Tests for Math.NumberTheory.Recurrences.Pentagonal -- {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Recurrences.PentagonalTests ( testSuite ) where import Data.Proxy (Proxy (..)) import GHC.Natural (Natural) import GHC.TypeNats (SomeNat (..), someNatVal) import Math.NumberTheory.Moduli (Mod, getVal) import Math.NumberTheory.Recurrences (partition) import Math.NumberTheory.TestUtils import Test.Tasty import Test.Tasty.HUnit -- | Helper to avoid writing @partition !!@ too many times. partition' :: Num a => Int -> a partition' = (partition !!) -- | Check that the @k@-th generalized pentagonal number is -- @div (3 * k² - k) 2@, where @k ∈ {0, 1, -1, 2, -2, 3, -3, 4, ...}@. -- Notice that @-1@ is the @2 * abs (-1) == 2@-nd index in the zero-based list, -- while @2@ is the @2 * 2 - 1 == 3@-rd, and so on. pentagonalNumbersProperty1 :: AnySign Int -> Bool pentagonalNumbersProperty1 (AnySign n) | n == 0 = head pents == 0 | n > 0 = pents !! (2 * n - 1) == pent n | otherwise = pents !! (2 * abs n) == pent n where pent m = div (3 * (m * m) - m) 2 -- | Check that the first 20 elements of @partition@ are correct per -- https://oeis.org/A000041. partitionSpecialCase20 :: Assertion partitionSpecialCase20 = assertEqual "partition" (take 20 partition) [1, 1, 2, 3, 5, 7, 11, 15, 22, 30, 42, 56, 77, 101, 135, 176, 231, 297, 385, 490] -- | Copied from @Math.NumberTheory.Recurrences.Pentagonal@ to test the -- reference implementation of @partition@. pentagonalSigns :: Num a => [a] -> [a] pentagonalSigns = zipWith (*) (cycle [1, 1, -1, -1]) -- | Copied from @Math.NumberTheory.Recurrences.Pentagonal@ to test the -- reference implementation of @partition@. pents :: (Enum a, Num a) => [a] pents = interleave (scanl (\acc n -> acc + 3 * n - 1) 0 [1..]) (scanl (\acc n -> acc + 3 * n - 2) 1 [2..]) where interleave :: [a] -> [a] -> [a] interleave (n : ns) (m : ms) = n : m : interleave ns ms interleave _ _ = [] -- | Check that @p(n) = p(n-1) + p(n-2) - p(n-5) - p(n-7) + p(n-11) + ...@, -- where @p(x) = 0@ for any negative integer and @p(0) = 1@. partitionProperty1 :: Positive Int -> Bool partitionProperty1 (Positive n) = partition' n == (sum . pentagonalSigns . map (\m -> partition' (n - m)) . takeWhile (\m -> n - m >= 0) . tail $ pents) -- | Check that -- @partition :: [Math.NumberTheory.Moduli.Mod n] == map (`mod` n) partition@. partitionProperty2 :: NonNegative Integer -> Positive Natural -> Bool partitionProperty2 (NonNegative m) n@(someNatVal . getPositive -> (SomeNat (Proxy :: Proxy n))) = (take m' . map getVal $ (partition :: [Mod n])) == map helper (take m' partition :: [Integer]) where m' = fromIntegral m n' = fromIntegral n helper x = x `mod` n' testSuite :: TestTree testSuite = testGroup "Pentagonal" [ testGroup "partition" [ testSmallAndQuick "matches definition" partitionProperty1 , testSmallAndQuick "mod n" partitionProperty2 , testCase "first 20 elements of partition are correct" partitionSpecialCase20 ] , testGroup "Generalized pentagonal numbers" [ testSmallAndQuick "matches definition" pentagonalNumbersProperty1 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/RootsOfUnityTests.hs0000644000000000000000000000142307346545000023363 0ustar0000000000000000-- | -- Module: Math.NumberTheory.RootsOfUnityTests -- Copyright: (c) 2018 Bhavik Mehta -- License: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.RootsOfUnity -- module Math.NumberTheory.RootsOfUnityTests where import Test.Tasty import Data.Complex import Data.Ratio import Data.Semigroup import Math.NumberTheory.DirichletCharacters (toRootOfUnity, toComplex) import Math.NumberTheory.TestUtils (testSmallAndQuick, Positive(..)) rootOfUnityTest :: Integer -> Positive Integer -> Bool rootOfUnityTest n (Positive d) = toComplex ((d `div` gcd n d) `stimes` toRootOfUnity (n % d)) == (1 :: Complex Double) testSuite :: TestTree testSuite = testSmallAndQuick "RootOfUnity contains roots of unity" rootOfUnityTest arithmoi-0.12.1.0/test-suite/Math/NumberTheory/SmoothNumbersTests.hs0000644000000000000000000000737107346545000023554 0ustar0000000000000000-- | -- Module: Math.NumberTheory.SmoothNumbersTests -- Copyright: (c) 2018 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.SmoothNumbersTests -- {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.SmoothNumbersTests ( testSuite ) where import Prelude hiding (mod, rem) import Test.Tasty import Test.Tasty.HUnit import Data.Coerce import Data.Euclidean import Data.List (nub) import Numeric.Natural import Math.NumberTheory.Primes (Prime (..)) import qualified Math.NumberTheory.Quadratic.GaussianIntegers as G import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E import Math.NumberTheory.SmoothNumbers (SmoothBasis, fromList, isSmooth, smoothOver, smoothOver') import Math.NumberTheory.TestUtils isSmoothPropertyHelper :: (Eq a, Num a, Euclidean a) => (a -> Integer) -> [a] -> Int -> Int -> Bool isSmoothPropertyHelper norm primes' i1 i2 = let primes = take i1 primes' basis = fromList primes in all (isSmooth basis) $ take i2 $ smoothOver' norm basis isSmoothProperty1 :: Positive Int -> Positive Int -> Bool isSmoothProperty1 (Positive i1) (Positive i2) = isSmoothPropertyHelper G.norm (map unPrime G.primes) i1 i2 isSmoothProperty2 :: Positive Int -> Positive Int -> Bool isSmoothProperty2 (Positive i1) (Positive i2) = isSmoothPropertyHelper E.norm (map unPrime E.primes) i1 i2 smoothOverInRange :: Integral a => SmoothBasis a -> a -> a -> [a] smoothOverInRange s lo hi = takeWhile (<= hi) $ dropWhile (< lo) $ smoothOver s smoothOverInRangeBF :: (Eq a, Enum a, GcdDomain a) => SmoothBasis a -> a -> a -> [a] smoothOverInRangeBF prs lo hi = coerce $ filter (isSmooth prs) $ coerce [lo..hi] smoothOverInRangeProperty :: (Show a, Integral a) => (SmoothBasis a, Positive a, Positive a) -> ([a], [a]) smoothOverInRangeProperty (s, Positive lo', Positive diff') = (map unwrapIntegral xs, map unwrapIntegral ys) where lo = WrapIntegral lo' `rem` 2^18 diff = WrapIntegral diff' `rem` 2^18 hi = lo + diff xs = smoothOverInRange (coerce s) lo hi ys = smoothOverInRangeBF (coerce s) lo hi smoothNumbersAreUniqueProperty :: (Show a, Integral a) => SmoothBasis a -> Positive Int -> Bool smoothNumbersAreUniqueProperty s (Positive len) = nub l == l where l = take len $ smoothOver s isSmoothSpecialCase1 :: Assertion isSmoothSpecialCase1 = assertBool "should be distinct" $ nub l == l where b = fromList [1+3*G.ι,6+8*G.ι] l = take 10 $ map abs $ smoothOver' G.norm b isSmoothSpecialCase2 :: Assertion isSmoothSpecialCase2 = assertBool "should be smooth" $ isSmooth b 6 where b = fromList [4, 3, 6, 10, 7::Int] testSuite :: TestTree testSuite = testGroup "SmoothNumbers" [ testGroup "smoothOverInRange == smoothOverInRangeBF" [ testEqualSmallAndQuick "Int" (smoothOverInRangeProperty @Int) , testEqualSmallAndQuick "Word" (smoothOverInRangeProperty @Word) , testEqualSmallAndQuick "Integer" (smoothOverInRangeProperty @Integer) , testEqualSmallAndQuick "Natural" (smoothOverInRangeProperty @Natural) ] , testGroup "smoothOver generates a list without duplicates" [ testSmallAndQuick "Integer" (smoothNumbersAreUniqueProperty @Integer) , testSmallAndQuick "Natural" (smoothNumbersAreUniqueProperty @Natural) ] , testGroup "Quadratic rings" [ testGroup "smoothOver generates valid smooth numbers" [ testSmallAndQuick "Gaussian" isSmoothProperty1 , testSmallAndQuick "Eisenstein" isSmoothProperty2 ] , testCase "all distinct for base [1+3*i,6+8*i]" isSmoothSpecialCase1 , testCase "6 is smooth for base [4,3,6,10,7]" isSmoothSpecialCase2 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/TestUtils.hs0000644000000000000000000004041007346545000021653 0ustar0000000000000000-- | -- Module: Math.NumberTheory.TestUtils -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Utils to test Math.NumberTheory -- {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.TestUtils ( module Math.NumberTheory.TestUtils.Wrappers , module Math.NumberTheory.TestUtils.MyCompose , module Test.SmallCheck.Series , Large(..) , NonZero(..) , testIntegralProperty , testIntegralPropertyNoLarge , testSameIntegralProperty , testSameIntegralProperty3 , testIntegral2Property , testSmallAndQuick , testEqualSmallAndQuick -- * Export for @Zeta@ tests , assertEqualUpToEps -- * Export for Inverse tests , TestableIntegral , lawsToTest ) where import Test.QuickCheck.Classes import Test.SmallCheck.Series (Positive(..), NonNegative(..), NonZero(..), Serial(..), Series, generate, (\/), cons2) import Test.Tasty import Test.Tasty.HUnit (Assertion, assertBool) import Test.Tasty.SmallCheck as SC import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..), NonZero(..), generate) import Data.Bits import Data.Euclidean import Data.Kind import Data.Semiring (Semiring) import Numeric.Natural import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E (EisensteinInteger(..)) import Math.NumberTheory.Quadratic.GaussianIntegers (GaussianInteger(..)) import Math.NumberTheory.Primes (Prime, UniqueFactorisation) import qualified Math.NumberTheory.SmoothNumbers as SN import Math.NumberTheory.TestUtils.MyCompose import Math.NumberTheory.TestUtils.Wrappers instance Arbitrary Natural where arbitrary = fromInteger <$> (arbitrary `suchThat` (>= 0)) shrink = map fromInteger . filter (>= 0) . shrink . toInteger instance Arbitrary E.EisensteinInteger where arbitrary = (E.:+) <$> arbitrary <*> arbitrary shrink (x E.:+ y) = map (x E.:+) (shrink y) ++ map (E.:+ y) (shrink x) instance Monad m => Serial m E.EisensteinInteger where series = cons2 (E.:+) instance Arbitrary GaussianInteger where arbitrary = (:+) <$> arbitrary <*> arbitrary shrink (x :+ y) = map (x :+) (shrink y) ++ map (:+ y) (shrink x) instance Monad m => Serial m GaussianInteger where series = cons2 (:+) ------------------------------------------------------------------------------- -- SmoothNumbers instance (Ord a, Num a, Euclidean a, Arbitrary a) => Arbitrary (SN.SmoothBasis a) where arbitrary = SN.fromList <$> arbitrary shrink xs = SN.fromList <$> shrink (SN.unSmoothBasis xs) instance (Ord a, Num a, Euclidean a, Serial m a) => Serial m (SN.SmoothBasis a) where series = SN.fromList <$> series ------------------------------------------------------------------------------- -- https://www.cs.ox.ac.uk/projects/utgp/school/andres.pdf, p. 21 -- :k Compose = (k1 -> Constraint) -> (k2 -> k1) -> (k2 -> Constraint) class (f (g x)) => (f `Compose` g) x instance (f (g x)) => (f `Compose` g) x type family ConcatMap (w :: Type -> Constraint) (cs :: [Type]) :: Constraint where ConcatMap w '[] = () ConcatMap w (c ': cs) = (w c, ConcatMap w cs) type family Matrix (as :: [Type -> Constraint]) (w :: Type -> Type) (bs :: [Type]) :: Constraint where Matrix '[] w bs = () Matrix (a ': as) w bs = (ConcatMap (a `Compose` w) bs, Matrix as w bs) type TestableIntegral wrapper = ( Matrix '[Arbitrary, Show, Serial IO] wrapper '[Int, Word, Integer, Natural] , Matrix '[Arbitrary, Show] wrapper '[Large Int, Large Word, Huge Integer, Huge Natural] , Matrix '[Bounded, Integral] wrapper '[Int, Word] , Num (wrapper Integer) , Num (wrapper Natural) , Functor wrapper ) testIntegralProperty :: forall wrapper bool. (TestableIntegral wrapper, SC.Testable IO bool, QC.Testable bool) => String -> (forall a. (GcdDomain a, Euclidean a, Semiring a, Integral a, Bits a, UniqueFactorisation a, Show a) => wrapper a -> bool) -> TestTree testIntegralProperty name f = testGroup name [ SC.testProperty "smallcheck Int" (f :: wrapper Int -> bool) , SC.testProperty "smallcheck Word" (f :: wrapper Word -> bool) , SC.testProperty "smallcheck Integer" (f :: wrapper Integer -> bool) , SC.testProperty "smallcheck Natural" (f :: wrapper Natural -> bool) , QC.testProperty "quickcheck Int" (f :: wrapper Int -> bool) , QC.testProperty "quickcheck Word" (f :: wrapper Word -> bool) , QC.testProperty "quickcheck Integer" (f :: wrapper Integer -> bool) , QC.testProperty "quickcheck Natural" (f :: wrapper Natural -> bool) , QC.testProperty "quickcheck Large Int" ((f :: wrapper Int -> bool) . getLarge) , QC.testProperty "quickcheck Large Word" ((f :: wrapper Word -> bool) . getLarge) , QC.testProperty "quickcheck Huge Integer" ((f :: wrapper Integer -> bool) . getHuge) , QC.testProperty "quickcheck Huge Natural" ((f :: wrapper Natural -> bool) . getHuge) ] testIntegralPropertyNoLarge :: forall wrapper bool. (TestableIntegral wrapper, SC.Testable IO bool, QC.Testable bool) => String -> (forall a. (Euclidean a, Semiring a, Integral a, Bits a, UniqueFactorisation a, Show a, Enum (Prime a)) => wrapper a -> bool) -> TestTree testIntegralPropertyNoLarge name f = testGroup name [ SC.testProperty "smallcheck Int" (f :: wrapper Int -> bool) , SC.testProperty "smallcheck Word" (f :: wrapper Word -> bool) , SC.testProperty "smallcheck Integer" (f :: wrapper Integer -> bool) , SC.testProperty "smallcheck Natural" (f :: wrapper Natural -> bool) , QC.testProperty "quickcheck Int" (f :: wrapper Int -> bool) , QC.testProperty "quickcheck Word" (f :: wrapper Word -> bool) , QC.testProperty "quickcheck Integer" (f :: wrapper Integer -> bool) , QC.testProperty "quickcheck Natural" (f :: wrapper Natural -> bool) ] testSameIntegralProperty :: forall wrapper1 wrapper2 bool. (TestableIntegral wrapper1, TestableIntegral wrapper2, SC.Testable IO bool, QC.Testable bool) => String -> (forall a. (GcdDomain a, Euclidean a, Integral a, Bits a, UniqueFactorisation a, Show a) => wrapper1 a -> wrapper2 a -> bool) -> TestTree testSameIntegralProperty name f = testGroup name [ SC.testProperty "smallcheck Int" (f :: wrapper1 Int -> wrapper2 Int -> bool) , SC.testProperty "smallcheck Word" (f :: wrapper1 Word -> wrapper2 Word -> bool) , SC.testProperty "smallcheck Integer" (f :: wrapper1 Integer -> wrapper2 Integer -> bool) , SC.testProperty "smallcheck Natural" (f :: wrapper1 Natural -> wrapper2 Natural -> bool) , QC.testProperty "quickcheck Int" (f :: wrapper1 Int -> wrapper2 Int -> bool) , QC.testProperty "quickcheck Word" (f :: wrapper1 Word -> wrapper2 Word -> bool) , QC.testProperty "quickcheck Integer" (f :: wrapper1 Integer -> wrapper2 Integer -> bool) , QC.testProperty "quickcheck Natural" (f :: wrapper1 Natural -> wrapper2 Natural -> bool) , QC.testProperty "quickcheck Large Int" (\a b -> (f :: wrapper1 Int -> wrapper2 Int -> bool) (getLarge <$> a) (getLarge <$> b)) , QC.testProperty "quickcheck Large Word" (\a b -> (f :: wrapper1 Word -> wrapper2 Word -> bool) (getLarge <$> a) (getLarge <$> b)) , QC.testProperty "quickcheck Huge Integer" (\a b -> (f :: wrapper1 Integer -> wrapper2 Integer -> bool) (getHuge <$> a) (getHuge <$> b)) , QC.testProperty "quickcheck Huge Natural" (\a b -> (f :: wrapper1 Natural -> wrapper2 Natural -> bool) (getHuge <$> a) (getHuge <$> b)) ] testSameIntegralProperty3 :: forall wrapper1 wrapper2 wrapper3 bool. (TestableIntegral wrapper1, TestableIntegral wrapper2, TestableIntegral wrapper3, SC.Testable IO bool, QC.Testable bool) => String -> (forall a. (Euclidean a, Integral a, Bits a, UniqueFactorisation a, Show a) => wrapper1 a -> wrapper2 a -> wrapper3 a -> bool) -> TestTree testSameIntegralProperty3 name f = testGroup name [ SC.testProperty "smallcheck Int" (f :: wrapper1 Int -> wrapper2 Int -> wrapper3 Int -> bool) , SC.testProperty "smallcheck Word" (f :: wrapper1 Word -> wrapper2 Word -> wrapper3 Word -> bool) , SC.testProperty "smallcheck Integer" (f :: wrapper1 Integer -> wrapper2 Integer -> wrapper3 Integer -> bool) , SC.testProperty "smallcheck Natural" (f :: wrapper1 Natural -> wrapper2 Natural -> wrapper3 Natural -> bool) , QC.testProperty "quickcheck Int" (f :: wrapper1 Int -> wrapper2 Int -> wrapper3 Int -> bool) , QC.testProperty "quickcheck Word" (f :: wrapper1 Word -> wrapper2 Word -> wrapper3 Word -> bool) , QC.testProperty "quickcheck Integer" (f :: wrapper1 Integer -> wrapper2 Integer -> wrapper3 Integer -> bool) , QC.testProperty "quickcheck Natural" (f :: wrapper1 Natural -> wrapper2 Natural -> wrapper3 Natural -> bool) , QC.testProperty "quickcheck Large Int" (\a b c -> (f :: wrapper1 Int -> wrapper2 Int -> wrapper3 Int -> bool) (getLarge <$> a) (getLarge <$> b) (getLarge <$> c)) , QC.testProperty "quickcheck Large Word" (\a b c -> (f :: wrapper1 Word -> wrapper2 Word -> wrapper3 Word -> bool) (getLarge <$> a) (getLarge <$> b) (getLarge <$> c)) , QC.testProperty "quickcheck Huge Integer" (\a b c -> (f :: wrapper1 Integer -> wrapper2 Integer -> wrapper3 Integer -> bool) (getHuge <$> a) (getHuge <$> b) (getHuge <$> c)) , QC.testProperty "quickcheck Huge Natural" (\a b c -> (f :: wrapper1 Natural -> wrapper2 Natural -> wrapper3 Natural -> bool) (getHuge <$> a) (getHuge <$> b) (getHuge <$> c)) ] testIntegral2Property :: forall wrapper1 wrapper2 bool. (TestableIntegral wrapper1, TestableIntegral wrapper2, SC.Testable IO bool, QC.Testable bool) => String -> (forall a1 a2. (Integral a1, Integral a2, Bits a1, Bits a2, UniqueFactorisation a1, UniqueFactorisation a2, Show a1, Show a2) => wrapper1 a1 -> wrapper2 a2 -> bool) -> TestTree testIntegral2Property name f = testGroup name [ SC.testProperty "smallcheck Int Int" (f :: wrapper1 Int -> wrapper2 Int -> bool) , SC.testProperty "smallcheck Int Word" (f :: wrapper1 Int -> wrapper2 Word -> bool) , SC.testProperty "smallcheck Int Integer" (f :: wrapper1 Int -> wrapper2 Integer -> bool) , SC.testProperty "smallcheck Int Natural" (f :: wrapper1 Int -> wrapper2 Natural -> bool) , SC.testProperty "smallcheck Word Int" (f :: wrapper1 Word -> wrapper2 Int -> bool) , SC.testProperty "smallcheck Word Word" (f :: wrapper1 Word -> wrapper2 Word -> bool) , SC.testProperty "smallcheck Word Integer" (f :: wrapper1 Word -> wrapper2 Integer -> bool) , SC.testProperty "smallcheck Word Natural" (f :: wrapper1 Word -> wrapper2 Natural -> bool) , SC.testProperty "smallcheck Integer Int" (f :: wrapper1 Integer -> wrapper2 Int -> bool) , SC.testProperty "smallcheck Integer Word" (f :: wrapper1 Integer -> wrapper2 Word -> bool) , SC.testProperty "smallcheck Integer Integer" (f :: wrapper1 Integer -> wrapper2 Integer -> bool) , SC.testProperty "smallcheck Integer Natural" (f :: wrapper1 Integer -> wrapper2 Natural -> bool) , SC.testProperty "smallcheck Natural Int" (f :: wrapper1 Natural -> wrapper2 Int -> bool) , SC.testProperty "smallcheck Natural Word" (f :: wrapper1 Natural -> wrapper2 Word -> bool) , SC.testProperty "smallcheck Natural Integer" (f :: wrapper1 Natural -> wrapper2 Integer -> bool) , SC.testProperty "smallcheck Natural Natural" (f :: wrapper1 Natural -> wrapper2 Natural -> bool) , QC.testProperty "quickcheck Int Int" (f :: wrapper1 Int -> wrapper2 Int -> bool) , QC.testProperty "quickcheck Int Word" (f :: wrapper1 Int -> wrapper2 Word -> bool) , QC.testProperty "quickcheck Int Integer" (f :: wrapper1 Int -> wrapper2 Integer -> bool) , QC.testProperty "quickcheck Int Natural" (f :: wrapper1 Int -> wrapper2 Natural -> bool) , QC.testProperty "quickcheck Word Int" (f :: wrapper1 Word -> wrapper2 Int -> bool) , QC.testProperty "quickcheck Word Word" (f :: wrapper1 Word -> wrapper2 Word -> bool) , QC.testProperty "quickcheck Word Integer" (f :: wrapper1 Word -> wrapper2 Integer -> bool) , QC.testProperty "quickcheck Word Natural" (f :: wrapper1 Word -> wrapper2 Natural -> bool) , QC.testProperty "quickcheck Integer Int" (f :: wrapper1 Integer -> wrapper2 Int -> bool) , QC.testProperty "quickcheck Integer Word" (f :: wrapper1 Integer -> wrapper2 Word -> bool) , QC.testProperty "quickcheck Integer Integer" (f :: wrapper1 Integer -> wrapper2 Integer -> bool) , QC.testProperty "quickcheck Integer Natural" (f :: wrapper1 Integer -> wrapper2 Natural -> bool) , QC.testProperty "quickcheck Natural Int" (f :: wrapper1 Natural -> wrapper2 Int -> bool) , QC.testProperty "quickcheck Natural Word" (f :: wrapper1 Natural -> wrapper2 Word -> bool) , QC.testProperty "quickcheck Natural Integer" (f :: wrapper1 Natural -> wrapper2 Integer -> bool) , QC.testProperty "quickcheck Natural Natural" (f :: wrapper1 Natural -> wrapper2 Natural -> bool) , QC.testProperty "quickcheck Large Int Int" ((f :: wrapper1 Int -> wrapper2 Int -> bool) . fmap getLarge) , QC.testProperty "quickcheck Large Int Word" ((f :: wrapper1 Int -> wrapper2 Word -> bool) . fmap getLarge) , QC.testProperty "quickcheck Large Int Integer" ((f :: wrapper1 Int -> wrapper2 Integer -> bool) . fmap getLarge) , QC.testProperty "quickcheck Large Int Natural" ((f :: wrapper1 Int -> wrapper2 Natural -> bool) . fmap getLarge) , QC.testProperty "quickcheck Large Word Int" ((f :: wrapper1 Word -> wrapper2 Int -> bool) . fmap getLarge) , QC.testProperty "quickcheck Large Word Word" ((f :: wrapper1 Word -> wrapper2 Word -> bool) . fmap getLarge) , QC.testProperty "quickcheck Large Word Integer" ((f :: wrapper1 Word -> wrapper2 Integer -> bool) . fmap getLarge) , QC.testProperty "quickcheck Large Word Natural" ((f :: wrapper1 Word -> wrapper2 Natural -> bool) . fmap getLarge) , QC.testProperty "quickcheck Huge Integer Int" ((f :: wrapper1 Integer -> wrapper2 Int -> bool) . fmap getHuge) , QC.testProperty "quickcheck Huge Integer Word" ((f :: wrapper1 Integer -> wrapper2 Word -> bool) . fmap getHuge) , QC.testProperty "quickcheck Huge Integer Integer" ((f :: wrapper1 Integer -> wrapper2 Integer -> bool) . fmap getHuge) , QC.testProperty "quickcheck Huge Integer Natural" ((f :: wrapper1 Integer -> wrapper2 Natural -> bool) . fmap getHuge) , QC.testProperty "quickcheck Huge Natural Int" ((f :: wrapper1 Natural -> wrapper2 Int -> bool) . fmap getHuge) , QC.testProperty "quickcheck Huge Natural Word" ((f :: wrapper1 Natural -> wrapper2 Word -> bool) . fmap getHuge) , QC.testProperty "quickcheck Huge Natural Integer" ((f :: wrapper1 Natural -> wrapper2 Integer -> bool) . fmap getHuge) , QC.testProperty "quickcheck Huge Natural Natural" ((f :: wrapper1 Natural -> wrapper2 Natural -> bool) . fmap getHuge) ] testSmallAndQuick :: (SC.Testable IO a, QC.Testable a) => String -> a -> TestTree testSmallAndQuick name f = testGroup name [ SC.testProperty "smallcheck" f , QC.testProperty "quickcheck" f ] testEqualSmallAndQuick :: (Serial IO a, Arbitrary a, Show a, Eq b, Show b) => String -> (a -> (b, b)) -> TestTree testEqualSmallAndQuick name f = testGroup name [ SC.testProperty "smallcheck" (uncurry (==) . f) , QC.testProperty "quickcheck" (uncurry (===) . f) ] -- | Used in @Math.NumberTheory.Zeta.DirichletTests@ and -- @Math.NumberTheory.Zeta.RiemannTests@. assertEqualUpToEps :: String -> Double -> Double -> Double -> Assertion assertEqualUpToEps msg eps expected actual = assertBool msg (abs (expected - actual) < eps) lawsToTest :: Laws -> TestTree lawsToTest (Laws name props) = testGroup name $ map (uncurry QC.testProperty) props arithmoi-0.12.1.0/test-suite/Math/NumberTheory/TestUtils/0000755000000000000000000000000007346545000021320 5ustar0000000000000000arithmoi-0.12.1.0/test-suite/Math/NumberTheory/TestUtils/MyCompose.hs0000644000000000000000000000161007346545000023565 0ustar0000000000000000-- | -- Module: Math.NumberTheory.TestUtils.MyCompose -- Copyright: (c) 2016-2017 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Utils to test Math.NumberTheory -- {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} module Math.NumberTheory.TestUtils.MyCompose ( MyCompose(..) ) where import GHC.Generics (Generic) import Test.QuickCheck (Arbitrary) import Test.SmallCheck.Series (Serial) newtype MyCompose f g a = MyCompose { getMyCompose :: f (g a) } deriving (Eq, Ord, Show, Functor, Num, Enum, Bounded, Real, Integral, Arbitrary, Generic) instance (Monad m, Serial m (f (g a))) => Serial m (MyCompose f g a) arithmoi-0.12.1.0/test-suite/Math/NumberTheory/TestUtils/Wrappers.hs0000644000000000000000000001607407346545000023467 0ustar0000000000000000-- | -- Module: Math.NumberTheory.TestUtils.Wrappers -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Utils to test Math.NumberTheory -- {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.TestUtils.Wrappers where import Control.Applicative import Data.Coerce import Data.Euclidean import Data.Functor.Classes import Data.Semiring (Semiring) import Test.Tasty.QuickCheck as QC hiding (Positive(..), NonNegative(..), NonZero(..)) import Test.SmallCheck.Series (Positive(..), NonNegative(..), NonZero(..), Serial(..), Series) import Math.NumberTheory.Primes (Prime, UniqueFactorisation(..)) ------------------------------------------------------------------------------- -- AnySign newtype AnySign a = AnySign { getAnySign :: a } deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real, Functor, Foldable, Traversable, Arbitrary, Semiring, GcdDomain, Euclidean) instance (Monad m, Serial m a) => Serial m (AnySign a) where series = AnySign <$> series instance Eq1 AnySign where liftEq eq (AnySign a) (AnySign b) = a `eq` b instance Ord1 AnySign where liftCompare cmp (AnySign a) (AnySign b) = a `cmp` b instance Show1 AnySign where liftShowsPrec shw _ p (AnySign a) = shw p a ------------------------------------------------------------------------------- -- Positive from smallcheck deriving instance Semiring a => Semiring (Positive a) deriving instance GcdDomain a => GcdDomain (Positive a) deriving instance Euclidean a => Euclidean (Positive a) instance (Num a, Ord a, Arbitrary a) => Arbitrary (Positive a) where arbitrary = Positive <$> (arbitrary `suchThat` (> 0)) shrink (Positive x) = Positive <$> filter (> 0) (shrink x) instance Eq1 Positive where liftEq eq (Positive a) (Positive b) = a `eq` b instance Ord1 Positive where liftCompare cmp (Positive a) (Positive b) = a `cmp` b instance Show1 Positive where liftShowsPrec shw _ p (Positive a) = shw p a ------------------------------------------------------------------------------- -- NonNegative from smallcheck deriving instance Semiring a => Semiring (NonNegative a) deriving instance GcdDomain a => GcdDomain (NonNegative a) deriving instance Euclidean a => Euclidean (NonNegative a) instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonNegative a) where arbitrary = NonNegative <$> (arbitrary `suchThat` (>= 0)) shrink (NonNegative x) = NonNegative <$> filter (>= 0) (shrink x) instance Eq1 NonNegative where liftEq eq (NonNegative a) (NonNegative b) = a `eq` b instance Ord1 NonNegative where liftCompare cmp (NonNegative a) (NonNegative b) = a `cmp` b instance Show1 NonNegative where liftShowsPrec shw _ p (NonNegative a) = shw p a ------------------------------------------------------------------------------- -- NonZero from smallcheck deriving instance Semiring a => Semiring (NonZero a) deriving instance GcdDomain a => GcdDomain (NonZero a) deriving instance Euclidean a => Euclidean (NonZero a) instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonZero a) where arbitrary = NonZero <$> (arbitrary `suchThat` (/= 0)) shrink (NonZero x) = NonZero <$> filter (/= 0) (shrink x) instance Eq1 NonZero where liftEq eq (NonZero a) (NonZero b) = a `eq` b instance Ord1 NonZero where liftCompare cmp (NonZero a) (NonZero b) = a `cmp` b instance Show1 NonZero where liftShowsPrec shw _ p (NonZero a) = shw p a ------------------------------------------------------------------------------- -- Huge newtype Huge a = Huge { getHuge :: a } deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real, Functor, Foldable, Traversable) instance (Num a, Arbitrary a) => Arbitrary (Huge a) where arbitrary = do Positive l <- arbitrary ds <- vector l return $ Huge $ foldl1 (\acc n -> acc * 2^63 + n) ds shrink (Huge n) = Huge <$> shrink n instance Eq1 Huge where liftEq eq (Huge a) (Huge b) = a `eq` b instance Ord1 Huge where liftCompare cmp (Huge a) (Huge b) = a `cmp` b instance Show1 Huge where liftShowsPrec shw _ p (Huge a) = shw p a ------------------------------------------------------------------------------- -- Power newtype Power a = Power { getPower :: a } deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real, Functor, Foldable, Traversable, Semiring, GcdDomain, Euclidean) instance (Monad m, Num a, Ord a, Serial m a) => Serial m (Power a) where series = Power <$> series `suchThatSerial` (> 0) instance (Num a, Ord a, Integral a, Arbitrary a) => Arbitrary (Power a) where arbitrary = Power <$> arbitrarySizedNatural `suchThat` (> 0) shrink (Power x) = Power <$> filter (> 0) (shrink x) instance Eq1 Power where liftEq eq (Power a) (Power b) = a `eq` b instance Ord1 Power where liftCompare cmp (Power a) (Power b) = a `cmp` b instance Show1 Power where liftShowsPrec shw _ p (Power a) = shw p a ------------------------------------------------------------------------------- -- Odd newtype Odd a = Odd { getOdd :: a } deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real, Functor, Foldable, Traversable) instance (Monad m, Serial m a, Integral a) => Serial m (Odd a) where series = Odd <$> series `suchThatSerial` odd instance (Integral a, Arbitrary a) => Arbitrary (Odd a) where arbitrary = Odd <$> (arbitrary `suchThat` odd) shrink (Odd x) = Odd <$> filter odd (shrink x) instance Eq1 Odd where liftEq eq (Odd a) (Odd b) = a `eq` b instance Ord1 Odd where liftCompare cmp (Odd a) (Odd b) = a `cmp` b instance Show1 Odd where liftShowsPrec shw _ p (Odd a) = shw p a ------------------------------------------------------------------------------- -- Prime instance (Arbitrary a, UniqueFactorisation a) => Arbitrary (Prime a) where arbitrary = (arbitrary :: Gen a) `suchThatMap` isPrime instance (Monad m, Serial m a, UniqueFactorisation a) => Serial m (Prime a) where series = (series :: Series m a) `suchThatMapSerial` isPrime ------------------------------------------------------------------------------- -- UniqueFactorisation instance UniqueFactorisation a => UniqueFactorisation (Large a) where factorise (Large x) = coerce $ factorise x isPrime (Large x) = coerce $ isPrime x instance UniqueFactorisation a => UniqueFactorisation (Huge a) where factorise (Huge x) = coerce $ factorise x isPrime (Huge x) = coerce $ isPrime x ------------------------------------------------------------------------------- -- Utils suchThatSerial :: Series m a -> (a -> Bool) -> Series m a suchThatSerial s p = s >>= \x -> if p x then pure x else empty suchThatMapSerial :: Series m a -> (a -> Maybe b) -> Series m b suchThatMapSerial s p = s >>= maybe empty pure . p arithmoi-0.12.1.0/test-suite/Math/NumberTheory/UniqueFactorisationTests.hs0000644000000000000000000000262107346545000024734 0ustar0000000000000000-- | -- Module: Math.NumberTheory.UniqueFactorisationTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.ArithmeticFunctions -- {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.UniqueFactorisationTests ( testSuite ) where import Test.Tasty import Math.NumberTheory.Quadratic.EisensteinIntegers import Math.NumberTheory.Quadratic.GaussianIntegers import Math.NumberTheory.Primes import Math.NumberTheory.TestUtils import Numeric.Natural testRules :: forall a. (UniqueFactorisation a, Num a, Eq a) => a -> Bool testRules n = n == 0 || all (\(p, _) -> unP p == abs (unP p)) fs && abs n == abs (product (map (\(p, k) -> unP p ^ k) fs)) where fs = factorise n unP :: Prime a -> a unP = unPrime testSuite :: TestTree testSuite = testGroup "UniqueFactorisation" [ testSmallAndQuick "Int" (testRules :: Int -> Bool) , testSmallAndQuick "Word" (testRules :: Word -> Bool) , testSmallAndQuick "Integer" (testRules :: Integer -> Bool) , testSmallAndQuick "Natural" (testRules :: Natural -> Bool) , testSmallAndQuick "GaussianInteger" (testRules :: GaussianInteger -> Bool) , testSmallAndQuick "EisensteinInteger" (testRules :: EisensteinInteger -> Bool) ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Zeta/0000755000000000000000000000000007346545000020263 5ustar0000000000000000arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Zeta/DirichletTests.hs0000644000000000000000000000663307346545000023561 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Zeta.DirichletTests -- Copyright: (c) 2018 Alexandre Rodrigues Baldé -- Licence: MIT -- Maintainer: Alexandre Rodrigues Baldé -- -- Tests for Math.NumberTheory.Zeta.Dirichlet -- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Zeta.DirichletTests ( testSuite ) where import Data.ExactPi (approximateValue) import Test.Tasty import Test.Tasty.HUnit (Assertion, assertEqual, testCase) import Math.NumberTheory.Zeta (betas, betasOdd) import Math.NumberTheory.TestUtils epsilon :: Double epsilon = 1e-14 betas' :: [Double] betas' = betas epsilon betasOddSpecialCase1 :: Assertion betasOddSpecialCase1 = assertEqualUpToEps "beta(1) = pi/4" epsilon (approximateValue $ head betasOdd) (pi / 4) betasOddSpecialCase2 :: Assertion betasOddSpecialCase2 = assertEqualUpToEps "beta(3) = pi^3/32" epsilon (approximateValue $ betasOdd !! 1) (pi^3 / 32) betasOddSpecialCase3 :: Assertion betasOddSpecialCase3 = assertEqualUpToEps "beta(5) = 5*pi^5/1536" epsilon (approximateValue $ betasOdd !! 2) ((5 * pi^5) / 1536) betasOddProperty1 :: Positive Int -> Bool betasOddProperty1 (Positive m) = betaM < 1 || betaM < betaM1 where betaM = approximateValue (betasOdd !! m) betaM1 = approximateValue (betasOdd !! (m + 1)) betasOddProperty2 :: NonNegative Int -> Bool betasOddProperty2 (NonNegative m) = abs (betaM - betaM') < epsilon where betaM = approximateValue (betasOdd !! m) betaM' = betas' !! ((2 * m) + 1) betasSpecialCase1 :: Assertion betasSpecialCase1 = assertEqual "beta(0) = 1/2" (head betas') (1 / 2) betasSpecialCase2 :: Assertion betasSpecialCase2 = assertEqualUpToEps "beta(2) = 0.9159655" epsilon (betas' !! 2) 0.9159655941772190150546035149323841107 betasSpecialCase3 :: Assertion betasSpecialCase3 = assertEqualUpToEps "beta(4) = 0.9889445" epsilon (betas' !! 4) 0.9889445517411053361084226332283778213 betasProperty1 :: Positive Int -> Bool betasProperty1 (Positive m) = betaM <= betaM1 && betaM1 <= 1 where betaM = betas' !! m betaM1 = betas' !! (m + 1) betasProperty2 :: NonNegative Int -> NonNegative Int -> Bool betasProperty2 (NonNegative e1) (NonNegative e2) = maximum (take 35 $ drop 2 $ zipWith ((abs .) . (-)) (betas eps1) (betas eps2)) <= eps1 + eps2 where eps1, eps2 :: Double eps1 = max ((1.0 / 2) ^ e1) ((1.0 / 2) ^ 53) eps2 = max ((1.0 / 2) ^ e2) ((1.0 / 2) ^ 53) testSuite :: TestTree testSuite = testGroup "Beta" [ testGroup "betasOdd" [ testCase "beta(1)" betasOddSpecialCase1 , testCase "beta(3)" betasOddSpecialCase2 , testCase "beta(5)" betasOddSpecialCase3 , testSmallAndQuick "beta(2n-1) < beta(2n+1)" betasOddProperty1 , testSmallAndQuick "betasOdd matches betas" betasOddProperty2 ] , testGroup "betas" [ testCase "beta(0)" betasSpecialCase1 , testCase "beta(2)" betasSpecialCase2 , testCase "beta(4)" betasSpecialCase3 , testSmallAndQuick "beta(n) < beta(n+1)" betasProperty1 , testSmallAndQuick "precision" betasProperty2 ] ] arithmoi-0.12.1.0/test-suite/Math/NumberTheory/Zeta/RiemannTests.hs0000644000000000000000000000664607346545000023247 0ustar0000000000000000-- | -- Module: Math.NumberTheory.Zeta.RiemannTests -- Copyright: (c) 2016 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- Tests for Math.NumberTheory.Zeta.Riemann -- {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.NumberTheory.Zeta.RiemannTests ( testSuite ) where import Data.ExactPi (approximateValue) import Test.Tasty import Test.Tasty.HUnit (Assertion, assertEqual, testCase) import Math.NumberTheory.Zeta import Math.NumberTheory.TestUtils epsilon :: Double epsilon = 1e-14 zetasEvenSpecialCase1 :: Assertion zetasEvenSpecialCase1 = assertEqual "zeta(0) = -1/2" (approximateValue $ head zetasEven) (-1 / 2) zetasEvenSpecialCase2 :: Assertion zetasEvenSpecialCase2 = assertEqualUpToEps "zeta(2) = pi^2/6" epsilon (approximateValue $ zetasEven !! 1) (pi * pi / 6) zetasEvenSpecialCase3 :: Assertion zetasEvenSpecialCase3 = assertEqualUpToEps "zeta(4) = pi^4/90" epsilon (approximateValue $ zetasEven !! 2) (pi ^ 4 / 90) zetasEvenProperty1 :: Positive Int -> Bool zetasEvenProperty1 (Positive m) = zetaM < 1 || zetaM > zetaM1 where zetaM = approximateValue (zetasEven !! m) zetaM1 = approximateValue (zetasEven !! (m + 1)) zetasEvenProperty2 :: Positive Int -> Bool zetasEvenProperty2 (Positive m) = abs (zetaM - zetaM') < epsilon where zetaM = approximateValue (zetasEven !! m) zetaM' = zetas' !! (2 * m) zetas' :: [Double] zetas' = zetas epsilon zetasSpecialCase1 :: Assertion zetasSpecialCase1 = assertEqual "zeta(1) = Infinity" (zetas' !! 1) (1 / 0) zetasSpecialCase2 :: Assertion zetasSpecialCase2 = assertEqualUpToEps "zeta(3) = 1.2020569" epsilon (zetas' !! 3) 1.2020569031595942853997381615114499908 zetasSpecialCase3 :: Assertion zetasSpecialCase3 = assertEqualUpToEps "zeta(5) = 1.0369277" epsilon (zetas' !! 5) 1.0369277551433699263313654864570341681 zetasProperty1 :: Positive Int -> Bool zetasProperty1 (Positive m) = zetaM >= zetaM1 && zetaM1 >= 1 where zetaM = zetas' !! m zetaM1 = zetas' !! (m + 1) -- | Let z1 be an approximation of z with precision eps1, -- and z2 be an approximation of the same value with precision eps2. -- Then (independently of the true value of z) -- abs (z1 - z2) < eps1 + eps2. zetasProperty2 :: NonNegative Int -> NonNegative Int -> Bool zetasProperty2 (NonNegative e1) (NonNegative e2) = maximum (take 35 $ drop 2 $ zipWith ((abs .) . (-)) (zetas eps1) (zetas eps2)) < eps1 + eps2 where eps1, eps2 :: Double eps1 = max ((1.0 / 2) ^ e1) ((1.0 / 2) ^ 53) eps2 = max ((1.0 / 2) ^ e2) ((1.0 / 2) ^ 53) testSuite :: TestTree testSuite = testGroup "Zeta" [ testGroup "zetasEven" [ testCase "zeta(0)" zetasEvenSpecialCase1 , testCase "zeta(2)" zetasEvenSpecialCase2 , testCase "zeta(4)" zetasEvenSpecialCase3 , testSmallAndQuick "zeta(2n) > zeta(2n+2)" zetasEvenProperty1 , testSmallAndQuick "zetasEven matches zetas" zetasEvenProperty2 ] , testGroup "zetas" [ testCase "zeta(1)" zetasSpecialCase1 , testCase "zeta(3)" zetasSpecialCase2 , testCase "zeta(5)" zetasSpecialCase3 , testSmallAndQuick "zeta(n) > zeta(n+1)" zetasProperty1 , testSmallAndQuick "precision" zetasProperty2 ] ] arithmoi-0.12.1.0/test-suite/0000755000000000000000000000000007346545000014044 5ustar0000000000000000arithmoi-0.12.1.0/test-suite/Test.hs0000644000000000000000000001000307346545000015311 0ustar0000000000000000import Test.Tasty import Test.Tasty.Ingredients.Rerun import qualified Math.NumberTheory.EuclideanTests as Euclidean import qualified Math.NumberTheory.Recurrences.PentagonalTests as RecurrencesPentagonal import qualified Math.NumberTheory.Recurrences.BilinearTests as RecurrencesBilinear import qualified Math.NumberTheory.Recurrences.LinearTests as RecurrencesLinear import qualified Math.NumberTheory.Moduli.ChineseTests as ModuliChinese import qualified Math.NumberTheory.Moduli.ClassTests as ModuliClass import qualified Math.NumberTheory.Moduli.CbrtTests as ModuliCbrt import qualified Math.NumberTheory.Moduli.DiscreteLogarithmTests as ModuliDiscreteLogarithm import qualified Math.NumberTheory.Moduli.EquationsTests as ModuliEquations import qualified Math.NumberTheory.Moduli.JacobiTests as ModuliJacobi import qualified Math.NumberTheory.Moduli.PrimitiveRootTests as ModuliPrimitiveRoot import qualified Math.NumberTheory.Moduli.SingletonTests as ModuliSingleton import qualified Math.NumberTheory.Moduli.SqrtTests as ModuliSqrt import qualified Math.NumberTheory.MoebiusInversionTests as MoebiusInversion import qualified Math.NumberTheory.PrefactoredTests as Prefactored import qualified Math.NumberTheory.PrimesTests as Primes import qualified Math.NumberTheory.Primes.CountingTests as Counting import qualified Math.NumberTheory.Primes.FactorisationTests as Factorisation -- import qualified Math.NumberTheory.Primes.LinearAlgebraTests as LinearAlgebra -- import qualified Math.NumberTheory.Primes.QuadraticSieveTests as QuadraticSieve import qualified Math.NumberTheory.Primes.SequenceTests as Sequence import qualified Math.NumberTheory.Primes.SieveTests as Sieve import qualified Math.NumberTheory.Primes.TestingTests as Testing import qualified Math.NumberTheory.EisensteinIntegersTests as Eisenstein import qualified Math.NumberTheory.GaussianIntegersTests as Gaussian import qualified Math.NumberTheory.ArithmeticFunctionsTests as ArithmeticFunctions import qualified Math.NumberTheory.ArithmeticFunctions.InverseTests as Inverse import qualified Math.NumberTheory.ArithmeticFunctions.MertensTests as Mertens import qualified Math.NumberTheory.ArithmeticFunctions.SieveBlockTests as SieveBlock import qualified Math.NumberTheory.UniqueFactorisationTests as UniqueFactorisation import qualified Math.NumberTheory.CurvesTests as Curves import qualified Math.NumberTheory.SmoothNumbersTests as SmoothNumbers import qualified Math.NumberTheory.Zeta.RiemannTests as Riemann import qualified Math.NumberTheory.Zeta.DirichletTests as Dirichlet import qualified Math.NumberTheory.DirichletCharactersTests as DirichletChar import qualified Math.NumberTheory.RootsOfUnityTests as RootsOfUnity import qualified Math.NumberTheory.DiophantineTests as Diophantine main :: IO () main = defaultMainWithRerun tests tests :: TestTree tests = testGroup "All" [ Euclidean.testSuite , testGroup "Recurrences" [ RecurrencesPentagonal.testSuite , RecurrencesLinear.testSuite , RecurrencesBilinear.testSuite ] , testGroup "Moduli" [ ModuliChinese.testSuite , ModuliClass.testSuite , ModuliCbrt.testSuite , ModuliDiscreteLogarithm.testSuite , ModuliEquations.testSuite , ModuliJacobi.testSuite , ModuliPrimitiveRoot.testSuite , ModuliSingleton.testSuite , ModuliSqrt.testSuite ] , MoebiusInversion.testSuite , Prefactored.testSuite , testGroup "Primes" [ Primes.testSuite , Counting.testSuite , Factorisation.testSuite -- , LinearAlgebra.testSuite -- , QuadraticSieve.testSuite , Sequence.testSuite , Sieve.testSuite , Testing.testSuite ] , Eisenstein.testSuite , Gaussian.testSuite , testGroup "ArithmeticFunctions" [ ArithmeticFunctions.testSuite , Inverse.testSuite , Mertens.testSuite , SieveBlock.testSuite ] , UniqueFactorisation.testSuite , Curves.testSuite , SmoothNumbers.testSuite , Diophantine.testSuite , testGroup "Zeta" [ Riemann.testSuite , Dirichlet.testSuite ] , DirichletChar.testSuite , RootsOfUnity.testSuite ]