| Copyright | (c) 2016-2018 Andrew.Lelechenko |
|---|---|
| License | MIT |
| Maintainer | Andrew Lelechenko <andrew.lelechenko@gmail.com> |
| Safe Haskell | None |
| Language | Haskell2010 |
Math.NumberTheory.Primes
Contents
Description
Synopsis
- data Prime a
- unPrime :: Prime a -> a
- toPrimeIntegral :: (Integral a, Integral b, Bits a, Bits b) => Prime a -> Maybe (Prime b)
- nextPrime :: (Bits a, Integral a, UniqueFactorisation a) => a -> Prime a
- precPrime :: (Bits a, Integral a, UniqueFactorisation a) => a -> Prime a
- class Num a => UniqueFactorisation a where
- factorBack :: Num a => [(Prime a, Word)] -> a
- primes :: Integral a => [Prime a]
Documentation
Wrapper for prime elements of a. It is supposed to be constructed
by nextPrime / 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.
approxPrimeCount):
>>>fromEnum (precPrime 100)25
- Get 25-th prime number (cf.
nthPrimeApprox):
>>>toEnum 25 :: Prime IntPrime 97
Instances
toPrimeIntegral :: (Integral a, Integral b, Bits a, Bits b) => Prime a -> Maybe (Prime b) Source #
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 aThe 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.
nextPrime :: (Bits a, Integral a, UniqueFactorisation a) => a -> Prime a Source #
Smallest prime, greater or equal to argument.
nextPrime (-100) == 2 nextPrime 1000 == 1009 nextPrime 1009 == 1009
precPrime :: (Bits a, Integral a, UniqueFactorisation a) => a -> Prime a Source #
Largest prime, less or equal to argument. Undefined, when argument < 2.
precPrime 100 == 97 precPrime 97 == 97
class Num a => UniqueFactorisation a where Source #
A class for unique factorisation domains.
Methods
factorise :: a -> [(Prime a, Word)] Source #
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 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)]
isPrime :: a -> Maybe (Prime a) Source #
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 isPrime.
If you were looking for the latter, please import
Math.NumberTheory.Primes.Testing instead of this module.
Instances
| UniqueFactorisation EisensteinInteger Source # | See the source code and Haddock comments for the |
Defined in Math.NumberTheory.Quadratic.EisensteinIntegers Methods factorise :: EisensteinInteger -> [(Prime EisensteinInteger, Word)] Source # isPrime :: EisensteinInteger -> Maybe (Prime EisensteinInteger) Source # | |
| UniqueFactorisation GaussianInteger Source # | |
Defined in Math.NumberTheory.Quadratic.GaussianIntegers Methods factorise :: GaussianInteger -> [(Prime GaussianInteger, Word)] Source # isPrime :: GaussianInteger -> Maybe (Prime GaussianInteger) Source # | |
| UniqueFactorisation Integer Source # | |
| UniqueFactorisation Natural Source # | |
| UniqueFactorisation Int Source # | |
| UniqueFactorisation Word Source # | |
| (Eq a, GcdDomain a, UniqueFactorisation a) => UniqueFactorisation (Prefactored a) Source # | |
Defined in Math.NumberTheory.Prefactored Methods factorise :: Prefactored a -> [(Prime (Prefactored a), Word)] Source # isPrime :: Prefactored a -> Maybe (Prime (Prefactored a)) Source # | |
Old interface
primes :: Integral a => [Prime a] Source #
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
Orphan instances
| Bounded (Prime Int) Source # | |
| Bounded (Prime Word) Source # | |
| Enum (Prime Integer) Source # | |
Methods succ :: Prime Integer -> Prime Integer # pred :: Prime Integer -> Prime Integer # toEnum :: Int -> Prime Integer # fromEnum :: Prime Integer -> Int # enumFrom :: Prime Integer -> [Prime Integer] # enumFromThen :: Prime Integer -> Prime Integer -> [Prime Integer] # enumFromTo :: Prime Integer -> Prime Integer -> [Prime Integer] # enumFromThenTo :: Prime Integer -> Prime Integer -> Prime Integer -> [Prime Integer] # | |
| Enum (Prime Natural) Source # | |
Methods succ :: Prime Natural -> Prime Natural # pred :: Prime Natural -> Prime Natural # toEnum :: Int -> Prime Natural # fromEnum :: Prime Natural -> Int # enumFrom :: Prime Natural -> [Prime Natural] # enumFromThen :: Prime Natural -> Prime Natural -> [Prime Natural] # enumFromTo :: Prime Natural -> Prime Natural -> [Prime Natural] # enumFromThenTo :: Prime Natural -> Prime Natural -> Prime Natural -> [Prime Natural] # | |
| Enum (Prime Int) Source # | |
Methods succ :: Prime Int -> Prime Int # pred :: Prime Int -> Prime Int # fromEnum :: Prime Int -> Int # enumFrom :: Prime Int -> [Prime Int] # enumFromThen :: Prime Int -> Prime Int -> [Prime Int] # enumFromTo :: Prime Int -> Prime Int -> [Prime Int] # enumFromThenTo :: Prime Int -> Prime Int -> Prime Int -> [Prime Int] # | |
| Enum (Prime Word) Source # | |
Methods succ :: Prime Word -> Prime Word # pred :: Prime Word -> Prime Word # fromEnum :: Prime Word -> Int # enumFrom :: Prime Word -> [Prime Word] # enumFromThen :: Prime Word -> Prime Word -> [Prime Word] # enumFromTo :: Prime Word -> Prime Word -> [Prime Word] # enumFromThenTo :: Prime Word -> Prime Word -> Prime Word -> [Prime Word] # | |