{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Math.NumberTheory.Moduli.Multiplicative
(
MultMod
, multElement
, isMultElement
, invertGroup
, 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
newtype MultMod m = MultMod {
forall (m :: Nat). MultMod m -> Mod m
multElement :: Mod m
} deriving (MultMod m -> MultMod m -> Bool
forall (m :: Nat). MultMod m -> MultMod m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultMod m -> MultMod m -> Bool
$c/= :: forall (m :: Nat). MultMod m -> MultMod m -> Bool
== :: MultMod m -> MultMod m -> Bool
$c== :: forall (m :: Nat). MultMod m -> MultMod m -> Bool
Eq, MultMod m -> MultMod m -> Bool
MultMod m -> MultMod m -> Ordering
MultMod m -> MultMod m -> MultMod m
forall (m :: Nat). Eq (MultMod m)
forall (m :: Nat). MultMod m -> MultMod m -> Bool
forall (m :: Nat). MultMod m -> MultMod m -> Ordering
forall (m :: Nat). MultMod m -> MultMod m -> MultMod m
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
min :: MultMod m -> MultMod m -> MultMod m
$cmin :: forall (m :: Nat). MultMod m -> MultMod m -> MultMod m
max :: MultMod m -> MultMod m -> MultMod m
$cmax :: forall (m :: Nat). MultMod m -> MultMod m -> MultMod m
>= :: MultMod m -> MultMod m -> Bool
$c>= :: forall (m :: Nat). MultMod m -> MultMod m -> Bool
> :: MultMod m -> MultMod m -> Bool
$c> :: forall (m :: Nat). MultMod m -> MultMod m -> Bool
<= :: MultMod m -> MultMod m -> Bool
$c<= :: forall (m :: Nat). MultMod m -> MultMod m -> Bool
< :: MultMod m -> MultMod m -> Bool
$c< :: forall (m :: Nat). MultMod m -> MultMod m -> Bool
compare :: MultMod m -> MultMod m -> Ordering
$ccompare :: forall (m :: Nat). MultMod m -> MultMod m -> Ordering
Ord, Int -> MultMod m -> ShowS
forall (m :: Nat). Int -> MultMod m -> ShowS
forall (m :: Nat). [MultMod m] -> ShowS
forall (m :: Nat). MultMod m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultMod m] -> ShowS
$cshowList :: forall (m :: Nat). [MultMod m] -> ShowS
show :: MultMod m -> String
$cshow :: forall (m :: Nat). MultMod m -> String
showsPrec :: Int -> MultMod m -> ShowS
$cshowsPrec :: forall (m :: Nat). Int -> MultMod m -> ShowS
Show)
instance KnownNat m => Semigroup (MultMod m) where
MultMod Mod m
a <> :: MultMod m -> MultMod m -> MultMod m
<> MultMod Mod m
b = forall (m :: Nat). Mod m -> MultMod m
MultMod (Mod m
a forall a. Num a => a -> a -> a
* Mod m
b)
stimes :: forall b. Integral b => b -> MultMod m -> MultMod m
stimes b
k a :: MultMod m
a@(MultMod Mod m
a')
| b
k forall a. Ord a => a -> a -> Bool
>= b
0 = forall (m :: Nat). Mod m -> MultMod m
MultMod (Mod m
a' forall (m :: Nat) a.
(KnownNat m, Integral a) =>
Mod m -> a -> Mod m
^% b
k)
| Bool
otherwise = forall (m :: Nat). KnownNat m => MultMod m -> MultMod m
invertGroup forall a b. (a -> b) -> a -> b
$ forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (-b
k) MultMod m
a
instance KnownNat m => Monoid (MultMod m) where
mempty :: MultMod m
mempty = forall (m :: Nat). Mod m -> MultMod m
MultMod Mod m
1
mappend :: MultMod m -> MultMod m -> MultMod m
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance KnownNat m => Bounded (MultMod m) where
minBound :: MultMod m
minBound = forall (m :: Nat). Mod m -> MultMod m
MultMod Mod m
1
maxBound :: MultMod m
maxBound = forall (m :: Nat). Mod m -> MultMod m
MultMod (-Mod m
1)
isMultElement :: KnownNat m => Mod m -> Maybe (MultMod m)
isMultElement :: forall (m :: Nat). KnownNat m => Mod m -> Maybe (MultMod m)
isMultElement Mod m
a = if forall (m :: Nat). Mod m -> Nat
unMod Mod m
a forall a. Integral a => a -> a -> a
`gcd` forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal Mod m
a forall a. Eq a => a -> a -> Bool
== Nat
1
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: Nat). Mod m -> MultMod m
MultMod Mod m
a
else forall a. Maybe a
Nothing
invertGroup :: KnownNat m => MultMod m -> MultMod m
invertGroup :: forall (m :: Nat). KnownNat m => MultMod m -> MultMod m
invertGroup (MultMod Mod m
a) = case forall (m :: Nat). KnownNat m => Mod m -> Maybe (Mod m)
invertMod Mod m
a of
Just Mod m
b -> forall (m :: Nat). Mod m -> MultMod m
MultMod Mod m
b
Maybe (Mod m)
Nothing -> forall a. HasCallStack => String -> a
error String
"Math.NumberTheory.Moduli.invertGroup: failed to invert element"
newtype PrimitiveRoot m = PrimitiveRoot
{ forall (m :: Nat). PrimitiveRoot m -> MultMod m
unPrimitiveRoot :: MultMod m
}
deriving (PrimitiveRoot m -> PrimitiveRoot m -> Bool
forall (m :: Nat). PrimitiveRoot m -> PrimitiveRoot m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimitiveRoot m -> PrimitiveRoot m -> Bool
$c/= :: forall (m :: Nat). PrimitiveRoot m -> PrimitiveRoot m -> Bool
== :: PrimitiveRoot m -> PrimitiveRoot m -> Bool
$c== :: forall (m :: Nat). PrimitiveRoot m -> PrimitiveRoot m -> Bool
Eq, Int -> PrimitiveRoot m -> ShowS
forall (m :: Nat). Int -> PrimitiveRoot m -> ShowS
forall (m :: Nat). [PrimitiveRoot m] -> ShowS
forall (m :: Nat). PrimitiveRoot m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimitiveRoot m] -> ShowS
$cshowList :: forall (m :: Nat). [PrimitiveRoot m] -> ShowS
show :: PrimitiveRoot m -> String
$cshow :: forall (m :: Nat). PrimitiveRoot m -> String
showsPrec :: Int -> PrimitiveRoot m -> ShowS
$cshowsPrec :: forall (m :: Nat). Int -> PrimitiveRoot m -> ShowS
Show)
isPrimitiveRoot
:: (Integral a, UniqueFactorisation a)
=> CyclicGroup a m
-> Mod m
-> Maybe (PrimitiveRoot m)
isPrimitiveRoot :: forall a (m :: Nat).
(Integral a, UniqueFactorisation a) =>
CyclicGroup a m -> Mod m -> Maybe (PrimitiveRoot m)
isPrimitiveRoot CyclicGroup a m
cg Mod m
r = case forall a (m :: Nat).
Integral a =>
CyclicGroup a m -> (() :: Constraint) :- KnownNat m
proofFromCyclicGroup CyclicGroup a m
cg of
Sub Dict (KnownNat m)
(() :: Constraint) => Dict (KnownNat m)
Dict -> do
MultMod m
r' <- forall (m :: Nat). KnownNat m => Mod m -> Maybe (MultMod m)
isMultElement Mod m
r
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a (m :: Nat).
(Integral a, UniqueFactorisation a) =>
CyclicGroup a m -> a -> Bool
isPrimitiveRoot' CyclicGroup a m
cg (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (m :: Nat). Mod m -> Nat
unMod Mod m
r))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Nat). MultMod m -> PrimitiveRoot m
PrimitiveRoot MultMod m
r'
discreteLogarithm :: CyclicGroup Integer m -> PrimitiveRoot m -> MultMod m -> Natural
discreteLogarithm :: forall (m :: Nat).
CyclicGroup Integer m -> PrimitiveRoot m -> MultMod m -> Nat
discreteLogarithm CyclicGroup Integer m
cg (forall (m :: Nat). MultMod m -> Mod m
multElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Nat). PrimitiveRoot m -> MultMod m
unPrimitiveRoot -> Mod m
a) (forall (m :: Nat). MultMod m -> Mod m
multElement -> Mod m
b) = case CyclicGroup Integer m
cg of
CyclicGroup Integer m
CG2
-> Nat
0
CyclicGroup Integer m
CG4
-> if forall (m :: Nat). Mod m -> Nat
unMod Mod m
b forall a. Eq a => a -> a -> Bool
== Nat
1 then Nat
0 else Nat
1
CGOddPrimePower (forall a. Prime a -> a
unPrime -> Integer
p) Word
k
-> Integer -> Word -> Integer -> Integer -> Nat
discreteLogarithmPP Integer
p Word
k (forall a. Integral a => a -> Integer
toInteger (forall (m :: Nat). Mod m -> Nat
unMod Mod m
a)) (forall a. Integral a => a -> Integer
toInteger (forall (m :: Nat). Mod m -> Nat
unMod Mod m
b))
CGDoubleOddPrimePower (forall a. Prime a -> a
unPrime -> Integer
p) Word
k
-> Integer -> Word -> Integer -> Integer -> Nat
discreteLogarithmPP Integer
p Word
k (forall a. Integral a => a -> Integer
toInteger (forall (m :: Nat). Mod m -> Nat
unMod Mod m
a) forall a. Integral a => a -> a -> a
`rem` Integer
pforall a b. (Num a, Integral b) => a -> b -> a
^Word
k) (forall a. Integral a => a -> Integer
toInteger (forall (m :: Nat). Mod m -> Nat
unMod Mod m
b) forall a. Integral a => a -> a -> a
`rem` Integer
pforall a b. (Num a, Integral b) => a -> b -> a
^Word
k)