{-
	Copyright (C) 2011-2015 Dr. Alistair Ward

	This program is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with this program.  If not, see <https://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Generates the constant list of /prime-numbers/, by a variety of different algorithms.

	* <https://www.haskell.org/haskellwiki/Prime_numbers>.

	* <https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.31.3936&rep=rep1&type=pdf>.

	* <https://larc.unt.edu/ian/pubs/sieve.pdf>.
-}

module Factory.Math.Implementations.Primes.Algorithm(
-- * Types
-- ** Data-types
	Algorithm(..)
) where

import qualified	Data.Default
import qualified	Data.Numbers.Primes
import qualified	Factory.Data.PrimeWheel					as Data.PrimeWheel
import qualified	Factory.Math.Implementations.Primes.SieveOfAtkin	as Math.Implementations.Primes.SieveOfAtkin
import qualified	Factory.Math.Implementations.Primes.SieveOfEratosthenes	as Math.Implementations.Primes.SieveOfEratosthenes
import qualified	Factory.Math.Implementations.Primes.TrialDivision	as Math.Implementations.Primes.TrialDivision
import qualified	Factory.Math.Implementations.Primes.TurnersSieve	as Math.Implementations.Primes.TurnersSieve
import qualified	Factory.Math.Primes					as Math.Primes

-- | The implemented methods by which the primes may be generated.
data Algorithm
	= SieveOfAtkin Integer					-- ^ The /Sieve of Atkin/, optimised using a 'Data.PrimeWheel.PrimeWheel' of optimal size, for primes up to the specified maximum bound; <https://en.wikipedia.org/wiki/Sieve_of_Atkin>.
	| SieveOfEratosthenes Data.PrimeWheel.NPrimes		-- ^ The /Sieve of Eratosthenes/ (<https://en.wikipedia.org/wiki/Sieve_of_Eratosthenes>), optimised using a 'Data.PrimeWheel.PrimeWheel'.
	| TrialDivision Data.PrimeWheel.NPrimes			-- ^ For each candidate, confirm indivisibility, by all /primes/ smaller than its /square-root/, optimised using a 'Data.PrimeWheel.PrimeWheel'.
	| TurnersSieve						-- ^ For each /prime/, the infinite list of candidates greater than its /square/, is filtered for indivisibility; <https://www.haskell.org/haskellwiki/Prime_numbers#Turner.27s_sieve_-_Trial_division>.
	| WheelSieve Int					-- ^ 'Data.Numbers.Primes.wheelSieve'.
	deriving (Algorithm -> Algorithm -> Bool
(Algorithm -> Algorithm -> Bool)
-> (Algorithm -> Algorithm -> Bool) -> Eq Algorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Algorithm -> Algorithm -> Bool
$c/= :: Algorithm -> Algorithm -> Bool
== :: Algorithm -> Algorithm -> Bool
$c== :: Algorithm -> Algorithm -> Bool
Eq, ReadPrec [Algorithm]
ReadPrec Algorithm
Int -> ReadS Algorithm
ReadS [Algorithm]
(Int -> ReadS Algorithm)
-> ReadS [Algorithm]
-> ReadPrec Algorithm
-> ReadPrec [Algorithm]
-> Read Algorithm
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Algorithm]
$creadListPrec :: ReadPrec [Algorithm]
readPrec :: ReadPrec Algorithm
$creadPrec :: ReadPrec Algorithm
readList :: ReadS [Algorithm]
$creadList :: ReadS [Algorithm]
readsPrec :: Int -> ReadS Algorithm
$creadsPrec :: Int -> ReadS Algorithm
Read, Int -> Algorithm -> ShowS
[Algorithm] -> ShowS
Algorithm -> String
(Int -> Algorithm -> ShowS)
-> (Algorithm -> String)
-> ([Algorithm] -> ShowS)
-> Show Algorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Algorithm] -> ShowS
$cshowList :: [Algorithm] -> ShowS
show :: Algorithm -> String
$cshow :: Algorithm -> String
showsPrec :: Int -> Algorithm -> ShowS
$cshowsPrec :: Int -> Algorithm -> ShowS
Show)

instance Data.Default.Default Algorithm	where
	def :: Algorithm
def	= Int -> Algorithm
SieveOfEratosthenes Int
7	-- Resulting in a wheel of circumference 510510.

instance Math.Primes.Algorithmic Algorithm	where
	primes :: Algorithm -> [i]
primes (SieveOfAtkin Integer
maxPrime)		= Int -> i -> [i]
forall i. (NFData i, Ix i, Integral i) => Int -> i -> [i]
Math.Implementations.Primes.SieveOfAtkin.sieveOfAtkin (Integer -> Int
forall i. Integral i => i -> Int
Data.PrimeWheel.estimateOptimalSize Integer
maxPrime) (i -> [i]) -> i -> [i]
forall a b. (a -> b) -> a -> b
$ Integer -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPrime
	primes (SieveOfEratosthenes Int
wheelSize)	= Int -> [i]
forall i. Integral i => Int -> [i]
Math.Implementations.Primes.SieveOfEratosthenes.sieveOfEratosthenes Int
wheelSize
	primes (TrialDivision Int
wheelSize)	= Int -> [i]
forall i. Integral i => Int -> [i]
Math.Implementations.Primes.TrialDivision.trialDivision Int
wheelSize
	primes Algorithm
TurnersSieve			= [i]
forall prime. Integral prime => [prime]
Math.Implementations.Primes.TurnersSieve.turnersSieve
	primes (WheelSieve Int
wheelSize)		= Int -> [i]
forall i. Integral i => Int -> [i]
Data.Numbers.Primes.wheelSieve Int
wheelSize	-- Has better space-complexity than 'SieveOfEratosthenes'.