{-
	Copyright (C) 2011 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@]

	* Exports a common interface for primality-implementations.

	* Provides utilities for these implementations.
-}

module Factory.Math.Primality(
-- * Type-classes
	Algorithmic(..),
-- * Functions
	carmichaelNumbers,
-- ** Predicates
	areCoprime,
	isFermatWitness,
	isCarmichaelNumber
) where

import qualified	Control.DeepSeq
import qualified	Factory.Math.Power	as Math.Power

-- | Defines the methods expected of a primality-testing algorithm.
class Algorithmic algorithm	where
	isPrime	:: (Control.DeepSeq.NFData i, Integral i, Show i) => algorithm -> i -> Bool

{- |
	'True' if the two specified integers are /relatively prime/,
	i.e. if they share no common positive factors except one.

	* @1@ and @-1@ are the only numbers which are /coprime/ to themself.

	* <https://en.wikipedia.org/wiki/Coprime>.

	* <https://mathworld.wolfram.com/RelativelyPrime.html>.
-}
areCoprime :: Integral i => i -> i -> Bool
areCoprime :: i -> i -> Bool
areCoprime i
i	= (i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
1) (i -> Bool) -> (i -> i) -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> i
forall a. Integral a => a -> a -> a
gcd i
i

{- |
	* Tests /Fermat's Little Theorem/ for all applicable values, as a probabilistic primality-test.

	* <https://en.wikipedia.org/wiki/Fermat%27s_little_theorem>.

	* <https://en.wikipedia.org/wiki/Fermat_primality_test>.

	* <https://en.wikipedia.org/wiki/Fermat_pseudoprime>.

	* CAVEAT: this primality-test fails for the /Carmichael numbers/.

	* TODO: confirm that all values must be tested.
-}
isFermatWitness :: (Integral i, Show i) => i -> Bool
isFermatWitness :: i -> Bool
isFermatWitness i
i	= Bool -> Bool
not (Bool -> Bool) -> ([i] -> Bool) -> [i] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Bool) -> [i] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all i -> Bool
isFermatPseudoPrime ([i] -> Bool) -> [i] -> Bool
forall a b. (a -> b) -> a -> b
$ (i -> Bool) -> [i] -> [i]
forall a. (a -> Bool) -> [a] -> [a]
filter (i -> i -> Bool
forall i. Integral i => i -> i -> Bool
areCoprime i
i) [i
2 .. i -> i
forall a. Enum a => a -> a
pred i
i]	where
	isFermatPseudoPrime :: i -> Bool
isFermatPseudoPrime i
base	= i -> i -> i -> i
forall i power.
(Integral i, Integral power, Show power) =>
i -> power -> i -> i
Math.Power.raiseModulo i
base (i -> i
forall a. Enum a => a -> a
pred i
i) i
i i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
1	-- CAVEAT: a /Fermat Pseudo-prime/ must also be a /composite/ number.

{- |
	* A /Carmichael number/ is an /odd/ /composite/ number which satisfies /Fermat's little theorem/.

	* <https://en.wikipedia.org/wiki/Carmichael_number>.

	* <https://mathworld.wolfram.com/CarmichaelNumber.html>.
-}
isCarmichaelNumber :: (
	Algorithmic		algorithm,
	Control.DeepSeq.NFData	i,
	Integral		i,
	Show			i
 ) => algorithm -> i -> Bool
isCarmichaelNumber :: algorithm -> i -> Bool
isCarmichaelNumber algorithm
algorithm i
i	= Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
	i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
2,
	i -> Bool
forall a. Integral a => a -> Bool
even i
i,
	i -> Bool
forall i. (Integral i, Show i) => i -> Bool
isFermatWitness i
i,
	algorithm -> i -> Bool
forall algorithm i.
(Algorithmic algorithm, NFData i, Integral i, Show i) =>
algorithm -> i -> Bool
isPrime algorithm
algorithm i
i
 ]

-- | An ordered list of the /Carmichael/ numbers; <https://en.wikipedia.org/wiki/Carmichael_number>.
carmichaelNumbers :: (
	Algorithmic		algorithm,
	Control.DeepSeq.NFData	i,
	Integral		i,
	Show			i
 ) => algorithm -> [i]
carmichaelNumbers :: algorithm -> [i]
carmichaelNumbers algorithm
algorithm	= algorithm -> i -> Bool
forall algorithm i.
(Algorithmic algorithm, NFData i, Integral i, Show i) =>
algorithm -> i -> Bool
isCarmichaelNumber algorithm
algorithm (i -> Bool) -> [i] -> [i]
forall a. (a -> Bool) -> [a] -> [a]
`filter` [i
3, i
5 ..]