-- |
-- Module:      Math.NumberTheory.DirichletCharacters
-- Copyright:   (c) 2018 Bhavik Mehta
-- Licence:     MIT
-- Maintainer:  Bhavik Mehta <bhavikmehta8@gmail.com>
--
-- Implementation and enumeration of Dirichlet characters.
--

{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE ViewPatterns               #-}

module Math.NumberTheory.DirichletCharacters
  (
  -- * An absorbing semigroup
  OrZero, pattern Zero, pattern NonZero
  , orZeroToNum
  -- * Dirichlet characters
  , DirichletCharacter
  -- ** Construction
  , indexToChar
  , indicesToChars
  , characterNumber
  , allChars
  , fromTable
  -- ** Evaluation
  , eval
  , evalGeneral
  , evalAll
  -- ** Special Dirichlet characters
  , principalChar
  , isPrincipal
  , orderChar
  -- ** Real Dirichlet characters
  , RealCharacter
  , isRealCharacter
  , getRealChar
  , toRealFunction
  , jacobiCharacter
  -- ** Primitive characters
  , PrimitiveCharacter
  , isPrimitive
  , getPrimitiveChar
  , induced
  , makePrimitive
  , WithNat(..)
  -- * Roots of unity
  , RootOfUnity(..)
  , toRootOfUnity
  , toComplex
  -- * Debugging
  , 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

-- | A Dirichlet character mod \(n\) is a group homomorphism from \((\mathbb{Z}/n\mathbb{Z})^*\)
-- to \(\mathbb{C}^*\), represented abstractly by `DirichletCharacter`. In particular, they take
-- values at roots of unity and can be evaluated using `eval`.
-- A Dirichlet character can be extended to a completely multiplicative function on \(\mathbb{Z}\)
-- by assigning the value 0 for \(a\) sharing a common factor with \(n\), using `evalGeneral`.
--
-- There are finitely many possible Dirichlet characters for a given modulus, in particular there
-- are \(\phi(n)\) characters modulo \(n\), where \(\phi\) refers to Euler's `totient` function.
-- This gives rise to `Enum` and `Bounded` instances.
newtype DirichletCharacter (n :: Nat) = Generated [DirichletFactor]

-- | The group (Z/nZ)^* decomposes to a product (Z/2^k0 Z)^* x (Z/p1^k1 Z)^* x ... x (Z/pi^ki Z)^*
-- where n = 2^k0 p1^k1 ... pi^ki, and the pj are odd primes, k0 possibly 0. Thus, a group
-- homomorphism from (Z/nZ)^* is characterised by group homomorphisms from each of these factor
-- groups. Furthermore, for odd p, we have (Z/p^k Z)^* isomorphic to Z / p^(k-1)*(p-1) Z, an
-- additive group, where an isomorphism is specified by a choice of primitive root.
-- Similarly, for k >= 2, (Z/2^k Z)^* is isomorphic to Z/2Z * (Z / 2^(k-2) Z) (and for k < 2
-- it is trivial).  (See @lambda@ for this isomorphism).
-- Thus, to specify a Dirichlet character, it suffices to specify the value of generators
-- of each of these cyclic groups, when primitive roots are given. This data is given by a
-- DirichletFactor.
-- We have the invariant that the factors must be given in strictly increasing order, and the
-- generator is as given by @generator@, and are each non-trivial. These conditions are verified
-- using `validChar`.
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 -- this ought to be Word, but many applications
                                                    -- needed to use wordToInt, so Int is cleaner
                                                    -- Required to be >= 2
                                , 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

-- | For primes, define the canonical primitive root as the smallest such.
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]

-- | Implement the function \(\lambda\) from page 5 of
-- https://www2.eecs.berkeley.edu/Pubs/TechRpts/1984/CSD-84-186.pdf
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))


-- | For elements of the multiplicative group \((\mathbb{Z}/n\mathbb{Z})^*\), a Dirichlet
-- character evaluates to a root of unity.
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

-- | Evaluate each factor of the Dirichlet character.
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)

-- | A character can evaluate to a root of unity or zero: represented by @Nothing@.
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

-- | Give the principal character for this modulus: a principal character mod \(n\) is 1 for
-- \(a\) coprime to \(n\), and 0 otherwise.
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"

-- | This Semigroup is in fact a group, so @stimes@ can be called with a negative first argument.
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

-- | We define `succ` and `pred` with more efficient implementations than
-- @`toEnum` . (+1) . `fromEnum`@.
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)

-- | We have a (non-canonical) enumeration of dirichlet characters.
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

-- | Give the dirichlet character from its number.
-- Inverse of `characterNumber`.
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

-- | Give a collection of dirichlet characters from their numbers. This may be more efficient than
-- `indexToChar` for multiple characters, as it prevents some internal recalculations.
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

-- | List all characters for the modulus. This is preferred to using @[minBound..maxBound]@.
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)

-- | The same as `indexToChar`, but if we're given a character we can create others more efficiently.
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

-- | Use one character to make many more: better than indicesToChars since it avoids recalculating
-- some primitive roots
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

