| Copyright | (c) 2018 Alexandre Rodrigues Baldé |
|---|---|
| License | MIT |
| Maintainer | Alexandre Rodrigues Baldé <alexandrer_b@outlook.com> |
| Stability | Provisional |
| Portability | Non-portable (GHC extensions) |
| Safe Haskell | None |
| Language | Haskell2010 |
Math.NumberTheory.Quadratic.EisensteinIntegers
Contents
Description
This module exports functions for manipulating Eisenstein integers, including computing their prime factorisations.
Synopsis
- data EisensteinInteger = (:+) {}
- ω :: EisensteinInteger
- conjugate :: EisensteinInteger -> EisensteinInteger
- norm :: EisensteinInteger -> Integer
- associates :: EisensteinInteger -> [EisensteinInteger]
- ids :: [EisensteinInteger]
- divideByThree :: EisensteinInteger -> (Int, EisensteinInteger)
- factorise :: EisensteinInteger -> [(EisensteinInteger, Int)]
- findPrime :: Integer -> EisensteinInteger
- isPrime :: EisensteinInteger -> Bool
- primes :: [EisensteinInteger]
Documentation
data EisensteinInteger Source #
An Eisenstein integer is a + bω, where a and b are both integers.
Instances
ω :: EisensteinInteger Source #
The imaginary unit for Eisenstein integers, where
ω == (-1/2) + ((sqrt 3)/2)ι == exp(2*pi*ι/3)
and ι is the usual imaginary unit with ι² == -1.
conjugate :: EisensteinInteger -> EisensteinInteger Source #
Conjugate a Eisenstein integer.
norm :: EisensteinInteger -> Integer Source #
The square of the magnitude of a Eisenstein integer.
associates :: EisensteinInteger -> [EisensteinInteger] Source #
Produce a list of an EisensteinInteger's associates.
ids :: [EisensteinInteger] Source #
List of all Eisenstein units, counterclockwise across all sextants,
starting with 1.
divideByThree :: EisensteinInteger -> (Int, EisensteinInteger) Source #
Remove 1 - ω factors from an EisensteinInteger, and calculate that
prime's multiplicity in the number's factorisation.
Primality functions
factorise :: EisensteinInteger -> [(EisensteinInteger, Int)] Source #
Compute the prime factorisation of a Eisenstein integer. This is unique
up to units (+- 1, +- ω, +/- ω²).
* Unit factors are not included in the result.
* All prime factors are primary i.e. e ≡ 2 (modE 3), for an Eisenstein
prime factor e.
- This function works by factorising the norm of an Eisenstein integer
and then, for each prime factor, finding the Eisenstein prime whose norm
is said prime factor with
findPrime. - This is only possible because the norm function of the Euclidean Domain of
Eisenstein integers is multiplicative:
norm (e1 * e2) == norm e1 * norm e2for any twoEisensteinIntegerse1, e2. - In the previously mentioned work Bandara, Sarada, "An Exposition of the Eisenstein Integers" (2016),
in Theorem 8.4 in Chapter 8, a way is given to express any Eisenstein
integer
μas(-1)^a * ω^b * (1 - ω)^c * product [π_i^a_i | i <- [1..N]]wherea, b, c, a_iare nonnegative integers,N > 1is an integer andπ_iare primary primes (for a primary Eisenstein primep,p ≡ 2 (modE 3), seeprimaryabove). - Aplying
normto both sides of Theorem 8.4:norm μ = norm ((-1)^a * ω^b * (1 - ω)^c * product [ π_i^a_i | i <- [1..N]])==norm μ = norm ((-1)^a) * norm (ω^b) * norm ((1 - ω)^c) * norm (product [ π_i^a_i | i <- [1..N]])==norm μ = (norm (-1))^a * (norm ω)^b * (norm (1 - ω))^c * product [ norm (π_i^a_i) | i <- [1..N]]==norm μ = (norm (-1))^a * (norm ω)^b * (norm (1 - ω))^c * product [ (norm π_i)^a_i) | i <- [1..N]]==norm μ = 1^a * 1^b * 3^c * product [ (norm π_i)^a_i) | i <- [1..N]]==norm μ = 3^c * product [ (norm π_i)^a_i) | i <- [1..N]]wherea, b, c, a_iare nonnegative integers, andN > 1is an integer. - The remainder of the Eisenstein integer factorisation problem is about
finding appropriate
[e_i | i <- [1..M]such that(nub . map norm) [e_i | i <- [1..N]] == [π_i | i <- [1..N]]where1 < N <= Mare integers,nubremoves duplicates and==is equality on sets. - The reason
M >= Nis because the prime factors of an Eisenstein integer may include a prime factor and its conjugate, meaning the number may have more Eisenstein prime factors than its norm has integer prime factors.
findPrime :: Integer -> EisensteinInteger Source #
Find an Eisenstein integer whose norm is the given prime number
in the form 3k + 1 using a modification of the
Hermite-Serret algorithm.
The maintainer Andrew Lelechenko
derived the following:
* Each prime of form 3n+1 is actually of form 6k+1.
* One has (z+3k)^2 ≡ z^2 + 6kz + 9k^2 ≡ z^2 + (6k+1)z - z + 9k^2 ≡ z^2 - z + 9k^2 (mod 6k+1).
- The goal is to solve
z^2 - z + 1 ≡ 0 (mod 6k+1). One has:z^2 - z + 9k^2 ≡ 9k^2 - 1 (mod 6k+1)(z+3k)^2 ≡ 9k^2-1 (mod 6k+1)z+3k = sqrtMod(9k^2-1)z = sqrtMod(9k^2-1) - 3k - For example, let
p = 7, thenk = 1. Square root of9*1^2-1 modulo 7is1. - And
z = 1 - 3*1 = -2 ≡ 5 (mod 7). - Truly,
norm (5 :+ 1) = 25 - 5 + 1 = 21 ≡ 0 (mod 7).
isPrime :: EisensteinInteger -> Bool Source #
Checks if a given EisensteinInteger is prime. EisensteinIntegers
whose norm is a prime congruent to 0 or 1 modulo 3 are prime.
See Bandara, Sarada, "An Exposition of the Eisenstein Integers" (2016),
page 12.
primes :: [EisensteinInteger] Source #
An infinite list of Eisenstein primes. Uses primes in Z to exhaustively
generate all Eisenstein primes in order of ascending magnitude.
* Every prime is in the first sextant, so the list contains no associates.
* Eisenstein primes from the whole complex plane can be generated by
applying associates to each prime in this list.