1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Math.NumberTheory.Moduli.DiscreteLogarithmTests
( testSuite
) where
import Test.Tasty
import Data.Maybe
import Data.Mod
import Data.Proxy
import Data.Semigroup
import GHC.TypeNats (SomeNat(..), KnownNat, someNatVal)
import Numeric.Natural
import Math.NumberTheory.ArithmeticFunctions (totient)
import Math.NumberTheory.Moduli.Multiplicative
import Math.NumberTheory.Moduli.Singleton
import Math.NumberTheory.Primes
import Math.NumberTheory.TestUtils
nextPrimitiveRoot :: (KnownNat m, UniqueFactorisation a, Integral a) => CyclicGroup a m -> Mod m -> Maybe (PrimitiveRoot m)
nextPrimitiveRoot cg g = listToMaybe $ mapMaybe (isPrimitiveRoot cg) [g..g+100]
nextMultElement :: KnownNat m => Mod m -> Maybe (MultMod m)
nextMultElement g = listToMaybe $ mapMaybe isMultElement [g..g+100]
-- | Ensure 'discreteLogarithm' returns in the appropriate range.
discreteLogRange :: Positive Natural -> Integer -> Integer -> Bool
discreteLogRange (Positive m) a b =
case someNatVal m of
SomeNat (_ :: Proxy m) -> (/= Just False) $ do
cg <- cyclicGroup :: Maybe (CyclicGroup Integer m)
a' <- nextPrimitiveRoot cg (fromInteger a)
b' <- nextMultElement (fromInteger b)
return $ discreteLogarithm cg a' b' < totient m
-- | Check that 'discreteLogarithm' inverts exponentiation.
discreteLogarithmProperty :: Positive Natural -> Integer -> Integer -> Bool
discreteLogarithmProperty (Positive m) a b =
case someNatVal m of
SomeNat (_ :: Proxy m) -> (/= Just False) $ do
cg <- cyclicGroup :: Maybe (CyclicGroup Integer m)
a' <- nextPrimitiveRoot cg (fromInteger a)
b' <- nextMultElement (fromInteger b)
return $ discreteLogarithm cg a' b' `stimes` unPrimitiveRoot a' == b'
-- | Check that 'discreteLogarithm' inverts exponentiation in the other direction.
discreteLogarithmProperty' :: Positive Natural -> Integer -> Natural -> Bool
discreteLogarithmProperty' (Positive m) a k =
case someNatVal m of
SomeNat (_ :: Proxy m) -> (/= Just False) $ do
cg <- cyclicGroup :: Maybe (CyclicGroup Integer m)
a'' <- nextPrimitiveRoot cg (fromInteger a)
let a' = unPrimitiveRoot a''
return $ discreteLogarithm cg a'' (k `stimes` a') == k `mod` totient m
testSuite :: TestTree
testSuite = testGroup "Discrete logarithm"
[ testSmallAndQuick "output is correct range" discreteLogRange
, testSmallAndQuick "a^(log_a b) == b" discreteLogarithmProperty
, testSmallAndQuick "log_a a^k == k" discreteLogarithmProperty'
]
|