-- We assign each natural a unique Template, which can be decorated (eg in `unroll`) to
-- form a DirichletCharacter. A Template effectively holds the information carried around
-- in a DirichletFactor which depends only on the modulus of the character.
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
                             } -- the modulus is derivable from the other values, but calculation
                               -- may be expensive, so we pre-calculate it
                               -- morally getModulus should be a prefactored but seems to be
                               -- pointless here
              | 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)

-- the validity of the producted dirichletfactor list here requires the template to be valid
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)

-- | Test if a given Dirichlet character is prinicpal for its modulus: a principal character mod
-- \(n\) is 1 for \(a\) coprime to \(n\), and 0 otherwise.
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

-- | Induce a Dirichlet character to a higher modulus. If \(d \mid n\), then \(a \bmod{n}\) can be
-- reduced to \(a \bmod{d}\). Thus, the multiplicative function on \(\mathbb{Z}/d\mathbb{Z}\)
-- induces a multiplicative function on \(\mathbb{Z}/n\mathbb{Z}\).
--
-- >>> :set -XTypeApplications -XDataKinds
-- >>> chi = indexToChar 5 :: DirichletCharacter 45
-- >>> chi2 = induced @135 chi :: Maybe (DirichletCharacter 135)
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

-- | The <https://en.wikipedia.org/wiki/Jacobi_symbol Jacobi symbol> gives a real Dirichlet
-- character for odd moduli.
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)
          -- jacobi symbol of a primitive root mod p over p is always -1
        go Template
_ = [Char] -> DirichletFactor
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error in jacobiCharacter: please report this as a bug"
          -- every factor of n should be odd

-- | A Dirichlet character is real if it is real-valued.
newtype RealCharacter n = RealChar { -- | Extract the character itself from a `RealCharacter`.
                                     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

-- | Test if a given `DirichletCharacter` is real, and if so give a `RealCharacter`.
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

-- TODO: it should be possible to calculate this without eval/evalGeneral
-- and thus avoid using discrete log calculations: consider the order of m
-- inside each of the factor groups?
-- | Evaluate a real Dirichlet character, which can only take values \(-1,0,1\).
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"
                                      -- A real character should not be able to evaluate to
                                      -- anything other than {-1,0,1}, so should not reach this branch

-- | Test if the internal DirichletCharacter structure is valid.
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

-- | Get the order of the Dirichlet Character.
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

-- | Test if a Dirichlet character is <https://en.wikipedia.org/wiki/Dirichlet_character#Primitive_characters_and_conductor primitive>.
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
        -- for odd p, we're testing if phi(p^(k-1)) `stimes` a is 1, since this means the
        -- character can come from some the smaller modulus p^(k-1)
        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

-- | A Dirichlet character is primitive if cannot be 'induced' from any character with
-- strictly smaller modulus.
newtype PrimitiveCharacter n = PrimitiveCharacter { -- | Extract the character itself from a `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

-- | Wrapper to hide an unknown type-level natural.
data WithNat (a :: Nat -> Type) where
  WithNat :: KnownNat m => a m -> WithNat a

-- | This function also provides access to the new modulus on type level, with a KnownNat instance
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

-- | Similar to Maybe, but with different Semigroup and Monoid instances.
type OrZero a = Ap Maybe a

-- | 'Ap' 'Nothing'
pattern Zero :: OrZero a
pattern $bZero :: OrZero a
$mZero :: forall r a. OrZero a -> (Void# -> r) -> (Void# -> r) -> r
Zero = Ap Nothing

-- | 'Ap' ('Just' x)
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 #-}

-- | Interpret an `OrZero` as a number, taking the `Zero` case to be 0.
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

-- | In general, evaluating a DirichletCharacter at a point involves solving the discrete logarithm
-- problem, which can be hard: the implementations here are around O(sqrt n).
-- However, evaluating a dirichlet character at every point amounts to solving the discrete
-- logarithm problem at every point also, which can be done together in O(n) time, better than
-- using a complex algorithm at each point separately. Thus, if a large number of evaluations
-- of a dirichlet character are required, `evalAll` will be better than `evalGeneral`, since
-- computations can be shared.
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
              -- TODO: we're in the ST monad here anyway, could be better to use STRefs to manage
              -- this loop, the current implementation probably doesn't fuse well
              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)
              -- don't bother with bounds check since m was reduced mod p^k
              MVector s (OrZero RootOfUnity)
-> ST s (MVector s (OrZero RootOfUnity))
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s (OrZero RootOfUnity)
v
        -- for powers of two we use lambda directly instead, since the generators of the cyclic
        -- groups aren't obvious; it's possible to get them though:
        -- 5^(lambda(5)^{-1} mod 2^(p-2)) mod 2^p
        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

-- somewhere between unfoldr and iterate
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)

-- | Attempt to construct a character from its table of values.
-- An inverse to `evalAll`, defined only on its image.
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..]]

-- For reasons that aren't clear to me, `exp4` gives the inverse of 1 under lambda, so it gives the generator
-- This is the same as https://oeis.org/A320814
-- In particular, lambda (exp4 n) n == 1 (for n >= 3)
-- I've verified this for 3 <= n <= 2000, so the reasoning in fromTable should be accurate for moduli below 2^2000
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