{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Math.NumberTheory.DirichletCharacters
(
OrZero, pattern Zero, pattern NonZero
, orZeroToNum
, DirichletCharacter
, indexToChar
, indicesToChars
, characterNumber
, allChars
, fromTable
, eval
, evalGeneral
, evalAll
, principalChar
, isPrincipal
, orderChar
, RealCharacter
, isRealCharacter
, getRealChar
, toRealFunction
, jacobiCharacter
, PrimitiveCharacter
, isPrimitive
, getPrimitiveChar
, induced
, makePrimitive
, WithNat(..)
, RootOfUnity(..)
, toRootOfUnity
, toComplex
, validChar
) where
#if !MIN_VERSION_base(4,12,0)
import Control.Applicative (liftA2)
#endif
import Data.Bits (Bits(..))
import Data.Constraint
import Data.Foldable
import Data.Functor.Identity (Identity(..))
import Data.Kind
import Data.List (sort, unfoldr)
import Data.Maybe (mapMaybe, fromJust, fromMaybe)
import Data.Mod
#if MIN_VERSION_base(4,12,0)
import Data.Monoid (Ap(..))
#endif
import Data.Proxy (Proxy(..))
import Data.Ratio ((%), numerator, denominator)
import Data.Semigroup (Semigroup(..),Product(..))
import Data.Traversable
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Data.Vector (Vector, (!))
import GHC.TypeNats (KnownNat, Nat, SomeNat(..), natVal, someNatVal)
import Numeric.Natural (Natural)
import Math.NumberTheory.ArithmeticFunctions (totient)
import Math.NumberTheory.Moduli.Chinese
import Math.NumberTheory.Moduli.Internal (discreteLogarithmPP)
import Math.NumberTheory.Moduli.Multiplicative
import Math.NumberTheory.Moduli.Singleton
import Math.NumberTheory.Primes
import Math.NumberTheory.RootsOfUnity
import Math.NumberTheory.Utils
import Math.NumberTheory.Utils.FromIntegral
newtype DirichletCharacter (n :: Nat) = Generated [DirichletFactor]
data DirichletFactor = OddPrime { DirichletFactor -> Prime Natural
_getPrime :: Prime Natural
, DirichletFactor -> Word
_getPower :: Word
, DirichletFactor -> Natural
_getGenerator :: Natural
, DirichletFactor -> RootOfUnity
_getValue :: RootOfUnity
}
| TwoPower { DirichletFactor -> Int
_getPower2 :: Int
, DirichletFactor -> RootOfUnity
_getFirstValue :: RootOfUnity
, DirichletFactor -> RootOfUnity
_getSecondValue :: RootOfUnity
}
| Two
instance Eq (DirichletCharacter n) where
Generated [DirichletFactor]
a == :: DirichletCharacter n -> DirichletCharacter n -> Bool
== Generated [DirichletFactor]
b = [DirichletFactor]
a [DirichletFactor] -> [DirichletFactor] -> Bool
forall a. Eq a => a -> a -> Bool
== [DirichletFactor]
b
instance Eq DirichletFactor where
TwoPower Int
_ RootOfUnity
x1 RootOfUnity
x2 == :: DirichletFactor -> DirichletFactor -> Bool
== TwoPower Int
_ RootOfUnity
y1 RootOfUnity
y2 = RootOfUnity
x1 RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
y1 Bool -> Bool -> Bool
&& RootOfUnity
x2 RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
y2
OddPrime Prime Natural
_ Word
_ Natural
_ RootOfUnity
x == OddPrime Prime Natural
_ Word
_ Natural
_ RootOfUnity
y = RootOfUnity
x RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
y
DirichletFactor
Two == DirichletFactor
Two = Bool
True
DirichletFactor
_ == DirichletFactor
_ = Bool
False
generator :: Prime Natural -> Word -> Natural
generator :: Prime Natural -> Word -> Natural
generator Prime Natural
p Word
k = case [(Prime Natural, Word)] -> Maybe (Some (CyclicGroup Natural))
forall a.
(Eq a, Num a) =>
[(Prime a, Word)] -> Maybe (Some (CyclicGroup a))
cyclicGroupFromFactors [(Prime Natural
p, Word
k)] of
Maybe (Some (CyclicGroup Natural))
Nothing -> [Char] -> Natural
forall a. HasCallStack => [Char] -> a
error [Char]
"illegal"
Just (Some CyclicGroup Natural m
cg)
| Sub (() :: Constraint) => Dict (KnownNat m)
Dict <- CyclicGroup Natural m -> (() :: Constraint) :- KnownNat m
forall a (m :: Nat).
Integral a =>
CyclicGroup a m -> (() :: Constraint) :- KnownNat m
proofFromCyclicGroup CyclicGroup Natural m
cg ->
Mod m -> Natural
forall (m :: Nat). Mod m -> Natural
unMod (Mod m -> Natural) -> Mod m -> Natural
forall a b. (a -> b) -> a -> b
$ MultMod m -> Mod m
forall (m :: Nat). MultMod m -> Mod m
multElement (MultMod m -> Mod m) -> MultMod m -> Mod m
forall a b. (a -> b) -> a -> b
$ PrimitiveRoot m -> MultMod m
forall (m :: Nat). PrimitiveRoot m -> MultMod m
unPrimitiveRoot (PrimitiveRoot m -> MultMod m) -> PrimitiveRoot m -> MultMod m
forall a b. (a -> b) -> a -> b
$ [PrimitiveRoot m] -> PrimitiveRoot m
forall a. [a] -> a
head ([PrimitiveRoot m] -> PrimitiveRoot m)
-> [PrimitiveRoot m] -> PrimitiveRoot m
forall a b. (a -> b) -> a -> b
$
(Mod m -> Maybe (PrimitiveRoot m)) -> [Mod m] -> [PrimitiveRoot m]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (CyclicGroup Natural m -> Mod m -> Maybe (PrimitiveRoot m)
forall a (m :: Nat).
(Integral a, UniqueFactorisation a) =>
CyclicGroup a m -> Mod m -> Maybe (PrimitiveRoot m)
isPrimitiveRoot CyclicGroup Natural m
cg) [Mod m
2..Mod m
forall a. Bounded a => a
maxBound]
lambda :: Integer -> Int -> Integer
lambda :: Integer -> Int -> Integer
lambda Integer
x Int
e = ((Integer
xPower Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Integer
modulus Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
where
modulus :: Integer
modulus = Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
largeMod :: Natural
largeMod = Natural
1 Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
xPower :: Integer
xPower = case Natural -> SomeNat
someNatVal Natural
largeMod of
SomeNat (Proxy n
_ :: Proxy largeMod) ->
Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Mod n -> Natural
forall (m :: Nat). Mod m -> Natural
unMod (Integer -> Mod n
forall a. Num a => Integer -> a
fromInteger Integer
x Mod n -> Integer -> Mod n
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
modulus) :: Mod largeMod))
eval :: DirichletCharacter n -> MultMod n -> RootOfUnity
eval :: DirichletCharacter n -> MultMod n -> RootOfUnity
eval (Generated [DirichletFactor]
ds) MultMod n
m = (DirichletFactor -> RootOfUnity)
-> [DirichletFactor] -> RootOfUnity
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Integer -> DirichletFactor -> RootOfUnity
evalFactor Integer
m') [DirichletFactor]
ds
where
m' :: Integer
m' = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ Mod n -> Natural
forall (m :: Nat). Mod m -> Natural
unMod (Mod n -> Natural) -> Mod n -> Natural
forall a b. (a -> b) -> a -> b
$ MultMod n -> Mod n
forall (m :: Nat). MultMod m -> Mod m
multElement MultMod n
m
evalFactor :: Integer -> DirichletFactor -> RootOfUnity
evalFactor :: Integer -> DirichletFactor -> RootOfUnity
evalFactor Integer
m =
\case
OddPrime (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer)
-> (Prime Natural -> Natural) -> Prime Natural -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prime Natural -> Natural
forall a. Prime a -> a
unPrime -> Integer
p) Word
k (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
a) RootOfUnity
b ->
Integer -> Word -> Integer -> Integer -> Natural
discreteLogarithmPP Integer
p Word
k Integer
a (Integer
m Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
pInteger -> Word -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Word
k) Natural -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
b
TwoPower Int
k RootOfUnity
s RootOfUnity
b -> (if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
m Int
1 then RootOfUnity
s else RootOfUnity
forall a. Monoid a => a
mempty)
RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<> Integer -> Int -> Integer
lambda (Int -> Integer -> Integer
forall p. (Bits p, Num p) => Int -> p -> p
thingy Int
k Integer
m) Int
k Integer -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
b
DirichletFactor
Two -> RootOfUnity
forall a. Monoid a => a
mempty
thingy :: (Bits p, Num p) => Int -> p -> p
thingy :: Int -> p -> p
thingy Int
k p
m = if p -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit p
m Int
1
then Int -> p
forall a. Bits a => Int -> a
bit Int
k p -> p -> p
forall a. Num a => a -> a -> a
- p
m'
else p
m'
where m' :: p
m' = p
m p -> p -> p
forall a. Bits a => a -> a -> a
.&. (Int -> p
forall a. Bits a => Int -> a
bit Int
k p -> p -> p
forall a. Num a => a -> a -> a
- p
1)
evalGeneral :: KnownNat n => DirichletCharacter n -> Mod n -> OrZero RootOfUnity
evalGeneral :: DirichletCharacter n -> Mod n -> OrZero RootOfUnity
evalGeneral DirichletCharacter n
chi Mod n
t = case Mod n -> Maybe (MultMod n)
forall (m :: Nat). KnownNat m => Mod m -> Maybe (MultMod m)
isMultElement Mod n
t of
Maybe (MultMod n)
Nothing -> OrZero RootOfUnity
forall a. OrZero a
Zero
Just MultMod n
x -> RootOfUnity -> OrZero RootOfUnity
forall a. a -> OrZero a
NonZero (RootOfUnity -> OrZero RootOfUnity)
-> RootOfUnity -> OrZero RootOfUnity
forall a b. (a -> b) -> a -> b
$ DirichletCharacter n -> MultMod n -> RootOfUnity
forall (n :: Nat). DirichletCharacter n -> MultMod n -> RootOfUnity
eval DirichletCharacter n
chi MultMod n
x
principalChar :: KnownNat n => DirichletCharacter n
principalChar :: DirichletCharacter n
principalChar = DirichletCharacter n
forall a. Bounded a => a
minBound
mulChars :: DirichletCharacter n -> DirichletCharacter n -> DirichletCharacter n
mulChars :: DirichletCharacter n
-> DirichletCharacter n -> DirichletCharacter n
mulChars (Generated [DirichletFactor]
x) (Generated [DirichletFactor]
y) = [DirichletFactor] -> DirichletCharacter n
forall (n :: Nat). [DirichletFactor] -> DirichletCharacter n
Generated ((DirichletFactor -> DirichletFactor -> DirichletFactor)
-> [DirichletFactor] -> [DirichletFactor] -> [DirichletFactor]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith DirichletFactor -> DirichletFactor -> DirichletFactor
combine [DirichletFactor]
x [DirichletFactor]
y)
where combine :: DirichletFactor -> DirichletFactor -> DirichletFactor
combine :: DirichletFactor -> DirichletFactor -> DirichletFactor
combine DirichletFactor
Two DirichletFactor
Two = DirichletFactor
Two
combine (OddPrime Prime Natural
p Word
k Natural
g RootOfUnity
n) (OddPrime Prime Natural
_ Word
_ Natural
_ RootOfUnity
m) =
Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p Word
k Natural
g (RootOfUnity
n RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<> RootOfUnity
m)
combine (TwoPower Int
k RootOfUnity
a RootOfUnity
n) (TwoPower Int
_ RootOfUnity
b RootOfUnity
m) =
Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
k (RootOfUnity
a RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<> RootOfUnity
b) (RootOfUnity
n RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<> RootOfUnity
m)
combine DirichletFactor
_ DirichletFactor
_ = [Char] -> DirichletFactor
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error: malformed DirichletCharacter"
instance Semigroup (DirichletCharacter n) where
<> :: DirichletCharacter n
-> DirichletCharacter n -> DirichletCharacter n
(<>) = DirichletCharacter n
-> DirichletCharacter n -> DirichletCharacter n
forall (n :: Nat).
DirichletCharacter n
-> DirichletCharacter n -> DirichletCharacter n
mulChars
stimes :: b -> DirichletCharacter n -> DirichletCharacter n
stimes = b -> DirichletCharacter n -> DirichletCharacter n
forall a (n :: Nat).
Integral a =>
a -> DirichletCharacter n -> DirichletCharacter n
stimesChar
instance KnownNat n => Monoid (DirichletCharacter n) where
mempty :: DirichletCharacter n
mempty = DirichletCharacter n
forall (n :: Nat). KnownNat n => DirichletCharacter n
principalChar
mappend :: DirichletCharacter n
-> DirichletCharacter n -> DirichletCharacter n
mappend = DirichletCharacter n
-> DirichletCharacter n -> DirichletCharacter n
forall a. Semigroup a => a -> a -> a
(<>)
stimesChar :: Integral a => a -> DirichletCharacter n -> DirichletCharacter n
stimesChar :: a -> DirichletCharacter n -> DirichletCharacter n
stimesChar a
s (Generated [DirichletFactor]
xs) = [DirichletFactor] -> DirichletCharacter n
forall (n :: Nat). [DirichletFactor] -> DirichletCharacter n
Generated ((DirichletFactor -> DirichletFactor)
-> [DirichletFactor] -> [DirichletFactor]
forall a b. (a -> b) -> [a] -> [b]
map DirichletFactor -> DirichletFactor
mult [DirichletFactor]
xs)
where mult :: DirichletFactor -> DirichletFactor
mult :: DirichletFactor -> DirichletFactor
mult (OddPrime Prime Natural
p Word
k Natural
g RootOfUnity
n) = Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p Word
k Natural
g (a
s a -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
n)
mult (TwoPower Int
k RootOfUnity
a RootOfUnity
b) = Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
k (a
s a -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
a) (a
s a -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
b)
mult DirichletFactor
Two = DirichletFactor
Two
instance KnownNat n => Enum (DirichletCharacter n) where
toEnum :: Int -> DirichletCharacter n
toEnum = Natural -> DirichletCharacter n
forall (n :: Nat). KnownNat n => Natural -> DirichletCharacter n
indexToChar (Natural -> DirichletCharacter n)
-> (Int -> Natural) -> Int -> DirichletCharacter n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
intToNatural
fromEnum :: DirichletCharacter n -> Int
fromEnum = Integer -> Int
integerToInt (Integer -> Int)
-> (DirichletCharacter n -> Integer) -> DirichletCharacter n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirichletCharacter n -> Integer
forall (n :: Nat). DirichletCharacter n -> Integer
characterNumber
succ :: DirichletCharacter n -> DirichletCharacter n
succ DirichletCharacter n
x = DirichletCharacter n -> Integer -> DirichletCharacter n
forall a (n :: Nat).
Integral a =>
DirichletCharacter n -> a -> DirichletCharacter n
makeChar DirichletCharacter n
x (DirichletCharacter n -> Integer
forall (n :: Nat). DirichletCharacter n -> Integer
characterNumber DirichletCharacter n
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
pred :: DirichletCharacter n -> DirichletCharacter n
pred DirichletCharacter n
x = DirichletCharacter n -> Integer -> DirichletCharacter n
forall a (n :: Nat).
Integral a =>
DirichletCharacter n -> a -> DirichletCharacter n
makeChar DirichletCharacter n
x (DirichletCharacter n -> Integer
forall (n :: Nat). DirichletCharacter n -> Integer
characterNumber DirichletCharacter n
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
enumFromTo :: DirichletCharacter n
-> DirichletCharacter n -> [DirichletCharacter n]
enumFromTo DirichletCharacter n
x DirichletCharacter n
y = DirichletCharacter n -> [Int] -> [DirichletCharacter n]
forall a (f :: * -> *) (n :: Nat).
(Integral a, Functor f) =>
DirichletCharacter n -> f a -> f (DirichletCharacter n)
bulkMakeChars DirichletCharacter n
x [DirichletCharacter n -> Int
forall a. Enum a => a -> Int
fromEnum DirichletCharacter n
x..DirichletCharacter n -> Int
forall a. Enum a => a -> Int
fromEnum DirichletCharacter n
y]
enumFrom :: DirichletCharacter n -> [DirichletCharacter n]
enumFrom DirichletCharacter n
x = DirichletCharacter n -> [Int] -> [DirichletCharacter n]
forall a (f :: * -> *) (n :: Nat).
(Integral a, Functor f) =>
DirichletCharacter n -> f a -> f (DirichletCharacter n)
bulkMakeChars DirichletCharacter n
x [DirichletCharacter n -> Int
forall a. Enum a => a -> Int
fromEnum DirichletCharacter n
x..]
enumFromThenTo :: DirichletCharacter n
-> DirichletCharacter n
-> DirichletCharacter n
-> [DirichletCharacter n]
enumFromThenTo DirichletCharacter n
x DirichletCharacter n
y DirichletCharacter n
z = DirichletCharacter n -> [Int] -> [DirichletCharacter n]
forall a (f :: * -> *) (n :: Nat).
(Integral a, Functor f) =>
DirichletCharacter n -> f a -> f (DirichletCharacter n)
bulkMakeChars DirichletCharacter n
x [DirichletCharacter n -> Int
forall a. Enum a => a -> Int
fromEnum DirichletCharacter n
x, DirichletCharacter n -> Int
forall a. Enum a => a -> Int
fromEnum DirichletCharacter n
y..DirichletCharacter n -> Int
forall a. Enum a => a -> Int
fromEnum DirichletCharacter n
z]
enumFromThen :: DirichletCharacter n
-> DirichletCharacter n -> [DirichletCharacter n]
enumFromThen DirichletCharacter n
x DirichletCharacter n
y = DirichletCharacter n -> [Int] -> [DirichletCharacter n]
forall a (f :: * -> *) (n :: Nat).
(Integral a, Functor f) =>
DirichletCharacter n -> f a -> f (DirichletCharacter n)
bulkMakeChars DirichletCharacter n
x [DirichletCharacter n -> Int
forall a. Enum a => a -> Int
fromEnum DirichletCharacter n
x, DirichletCharacter n -> Int
forall a. Enum a => a -> Int
fromEnum DirichletCharacter n
y..]
instance KnownNat n => Bounded (DirichletCharacter n) where
minBound :: DirichletCharacter n
minBound = Natural -> DirichletCharacter n
forall (n :: Nat). KnownNat n => Natural -> DirichletCharacter n
indexToChar Natural
0
maxBound :: DirichletCharacter n
maxBound = Natural -> DirichletCharacter n
forall (n :: Nat). KnownNat n => Natural -> DirichletCharacter n
indexToChar (Natural -> Natural
forall n. UniqueFactorisation n => n -> n
totient Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1)
where n :: Natural
n = Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
characterNumber :: DirichletCharacter n -> Integer
characterNumber :: DirichletCharacter n -> Integer
characterNumber (Generated [DirichletFactor]
y) = (Integer -> DirichletFactor -> Integer)
-> Integer -> [DirichletFactor] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> DirichletFactor -> Integer
go Integer
0 [DirichletFactor]
y
where go :: Integer -> DirichletFactor -> Integer
go Integer
x (OddPrime Prime Natural
p Word
k Natural
_ RootOfUnity
a) = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Ratio Integer -> Integer
forall a. Ratio a -> a
numerator (RootOfUnity -> Ratio Integer
fromRootOfUnity RootOfUnity
a Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* (Integer
m Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1))
where p' :: Integer
p' = Natural -> Integer
naturalToInteger (Prime Natural -> Natural
forall a. Prime a -> a
unPrime Prime Natural
p)
m :: Integer
m = Integer
p'Integer -> Word -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Word
kWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
p'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)
go Integer
x (TwoPower Int
k RootOfUnity
a RootOfUnity
b) = Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Ratio Integer -> Integer
forall a. Ratio a -> a
numerator (RootOfUnity -> Ratio Integer
fromRootOfUnity RootOfUnity
a Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
2)
where m :: Integer
m = Int -> Integer
forall a. Bits a => Int -> a
bit (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) :: Integer
x' :: Integer
x' = Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Ratio Integer -> Integer
forall a. Ratio a -> a
numerator (RootOfUnity -> Ratio Integer
fromRootOfUnity RootOfUnity
b Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* (Integer
m Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1))
go Integer
x DirichletFactor
Two = Integer
x
indexToChar :: forall n. KnownNat n => Natural -> DirichletCharacter n
indexToChar :: Natural -> DirichletCharacter n
indexToChar = Identity (DirichletCharacter n) -> DirichletCharacter n
forall a. Identity a -> a
runIdentity (Identity (DirichletCharacter n) -> DirichletCharacter n)
-> (Natural -> Identity (DirichletCharacter n))
-> Natural
-> DirichletCharacter n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Natural -> Identity (DirichletCharacter n)
forall (n :: Nat) (f :: * -> *).
(KnownNat n, Functor f) =>
f Natural -> f (DirichletCharacter n)
indicesToChars (Identity Natural -> Identity (DirichletCharacter n))
-> (Natural -> Identity Natural)
-> Natural
-> Identity (DirichletCharacter n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Identity Natural
forall a. a -> Identity a
Identity
indicesToChars :: forall n f. (KnownNat n, Functor f) => f Natural -> f (DirichletCharacter n)
indicesToChars :: f Natural -> f (DirichletCharacter n)
indicesToChars = (Natural -> DirichletCharacter n)
-> f Natural -> f (DirichletCharacter n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([DirichletFactor] -> DirichletCharacter n
forall (n :: Nat). [DirichletFactor] -> DirichletCharacter n
Generated ([DirichletFactor] -> DirichletCharacter n)
-> (Natural -> [DirichletFactor])
-> Natural
-> DirichletCharacter n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Template] -> Natural -> [DirichletFactor]
unroll [Template]
t (Natural -> [DirichletFactor])
-> (Natural -> Natural) -> Natural -> [DirichletFactor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`mod` Natural
m))
where n :: Natural
n = Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
(Product Natural
m, [Template]
t) = Natural -> (Product Natural, [Template])
mkTemplate Natural
n
allChars :: forall n. KnownNat n => [DirichletCharacter n]
allChars :: [DirichletCharacter n]
allChars = [Natural] -> [DirichletCharacter n]
forall (n :: Nat) (f :: * -> *).
(KnownNat n, Functor f) =>
f Natural -> f (DirichletCharacter n)
indicesToChars [Natural
0..Natural
mNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
1]
where m :: Natural
m = Natural -> Natural
forall n. UniqueFactorisation n => n -> n
totient (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
makeChar :: Integral a => DirichletCharacter n -> a -> DirichletCharacter n
makeChar :: DirichletCharacter n -> a -> DirichletCharacter n
makeChar DirichletCharacter n
x = Identity (DirichletCharacter n) -> DirichletCharacter n
forall a. Identity a -> a
runIdentity (Identity (DirichletCharacter n) -> DirichletCharacter n)
-> (a -> Identity (DirichletCharacter n))
-> a
-> DirichletCharacter n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirichletCharacter n
-> Identity a -> Identity (DirichletCharacter n)
forall a (f :: * -> *) (n :: Nat).
(Integral a, Functor f) =>
DirichletCharacter n -> f a -> f (DirichletCharacter n)
bulkMakeChars DirichletCharacter n
x (Identity a -> Identity (DirichletCharacter n))
-> (a -> Identity a) -> a -> Identity (DirichletCharacter n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity
bulkMakeChars :: (Integral a, Functor f) => DirichletCharacter n -> f a -> f (DirichletCharacter n)
bulkMakeChars :: DirichletCharacter n -> f a -> f (DirichletCharacter n)
bulkMakeChars DirichletCharacter n
x = (a -> DirichletCharacter n) -> f a -> f (DirichletCharacter n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([DirichletFactor] -> DirichletCharacter n
forall (n :: Nat). [DirichletFactor] -> DirichletCharacter n
Generated ([DirichletFactor] -> DirichletCharacter n)
-> (a -> [DirichletFactor]) -> a -> DirichletCharacter n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Template] -> Natural -> [DirichletFactor]
unroll [Template]
t (Natural -> [DirichletFactor])
-> (a -> Natural) -> a -> [DirichletFactor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`mod` Natural
m) (Natural -> Natural) -> (a -> Natural) -> a -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral')
where (Product Natural
m, [Template]
t) = DirichletCharacter n -> (Product Natural, [Template])
forall (n :: Nat).
DirichletCharacter n -> (Product Natural, [Template])
templateFromCharacter DirichletCharacter n
x
data Template = OddTemplate { Template -> Prime Natural
_getPrime' :: Prime Natural
, Template -> Word
_getPower' :: Word
, Template -> Natural
_getGenerator' :: !Natural
, Template -> Natural
_getModulus' :: !Natural
}
| TwoPTemplate { Template -> Int
_getPower2' :: Int
, _getModulus' :: !Natural
}
| TwoTemplate
templateFromCharacter :: DirichletCharacter n -> (Product Natural, [Template])
templateFromCharacter :: DirichletCharacter n -> (Product Natural, [Template])
templateFromCharacter (Generated [DirichletFactor]
t) = (DirichletFactor -> (Product Natural, Template))
-> [DirichletFactor] -> (Product Natural, [Template])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse DirichletFactor -> (Product Natural, Template)
go [DirichletFactor]
t
where go :: DirichletFactor -> (Product Natural, Template)
go (OddPrime Prime Natural
p Word
k Natural
g RootOfUnity
_) = (Natural -> Product Natural
forall a. a -> Product a
Product Natural
m, Prime Natural -> Word -> Natural -> Natural -> Template
OddTemplate Prime Natural
p Word
k Natural
g Natural
m)
where p' :: Natural
p' = Prime Natural -> Natural
forall a. Prime a -> a
unPrime Prime Natural
p
m :: Natural
m = Natural
p'Natural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^(Word
kWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
*(Natural
p'Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
1)
go (TwoPower Int
k RootOfUnity
_ RootOfUnity
_) = (Natural -> Product Natural
forall a. a -> Product a
Product (Natural
2Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
*Natural
m), Int -> Natural -> Template
TwoPTemplate Int
k Natural
m)
where m :: Natural
m = Int -> Natural
forall a. Bits a => Int -> a
bit (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
go DirichletFactor
Two = (Natural -> Product Natural
forall a. a -> Product a
Product Natural
1, Template
TwoTemplate)
mkTemplate :: Natural -> (Product Natural, [Template])
mkTemplate :: Natural -> (Product Natural, [Template])
mkTemplate = [(Prime Natural, Word)] -> (Product Natural, [Template])
go ([(Prime Natural, Word)] -> (Product Natural, [Template]))
-> (Natural -> [(Prime Natural, Word)])
-> Natural
-> (Product Natural, [Template])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Prime Natural, Word)] -> [(Prime Natural, Word)]
forall a. Ord a => [a] -> [a]
sort ([(Prime Natural, Word)] -> [(Prime Natural, Word)])
-> (Natural -> [(Prime Natural, Word)])
-> Natural
-> [(Prime Natural, Word)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> [(Prime Natural, Word)]
forall a. UniqueFactorisation a => a -> [(Prime a, Word)]
factorise
where go :: [(Prime Natural, Word)] -> (Product Natural, [Template])
go :: [(Prime Natural, Word)] -> (Product Natural, [Template])
go ((Prime Natural -> Natural
forall a. Prime a -> a
unPrime -> Natural
2, Word
1): [(Prime Natural, Word)]
xs) = (Natural -> Product Natural
forall a. a -> Product a
Product Natural
1, [Template
TwoTemplate]) (Product Natural, [Template])
-> (Product Natural, [Template]) -> (Product Natural, [Template])
forall a. Semigroup a => a -> a -> a
<> ((Prime Natural, Word) -> (Product Natural, Template))
-> [(Prime Natural, Word)] -> (Product Natural, [Template])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Prime Natural, Word) -> (Product Natural, Template)
odds [(Prime Natural, Word)]
xs
go ((Prime Natural -> Natural
forall a. Prime a -> a
unPrime -> Natural
2, Word -> Int
wordToInt -> Int
k): [(Prime Natural, Word)]
xs) = (Natural -> Product Natural
forall a. a -> Product a
Product (Natural
2Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
*Natural
m), [Int -> Natural -> Template
TwoPTemplate Int
k Natural
m]) (Product Natural, [Template])
-> (Product Natural, [Template]) -> (Product Natural, [Template])
forall a. Semigroup a => a -> a -> a
<> ((Prime Natural, Word) -> (Product Natural, Template))
-> [(Prime Natural, Word)] -> (Product Natural, [Template])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Prime Natural, Word) -> (Product Natural, Template)
odds [(Prime Natural, Word)]
xs
where m :: Natural
m = Int -> Natural
forall a. Bits a => Int -> a
bit (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
go [(Prime Natural, Word)]
xs = ((Prime Natural, Word) -> (Product Natural, Template))
-> [(Prime Natural, Word)] -> (Product Natural, [Template])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Prime Natural, Word) -> (Product Natural, Template)
odds [(Prime Natural, Word)]
xs
odds :: (Prime Natural, Word) -> (Product Natural, Template)
odds :: (Prime Natural, Word) -> (Product Natural, Template)
odds (Prime Natural
p, Word
k) = (Natural -> Product Natural
forall a. a -> Product a
Product Natural
m, Prime Natural -> Word -> Natural -> Natural -> Template
OddTemplate Prime Natural
p Word
k (Prime Natural -> Word -> Natural
generator Prime Natural
p Word
k) Natural
m)
where p' :: Natural
p' = Prime Natural -> Natural
forall a. Prime a -> a
unPrime Prime Natural
p
m :: Natural
m = Natural
p'Natural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^(Word
kWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
*(Natural
p'Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
1)
unroll :: [Template] -> Natural -> [DirichletFactor]
unroll :: [Template] -> Natural -> [DirichletFactor]
unroll [Template]
t Natural
m = (Natural, [DirichletFactor]) -> [DirichletFactor]
forall a b. (a, b) -> b
snd ((Natural -> Template -> (Natural, DirichletFactor))
-> Natural -> [Template] -> (Natural, [DirichletFactor])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Natural -> Template -> (Natural, DirichletFactor)
func Natural
m [Template]
t)
where func :: Natural -> Template -> (Natural, DirichletFactor)
func :: Natural -> Template -> (Natural, DirichletFactor)
func Natural
a (OddTemplate Prime Natural
p Word
k Natural
g Natural
n) = (Natural
a1, Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p Word
k Natural
g (Ratio Integer -> RootOfUnity
toRootOfUnity (Ratio Integer -> RootOfUnity) -> Ratio Integer -> RootOfUnity
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
a2 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n))
where (Natural
a1,Natural
a2) = Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
quotRem Natural
a Natural
n
func Natural
a (TwoPTemplate Int
k Natural
n) = (Natural
b1, Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
k (Ratio Integer -> RootOfUnity
toRootOfUnity (Ratio Integer -> RootOfUnity) -> Ratio Integer -> RootOfUnity
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
a2 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
2) (Ratio Integer -> RootOfUnity
toRootOfUnity (Ratio Integer -> RootOfUnity) -> Ratio Integer -> RootOfUnity
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
b2 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n))
where (Natural
a1,Natural
a2) = Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
quotRem Natural
a Natural
2
(Natural
b1,Natural
b2) = Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
quotRem Natural
a1 Natural
n
func Natural
a Template
TwoTemplate = (Natural
a, DirichletFactor
Two)
isPrincipal :: DirichletCharacter n -> Bool
isPrincipal :: DirichletCharacter n -> Bool
isPrincipal DirichletCharacter n
chi = DirichletCharacter n -> Integer
forall (n :: Nat). DirichletCharacter n -> Integer
characterNumber DirichletCharacter n
chi Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
induced :: forall n d. (KnownNat d, KnownNat n) => DirichletCharacter d -> Maybe (DirichletCharacter n)
induced :: DirichletCharacter d -> Maybe (DirichletCharacter n)
induced (Generated [DirichletFactor]
start) = if Natural
n Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`rem` Natural
d Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0
then DirichletCharacter n -> Maybe (DirichletCharacter n)
forall a. a -> Maybe a
Just ([DirichletFactor] -> DirichletCharacter n
forall (n :: Nat). [DirichletFactor] -> DirichletCharacter n
Generated ([Template] -> [DirichletFactor] -> [DirichletFactor]
combine ((Product Natural, [Template]) -> [Template]
forall a b. (a, b) -> b
snd ((Product Natural, [Template]) -> [Template])
-> (Product Natural, [Template]) -> [Template]
forall a b. (a -> b) -> a -> b
$ Natural -> (Product Natural, [Template])
mkTemplate Natural
n) [DirichletFactor]
start))
else Maybe (DirichletCharacter n)
forall a. Maybe a
Nothing
where n :: Natural
n = Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
d :: Natural
d = Proxy d -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
combine :: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine :: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine [] [DirichletFactor]
_ = []
combine [Template]
ts [] = (Template -> DirichletFactor) -> [Template] -> [DirichletFactor]
forall a b. (a -> b) -> [a] -> [b]
map Template -> DirichletFactor
newFactor [Template]
ts
combine (Template
t:[Template]
xs) (DirichletFactor
y:[DirichletFactor]
ys) = case (Template
t,DirichletFactor
y) of
(Template
TwoTemplate, DirichletFactor
Two) -> DirichletFactor
TwoDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine [Template]
xs [DirichletFactor]
ys
(Template
TwoTemplate, DirichletFactor
_) -> DirichletFactor
TwoDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine [Template]
xs (DirichletFactor
yDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
:[DirichletFactor]
ys)
(TwoPTemplate Int
k Natural
_, DirichletFactor
Two) -> Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
k RootOfUnity
forall a. Monoid a => a
mempty RootOfUnity
forall a. Monoid a => a
memptyDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine [Template]
xs [DirichletFactor]
ys
(TwoPTemplate Int
k Natural
_, TwoPower Int
_ RootOfUnity
a RootOfUnity
b) -> Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
k RootOfUnity
a RootOfUnity
bDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine [Template]
xs [DirichletFactor]
ys
(TwoPTemplate Int
k Natural
_, DirichletFactor
_) -> Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
k RootOfUnity
forall a. Monoid a => a
mempty RootOfUnity
forall a. Monoid a => a
memptyDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine [Template]
xs (DirichletFactor
yDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
:[DirichletFactor]
ys)
(OddTemplate Prime Natural
p Word
k Natural
_ Natural
_, OddPrime Prime Natural
q Word
_ Natural
g RootOfUnity
a) | Prime Natural
p Prime Natural -> Prime Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Prime Natural
q -> Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p Word
k Natural
g RootOfUnity
aDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine [Template]
xs [DirichletFactor]
ys
(OddTemplate Prime Natural
p Word
k Natural
g Natural
_, OddPrime Prime Natural
q Word
_ Natural
_ RootOfUnity
_) | Prime Natural
p Prime Natural -> Prime Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Prime Natural
q -> Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p Word
k Natural
g RootOfUnity
forall a. Monoid a => a
memptyDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
: [Template] -> [DirichletFactor] -> [DirichletFactor]
combine [Template]
xs (DirichletFactor
yDirichletFactor -> [DirichletFactor] -> [DirichletFactor]
forall a. a -> [a] -> [a]
:[DirichletFactor]
ys)
(Template, DirichletFactor)
_ -> [Char] -> [DirichletFactor]
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error in induced: please report this as a bug"
newFactor :: Template -> DirichletFactor
newFactor :: Template -> DirichletFactor
newFactor Template
TwoTemplate = DirichletFactor
Two
newFactor (TwoPTemplate Int
k Natural
_) = Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
k RootOfUnity
forall a. Monoid a => a
mempty RootOfUnity
forall a. Monoid a => a
mempty
newFactor (OddTemplate Prime Natural
p Word
k Natural
g Natural
_) = Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p Word
k Natural
g RootOfUnity
forall a. Monoid a => a
mempty
jacobiCharacter :: forall n. KnownNat n => Maybe (RealCharacter n)
jacobiCharacter :: Maybe (RealCharacter n)
jacobiCharacter = if Natural -> Bool
forall a. Integral a => a -> Bool
odd Natural
n
then RealCharacter n -> Maybe (RealCharacter n)
forall a. a -> Maybe a
Just (RealCharacter n -> Maybe (RealCharacter n))
-> RealCharacter n -> Maybe (RealCharacter n)
forall a b. (a -> b) -> a -> b
$ DirichletCharacter n -> RealCharacter n
forall (n :: Nat). DirichletCharacter n -> RealCharacter n
RealChar (DirichletCharacter n -> RealCharacter n)
-> DirichletCharacter n -> RealCharacter n
forall a b. (a -> b) -> a -> b
$ [DirichletFactor] -> DirichletCharacter n
forall (n :: Nat). [DirichletFactor] -> DirichletCharacter n
Generated ([DirichletFactor] -> DirichletCharacter n)
-> [DirichletFactor] -> DirichletCharacter n
forall a b. (a -> b) -> a -> b
$ (Template -> DirichletFactor) -> [Template] -> [DirichletFactor]
forall a b. (a -> b) -> [a] -> [b]
map Template -> DirichletFactor
go ([Template] -> [DirichletFactor])
-> [Template] -> [DirichletFactor]
forall a b. (a -> b) -> a -> b
$ (Product Natural, [Template]) -> [Template]
forall a b. (a, b) -> b
snd ((Product Natural, [Template]) -> [Template])
-> (Product Natural, [Template]) -> [Template]
forall a b. (a -> b) -> a -> b
$ Natural -> (Product Natural, [Template])
mkTemplate Natural
n
else Maybe (RealCharacter n)
forall a. Maybe a
Nothing
where n :: Natural
n = Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
go :: Template -> DirichletFactor
go :: Template -> DirichletFactor
go (OddTemplate Prime Natural
p Word
k Natural
g Natural
_) = Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p Word
k Natural
g (RootOfUnity -> DirichletFactor) -> RootOfUnity -> DirichletFactor
forall a b. (a -> b) -> a -> b
$ Ratio Integer -> RootOfUnity
toRootOfUnity (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
k Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
2)
go Template
_ = [Char] -> DirichletFactor
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error in jacobiCharacter: please report this as a bug"
newtype RealCharacter n = RealChar {
RealCharacter n -> DirichletCharacter n
getRealChar :: DirichletCharacter n
}
deriving RealCharacter n -> RealCharacter n -> Bool
(RealCharacter n -> RealCharacter n -> Bool)
-> (RealCharacter n -> RealCharacter n -> Bool)
-> Eq (RealCharacter n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: Nat). RealCharacter n -> RealCharacter n -> Bool
/= :: RealCharacter n -> RealCharacter n -> Bool
$c/= :: forall (n :: Nat). RealCharacter n -> RealCharacter n -> Bool
== :: RealCharacter n -> RealCharacter n -> Bool
$c== :: forall (n :: Nat). RealCharacter n -> RealCharacter n -> Bool
Eq
isRealCharacter :: DirichletCharacter n -> Maybe (RealCharacter n)
isRealCharacter :: DirichletCharacter n -> Maybe (RealCharacter n)
isRealCharacter t :: DirichletCharacter n
t@(Generated [DirichletFactor]
xs) = if (DirichletFactor -> Bool) -> [DirichletFactor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DirichletFactor -> Bool
real [DirichletFactor]
xs then RealCharacter n -> Maybe (RealCharacter n)
forall a. a -> Maybe a
Just (DirichletCharacter n -> RealCharacter n
forall (n :: Nat). DirichletCharacter n -> RealCharacter n
RealChar DirichletCharacter n
t) else Maybe (RealCharacter n)
forall a. Maybe a
Nothing
where real :: DirichletFactor -> Bool
real :: DirichletFactor -> Bool
real (OddPrime Prime Natural
_ Word
_ Natural
_ RootOfUnity
a) = RootOfUnity
a RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<> RootOfUnity
a RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty
real (TwoPower Int
_ RootOfUnity
_ RootOfUnity
b) = RootOfUnity
b RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<> RootOfUnity
b RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty
real DirichletFactor
Two = Bool
True
toRealFunction :: KnownNat n => RealCharacter n -> Mod n -> Int
toRealFunction :: RealCharacter n -> Mod n -> Int
toRealFunction (RealChar DirichletCharacter n
chi) Mod n
m = case DirichletCharacter n -> Mod n -> OrZero RootOfUnity
forall (n :: Nat).
KnownNat n =>
DirichletCharacter n -> Mod n -> OrZero RootOfUnity
evalGeneral DirichletCharacter n
chi Mod n
m of
OrZero RootOfUnity
Zero -> Int
0
NonZero RootOfUnity
t | RootOfUnity
t RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty -> Int
1
NonZero RootOfUnity
t | RootOfUnity
t RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Integer -> RootOfUnity
RootOfUnity (Integer
1 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
2) -> -Int
1
OrZero RootOfUnity
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error in toRealFunction: please report this as a bug"
validChar :: forall n. KnownNat n => DirichletCharacter n -> Bool
validChar :: DirichletCharacter n -> Bool
validChar (Generated [DirichletFactor]
xs) = Bool
correctDecomposition Bool -> Bool -> Bool
&& (DirichletFactor -> Bool) -> [DirichletFactor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DirichletFactor -> Bool
correctPrimitiveRoot [DirichletFactor]
xs Bool -> Bool -> Bool
&& (DirichletFactor -> Bool) -> [DirichletFactor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DirichletFactor -> Bool
validValued [DirichletFactor]
xs
where correctDecomposition :: Bool
correctDecomposition = [(Prime Natural, Word)] -> [(Prime Natural, Word)]
forall a. Ord a => [a] -> [a]
sort (Natural -> [(Prime Natural, Word)]
forall a. UniqueFactorisation a => a -> [(Prime a, Word)]
factorise Natural
n) [(Prime Natural, Word)] -> [(Prime Natural, Word)] -> Bool
forall a. Eq a => a -> a -> Bool
== (DirichletFactor -> (Prime Natural, Word))
-> [DirichletFactor] -> [(Prime Natural, Word)]
forall a b. (a -> b) -> [a] -> [b]
map DirichletFactor -> (Prime Natural, Word)
getPP [DirichletFactor]
xs
getPP :: DirichletFactor -> (Prime Natural, Word)
getPP (TwoPower Int
k RootOfUnity
_ RootOfUnity
_) = (Prime Natural
two, Int -> Word
intToWord Int
k)
getPP (OddPrime Prime Natural
p Word
k Natural
_ RootOfUnity
_) = (Prime Natural
p, Word
k)
getPP DirichletFactor
Two = (Prime Natural
two,Word
1)
correctPrimitiveRoot :: DirichletFactor -> Bool
correctPrimitiveRoot (OddPrime Prime Natural
p Word
k Natural
g RootOfUnity
_) = Natural
g Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Prime Natural -> Word -> Natural
generator Prime Natural
p Word
k
correctPrimitiveRoot DirichletFactor
_ = Bool
True
validValued :: DirichletFactor -> Bool
validValued (TwoPower Int
k RootOfUnity
a RootOfUnity
b) = RootOfUnity
a RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<> RootOfUnity
a RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& (Int -> Integer
forall a. Bits a => Int -> a
bit (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) :: Integer) Integer -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
b RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty
validValued (OddPrime (Prime Natural -> Natural
forall a. Prime a -> a
unPrime -> Natural
p) Word
k Natural
_ RootOfUnity
a) = (Natural
pNatural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^(Word
kWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
*(Natural
pNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
1)) Natural -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
a RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty
validValued DirichletFactor
Two = Bool
True
n :: Natural
n = Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
two :: Prime Natural
two = Natural -> Prime Natural
forall a.
(Bits a, Integral a, UniqueFactorisation a) =>
a -> Prime a
nextPrime Natural
2
orderChar :: DirichletCharacter n -> Integer
orderChar :: DirichletCharacter n -> Integer
orderChar (Generated [DirichletFactor]
xs) = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm Integer
1 ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (DirichletFactor -> Integer) -> [DirichletFactor] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map DirichletFactor -> Integer
orderFactor [DirichletFactor]
xs
where orderFactor :: DirichletFactor -> Integer
orderFactor (TwoPower Int
_ (RootOfUnity Ratio Integer
a) (RootOfUnity Ratio Integer
b)) = Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`lcm` Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
b
orderFactor (OddPrime Prime Natural
_ Word
_ Natural
_ (RootOfUnity Ratio Integer
a)) = Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
a
orderFactor DirichletFactor
Two = Integer
1
isPrimitive :: DirichletCharacter n -> Maybe (PrimitiveCharacter n)
isPrimitive :: DirichletCharacter n -> Maybe (PrimitiveCharacter n)
isPrimitive t :: DirichletCharacter n
t@(Generated [DirichletFactor]
xs) = if (DirichletFactor -> Bool) -> [DirichletFactor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DirichletFactor -> Bool
primitive [DirichletFactor]
xs then PrimitiveCharacter n -> Maybe (PrimitiveCharacter n)
forall a. a -> Maybe a
Just (DirichletCharacter n -> PrimitiveCharacter n
forall (n :: Nat). DirichletCharacter n -> PrimitiveCharacter n
PrimitiveCharacter DirichletCharacter n
t) else Maybe (PrimitiveCharacter n)
forall a. Maybe a
Nothing
where primitive :: DirichletFactor -> Bool
primitive :: DirichletFactor -> Bool
primitive DirichletFactor
Two = Bool
False
primitive (OddPrime Prime Natural
_ Word
1 Natural
_ RootOfUnity
a) = RootOfUnity
a RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
/= RootOfUnity
forall a. Monoid a => a
mempty
primitive (OddPrime (Prime Natural -> Natural
forall a. Prime a -> a
unPrime -> Natural
p) Word
k Natural
_ RootOfUnity
a) = (Natural
pNatural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^(Word
kWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
2)Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
*(Natural
pNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
1)) Natural -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
a RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
/= RootOfUnity
forall a. Monoid a => a
mempty
primitive (TwoPower Int
2 RootOfUnity
a RootOfUnity
_) = RootOfUnity
a RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
/= RootOfUnity
forall a. Monoid a => a
mempty
primitive (TwoPower Int
k RootOfUnity
_ RootOfUnity
b) = (Int -> Integer
forall a. Bits a => Int -> a
bit (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3) :: Integer) Integer -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
b RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
/= RootOfUnity
forall a. Monoid a => a
mempty
newtype PrimitiveCharacter n = PrimitiveCharacter {
PrimitiveCharacter n -> DirichletCharacter n
getPrimitiveChar :: DirichletCharacter n
}
deriving PrimitiveCharacter n -> PrimitiveCharacter n -> Bool
(PrimitiveCharacter n -> PrimitiveCharacter n -> Bool)
-> (PrimitiveCharacter n -> PrimitiveCharacter n -> Bool)
-> Eq (PrimitiveCharacter n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: Nat).
PrimitiveCharacter n -> PrimitiveCharacter n -> Bool
/= :: PrimitiveCharacter n -> PrimitiveCharacter n -> Bool
$c/= :: forall (n :: Nat).
PrimitiveCharacter n -> PrimitiveCharacter n -> Bool
== :: PrimitiveCharacter n -> PrimitiveCharacter n -> Bool
$c== :: forall (n :: Nat).
PrimitiveCharacter n -> PrimitiveCharacter n -> Bool
Eq
data WithNat (a :: Nat -> Type) where
WithNat :: KnownNat m => a m -> WithNat a
makePrimitive :: DirichletCharacter n -> WithNat PrimitiveCharacter
makePrimitive :: DirichletCharacter n -> WithNat PrimitiveCharacter
makePrimitive (Generated [DirichletFactor]
xs) =
case Natural -> SomeNat
someNatVal ([Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Natural]
mods) of
SomeNat (Proxy n
Proxy :: Proxy m) -> PrimitiveCharacter n -> WithNat PrimitiveCharacter
forall (m :: Nat) (a :: Nat -> *). KnownNat m => a m -> WithNat a
WithNat (DirichletCharacter n -> PrimitiveCharacter n
forall (n :: Nat). DirichletCharacter n -> PrimitiveCharacter n
PrimitiveCharacter ([DirichletFactor] -> DirichletCharacter n
forall (n :: Nat). [DirichletFactor] -> DirichletCharacter n
Generated [DirichletFactor]
ys) :: PrimitiveCharacter m)
where ([Natural]
mods,[DirichletFactor]
ys) = [(Natural, DirichletFactor)] -> ([Natural], [DirichletFactor])
forall a b. [(a, b)] -> ([a], [b])
unzip ((DirichletFactor -> Maybe (Natural, DirichletFactor))
-> [DirichletFactor] -> [(Natural, DirichletFactor)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DirichletFactor -> Maybe (Natural, DirichletFactor)
prim [DirichletFactor]
xs)
prim :: DirichletFactor -> Maybe (Natural, DirichletFactor)
prim :: DirichletFactor -> Maybe (Natural, DirichletFactor)
prim DirichletFactor
Two = Maybe (Natural, DirichletFactor)
forall a. Maybe a
Nothing
prim (OddPrime Prime Natural
p' Word
k Natural
g RootOfUnity
a) = case ((Word, Natural) -> Bool)
-> [(Word, Natural)] -> Maybe (Word, Natural)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Word, Natural) -> Bool
works [(Word, Natural)]
options of
Maybe (Word, Natural)
Nothing -> [Char] -> Maybe (Natural, DirichletFactor)
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid character"
Just (Word
0,Natural
_) -> Maybe (Natural, DirichletFactor)
forall a. Maybe a
Nothing
Just (Word
i,Natural
_) -> (Natural, DirichletFactor) -> Maybe (Natural, DirichletFactor)
forall a. a -> Maybe a
Just (Natural
pNatural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^Word
i, Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p' Word
i Natural
g RootOfUnity
a)
where options :: [(Word, Natural)]
options = (Word
0,Natural
1)(Word, Natural) -> [(Word, Natural)] -> [(Word, Natural)]
forall a. a -> [a] -> [a]
: [(Word
i,Natural
pNatural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^(Word
iWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
*(Natural
pNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
1)) | Word
i <- [Word
1..Word
k]]
works :: (Word, Natural) -> Bool
works (Word
_,Natural
phi) = Natural
phi Natural -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
a RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty
p :: Natural
p = Prime Natural -> Natural
forall a. Prime a -> a
unPrime Prime Natural
p'
prim (TwoPower Int
k RootOfUnity
a RootOfUnity
b) = case ((Int, Natural) -> Bool)
-> [(Int, Natural)] -> Maybe (Int, Natural)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int, Natural) -> Bool
worksb [(Int, Natural)]
options of
Maybe (Int, Natural)
Nothing -> [Char] -> Maybe (Natural, DirichletFactor)
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid character"
Just (Int
2,Natural
_) | RootOfUnity
a RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty -> Maybe (Natural, DirichletFactor)
forall a. Maybe a
Nothing
Just (Int
i,Natural
_) -> (Natural, DirichletFactor) -> Maybe (Natural, DirichletFactor)
forall a. a -> Maybe a
Just (Int -> Natural
forall a. Bits a => Int -> a
bit Int
i :: Natural, Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
i RootOfUnity
a RootOfUnity
b)
where options :: [(Int, Natural)]
options = [(Int
i, Int -> Natural
forall a. Bits a => Int -> a
bit (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) :: Natural) | Int
i <- [Int
2..Int
k]]
worksb :: (Int, Natural) -> Bool
worksb (Int
_,Natural
phi) = Natural
phi Natural -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
b RootOfUnity -> RootOfUnity -> Bool
forall a. Eq a => a -> a -> Bool
== RootOfUnity
forall a. Monoid a => a
mempty
#if !MIN_VERSION_base(4,12,0)
newtype Ap f a = Ap { getAp :: f a }
deriving (Eq, Functor, Applicative, Monad)
instance (Applicative f, Semigroup a) => Semigroup (Ap f a) where
(<>) = liftA2 (<>)
instance (Applicative f, Semigroup a, Monoid a) => Monoid (Ap f a) where
mempty = pure mempty
mappend = (<>)
#endif
type OrZero a = Ap Maybe a
pattern Zero :: OrZero a
pattern $bZero :: OrZero a
$mZero :: forall r a. OrZero a -> (Void# -> r) -> (Void# -> r) -> r
Zero = Ap Nothing
pattern NonZero :: a -> OrZero a
pattern $bNonZero :: a -> OrZero a
$mNonZero :: forall r a. OrZero a -> (a -> r) -> (Void# -> r) -> r
NonZero x = Ap (Just x)
{-# COMPLETE Zero, NonZero #-}
orZeroToNum :: Num a => (b -> a) -> OrZero b -> a
orZeroToNum :: (b -> a) -> OrZero b -> a
orZeroToNum b -> a
_ OrZero b
Zero = a
0
orZeroToNum b -> a
f (NonZero b
x) = b -> a
f b
x
evalAll :: forall n. KnownNat n => DirichletCharacter n -> Vector (OrZero RootOfUnity)
evalAll :: DirichletCharacter n -> Vector (OrZero RootOfUnity)
evalAll (Generated [DirichletFactor]
xs) = Int -> (Int -> OrZero RootOfUnity) -> Vector (OrZero RootOfUnity)
forall a. Int -> (Int -> a) -> Vector a
V.generate (Natural -> Int
naturalToInt Natural
n) Int -> OrZero RootOfUnity
func
where n :: Natural
n = Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
vectors :: [(Int, Vector (OrZero RootOfUnity))]
vectors = (DirichletFactor -> (Int, Vector (OrZero RootOfUnity)))
-> [DirichletFactor] -> [(Int, Vector (OrZero RootOfUnity))]
forall a b. (a -> b) -> [a] -> [b]
map DirichletFactor -> (Int, Vector (OrZero RootOfUnity))
mkVector [DirichletFactor]
xs
func :: Int -> OrZero RootOfUnity
func :: Int -> OrZero RootOfUnity
func Int
m = ((Int, Vector (OrZero RootOfUnity)) -> OrZero RootOfUnity)
-> [(Int, Vector (OrZero RootOfUnity))] -> OrZero RootOfUnity
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int, Vector (OrZero RootOfUnity)) -> OrZero RootOfUnity
go [(Int, Vector (OrZero RootOfUnity))]
vectors
where go :: (Int, Vector (OrZero RootOfUnity)) -> OrZero RootOfUnity
go :: (Int, Vector (OrZero RootOfUnity)) -> OrZero RootOfUnity
go (Int
modulus,Vector (OrZero RootOfUnity)
v) = Vector (OrZero RootOfUnity)
v Vector (OrZero RootOfUnity) -> Int -> OrZero RootOfUnity
forall a. Vector a -> Int -> a
! (Int
m Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
modulus)
mkVector :: DirichletFactor -> (Int, Vector (OrZero RootOfUnity))
mkVector :: DirichletFactor -> (Int, Vector (OrZero RootOfUnity))
mkVector DirichletFactor
Two = (Int
2, [OrZero RootOfUnity] -> Vector (OrZero RootOfUnity)
forall a. [a] -> Vector a
V.fromList [OrZero RootOfUnity
forall a. OrZero a
Zero, OrZero RootOfUnity
forall a. Monoid a => a
mempty])
mkVector (OddPrime Prime Natural
p Word
k (Natural -> Int
naturalToInt -> Int
g) RootOfUnity
a) = (Int
modulus, Vector (OrZero RootOfUnity)
w)
where
p' :: Natural
p' = Prime Natural -> Natural
forall a. Prime a -> a
unPrime Prime Natural
p
modulus :: Int
modulus = Natural -> Int
naturalToInt (Natural
p'Natural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^Word
k) :: Int
w :: Vector (OrZero RootOfUnity)
w = (forall s. ST s (MVector s (OrZero RootOfUnity)))
-> Vector (OrZero RootOfUnity)
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s (OrZero RootOfUnity)))
-> Vector (OrZero RootOfUnity))
-> (forall s. ST s (MVector s (OrZero RootOfUnity)))
-> Vector (OrZero RootOfUnity)
forall a b. (a -> b) -> a -> b
$ do
MVector s (OrZero RootOfUnity)
v <- Int
-> OrZero RootOfUnity
-> ST s (MVector (PrimState (ST s)) (OrZero RootOfUnity))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
MV.replicate Int
modulus OrZero RootOfUnity
forall a. OrZero a
Zero
let powers :: [(Int, RootOfUnity)]
powers = ((Int, RootOfUnity) -> Maybe (Int, RootOfUnity))
-> (Int, RootOfUnity) -> [(Int, RootOfUnity)]
forall a. (a -> Maybe a) -> a -> [a]
iterateMaybe (Int, RootOfUnity) -> Maybe (Int, RootOfUnity)
go (Int
1,RootOfUnity
forall a. Monoid a => a
mempty)
go :: (Int, RootOfUnity) -> Maybe (Int, RootOfUnity)
go (Int
m,RootOfUnity
x) = if Int
m' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then (Int, RootOfUnity) -> Maybe (Int, RootOfUnity)
forall a. a -> Maybe a
Just (Int
m', RootOfUnity
xRootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<>RootOfUnity
a)
else Maybe (Int, RootOfUnity)
forall a. Maybe a
Nothing
where m' :: Int
m' = Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
g Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
modulus
[(Int, RootOfUnity)] -> ((Int, RootOfUnity) -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Int, RootOfUnity)]
powers (((Int, RootOfUnity) -> ST s ()) -> ST s ())
-> ((Int, RootOfUnity) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Int
m,RootOfUnity
x) -> MVector (PrimState (ST s)) (OrZero RootOfUnity)
-> Int -> OrZero RootOfUnity -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (OrZero RootOfUnity)
MVector (PrimState (ST s)) (OrZero RootOfUnity)
v Int
m (RootOfUnity -> OrZero RootOfUnity
forall a. a -> OrZero a
NonZero RootOfUnity
x)
MVector s (OrZero RootOfUnity)
-> ST s (MVector s (OrZero RootOfUnity))
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s (OrZero RootOfUnity)
v
mkVector (TwoPower Int
k RootOfUnity
a RootOfUnity
b) = (Int
modulus, Vector (OrZero RootOfUnity)
w)
where
modulus :: Int
modulus = Int -> Int
forall a. Bits a => Int -> a
bit Int
k
w :: Vector (OrZero RootOfUnity)
w = Int -> (Int -> OrZero RootOfUnity) -> Vector (OrZero RootOfUnity)
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
modulus Int -> OrZero RootOfUnity
f
f :: Int -> OrZero RootOfUnity
f Int
m
| Int -> Bool
forall a. Integral a => a -> Bool
even Int
m = OrZero RootOfUnity
forall a. OrZero a
Zero
| Bool
otherwise = RootOfUnity -> OrZero RootOfUnity
forall a. a -> OrZero a
NonZero ((if Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
m Int
1 then RootOfUnity
a else RootOfUnity
forall a. Monoid a => a
mempty) RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
<> Integer -> Int -> Integer
lambda (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m'') Int
k Integer -> RootOfUnity -> RootOfUnity
forall a b. (Semigroup a, Integral b) => b -> a -> a
`stimes` RootOfUnity
b)
where m'' :: Int
m'' = Int -> Int -> Int
forall p. (Bits p, Num p) => Int -> p -> p
thingy Int
k Int
m
iterateMaybe :: (a -> Maybe a) -> a -> [a]
iterateMaybe :: (a -> Maybe a) -> a -> [a]
iterateMaybe a -> Maybe a
f a
x = (Maybe a -> Maybe (a, Maybe a)) -> Maybe a -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ((a -> (a, Maybe a)) -> Maybe a -> Maybe (a, Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
t -> (a
t, a -> Maybe a
f a
t))) (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
fromTable :: forall n. KnownNat n => Vector (OrZero RootOfUnity) -> Maybe (DirichletCharacter n)
fromTable :: Vector (OrZero RootOfUnity) -> Maybe (DirichletCharacter n)
fromTable Vector (OrZero RootOfUnity)
v = if Vector (OrZero RootOfUnity) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (OrZero RootOfUnity)
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> Int
naturalToInt Natural
n
then (Template -> Maybe DirichletFactor)
-> [Template] -> Maybe [DirichletFactor]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Template -> Maybe DirichletFactor
makeFactor [Template]
tmpl Maybe [DirichletFactor]
-> ([DirichletFactor] -> Maybe (DirichletCharacter n))
-> Maybe (DirichletCharacter n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DirichletCharacter n -> Maybe (DirichletCharacter n)
check (DirichletCharacter n -> Maybe (DirichletCharacter n))
-> ([DirichletFactor] -> DirichletCharacter n)
-> [DirichletFactor]
-> Maybe (DirichletCharacter n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DirichletFactor] -> DirichletCharacter n
forall (n :: Nat). [DirichletFactor] -> DirichletCharacter n
Generated
else Maybe (DirichletCharacter n)
forall a. Maybe a
Nothing
where n :: Natural
n = Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
n' :: Integer
n' = Natural -> Integer
naturalToInteger Natural
n :: Integer
tmpl :: [Template]
tmpl = (Product Natural, [Template]) -> [Template]
forall a b. (a, b) -> b
snd (Natural -> (Product Natural, [Template])
mkTemplate Natural
n)
check :: DirichletCharacter n -> Maybe (DirichletCharacter n)
check :: DirichletCharacter n -> Maybe (DirichletCharacter n)
check DirichletCharacter n
chi = if DirichletCharacter n -> Vector (OrZero RootOfUnity)
forall (n :: Nat).
KnownNat n =>
DirichletCharacter n -> Vector (OrZero RootOfUnity)
evalAll DirichletCharacter n
chi Vector (OrZero RootOfUnity) -> Vector (OrZero RootOfUnity) -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (OrZero RootOfUnity)
v then DirichletCharacter n -> Maybe (DirichletCharacter n)
forall a. a -> Maybe a
Just DirichletCharacter n
chi else Maybe (DirichletCharacter n)
forall a. Maybe a
Nothing
makeFactor :: Template -> Maybe DirichletFactor
makeFactor :: Template -> Maybe DirichletFactor
makeFactor Template
TwoTemplate = DirichletFactor -> Maybe DirichletFactor
forall a. a -> Maybe a
Just DirichletFactor
Two
makeFactor (TwoPTemplate Int
k Natural
_) = Int -> RootOfUnity -> RootOfUnity -> DirichletFactor
TwoPower Int
k (RootOfUnity -> RootOfUnity -> DirichletFactor)
-> Maybe RootOfUnity -> Maybe (RootOfUnity -> DirichletFactor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Maybe RootOfUnity
getValue (-Integer
1,Int -> Integer
forall a. Bits a => Int -> a
bit Int
k) Maybe (RootOfUnity -> DirichletFactor)
-> Maybe RootOfUnity -> Maybe DirichletFactor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer, Integer) -> Maybe RootOfUnity
getValue (Int -> Integer
exp4 Int
k, Int -> Integer
forall a. Bits a => Int -> a
bit Int
k)
makeFactor (OddTemplate Prime Natural
p Word
k Natural
g Natural
_) = Prime Natural -> Word -> Natural -> RootOfUnity -> DirichletFactor
OddPrime Prime Natural
p Word
k Natural
g (RootOfUnity -> DirichletFactor)
-> Maybe RootOfUnity -> Maybe DirichletFactor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Maybe RootOfUnity
getValue (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
g, Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Prime Natural -> Natural
forall a. Prime a -> a
unPrime Prime Natural
p)Integer -> Word -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Word
k)
getValue :: (Integer, Integer) -> Maybe RootOfUnity
getValue :: (Integer, Integer) -> Maybe RootOfUnity
getValue (Integer
g, Integer
m) = OrZero RootOfUnity -> Maybe RootOfUnity
forall k (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Vector (OrZero RootOfUnity)
v Vector (OrZero RootOfUnity) -> Int -> OrZero RootOfUnity
forall a. Vector a -> Int -> a
! Integer -> Int
forall a. Num a => Integer -> a
fromInteger ((Integer, Integer) -> Integer
forall a b. (a, b) -> a
fst (Maybe (Integer, Integer) -> (Integer, Integer)
forall a. HasCallStack => Maybe a -> a
fromJust ((Integer, Integer)
-> (Integer, Integer) -> Maybe (Integer, Integer)
forall a.
(Eq a, Ring a, Euclidean a) =>
(a, a) -> (a, a) -> Maybe (a, a)
chinese (Integer
g, Integer
m) (Integer
1, Integer
n' Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
m))) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n'))
exp4terms :: [Rational]
exp4terms :: [Ratio Integer]
exp4terms = [Integer
4Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
k Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Integer
1..Integer
k] | Integer
k <- [Integer
0..]]
exp4 :: Int -> Integer
exp4 :: Int -> Integer
exp4 Int
n
= (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Int -> Integer
forall a. Bits a => Int -> a
bit Int
n)
(Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Ratio Integer -> Integer) -> [Ratio Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\Ratio Integer
q -> (Ratio Integer -> Integer
forall a. Ratio a -> a
numerator Ratio Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"error in exp4") (Integer -> Integer -> Maybe Integer
recipMod (Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
q) (Int -> Integer
forall a. Bits a => Int -> a
bit Int
n))) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Int -> Integer
forall a. Bits a => Int -> a
bit Int
n)
([Ratio Integer] -> [Integer]) -> [Ratio Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Int -> [Ratio Integer] -> [Ratio Integer]
forall a. Int -> [a] -> [a]
take Int
n [Ratio Integer]
exp4terms