{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-identities #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- See the note on Modulus for why this warning is disabled

-- | Internal tools for modular arithmetic and primality testing. The main
-- functions are 'isPrime' and 'findInverse', though others are exported for
-- testing.
--
-- @since 0.1
module Numeric.Data.ModP.Internal.Primality
  ( -- * Primality Testing
    MaybePrime (..),
    isPrime,
    isPrimeTrials,
    millerRabin,

    -- ** Arithmoi vs. Default
    -- $arithmoi
    isPrimeArithmoi,
    isPrimeDefault,

    -- ** Helper Types
    -- $primality-helper
    Modulus (..),
    Pow (..),
    Mult (..),
    Rand (..),

    -- ** Helper Functions
    trial,
    isWitness,
    sqProgression,
    factor2,

    -- * Multiplicative Inverses

    -- ** Arithmoi vs. Default
    invert,
    invertArithmoi,
    invertDefault,

    -- ** Types / Low-level
    Bezout (..),
    R (..),
    S (..),
    T (..),
    findInverse,
    findBezout,

    -- * Misc
    errMsg,
  )
where

import Control.DeepSeq (NFData)
import Data.Data (Proxy (Proxy))
import Data.Kind (Type)
import GHC.Generics (Generic)
import GHC.TypeNats (KnownNat, natVal)
import Numeric.Natural (Natural)
import System.Random (UniformRange)
import System.Random qualified as Rand
import System.Random.Stateful qualified as RandState

#if USE_ARITHMOI
import Data.Mod (Mod)
import Data.Mod qualified as Mod
import Math.NumberTheory.Primes.Testing qualified as AM.Primes.Testing
#endif

-- | Result of running Miller-Rabin algorithm. At best we can determine if
-- some @n@ is definitely composite or "probably prime".
--
-- @since 0.1
type MaybePrime :: Type
data MaybePrime
  = Composite
  | ProbablyPrime
  deriving stock (MaybePrime -> MaybePrime -> Bool
(MaybePrime -> MaybePrime -> Bool)
-> (MaybePrime -> MaybePrime -> Bool) -> Eq MaybePrime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaybePrime -> MaybePrime -> Bool
== :: MaybePrime -> MaybePrime -> Bool
$c/= :: MaybePrime -> MaybePrime -> Bool
/= :: MaybePrime -> MaybePrime -> Bool
Eq, (forall x. MaybePrime -> Rep MaybePrime x)
-> (forall x. Rep MaybePrime x -> MaybePrime) -> Generic MaybePrime
forall x. Rep MaybePrime x -> MaybePrime
forall x. MaybePrime -> Rep MaybePrime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MaybePrime -> Rep MaybePrime x
from :: forall x. MaybePrime -> Rep MaybePrime x
$cto :: forall x. Rep MaybePrime x -> MaybePrime
to :: forall x. Rep MaybePrime x -> MaybePrime
Generic, Int -> MaybePrime -> ShowS
[MaybePrime] -> ShowS
MaybePrime -> String
(Int -> MaybePrime -> ShowS)
-> (MaybePrime -> String)
-> ([MaybePrime] -> ShowS)
-> Show MaybePrime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaybePrime -> ShowS
showsPrec :: Int -> MaybePrime -> ShowS
$cshow :: MaybePrime -> String
show :: MaybePrime -> String
$cshowList :: [MaybePrime] -> ShowS
showList :: [MaybePrime] -> ShowS
Show)
  deriving anyclass (MaybePrime -> ()
(MaybePrime -> ()) -> NFData MaybePrime
forall a. (a -> ()) -> NFData a
$crnf :: MaybePrime -> ()
rnf :: MaybePrime -> ()
NFData)

instance Semigroup MaybePrime where
  MaybePrime
Composite <> :: MaybePrime -> MaybePrime -> MaybePrime
<> MaybePrime
_ = MaybePrime
Composite
  MaybePrime
ProbablyPrime <> MaybePrime
r = MaybePrime
r

instance Monoid MaybePrime where
  mempty :: MaybePrime
mempty = MaybePrime
ProbablyPrime

-- TODO: Turns out, isPrime is slow. For example, isPrime 1_000_003 takes
-- quite a long time. Basic profiling (:set +s in ghci) shows that memory
-- scales with the prime. This is probably much worse than it should be.
--
-- The optional flag arithmoi enables the arithmoi package, which is much
-- faster. But it would be nice if we could improve the default as well.

-- | Tests primality via the Miller-Rabin algorithm with 100 trials. Returns
-- 'Composite' if the number is definitely composite, otherwise
-- 'ProbablyPrime'.
--
-- ==== __Examples__
-- >>> isPrime 7
-- ProbablyPrime
--
-- >>> isPrime 22
-- Composite
--
-- >>> isPrime 373
-- ProbablyPrime
--
-- @since 0.1
isPrime :: Integer -> MaybePrime
#if USE_ARITHMOI
isPrime = isPrimeArithmoi
#else
isPrime :: Integer -> MaybePrime
isPrime = Integer -> MaybePrime
isPrimeDefault
#endif
{-# INLINEABLE isPrime #-}

-- $arithmoi
--
-- By default, our isPrime function implements miller-rabin directly.
-- Unfortunately, the performance scales poorly (this is an issue with our
-- implementation, not miller-rabin). Thus we provide the optional flag
-- @arithmoi@ that instead uses the arithmoi package. Arithmoi is much faster,
-- though it is not a light dependency, hence the option.
--
-- In other words, the flag controls the tradeoff between isPrime speed vs.
-- dependency footprint. So why do we also provide isPrimeDefault and
-- isPrimeArithmoi? Benchmarking. We want to benchmark the difference, hence
-- we need both available when the flag is on.

-- | Uses arithmoi if available, otherwise errors.
isPrimeArithmoi :: Integer -> MaybePrime
#if USE_ARITHMOI
isPrimeArithmoi n =
  if AM.Primes.Testing.isPrime n
    then ProbablyPrime
    else Composite
#else
isPrimeArithmoi :: Integer -> MaybePrime
isPrimeArithmoi =
  String -> Integer -> MaybePrime
forall a. HasCallStack => String -> a
error
    (String -> Integer -> MaybePrime)
-> String -> Integer -> MaybePrime
forall a b. (a -> b) -> a -> b
$ String -> ShowS
errMsg
    String
"Internal.Primality.isPrimeArithmoi"
    String
"arithmoi flag is disabled. Either turn the flag on or use one of isPrime, isPrimeDefault."
#endif

-- | 'isPrimeTrials' with 100 trials.
isPrimeDefault :: Integer -> MaybePrime
isPrimeDefault :: Integer -> MaybePrime
isPrimeDefault = Int -> Integer -> MaybePrime
isPrimeTrials Int
100

-- | 'isPrime' that takes in an additional 'Int' parameter for the number
-- of trials to run. The more trials, the more confident we can be in
-- 'ProbablyPrime'.
--
-- ==== __Examples__
-- >>> isPrimeTrials 1 91
-- ProbablyPrime
--
-- >>> isPrimeTrials 2 91
-- Composite
--
-- Note: False positives can be found via:
--
-- @
-- -- search for \"ProbablyPrime\" after 1 trial in the composite sequence
-- -- for a given prime p
-- counter p = filter ((== ProbablyPrime) . snd) $
--   fmap (\x -> (x, isPrimeTrials 1 x)) [p + p, p + p + p ..]
-- @
--
-- @since 0.1
isPrimeTrials :: Int -> Integer -> MaybePrime
isPrimeTrials :: Int -> Integer -> MaybePrime
isPrimeTrials Int
_ Integer
1 = MaybePrime
Composite
isPrimeTrials Int
_ Integer
2 = MaybePrime
ProbablyPrime
isPrimeTrials Int
numTrials Integer
n
  | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
n = MaybePrime
Composite
  | Bool
otherwise = Modulus -> Int -> MaybePrime
millerRabin (Integer -> Modulus
MkModulus Integer
n) Int
numTrials
{-# INLINEABLE isPrimeTrials #-}

-- $primality-helper
-- For the following functions/types, a core concept is rewriting our \(n\) as
--
-- \[
--   n = 2^r d + 1,
-- \]
--
-- where \(d\) is odd i.e. we have factored out 2 as much as possible.
-- We use newtypes to track these numbers.

-- | Represents a modulus. When testing for primality, this is the \(n\) in
-- \(n = 2^{r} d + 1\).
--
-- @since 0.1
type Modulus :: Type
newtype Modulus = MkModulus Integer
  deriving stock (Modulus -> Modulus -> Bool
(Modulus -> Modulus -> Bool)
-> (Modulus -> Modulus -> Bool) -> Eq Modulus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Modulus -> Modulus -> Bool
== :: Modulus -> Modulus -> Bool
$c/= :: Modulus -> Modulus -> Bool
/= :: Modulus -> Modulus -> Bool
Eq, Int -> Modulus -> ShowS
[Modulus] -> ShowS
Modulus -> String
(Int -> Modulus -> ShowS)
-> (Modulus -> String) -> ([Modulus] -> ShowS) -> Show Modulus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Modulus -> ShowS
showsPrec :: Int -> Modulus -> ShowS
$cshow :: Modulus -> String
show :: Modulus -> String
$cshowList :: [Modulus] -> ShowS
showList :: [Modulus] -> ShowS
Show)
  deriving newtype (Int -> Modulus
Modulus -> Int
Modulus -> [Modulus]
Modulus -> Modulus
Modulus -> Modulus -> [Modulus]
Modulus -> Modulus -> Modulus -> [Modulus]
(Modulus -> Modulus)
-> (Modulus -> Modulus)
-> (Int -> Modulus)
-> (Modulus -> Int)
-> (Modulus -> [Modulus])
-> (Modulus -> Modulus -> [Modulus])
-> (Modulus -> Modulus -> [Modulus])
-> (Modulus -> Modulus -> Modulus -> [Modulus])
-> Enum Modulus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Modulus -> Modulus
succ :: Modulus -> Modulus
$cpred :: Modulus -> Modulus
pred :: Modulus -> Modulus
$ctoEnum :: Int -> Modulus
toEnum :: Int -> Modulus
$cfromEnum :: Modulus -> Int
fromEnum :: Modulus -> Int
$cenumFrom :: Modulus -> [Modulus]
enumFrom :: Modulus -> [Modulus]
$cenumFromThen :: Modulus -> Modulus -> [Modulus]
enumFromThen :: Modulus -> Modulus -> [Modulus]
$cenumFromTo :: Modulus -> Modulus -> [Modulus]
enumFromTo :: Modulus -> Modulus -> [Modulus]
$cenumFromThenTo :: Modulus -> Modulus -> Modulus -> [Modulus]
enumFromThenTo :: Modulus -> Modulus -> Modulus -> [Modulus]
Enum, Enum Modulus
Real Modulus
(Real Modulus, Enum Modulus) =>
(Modulus -> Modulus -> Modulus)
-> (Modulus -> Modulus -> Modulus)
-> (Modulus -> Modulus -> Modulus)
-> (Modulus -> Modulus -> Modulus)
-> (Modulus -> Modulus -> (Modulus, Modulus))
-> (Modulus -> Modulus -> (Modulus, Modulus))
-> (Modulus -> Integer)
-> Integral Modulus
Modulus -> Integer
Modulus -> Modulus -> (Modulus, Modulus)
Modulus -> Modulus -> Modulus
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Modulus -> Modulus -> Modulus
quot :: Modulus -> Modulus -> Modulus
$crem :: Modulus -> Modulus -> Modulus
rem :: Modulus -> Modulus -> Modulus
$cdiv :: Modulus -> Modulus -> Modulus
div :: Modulus -> Modulus -> Modulus
$cmod :: Modulus -> Modulus -> Modulus
mod :: Modulus -> Modulus -> Modulus
$cquotRem :: Modulus -> Modulus -> (Modulus, Modulus)
quotRem :: Modulus -> Modulus -> (Modulus, Modulus)
$cdivMod :: Modulus -> Modulus -> (Modulus, Modulus)
divMod :: Modulus -> Modulus -> (Modulus, Modulus)
$ctoInteger :: Modulus -> Integer
toInteger :: Modulus -> Integer
Integral, Eq Modulus
Eq Modulus =>
(Modulus -> Modulus -> Ordering)
-> (Modulus -> Modulus -> Bool)
-> (Modulus -> Modulus -> Bool)
-> (Modulus -> Modulus -> Bool)
-> (Modulus -> Modulus -> Bool)
-> (Modulus -> Modulus -> Modulus)
-> (Modulus -> Modulus -> Modulus)
-> Ord Modulus
Modulus -> Modulus -> Bool
Modulus -> Modulus -> Ordering
Modulus -> Modulus -> Modulus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Modulus -> Modulus -> Ordering
compare :: Modulus -> Modulus -> Ordering
$c< :: Modulus -> Modulus -> Bool
< :: Modulus -> Modulus -> Bool
$c<= :: Modulus -> Modulus -> Bool
<= :: Modulus -> Modulus -> Bool
$c> :: Modulus -> Modulus -> Bool
> :: Modulus -> Modulus -> Bool
$c>= :: Modulus -> Modulus -> Bool
>= :: Modulus -> Modulus -> Bool
$cmax :: Modulus -> Modulus -> Modulus
max :: Modulus -> Modulus -> Modulus
$cmin :: Modulus -> Modulus -> Modulus
min :: Modulus -> Modulus -> Modulus
Ord, Integer -> Modulus
Modulus -> Modulus
Modulus -> Modulus -> Modulus
(Modulus -> Modulus -> Modulus)
-> (Modulus -> Modulus -> Modulus)
-> (Modulus -> Modulus -> Modulus)
-> (Modulus -> Modulus)
-> (Modulus -> Modulus)
-> (Modulus -> Modulus)
-> (Integer -> Modulus)
-> Num Modulus
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Modulus -> Modulus -> Modulus
+ :: Modulus -> Modulus -> Modulus
$c- :: Modulus -> Modulus -> Modulus
- :: Modulus -> Modulus -> Modulus
$c* :: Modulus -> Modulus -> Modulus
* :: Modulus -> Modulus -> Modulus
$cnegate :: Modulus -> Modulus
negate :: Modulus -> Modulus
$cabs :: Modulus -> Modulus
abs :: Modulus -> Modulus
$csignum :: Modulus -> Modulus
signum :: Modulus -> Modulus
$cfromInteger :: Integer -> Modulus
fromInteger :: Integer -> Modulus
Num, Num Modulus
Ord Modulus
(Num Modulus, Ord Modulus) => (Modulus -> Rational) -> Real Modulus
Modulus -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Modulus -> Rational
toRational :: Modulus -> Rational
Real)

-- GHC 9+ is complaining that "Call of toInteger :: Integer -> Integer can
-- probably be omitted" when deriving Integral for all these types in this
-- module. My guess is the derived instance is generating toInteger for some
-- reason. Until we investigate further, disabling the -Widentities warning
-- is the easiest workaround.

-- | The \(r\) in \(n = 2^{r} d + 1\).
--
-- @since 0.1
type Pow :: Type
newtype Pow = MkPow Integer
  deriving stock (Pow -> Pow -> Bool
(Pow -> Pow -> Bool) -> (Pow -> Pow -> Bool) -> Eq Pow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pow -> Pow -> Bool
== :: Pow -> Pow -> Bool
$c/= :: Pow -> Pow -> Bool
/= :: Pow -> Pow -> Bool
Eq, Int -> Pow -> ShowS
[Pow] -> ShowS
Pow -> String
(Int -> Pow -> ShowS)
-> (Pow -> String) -> ([Pow] -> ShowS) -> Show Pow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pow -> ShowS
showsPrec :: Int -> Pow -> ShowS
$cshow :: Pow -> String
show :: Pow -> String
$cshowList :: [Pow] -> ShowS
showList :: [Pow] -> ShowS
Show, Eq Pow
Eq Pow =>
(Pow -> Pow -> Ordering)
-> (Pow -> Pow -> Bool)
-> (Pow -> Pow -> Bool)
-> (Pow -> Pow -> Bool)
-> (Pow -> Pow -> Bool)
-> (Pow -> Pow -> Pow)
-> (Pow -> Pow -> Pow)
-> Ord Pow
Pow -> Pow -> Bool
Pow -> Pow -> Ordering
Pow -> Pow -> Pow
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pow -> Pow -> Ordering
compare :: Pow -> Pow -> Ordering
$c< :: Pow -> Pow -> Bool
< :: Pow -> Pow -> Bool
$c<= :: Pow -> Pow -> Bool
<= :: Pow -> Pow -> Bool
$c> :: Pow -> Pow -> Bool
> :: Pow -> Pow -> Bool
$c>= :: Pow -> Pow -> Bool
>= :: Pow -> Pow -> Bool
$cmax :: Pow -> Pow -> Pow
max :: Pow -> Pow -> Pow
$cmin :: Pow -> Pow -> Pow
min :: Pow -> Pow -> Pow
Ord)
  deriving (Int -> Pow
Pow -> Int
Pow -> [Pow]
Pow -> Pow
Pow -> Pow -> [Pow]
Pow -> Pow -> Pow -> [Pow]
(Pow -> Pow)
-> (Pow -> Pow)
-> (Int -> Pow)
-> (Pow -> Int)
-> (Pow -> [Pow])
-> (Pow -> Pow -> [Pow])
-> (Pow -> Pow -> [Pow])
-> (Pow -> Pow -> Pow -> [Pow])
-> Enum Pow
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Pow -> Pow
succ :: Pow -> Pow
$cpred :: Pow -> Pow
pred :: Pow -> Pow
$ctoEnum :: Int -> Pow
toEnum :: Int -> Pow
$cfromEnum :: Pow -> Int
fromEnum :: Pow -> Int
$cenumFrom :: Pow -> [Pow]
enumFrom :: Pow -> [Pow]
$cenumFromThen :: Pow -> Pow -> [Pow]
enumFromThen :: Pow -> Pow -> [Pow]
$cenumFromTo :: Pow -> Pow -> [Pow]
enumFromTo :: Pow -> Pow -> [Pow]
$cenumFromThenTo :: Pow -> Pow -> Pow -> [Pow]
enumFromThenTo :: Pow -> Pow -> Pow -> [Pow]
Enum, Enum Pow
Real Pow
(Real Pow, Enum Pow) =>
(Pow -> Pow -> Pow)
-> (Pow -> Pow -> Pow)
-> (Pow -> Pow -> Pow)
-> (Pow -> Pow -> Pow)
-> (Pow -> Pow -> (Pow, Pow))
-> (Pow -> Pow -> (Pow, Pow))
-> (Pow -> Integer)
-> Integral Pow
Pow -> Integer
Pow -> Pow -> (Pow, Pow)
Pow -> Pow -> Pow
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Pow -> Pow -> Pow
quot :: Pow -> Pow -> Pow
$crem :: Pow -> Pow -> Pow
rem :: Pow -> Pow -> Pow
$cdiv :: Pow -> Pow -> Pow
div :: Pow -> Pow -> Pow
$cmod :: Pow -> Pow -> Pow
mod :: Pow -> Pow -> Pow
$cquotRem :: Pow -> Pow -> (Pow, Pow)
quotRem :: Pow -> Pow -> (Pow, Pow)
$cdivMod :: Pow -> Pow -> (Pow, Pow)
divMod :: Pow -> Pow -> (Pow, Pow)
$ctoInteger :: Pow -> Integer
toInteger :: Pow -> Integer
Integral, Integer -> Pow
Pow -> Pow
Pow -> Pow -> Pow
(Pow -> Pow -> Pow)
-> (Pow -> Pow -> Pow)
-> (Pow -> Pow -> Pow)
-> (Pow -> Pow)
-> (Pow -> Pow)
-> (Pow -> Pow)
-> (Integer -> Pow)
-> Num Pow
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Pow -> Pow -> Pow
+ :: Pow -> Pow -> Pow
$c- :: Pow -> Pow -> Pow
- :: Pow -> Pow -> Pow
$c* :: Pow -> Pow -> Pow
* :: Pow -> Pow -> Pow
$cnegate :: Pow -> Pow
negate :: Pow -> Pow
$cabs :: Pow -> Pow
abs :: Pow -> Pow
$csignum :: Pow -> Pow
signum :: Pow -> Pow
$cfromInteger :: Integer -> Pow
fromInteger :: Integer -> Pow
Num, Num Pow
Ord Pow
(Num Pow, Ord Pow) => (Pow -> Rational) -> Real Pow
Pow -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Pow -> Rational
toRational :: Pow -> Rational
Real) via Integer

-- | The \(d\) in \(n = 2^{r} d + 1\).
--
-- @since 0.1
type Mult :: Type
newtype Mult = MkMult Integer
  deriving stock (Mult -> Mult -> Bool
(Mult -> Mult -> Bool) -> (Mult -> Mult -> Bool) -> Eq Mult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mult -> Mult -> Bool
== :: Mult -> Mult -> Bool
$c/= :: Mult -> Mult -> Bool
/= :: Mult -> Mult -> Bool
Eq, Int -> Mult -> ShowS
[Mult] -> ShowS
Mult -> String
(Int -> Mult -> ShowS)
-> (Mult -> String) -> ([Mult] -> ShowS) -> Show Mult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mult -> ShowS
showsPrec :: Int -> Mult -> ShowS
$cshow :: Mult -> String
show :: Mult -> String
$cshowList :: [Mult] -> ShowS
showList :: [Mult] -> ShowS
Show, Eq Mult
Eq Mult =>
(Mult -> Mult -> Ordering)
-> (Mult -> Mult -> Bool)
-> (Mult -> Mult -> Bool)
-> (Mult -> Mult -> Bool)
-> (Mult -> Mult -> Bool)
-> (Mult -> Mult -> Mult)
-> (Mult -> Mult -> Mult)
-> Ord Mult
Mult -> Mult -> Bool
Mult -> Mult -> Ordering
Mult -> Mult -> Mult
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Mult -> Mult -> Ordering
compare :: Mult -> Mult -> Ordering
$c< :: Mult -> Mult -> Bool
< :: Mult -> Mult -> Bool
$c<= :: Mult -> Mult -> Bool
<= :: Mult -> Mult -> Bool
$c> :: Mult -> Mult -> Bool
> :: Mult -> Mult -> Bool
$c>= :: Mult -> Mult -> Bool
>= :: Mult -> Mult -> Bool
$cmax :: Mult -> Mult -> Mult
max :: Mult -> Mult -> Mult
$cmin :: Mult -> Mult -> Mult
min :: Mult -> Mult -> Mult
Ord)
  deriving (Int -> Mult
Mult -> Int
Mult -> [Mult]
Mult -> Mult
Mult -> Mult -> [Mult]
Mult -> Mult -> Mult -> [Mult]
(Mult -> Mult)
-> (Mult -> Mult)
-> (Int -> Mult)
-> (Mult -> Int)
-> (Mult -> [Mult])
-> (Mult -> Mult -> [Mult])
-> (Mult -> Mult -> [Mult])
-> (Mult -> Mult -> Mult -> [Mult])
-> Enum Mult
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Mult -> Mult
succ :: Mult -> Mult
$cpred :: Mult -> Mult
pred :: Mult -> Mult
$ctoEnum :: Int -> Mult
toEnum :: Int -> Mult
$cfromEnum :: Mult -> Int
fromEnum :: Mult -> Int
$cenumFrom :: Mult -> [Mult]
enumFrom :: Mult -> [Mult]
$cenumFromThen :: Mult -> Mult -> [Mult]
enumFromThen :: Mult -> Mult -> [Mult]
$cenumFromTo :: Mult -> Mult -> [Mult]
enumFromTo :: Mult -> Mult -> [Mult]
$cenumFromThenTo :: Mult -> Mult -> Mult -> [Mult]
enumFromThenTo :: Mult -> Mult -> Mult -> [Mult]
Enum, Enum Mult
Real Mult
(Real Mult, Enum Mult) =>
(Mult -> Mult -> Mult)
-> (Mult -> Mult -> Mult)
-> (Mult -> Mult -> Mult)
-> (Mult -> Mult -> Mult)
-> (Mult -> Mult -> (Mult, Mult))
-> (Mult -> Mult -> (Mult, Mult))
-> (Mult -> Integer)
-> Integral Mult
Mult -> Integer
Mult -> Mult -> (Mult, Mult)
Mult -> Mult -> Mult
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Mult -> Mult -> Mult
quot :: Mult -> Mult -> Mult
$crem :: Mult -> Mult -> Mult
rem :: Mult -> Mult -> Mult
$cdiv :: Mult -> Mult -> Mult
div :: Mult -> Mult -> Mult
$cmod :: Mult -> Mult -> Mult
mod :: Mult -> Mult -> Mult
$cquotRem :: Mult -> Mult -> (Mult, Mult)
quotRem :: Mult -> Mult -> (Mult, Mult)
$cdivMod :: Mult -> Mult -> (Mult, Mult)
divMod :: Mult -> Mult -> (Mult, Mult)
$ctoInteger :: Mult -> Integer
toInteger :: Mult -> Integer
Integral, Integer -> Mult
Mult -> Mult
Mult -> Mult -> Mult
(Mult -> Mult -> Mult)
-> (Mult -> Mult -> Mult)
-> (Mult -> Mult -> Mult)
-> (Mult -> Mult)
-> (Mult -> Mult)
-> (Mult -> Mult)
-> (Integer -> Mult)
-> Num Mult
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Mult -> Mult -> Mult
+ :: Mult -> Mult -> Mult
$c- :: Mult -> Mult -> Mult
- :: Mult -> Mult -> Mult
$c* :: Mult -> Mult -> Mult
* :: Mult -> Mult -> Mult
$cnegate :: Mult -> Mult
negate :: Mult -> Mult
$cabs :: Mult -> Mult
abs :: Mult -> Mult
$csignum :: Mult -> Mult
signum :: Mult -> Mult
$cfromInteger :: Integer -> Mult
fromInteger :: Integer -> Mult
Num, Num Mult
Ord Mult
(Num Mult, Ord Mult) => (Mult -> Rational) -> Real Mult
Mult -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Mult -> Rational
toRational :: Mult -> Rational
Real) via Integer

-- | Randomly generated \(m \in [2, n - 2] \) for testing \(n\)'s primality.
--
-- @since 0.1
type Rand :: Type
newtype Rand = MkRand Integer
  deriving stock (Rand -> Rand -> Bool
(Rand -> Rand -> Bool) -> (Rand -> Rand -> Bool) -> Eq Rand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rand -> Rand -> Bool
== :: Rand -> Rand -> Bool
$c/= :: Rand -> Rand -> Bool
/= :: Rand -> Rand -> Bool
Eq, Int -> Rand -> ShowS
[Rand] -> ShowS
Rand -> String
(Int -> Rand -> ShowS)
-> (Rand -> String) -> ([Rand] -> ShowS) -> Show Rand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rand -> ShowS
showsPrec :: Int -> Rand -> ShowS
$cshow :: Rand -> String
show :: Rand -> String
$cshowList :: [Rand] -> ShowS
showList :: [Rand] -> ShowS
Show, Eq Rand
Eq Rand =>
(Rand -> Rand -> Ordering)
-> (Rand -> Rand -> Bool)
-> (Rand -> Rand -> Bool)
-> (Rand -> Rand -> Bool)
-> (Rand -> Rand -> Bool)
-> (Rand -> Rand -> Rand)
-> (Rand -> Rand -> Rand)
-> Ord Rand
Rand -> Rand -> Bool
Rand -> Rand -> Ordering
Rand -> Rand -> Rand
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Rand -> Rand -> Ordering
compare :: Rand -> Rand -> Ordering
$c< :: Rand -> Rand -> Bool
< :: Rand -> Rand -> Bool
$c<= :: Rand -> Rand -> Bool
<= :: Rand -> Rand -> Bool
$c> :: Rand -> Rand -> Bool
> :: Rand -> Rand -> Bool
$c>= :: Rand -> Rand -> Bool
>= :: Rand -> Rand -> Bool
$cmax :: Rand -> Rand -> Rand
max :: Rand -> Rand -> Rand
$cmin :: Rand -> Rand -> Rand
min :: Rand -> Rand -> Rand
Ord)
  deriving (Int -> Rand
Rand -> Int
Rand -> [Rand]
Rand -> Rand
Rand -> Rand -> [Rand]
Rand -> Rand -> Rand -> [Rand]
(Rand -> Rand)
-> (Rand -> Rand)
-> (Int -> Rand)
-> (Rand -> Int)
-> (Rand -> [Rand])
-> (Rand -> Rand -> [Rand])
-> (Rand -> Rand -> [Rand])
-> (Rand -> Rand -> Rand -> [Rand])
-> Enum Rand
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Rand -> Rand
succ :: Rand -> Rand
$cpred :: Rand -> Rand
pred :: Rand -> Rand
$ctoEnum :: Int -> Rand
toEnum :: Int -> Rand
$cfromEnum :: Rand -> Int
fromEnum :: Rand -> Int
$cenumFrom :: Rand -> [Rand]
enumFrom :: Rand -> [Rand]
$cenumFromThen :: Rand -> Rand -> [Rand]
enumFromThen :: Rand -> Rand -> [Rand]
$cenumFromTo :: Rand -> Rand -> [Rand]
enumFromTo :: Rand -> Rand -> [Rand]
$cenumFromThenTo :: Rand -> Rand -> Rand -> [Rand]
enumFromThenTo :: Rand -> Rand -> Rand -> [Rand]
Enum, Enum Rand
Real Rand
(Real Rand, Enum Rand) =>
(Rand -> Rand -> Rand)
-> (Rand -> Rand -> Rand)
-> (Rand -> Rand -> Rand)
-> (Rand -> Rand -> Rand)
-> (Rand -> Rand -> (Rand, Rand))
-> (Rand -> Rand -> (Rand, Rand))
-> (Rand -> Integer)
-> Integral Rand
Rand -> Integer
Rand -> Rand -> (Rand, Rand)
Rand -> Rand -> Rand
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Rand -> Rand -> Rand
quot :: Rand -> Rand -> Rand
$crem :: Rand -> Rand -> Rand
rem :: Rand -> Rand -> Rand
$cdiv :: Rand -> Rand -> Rand
div :: Rand -> Rand -> Rand
$cmod :: Rand -> Rand -> Rand
mod :: Rand -> Rand -> Rand
$cquotRem :: Rand -> Rand -> (Rand, Rand)
quotRem :: Rand -> Rand -> (Rand, Rand)
$cdivMod :: Rand -> Rand -> (Rand, Rand)
divMod :: Rand -> Rand -> (Rand, Rand)
$ctoInteger :: Rand -> Integer
toInteger :: Rand -> Integer
Integral, Integer -> Rand
Rand -> Rand
Rand -> Rand -> Rand
(Rand -> Rand -> Rand)
-> (Rand -> Rand -> Rand)
-> (Rand -> Rand -> Rand)
-> (Rand -> Rand)
-> (Rand -> Rand)
-> (Rand -> Rand)
-> (Integer -> Rand)
-> Num Rand
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Rand -> Rand -> Rand
+ :: Rand -> Rand -> Rand
$c- :: Rand -> Rand -> Rand
- :: Rand -> Rand -> Rand
$c* :: Rand -> Rand -> Rand
* :: Rand -> Rand -> Rand
$cnegate :: Rand -> Rand
negate :: Rand -> Rand
$cabs :: Rand -> Rand
abs :: Rand -> Rand
$csignum :: Rand -> Rand
signum :: Rand -> Rand
$cfromInteger :: Integer -> Rand
fromInteger :: Integer -> Rand
Num, Num Rand
Ord Rand
(Num Rand, Ord Rand) => (Rand -> Rational) -> Real Rand
Rand -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Rand -> Rational
toRational :: Rand -> Rational
Real) via Integer

-- | @since 0.1
instance UniformRange Rand where
  uniformRM :: forall g (m :: Type -> Type).
StatefulGen g m =>
(Rand, Rand) -> g -> m Rand
uniformRM (MkRand Integer
l, MkRand Integer
u) = (Integer -> Rand) -> m Integer -> m Rand
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Rand
MkRand (m Integer -> m Rand) -> (g -> m Integer) -> g -> m Rand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Integer) -> g -> m Integer
forall a g (m :: Type -> Type).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: Type -> Type).
StatefulGen g m =>
(Integer, Integer) -> g -> m Integer
RandState.uniformRM (Integer
l, Integer
u)
  {-# INLINEABLE uniformRM #-}

-- | Miller-Rabin algorithm. Takes in the \(n\) to be tested and the number
-- of trials to perform. The higher the trials, the higher our confidence
-- in 'ProbablyPrime'.
millerRabin :: Modulus -> Int -> MaybePrime
millerRabin :: Modulus -> Int -> MaybePrime
millerRabin Modulus
2 = MaybePrime -> Int -> MaybePrime
forall a b. a -> b -> a
const MaybePrime
ProbablyPrime
millerRabin modulus :: Modulus
modulus@(MkModulus Integer
n) = StdGen -> Int -> MaybePrime
go StdGen
gen
  where
    gen :: StdGen
gen = Int -> StdGen
Rand.mkStdGen Int
373
    powMult :: (Pow, Mult)
powMult = Modulus -> (Pow, Mult)
factor2 (Modulus
modulus Modulus -> Modulus -> Modulus
forall a. Num a => a -> a -> a
- Modulus
1)
    range :: StateGenM StdGen -> StateT StdGen Identity Rand
range = (Rand, Rand) -> StateGenM StdGen -> StateT StdGen Identity Rand
forall a g (m :: Type -> Type).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: Type -> Type).
StatefulGen g m =>
(Rand, Rand) -> g -> m Rand
RandState.uniformRM (Rand
2, Integer -> Rand
MkRand (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2))

    go :: StdGen -> Int -> MaybePrime
go StdGen
_ Int
0 = MaybePrime
ProbablyPrime
    go StdGen
g !Int
k =
      let (Rand
randomVal, StdGen
g') = StdGen
-> (StateGenM StdGen -> StateT StdGen Identity Rand)
-> (Rand, StdGen)
forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
RandState.runStateGen StdGen
g StateGenM StdGen -> StateT StdGen Identity Rand
range
       in case Modulus -> (Pow, Mult) -> Rand -> MaybePrime
trial Modulus
modulus (Pow, Mult)
powMult Rand
randomVal of
            MaybePrime
Composite -> MaybePrime
Composite
            MaybePrime
ProbablyPrime -> StdGen -> Int -> MaybePrime
go StdGen
g' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINEABLE millerRabin #-}

-- | For \(n, r, d, x\) with \(n = 2^{r} d + 1\) and \(x \in [2, n - 2] \),
-- returns 'Composite' if \(n\) is definitely composite, 'ProbablyPrime'
-- otherwise.
--
-- ==== __Examples__
-- >>> trial 12 (factor2 (12 - 1)) 3
-- Composite
--
-- >>> trial 7 (factor2 (7 - 1)) 3
-- ProbablyPrime
--
-- @since 0.1
trial :: Modulus -> (Pow, Mult) -> Rand -> MaybePrime
trial :: Modulus -> (Pow, Mult) -> Rand -> MaybePrime
trial modulus :: Modulus
modulus@(MkModulus Integer
n) (Pow
r, Mult
d) (MkRand Integer
a)
  -- x = 1 or n - 1 -> skip
  | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 = MaybePrime
ProbablyPrime
  -- if we found a witness then n is definitely composite
  | Bool
otherwise = Modulus -> Pow -> Rand -> MaybePrime
isWitness Modulus
modulus Pow
r (Integer -> Rand
MkRand Integer
x)
  where
    x :: Integer
x = Integer
a Integer -> Mult -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Mult
d Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n
{-# INLINEABLE trial #-}

-- | For \(n, r, x\) with \(n = 2^{r} d + 1\) and some
-- \(x \equiv a^d \pmod n \), returns 'Composite' if \(x\) is a witness to
-- \(n\) being composite. Otherwise returns 'ProbablyPrime'.
--
-- ==== __Examples__
-- >>> let (pow, mult) = factor2 (12 - 1)
-- >>> let testVal = 3 ^ mult `mod` 12
-- >>> isWitness 12 pow testVal
-- Composite
--
-- >>> let (pow, mult) = factor2 (7 - 1)
-- >>> let testVal = 3 ^ mult `mod` 7
-- >>> isWitness 7 pow testVal
-- ProbablyPrime
--
-- @since 0.1
isWitness :: Modulus -> Pow -> Rand -> MaybePrime
isWitness :: Modulus -> Pow -> Rand -> MaybePrime
isWitness modulus :: Modulus
modulus@(MkModulus Integer
n) Pow
r (MkRand Integer
x) = Bool -> MaybePrime
coprimeToResult Bool
coprime
  where
    squares :: [Integer]
squares = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Pow -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pow
r) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Modulus -> Integer -> [Integer]
sqProgression Modulus
modulus Integer
x
    coprime :: Bool
coprime = (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> [Integer] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Integer]
squares
    coprimeToResult :: Bool -> MaybePrime
coprimeToResult Bool
True = MaybePrime
ProbablyPrime
    coprimeToResult Bool
False = MaybePrime
Composite
{-# INLINEABLE isWitness #-}

-- | For \(n, x\), returns the infinite progression
--
-- \[
-- x, x^2, x^4, x^8, \ldots \pmod n.
-- \]
--
-- ==== __Examples__
-- >>> take 5 $ sqProgression 7 3
-- [3,2,4,2,4]
--
-- @since 0.1
sqProgression :: Modulus -> Integer -> [Integer]
sqProgression :: Modulus -> Integer -> [Integer]
sqProgression (MkModulus Integer
n) = Integer -> [Integer]
go
  where
    go :: Integer -> [Integer]
go !Integer
y = Integer
y Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer]
go (Integer
y Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n)
{-# INLINEABLE sqProgression #-}

-- | Given \(n\), returns \((r, d)\) such that \(n = 2^r d\) with \(d\) odd
-- i.e. \(2\) has been factored out.
--
-- ==== __Examples__
-- >>> factor2 7
-- (MkPow 0,MkMult 7)
--
-- >>> factor2 8
-- (MkPow 3,MkMult 1)
--
-- >>> factor2 20
-- (MkPow 2,MkMult 5)
--
-- @since 0.1
factor2 :: Modulus -> (Pow, Mult)
factor2 :: Modulus -> (Pow, Mult)
factor2 (MkModulus Integer
n) = (Pow, Mult) -> (Pow, Mult)
forall {b} {a}. (Num a, Integral b) => (a, b) -> (a, b)
go (Integer -> Pow
MkPow Integer
0, Integer -> Mult
MkMult Integer
n)
  where
    go :: (a, b) -> (a, b)
go (!a
r, !b
d)
      | b
d b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
2 = (a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
1)
      | b -> Bool
forall a. Integral a => a -> Bool
even b
d = (a, b) -> (a, b)
go (a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
d b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
2)
      | Bool
otherwise = (a
r, b
d)
{-# INLINEABLE factor2 #-}

{- ORMOLU_DISABLE -}

-- | Finds the multiplicative inverse.
invert :: forall p. (KnownNat p) => Natural -> Natural
#if USE_ARITHMOI
invert = invertArithmoi @p
#else
invert :: forall (p :: Nat). KnownNat p => Nat -> Nat
invert = forall (p :: Nat). KnownNat p => Nat -> Nat
invertDefault @p
#endif
{-# INLINEABLE invert #-}

-- | Finds the multiplicative inverse with arithmoi if available, otherwise
-- errors.
invertArithmoi :: forall p. (KnownNat p) => Natural -> Natural
#if USE_ARITHMOI
invertArithmoi d =
  case Mod.invertMod (fromIntegral d :: Mod p) of
    Nothing ->
      error
        $ errMsg
            ".Internal.Primality.invert"
            ("Could not find inverse of " ++ (show d) ++ " (mod " ++ show p' ++ ")")
    Just n -> Mod.unMod n
  where
    p' = natVal @p Proxy
#else
invertArithmoi :: forall (p :: Nat). KnownNat p => Nat -> Nat
invertArithmoi =
  String -> Nat -> Nat
forall a. HasCallStack => String -> a
error
    (String -> Nat -> Nat) -> String -> Nat -> Nat
forall a b. (a -> b) -> a -> b
$ String -> ShowS
errMsg
    String
"Internal.Primality.invertArithmoi"
    String
"arithmoi flag is disabled. Either turn the flag on or use one of invert, invertDefault."
#endif

-- | Finds the multiplicative inverse using the built-in algorithm.
invertDefault :: forall p. (KnownNat p) => Natural -> Natural
invertDefault :: forall (p :: Nat). KnownNat p => Nat -> Nat
invertDefault Nat
d = Integer -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Nat) -> Integer -> Nat
forall a b. (a -> b) -> a -> b
$ Integer -> Modulus -> Integer
findInverse Integer
d' Modulus
p'
  where
    p' :: Modulus
p' = Integer -> Modulus
MkModulus (Integer -> Modulus) -> Integer -> Modulus
forall a b. (a -> b) -> a -> b
$ Nat -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Integer) -> Nat -> Integer
forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Nat
natVal @p Proxy p
forall {k} (t :: k). Proxy t
Proxy
    d' :: Integer
d' = Nat -> Integer
forall a. Integral a => a -> Integer
toInteger Nat
d

{- ORMOLU_ENABLE -}

-- | For \(a, p\), finds the multiplicative inverse of \(a\) in
-- \(\mathbb{Z}/p\mathbb{Z}\). That is, finds /e/ such that
--
-- \[
-- ae \equiv 1 \pmod p.
-- \]
--
-- Note: The returned \(e\) is only an inverse when \(a\) and \(p\) are
-- coprime i.e. \((a,p) = 1\). Of course this is guaranteed when \(p\) is
-- prime and \(0 < a < p \), but it otherwise not true in general.
--
-- Also, this function requires division, it is partial when
-- the modulus is 0.
--
-- @since 0.1
findInverse :: Integer -> Modulus -> Integer
findInverse :: Integer -> Modulus -> Integer
findInverse Integer
a (MkModulus Integer
p) = Integer
aInv Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p
  where
    (MkBezout R
_ S
_ (T' Integer
aInv)) = Integer -> Integer -> Bezout
eec Integer
p Integer
a
{-# INLINEABLE findInverse #-}

-- | @since 0.1
findBezout :: Integer -> Modulus -> Bezout
findBezout :: Integer -> Modulus -> Bezout
findBezout Integer
a (MkModulus Integer
p) = Integer -> Integer -> Bezout
eec Integer
p Integer
a
{-# INLINEABLE findBezout #-}

-- | @since 0.1t
type Bezout :: Type
data Bezout = MkBezout
  { Bezout -> R
bzGcd :: !R,
    Bezout -> S
bzS :: !S,
    Bezout -> T
bzT :: !T
  }
  deriving stock (Bezout -> Bezout -> Bool
(Bezout -> Bezout -> Bool)
-> (Bezout -> Bezout -> Bool) -> Eq Bezout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bezout -> Bezout -> Bool
== :: Bezout -> Bezout -> Bool
$c/= :: Bezout -> Bezout -> Bool
/= :: Bezout -> Bezout -> Bool
Eq, Int -> Bezout -> ShowS
[Bezout] -> ShowS
Bezout -> String
(Int -> Bezout -> ShowS)
-> (Bezout -> String) -> ([Bezout] -> ShowS) -> Show Bezout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bezout -> ShowS
showsPrec :: Int -> Bezout -> ShowS
$cshow :: Bezout -> String
show :: Bezout -> String
$cshowList :: [Bezout] -> ShowS
showList :: [Bezout] -> ShowS
Show)

-- | @since 0.1
type R :: Type
newtype R = R' Integer
  deriving stock (R -> R -> Bool
(R -> R -> Bool) -> (R -> R -> Bool) -> Eq R
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: R -> R -> Bool
== :: R -> R -> Bool
$c/= :: R -> R -> Bool
/= :: R -> R -> Bool
Eq, Int -> R -> ShowS
[R] -> ShowS
R -> String
(Int -> R -> ShowS) -> (R -> String) -> ([R] -> ShowS) -> Show R
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> R -> ShowS
showsPrec :: Int -> R -> ShowS
$cshow :: R -> String
show :: R -> String
$cshowList :: [R] -> ShowS
showList :: [R] -> ShowS
Show, Eq R
Eq R =>
(R -> R -> Ordering)
-> (R -> R -> Bool)
-> (R -> R -> Bool)
-> (R -> R -> Bool)
-> (R -> R -> Bool)
-> (R -> R -> R)
-> (R -> R -> R)
-> Ord R
R -> R -> Bool
R -> R -> Ordering
R -> R -> R
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: R -> R -> Ordering
compare :: R -> R -> Ordering
$c< :: R -> R -> Bool
< :: R -> R -> Bool
$c<= :: R -> R -> Bool
<= :: R -> R -> Bool
$c> :: R -> R -> Bool
> :: R -> R -> Bool
$c>= :: R -> R -> Bool
>= :: R -> R -> Bool
$cmax :: R -> R -> R
max :: R -> R -> R
$cmin :: R -> R -> R
min :: R -> R -> R
Ord)
  deriving (Int -> R
R -> Int
R -> [R]
R -> R
R -> R -> [R]
R -> R -> R -> [R]
(R -> R)
-> (R -> R)
-> (Int -> R)
-> (R -> Int)
-> (R -> [R])
-> (R -> R -> [R])
-> (R -> R -> [R])
-> (R -> R -> R -> [R])
-> Enum R
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: R -> R
succ :: R -> R
$cpred :: R -> R
pred :: R -> R
$ctoEnum :: Int -> R
toEnum :: Int -> R
$cfromEnum :: R -> Int
fromEnum :: R -> Int
$cenumFrom :: R -> [R]
enumFrom :: R -> [R]
$cenumFromThen :: R -> R -> [R]
enumFromThen :: R -> R -> [R]
$cenumFromTo :: R -> R -> [R]
enumFromTo :: R -> R -> [R]
$cenumFromThenTo :: R -> R -> R -> [R]
enumFromThenTo :: R -> R -> R -> [R]
Enum, Enum R
Real R
(Real R, Enum R) =>
(R -> R -> R)
-> (R -> R -> R)
-> (R -> R -> R)
-> (R -> R -> R)
-> (R -> R -> (R, R))
-> (R -> R -> (R, R))
-> (R -> Integer)
-> Integral R
R -> Integer
R -> R -> (R, R)
R -> R -> R
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: R -> R -> R
quot :: R -> R -> R
$crem :: R -> R -> R
rem :: R -> R -> R
$cdiv :: R -> R -> R
div :: R -> R -> R
$cmod :: R -> R -> R
mod :: R -> R -> R
$cquotRem :: R -> R -> (R, R)
quotRem :: R -> R -> (R, R)
$cdivMod :: R -> R -> (R, R)
divMod :: R -> R -> (R, R)
$ctoInteger :: R -> Integer
toInteger :: R -> Integer
Integral, Integer -> R
R -> R
R -> R -> R
(R -> R -> R)
-> (R -> R -> R)
-> (R -> R -> R)
-> (R -> R)
-> (R -> R)
-> (R -> R)
-> (Integer -> R)
-> Num R
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: R -> R -> R
+ :: R -> R -> R
$c- :: R -> R -> R
- :: R -> R -> R
$c* :: R -> R -> R
* :: R -> R -> R
$cnegate :: R -> R
negate :: R -> R
$cabs :: R -> R
abs :: R -> R
$csignum :: R -> R
signum :: R -> R
$cfromInteger :: Integer -> R
fromInteger :: Integer -> R
Num, Num R
Ord R
(Num R, Ord R) => (R -> Rational) -> Real R
R -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: R -> Rational
toRational :: R -> Rational
Real) via Integer

-- | @since 0.1
type S :: Type
newtype S = S' Integer
  deriving stock (S -> S -> Bool
(S -> S -> Bool) -> (S -> S -> Bool) -> Eq S
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: S -> S -> Bool
== :: S -> S -> Bool
$c/= :: S -> S -> Bool
/= :: S -> S -> Bool
Eq, Int -> S -> ShowS
[S] -> ShowS
S -> String
(Int -> S -> ShowS) -> (S -> String) -> ([S] -> ShowS) -> Show S
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> S -> ShowS
showsPrec :: Int -> S -> ShowS
$cshow :: S -> String
show :: S -> String
$cshowList :: [S] -> ShowS
showList :: [S] -> ShowS
Show, Eq S
Eq S =>
(S -> S -> Ordering)
-> (S -> S -> Bool)
-> (S -> S -> Bool)
-> (S -> S -> Bool)
-> (S -> S -> Bool)
-> (S -> S -> S)
-> (S -> S -> S)
-> Ord S
S -> S -> Bool
S -> S -> Ordering
S -> S -> S
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: S -> S -> Ordering
compare :: S -> S -> Ordering
$c< :: S -> S -> Bool
< :: S -> S -> Bool
$c<= :: S -> S -> Bool
<= :: S -> S -> Bool
$c> :: S -> S -> Bool
> :: S -> S -> Bool
$c>= :: S -> S -> Bool
>= :: S -> S -> Bool
$cmax :: S -> S -> S
max :: S -> S -> S
$cmin :: S -> S -> S
min :: S -> S -> S
Ord)
  deriving (Int -> S
S -> Int
S -> [S]
S -> S
S -> S -> [S]
S -> S -> S -> [S]
(S -> S)
-> (S -> S)
-> (Int -> S)
-> (S -> Int)
-> (S -> [S])
-> (S -> S -> [S])
-> (S -> S -> [S])
-> (S -> S -> S -> [S])
-> Enum S
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: S -> S
succ :: S -> S
$cpred :: S -> S
pred :: S -> S
$ctoEnum :: Int -> S
toEnum :: Int -> S
$cfromEnum :: S -> Int
fromEnum :: S -> Int
$cenumFrom :: S -> [S]
enumFrom :: S -> [S]
$cenumFromThen :: S -> S -> [S]
enumFromThen :: S -> S -> [S]
$cenumFromTo :: S -> S -> [S]
enumFromTo :: S -> S -> [S]
$cenumFromThenTo :: S -> S -> S -> [S]
enumFromThenTo :: S -> S -> S -> [S]
Enum, Enum S
Real S
(Real S, Enum S) =>
(S -> S -> S)
-> (S -> S -> S)
-> (S -> S -> S)
-> (S -> S -> S)
-> (S -> S -> (S, S))
-> (S -> S -> (S, S))
-> (S -> Integer)
-> Integral S
S -> Integer
S -> S -> (S, S)
S -> S -> S
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: S -> S -> S
quot :: S -> S -> S
$crem :: S -> S -> S
rem :: S -> S -> S
$cdiv :: S -> S -> S
div :: S -> S -> S
$cmod :: S -> S -> S
mod :: S -> S -> S
$cquotRem :: S -> S -> (S, S)
quotRem :: S -> S -> (S, S)
$cdivMod :: S -> S -> (S, S)
divMod :: S -> S -> (S, S)
$ctoInteger :: S -> Integer
toInteger :: S -> Integer
Integral, Integer -> S
S -> S
S -> S -> S
(S -> S -> S)
-> (S -> S -> S)
-> (S -> S -> S)
-> (S -> S)
-> (S -> S)
-> (S -> S)
-> (Integer -> S)
-> Num S
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: S -> S -> S
+ :: S -> S -> S
$c- :: S -> S -> S
- :: S -> S -> S
$c* :: S -> S -> S
* :: S -> S -> S
$cnegate :: S -> S
negate :: S -> S
$cabs :: S -> S
abs :: S -> S
$csignum :: S -> S
signum :: S -> S
$cfromInteger :: Integer -> S
fromInteger :: Integer -> S
Num, Num S
Ord S
(Num S, Ord S) => (S -> Rational) -> Real S
S -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: S -> Rational
toRational :: S -> Rational
Real) via Integer

-- | @since 0.1
type T :: Type
newtype T = T' Integer
  deriving stock (T -> T -> Bool
(T -> T -> Bool) -> (T -> T -> Bool) -> Eq T
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: T -> T -> Bool
== :: T -> T -> Bool
$c/= :: T -> T -> Bool
/= :: T -> T -> Bool
Eq, Int -> T -> ShowS
[T] -> ShowS
T -> String
(Int -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> T -> ShowS
showsPrec :: Int -> T -> ShowS
$cshow :: T -> String
show :: T -> String
$cshowList :: [T] -> ShowS
showList :: [T] -> ShowS
Show, Eq T
Eq T =>
(T -> T -> Ordering)
-> (T -> T -> Bool)
-> (T -> T -> Bool)
-> (T -> T -> Bool)
-> (T -> T -> Bool)
-> (T -> T -> T)
-> (T -> T -> T)
-> Ord T
T -> T -> Bool
T -> T -> Ordering
T -> T -> T
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: T -> T -> Ordering
compare :: T -> T -> Ordering
$c< :: T -> T -> Bool
< :: T -> T -> Bool
$c<= :: T -> T -> Bool
<= :: T -> T -> Bool
$c> :: T -> T -> Bool
> :: T -> T -> Bool
$c>= :: T -> T -> Bool
>= :: T -> T -> Bool
$cmax :: T -> T -> T
max :: T -> T -> T
$cmin :: T -> T -> T
min :: T -> T -> T
Ord)
  deriving (Int -> T
T -> Int
T -> [T]
T -> T
T -> T -> [T]
T -> T -> T -> [T]
(T -> T)
-> (T -> T)
-> (Int -> T)
-> (T -> Int)
-> (T -> [T])
-> (T -> T -> [T])
-> (T -> T -> [T])
-> (T -> T -> T -> [T])
-> Enum T
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: T -> T
succ :: T -> T
$cpred :: T -> T
pred :: T -> T
$ctoEnum :: Int -> T
toEnum :: Int -> T
$cfromEnum :: T -> Int
fromEnum :: T -> Int
$cenumFrom :: T -> [T]
enumFrom :: T -> [T]
$cenumFromThen :: T -> T -> [T]
enumFromThen :: T -> T -> [T]
$cenumFromTo :: T -> T -> [T]
enumFromTo :: T -> T -> [T]
$cenumFromThenTo :: T -> T -> T -> [T]
enumFromThenTo :: T -> T -> T -> [T]
Enum, Enum T
Real T
(Real T, Enum T) =>
(T -> T -> T)
-> (T -> T -> T)
-> (T -> T -> T)
-> (T -> T -> T)
-> (T -> T -> (T, T))
-> (T -> T -> (T, T))
-> (T -> Integer)
-> Integral T
T -> Integer
T -> T -> (T, T)
T -> T -> T
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: T -> T -> T
quot :: T -> T -> T
$crem :: T -> T -> T
rem :: T -> T -> T
$cdiv :: T -> T -> T
div :: T -> T -> T
$cmod :: T -> T -> T
mod :: T -> T -> T
$cquotRem :: T -> T -> (T, T)
quotRem :: T -> T -> (T, T)
$cdivMod :: T -> T -> (T, T)
divMod :: T -> T -> (T, T)
$ctoInteger :: T -> Integer
toInteger :: T -> Integer
Integral, Integer -> T
T -> T
T -> T -> T
(T -> T -> T)
-> (T -> T -> T)
-> (T -> T -> T)
-> (T -> T)
-> (T -> T)
-> (T -> T)
-> (Integer -> T)
-> Num T
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: T -> T -> T
+ :: T -> T -> T
$c- :: T -> T -> T
- :: T -> T -> T
$c* :: T -> T -> T
* :: T -> T -> T
$cnegate :: T -> T
negate :: T -> T
$cabs :: T -> T
abs :: T -> T
$csignum :: T -> T
signum :: T -> T
$cfromInteger :: Integer -> T
fromInteger :: Integer -> T
Num, Num T
Ord T
(Num T, Ord T) => (T -> Rational) -> Real T
T -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: T -> Rational
toRational :: T -> Rational
Real) via Integer

-- Solves for Bezout's identity using the extended euclidean algorithm:
-- https://en.wikipedia.org/wiki/Extended_Euclidean_algorithm#Pseudocode
eec :: Integer -> Integer -> Bezout
eec :: Integer -> Integer -> Bezout
eec Integer
a Integer
b = R -> R -> S -> S -> T -> T -> Bezout
go R
initOldR R
initR S
initOldS S
initS T
initOldT T
initT
  where
    (R
initOldR, R
initR) = (Integer -> R
R' Integer
a, Integer -> R
R' Integer
b)
    (S
initOldS, S
initS) = (Integer -> S
S' Integer
1, Integer -> S
S' Integer
0)
    (T
initOldT, T
initT) = (Integer -> T
T' Integer
0, Integer -> T
T' Integer
1)

    go :: R -> R -> S -> S -> T -> T -> Bezout
go R
oldR R
0 S
oldS S
_ T
oldT T
_ = R -> S -> T -> Bezout
MkBezout R
oldR S
oldS T
oldT
    go !R
oldR !R
r !S
oldS !S
s !T
oldT !T
t =
      let oldR' :: R
oldR' = R
r
          oldS' :: S
oldS' = S
s
          oldT' :: T
oldT' = T
t
          (R' Integer
q, R
r') = R
oldR R -> R -> (R, R)
forall a. Integral a => a -> a -> (a, a)
`quotRem` R
r
          s' :: S
s' = S
oldS S -> S -> S
forall a. Num a => a -> a -> a
- Integer -> S
S' Integer
q S -> S -> S
forall a. Num a => a -> a -> a
* S
s
          t' :: T
t' = T
oldT T -> T -> T
forall a. Num a => a -> a -> a
- Integer -> T
T' Integer
q T -> T -> T
forall a. Num a => a -> a -> a
* T
t
       in R -> R -> S -> S -> T -> T -> Bezout
go R
oldR' R
r' S
oldS' S
s' T
oldT' T
t'
{-# INLINEABLE eec #-}

-- | @since 0.1
errMsg :: String -> String -> String
errMsg :: String -> ShowS
errMsg String
fn String
msg =
  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
"Numeric.Data.ModP.",
      String
fn,
      String
": ",
      String
msg
    ]