{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
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 {
multElement :: Mod m
} deriving (Eq, Ord, Show)
instance KnownNat m => Semigroup (MultMod m) where
MultMod a <> MultMod b = MultMod (a * b)
stimes k a@(MultMod a')
| k >= 0 = MultMod (a' ^% k)
| otherwise = invertGroup $ stimes (-k) a
instance KnownNat m => Monoid (MultMod m) where
mempty = MultMod 1
mappend = (<>)
instance KnownNat m => Bounded (MultMod m) where
minBound = MultMod 1
maxBound = MultMod (-1)
isMultElement :: KnownNat m => Mod m -> Maybe (MultMod m)
isMultElement a = if unMod a `gcd` natVal a == 1
then Just $ MultMod a
else Nothing
invertGroup :: KnownNat m => MultMod m -> MultMod m
invertGroup (MultMod a) = case invertMod a of
Just b -> MultMod b
Nothing -> error "Math.NumberTheory.Moduli.invertGroup: failed to invert element"
newtype PrimitiveRoot m = PrimitiveRoot
{ unPrimitiveRoot :: MultMod m
}
deriving (Eq, Show)
isPrimitiveRoot
:: (Integral a, UniqueFactorisation a)
=> CyclicGroup a m
-> Mod m
-> Maybe (PrimitiveRoot m)
isPrimitiveRoot cg r = case proofFromCyclicGroup cg of
Sub Dict -> do
r' <- isMultElement r
guard $ isPrimitiveRoot' cg (fromIntegral (unMod r))
return $ PrimitiveRoot r'
discreteLogarithm :: CyclicGroup Integer m -> PrimitiveRoot m -> MultMod m -> Natural
discreteLogarithm cg (multElement . unPrimitiveRoot -> a) (multElement -> b) = case cg of
CG2
-> 0
CG4
-> if unMod b == 1 then 0 else 1
CGOddPrimePower (unPrime -> p) k
-> discreteLogarithmPP p k (toInteger (unMod a)) (toInteger (unMod b))
CGDoubleOddPrimePower (unPrime -> p) k
-> discreteLogarithmPP p k (toInteger (unMod a) `rem` p^k) (toInteger (unMod b) `rem` p^k)