Processing math: 100%
arithmoi-0.13.1.0: Efficient basic number-theoretic functions.
Copyright(c) 2018 Bhavik Mehta
LicenseMIT
MaintainerBhavik Mehta <bhavikmehta8@gmail.com>
Safe HaskellNone
LanguageHaskell2010

Math.NumberTheory.DirichletCharacters

Description

Implementation and enumeration of Dirichlet characters.

Synopsis

An absorbing semigroup

type OrZero a = Ap Maybe a Source #

Similar to Maybe, but with different Semigroup and Monoid instances.

pattern NonZero :: a -> OrZero a Source #

Ap (Just x)

orZeroToNum :: Num a => (b -> a) -> OrZero b -> a Source #

Interpret an OrZero as a number, taking the Zero case to be 0.

Dirichlet characters

data DirichletCharacter (n :: Nat) Source #

A Dirichlet character mod n is a group homomorphism from (Z/nZ) to 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 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 ϕ(n) characters modulo n, where ϕ refers to Euler's totient function. This gives rise to Enum and Bounded instances.

Instances

Instances details
KnownNat n => Monoid (DirichletCharacter n) Source # 
Instance details

Defined in Math.NumberTheory.DirichletCharacters

Semigroup (DirichletCharacter n) Source #

This Semigroup is in fact a group, so stimes can be called with a negative first argument.

Instance details

Defined in Math.NumberTheory.DirichletCharacters

KnownNat n => Bounded (DirichletCharacter n) Source # 
Instance details

Defined in Math.NumberTheory.DirichletCharacters

KnownNat n => Enum (DirichletCharacter n) Source #

We define succ and pred with more efficient implementations than toEnum . (+1) . fromEnum.

Instance details

Defined in Math.NumberTheory.DirichletCharacters

Eq (DirichletCharacter n) Source # 
Instance details

Defined in Math.NumberTheory.DirichletCharacters

Construction

indexToChar :: forall (n :: Nat). KnownNat n => Natural -> DirichletCharacter n Source #

Give the dirichlet character from its number. Inverse of characterNumber.

indicesToChars :: forall (n :: Nat) f. (KnownNat n, Functor f) => f Natural -> f (DirichletCharacter n) Source #

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.

characterNumber :: forall (n :: Nat). DirichletCharacter n -> Integer Source #

We have a (non-canonical) enumeration of dirichlet characters.

allChars :: forall (n :: Nat). KnownNat n => [DirichletCharacter n] Source #

List all characters for the modulus. This is preferred to using [minBound..maxBound].

fromTable :: forall (n :: Nat). KnownNat n => Vector (OrZero RootOfUnity) -> Maybe (DirichletCharacter n) Source #

Attempt to construct a character from its table of values. An inverse to evalAll, defined only on its image.

Evaluation

eval :: forall (n :: Nat). DirichletCharacter n -> MultMod n -> RootOfUnity Source #

For elements of the multiplicative group (Z/nZ), a Dirichlet character evaluates to a root of unity.

evalGeneral :: forall (n :: Nat). KnownNat n => DirichletCharacter n -> Mod n -> OrZero RootOfUnity Source #

A character can evaluate to a root of unity or zero: represented by Nothing.

evalAll :: forall (n :: Nat). KnownNat n => DirichletCharacter n -> Vector (OrZero RootOfUnity) Source #

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.

Special Dirichlet characters

principalChar :: forall (n :: Nat). KnownNat n => DirichletCharacter n Source #

Give the principal character for this modulus: a principal character mod n is 1 for a coprime to n, and 0 otherwise.

isPrincipal :: forall (n :: Nat). DirichletCharacter n -> Bool Source #

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.

orderChar :: forall (n :: Nat). DirichletCharacter n -> Integer Source #

Get the order of the Dirichlet Character.

Real Dirichlet characters

data RealCharacter (n :: Nat) Source #

A Dirichlet character is real if it is real-valued.

Instances

Instances details
Eq (RealCharacter n) Source # 
Instance details

Defined in Math.NumberTheory.DirichletCharacters

isRealCharacter :: forall (n :: Nat). DirichletCharacter n -> Maybe (RealCharacter n) Source #

Test if a given DirichletCharacter is real, and if so give a RealCharacter.

getRealChar :: RealCharacter n -> DirichletCharacter n Source #

Extract the character itself from a RealCharacter.

toRealFunction :: forall (n :: Nat). KnownNat n => RealCharacter n -> Mod n -> Int Source #

Evaluate a real Dirichlet character, which can only take values 1,0,1.

jacobiCharacter :: forall (n :: Nat). KnownNat n => Maybe (RealCharacter n) Source #

The Jacobi symbol gives a real Dirichlet character for odd moduli.

Primitive characters

data PrimitiveCharacter (n :: Nat) Source #

A Dirichlet character is primitive if cannot be induced from any character with strictly smaller modulus.

Instances

Instances details
Eq (PrimitiveCharacter n) Source # 
Instance details

Defined in Math.NumberTheory.DirichletCharacters

isPrimitive :: forall (n :: Nat). DirichletCharacter n -> Maybe (PrimitiveCharacter n) Source #

Test if a Dirichlet character is primitive.

induced :: forall (n :: Nat) (d :: Nat). (KnownNat d, KnownNat n) => DirichletCharacter d -> Maybe (DirichletCharacter n) Source #

Induce a Dirichlet character to a higher modulus. If dn, then amodn can be reduced to amodd. Thus, the multiplicative function on Z/dZ induces a multiplicative function on Z/nZ.

>>> :set -XTypeApplications -XDataKinds
>>> chi = indexToChar 5 :: DirichletCharacter 45
>>> chi2 = induced @135 chi :: Maybe (DirichletCharacter 135)

makePrimitive :: forall (n :: Nat). DirichletCharacter n -> WithNat PrimitiveCharacter Source #

This function also provides access to the new modulus on type level, with a KnownNat instance

data WithNat (a :: Nat -> Type) where Source #

Wrapper to hide an unknown type-level natural.

Constructors

WithNat :: forall (m :: Nat) (a :: Nat -> Type). KnownNat m => a m -> WithNat a 

Roots of unity

newtype RootOfUnity Source #

A representation of roots of unity: complex numbers z for which there is n such that zn=1.

Constructors

RootOfUnity 

Fields

  • fromRootOfUnity :: Rational

    Every root of unity can be expressed as e2πiq for some rational q satisfying 0q<1, this function extracts it.

Instances

Instances details
Monoid RootOfUnity Source # 
Instance details

Defined in Math.NumberTheory.RootsOfUnity

Semigroup RootOfUnity Source #

This Semigroup is in fact a group, so stimes can be called with a negative first argument.

Instance details

Defined in Math.NumberTheory.RootsOfUnity

Show RootOfUnity Source # 
Instance details

Defined in Math.NumberTheory.RootsOfUnity

Eq RootOfUnity Source # 
Instance details

Defined in Math.NumberTheory.RootsOfUnity

toRootOfUnity :: Rational -> RootOfUnity Source #

Given a rational q, produce the root of unity e2πiq.

toComplex :: Floating a => RootOfUnity -> Complex a Source #

Convert a root of unity into an inexact complex number. Due to floating point inaccuracies, it is recommended to avoid use of this until the end of a calculation. Alternatively, with the cyclotomic package, one can use polarRat 1 . fromRootOfUnity to convert to a cyclotomic number.

Debugging

validChar :: forall (n :: Nat). KnownNat n => DirichletCharacter n -> Bool Source #

Test if the internal DirichletCharacter structure is valid.