From 27feeae078e80eb0d06302d82b013cfe1af1ebfa Mon Sep 17 00:00:00 2001 From: folidota Date: Sat, 11 Apr 2020 23:42:32 +0100 Subject: [PATCH 01/18] Draft of CubicSymbol --- Math/NumberTheory/Moduli/CubicSymbol.hs | 34 +++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 Math/NumberTheory/Moduli/CubicSymbol.hs diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs new file mode 100644 index 000000000..fb53682b3 --- /dev/null +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -0,0 +1,34 @@ +module Math.NumberTheory.Moduli.CubicSymbol where + +import Math.NumberTheory.Quadratic.EisensteinIntegers +import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E + +import qualified Math.NumberTheory.Primes as P +import qualified Data.Euclidean as A + +data CubicSymbol = Zero | Omega | OmegaSquare | One + + +cubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol + +cubicSymbol alpha prime + -- Check whether @prime@ satifies norm and primality conditions. + | primeNorm == 3 = error "" + | (P.isPrime prime) == Nothing = error "" + -- Return 0 if @prime@ divides @alpha@ + | otherwise = omegaSymbol residue + + -- A.rem returns the remainder of the Euclidean algorithm. + where residue = A.rem alphaPower prime + -- Converts Eisenstein integer to CubicSymbol value. + omegaSymbol x + | x == 0 = Zero + | x == 0 E.:+ 1 = Omega + | x == (-1) E.:+ (-1) = OmegaSquare + | x == 1 = One + | otherwise = error "" + + primeNorm = E.norm prime + alphaPower = alpha^alphaExponent + -- Exponent is defined to be 1/3*(@primeNorm@ - 1). + alphaExponent = primeNorm `div` 3 From 8c7cb1ea7685d444bdc82160eaba6abc9963bf59 Mon Sep 17 00:00:00 2001 From: folidota Date: Sat, 11 Apr 2020 23:56:29 +0100 Subject: [PATCH 02/18] Edited arithmoi.cabal --- arithmoi.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/arithmoi.cabal b/arithmoi.cabal index f34f1b7f9..de893e0fc 100644 --- a/arithmoi.cabal +++ b/arithmoi.cabal @@ -59,6 +59,7 @@ library Math.NumberTheory.Moduli Math.NumberTheory.Moduli.Chinese Math.NumberTheory.Moduli.Class + Math.NumberTheory.Moduli.CubicSymbol Math.NumberTheory.Moduli.DiscreteLogarithm Math.NumberTheory.Moduli.Equations Math.NumberTheory.Moduli.Jacobi From ad0d2066622b541add6735d3ddc18785084e2088 Mon Sep 17 00:00:00 2001 From: folidota Date: Sun, 12 Apr 2020 16:53:51 +0100 Subject: [PATCH 03/18] Extended function to all integers and defined operations for CubicSymbol. --- Math/NumberTheory/Moduli/CubicSymbol.hs | 102 +++++++++++++++++++----- 1 file changed, 84 insertions(+), 18 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index fb53682b3..5b0fa09f8 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -1,34 +1,100 @@ -module Math.NumberTheory.Moduli.CubicSymbol where +module Math.NumberTheory.Moduli.CubicSymbol + ( CubicSymbol(..) + , conj + , cubicSymbol + ) where import Math.NumberTheory.Quadratic.EisensteinIntegers import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E import qualified Math.NumberTheory.Primes as P import qualified Data.Euclidean as A +import Data.Semigroup as S -data CubicSymbol = Zero | Omega | OmegaSquare | One -cubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol +data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) -cubicSymbol alpha prime +instance S.Semigroup CubicSymbol where + (<>) = multiplication + +instance Show CubicSymbol where + show x + | x == Zero = show 0 + | x == Omega = "ω" + | x == OmegaSquare = "ω²" + | x == One = show 1 + + +multiplication :: CubicSymbol -> CubicSymbol -> CubicSymbol +multiplication x y + | x == Zero || y == Zero = Zero + | x == One = y + | y == One = x + | x == Omega && y == Omega = OmegaSquare + | x == Omega && y == OmegaSquare = One + | x == OmegaSquare && y == Omega = One + | x == OmegaSquare && y == OmegaSquare = Omega + | otherwise = error "" + +exponentiation :: CubicSymbol -> Integer -> CubicSymbol +exponentiation symbol exponent + | symbol == Zero || symbol == One = symbol + | remainder == 0 = One + | symbol == Omega && remainder == 1 = Omega + | symbol == Omega && remainder == 2 = OmegaSquare + | symbol == OmegaSquare && remainder == 1 = OmegaSquare + | symbol == OmegaSquare && remainder == 1 = Omega + | otherwise = error "" + where remainder = exponent `rem` 3 + +conj :: CubicSymbol -> CubicSymbol +conj x + | x == Zero || x == One = x + | x == Omega = OmegaSquare + | x == OmegaSquare = Omega + | otherwise = error "" + + + +-- Converts Eisenstein integer to CubicSymbol value. +toCubicSymbol :: E.EisensteinInteger -> CubicSymbol +toCubicSymbol x + | x == 0 = Zero + | x == 0 E.:+ 1 = Omega + | x == (-1) E.:+ (-1) = OmegaSquare + | x == 1 = One + | otherwise = error "" + + +cubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol +cubicSymbol alpha n = Prelude.foldr (g) One factorisation + where factorisation = P.factorise n + g factor symbol = newSymbol <> symbol + where newSymbol = primePowerCubicSymbol alpha factor + + + +primePowerCubicSymbol :: E.EisensteinInteger -> (P.Prime E.EisensteinInteger, Word) -> CubicSymbol +primePowerCubicSymbol alpha (primeNumber, wordExponent) = exponentiation symbol exponent + where exponent = Prelude.fromIntegral wordExponent + symbol = primeCubicSymbol alpha prime + prime = P.unPrime primeNumber + + +primeCubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol +primeCubicSymbol alpha prime -- Check whether @prime@ satifies norm and primality conditions. - | primeNorm == 3 = error "" - | (P.isPrime prime) == Nothing = error "" + | primeNorm == 3 = error "This Eisenstein number is not coprime to 3." -- Return 0 if @prime@ divides @alpha@ - | otherwise = omegaSymbol residue + | otherwise = toCubicSymbol residue -- A.rem returns the remainder of the Euclidean algorithm. - where residue = A.rem alphaPower prime - -- Converts Eisenstein integer to CubicSymbol value. - omegaSymbol x - | x == 0 = Zero - | x == 0 E.:+ 1 = Omega - | x == (-1) E.:+ (-1) = OmegaSquare - | x == 1 = One - | otherwise = error "" - - primeNorm = E.norm prime - alphaPower = alpha^alphaExponent + where primeNorm = E.norm prime + residue = Prelude.foldr (f) 1 listOfAlphas + f = \x y -> A.rem (x * y) prime + -- The function @take@ does not accept Integer values. + listOfAlphas = [alpha | index <- [1..alphaExponent]] -- Exponent is defined to be 1/3*(@primeNorm@ - 1). alphaExponent = primeNorm `div` 3 + \ No newline at end of file From 72ce88f201460c607d481ec9ca1be442ddbf29ae Mon Sep 17 00:00:00 2001 From: folidota Date: Mon, 13 Apr 2020 00:06:01 +0100 Subject: [PATCH 04/18] Addressed comments on pattern matching --- Math/NumberTheory/Moduli/CubicSymbol.hs | 84 +++++++++++++------------ 1 file changed, 43 insertions(+), 41 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index 5b0fa09f8..510eab42e 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -1,15 +1,16 @@ +{-# LANGUAGE LambdaCase #-} + module Math.NumberTheory.Moduli.CubicSymbol ( CubicSymbol(..) , conj , cubicSymbol ) where -import Math.NumberTheory.Quadratic.EisensteinIntegers import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E - import qualified Math.NumberTheory.Primes as P import qualified Data.Euclidean as A -import Data.Semigroup as S +import qualified Data.Semigroup as S +import qualified Data.List as L @@ -19,52 +20,52 @@ instance S.Semigroup CubicSymbol where (<>) = multiplication instance Show CubicSymbol where - show x - | x == Zero = show 0 - | x == Omega = "ω" - | x == OmegaSquare = "ω²" - | x == One = show 1 + show = \case + Zero -> show 0 + Omega -> "ω" + OmegaSquare -> "ω²" + One -> show 1 multiplication :: CubicSymbol -> CubicSymbol -> CubicSymbol -multiplication x y - | x == Zero || y == Zero = Zero - | x == One = y - | y == One = x - | x == Omega && y == Omega = OmegaSquare - | x == Omega && y == OmegaSquare = One - | x == OmegaSquare && y == Omega = One - | x == OmegaSquare && y == OmegaSquare = Omega - | otherwise = error "" +multiplication Zero _ = Zero +multiplication _ Zero = Zero +multiplication One y = y +multiplication x One = x +multiplication Omega Omega = OmegaSquare +multiplication Omega OmegaSquare = One +multiplication OmegaSquare Omega = One +multiplication OmegaSquare OmegaSquare = Omega + + exponentiation :: CubicSymbol -> Integer -> CubicSymbol -exponentiation symbol exponent - | symbol == Zero || symbol == One = symbol - | remainder == 0 = One - | symbol == Omega && remainder == 1 = Omega - | symbol == Omega && remainder == 2 = OmegaSquare - | symbol == OmegaSquare && remainder == 1 = OmegaSquare - | symbol == OmegaSquare && remainder == 1 = Omega - | otherwise = error "" - where remainder = exponent `rem` 3 +exponentiation Zero _ = Zero +exponentiation One _ = One +exponentiation _ 0 = One +exponentiation Omega 1 = Omega +exponentiation Omega 2 = OmegaSquare +exponentiation OmegaSquare 1 = OmegaSquare +exponentiation OmegaSquare 2 = Omega -conj :: CubicSymbol -> CubicSymbol -conj x - | x == Zero || x == One = x - | x == Omega = OmegaSquare - | x == OmegaSquare = Omega - | otherwise = error "" +conj :: CubicSymbol -> CubicSymbol +conj = \case + Zero -> Zero + Omega -> OmegaSquare + OmegaSquare -> Omega + One -> One -- Converts Eisenstein integer to CubicSymbol value. toCubicSymbol :: E.EisensteinInteger -> CubicSymbol -toCubicSymbol x - | x == 0 = Zero - | x == 0 E.:+ 1 = Omega - | x == (-1) E.:+ (-1) = OmegaSquare - | x == 1 = One - | otherwise = error "" +toCubicSymbol = \case + 0 -> Zero + 0 E.:+ 1 -> Omega + (-1) E.:+ (-1) -> OmegaSquare + 1 -> One + + cubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol @@ -76,8 +77,9 @@ cubicSymbol alpha n = Prelude.foldr (g) One factorisation primePowerCubicSymbol :: E.EisensteinInteger -> (P.Prime E.EisensteinInteger, Word) -> CubicSymbol -primePowerCubicSymbol alpha (primeNumber, wordExponent) = exponentiation symbol exponent - where exponent = Prelude.fromIntegral wordExponent +primePowerCubicSymbol alpha (primeNumber, wordExponent) = exponentiation symbol remainder + where remainder = exponent `rem` 3 + exponent = Prelude.fromIntegral wordExponent symbol = primeCubicSymbol alpha prime prime = P.unPrime primeNumber @@ -94,7 +96,7 @@ primeCubicSymbol alpha prime residue = Prelude.foldr (f) 1 listOfAlphas f = \x y -> A.rem (x * y) prime -- The function @take@ does not accept Integer values. - listOfAlphas = [alpha | index <- [1..alphaExponent]] + listOfAlphas = L.genericReplicate alphaExponent alpha -- Exponent is defined to be 1/3*(@primeNorm@ - 1). alphaExponent = primeNorm `div` 3 \ No newline at end of file From d08fc9faec91e7c72bd14098c89bb18da74a0b6c Mon Sep 17 00:00:00 2001 From: folidota Date: Mon, 13 Apr 2020 20:37:07 +0100 Subject: [PATCH 05/18] Changed the implementation of the cubicSymbol function and added comments. --- Math/NumberTheory/Moduli/CubicSymbol.hs | 177 ++++++++++++++++-------- 1 file changed, 118 insertions(+), 59 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index 510eab42e..849aed217 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -17,29 +17,29 @@ import qualified Data.List as L data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) instance S.Semigroup CubicSymbol where - (<>) = multiplication + (<>) Zero _ = Zero + (<>) _ Zero = Zero + (<>) One y = y + (<>) x One = x + (<>) Omega Omega = OmegaSquare + (<>) Omega OmegaSquare = One + (<>) OmegaSquare Omega = One + (<>) OmegaSquare OmegaSquare = Omega + instance Show CubicSymbol where show = \case - Zero -> show 0 + Zero -> "0" Omega -> "ω" OmegaSquare -> "ω²" - One -> show 1 - - -multiplication :: CubicSymbol -> CubicSymbol -> CubicSymbol -multiplication Zero _ = Zero -multiplication _ Zero = Zero -multiplication One y = y -multiplication x One = x -multiplication Omega Omega = OmegaSquare -multiplication Omega OmegaSquare = One -multiplication OmegaSquare Omega = One -multiplication OmegaSquare OmegaSquare = Omega + One -> "1" + otherwise -> error "" +-- CHANGE INT TO INTEGERS MOD 6? +-- IS THIS MORE EFFICIENT THAN SEMIRING.STIMES? -exponentiation :: CubicSymbol -> Integer -> CubicSymbol +exponentiation :: CubicSymbol -> Int -> CubicSymbol exponentiation Zero _ = Zero exponentiation One _ = One exponentiation _ 0 = One @@ -49,54 +49,113 @@ exponentiation OmegaSquare 1 = OmegaSquare exponentiation OmegaSquare 2 = Omega - +-- EXHAUST ALL CASES conj :: CubicSymbol -> CubicSymbol conj = \case Zero -> Zero Omega -> OmegaSquare OmegaSquare -> Omega One -> One - --- Converts Eisenstein integer to CubicSymbol value. -toCubicSymbol :: E.EisensteinInteger -> CubicSymbol -toCubicSymbol = \case - 0 -> Zero - 0 E.:+ 1 -> Omega - (-1) E.:+ (-1) -> OmegaSquare - 1 -> One - - - - + otherwise -> error "" + +-- The algorithm cubicSymbol takes two Eisentein numbers @alpha@ and @beta@ and returns +-- their cubic symbol. It is divided in the following steps. + +-- 1) Check whether @beta@ is coprime to 3. +-- 2) Replace @alpha@ by the remainder of @alpha@ mod @beta@ +-- This does not affect the cubic symbol. +-- 3) Replace @alpha@ and @beta@ by their associated primary +-- divisors and keep track of how the cubic symbol changes +-- 4) Invoke cubic reciprocity and swap @alpha@ with @beta@. +-- Note both numbers have to be primary. +-- 5) If one of the two numbers is a unit or zero stop, +-- multiplying by the relevant cubic symbol, else go to 2). + +-- AVOID USING GUARDS IN FUNCTION? +-- CHANGE NAME OF FUNCTION TO CUBICRESIDUE? +-- CAN THIS RETURN MAYBE TYPE? + +-- This function takes two Eisenstein integers and returns their cubic residue character. +-- Note that the second argument must be coprime to 3 else the algorithm returns an error. cubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol -cubicSymbol alpha n = Prelude.foldr (g) One factorisation - where factorisation = P.factorise n - g factor symbol = newSymbol <> symbol - where newSymbol = primePowerCubicSymbol alpha factor - - - -primePowerCubicSymbol :: E.EisensteinInteger -> (P.Prime E.EisensteinInteger, Word) -> CubicSymbol -primePowerCubicSymbol alpha (primeNumber, wordExponent) = exponentiation symbol remainder - where remainder = exponent `rem` 3 - exponent = Prelude.fromIntegral wordExponent - symbol = primeCubicSymbol alpha prime - prime = P.unPrime primeNumber - - -primeCubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol -primeCubicSymbol alpha prime - -- Check whether @prime@ satifies norm and primality conditions. - | primeNorm == 3 = error "This Eisenstein number is not coprime to 3." - -- Return 0 if @prime@ divides @alpha@ - | otherwise = toCubicSymbol residue - - -- A.rem returns the remainder of the Euclidean algorithm. - where primeNorm = E.norm prime - residue = Prelude.foldr (f) 1 listOfAlphas - f = \x y -> A.rem (x * y) prime - -- The function @take@ does not accept Integer values. - listOfAlphas = L.genericReplicate alphaExponent alpha - -- Exponent is defined to be 1/3*(@primeNorm@ - 1). - alphaExponent = primeNorm `div` 3 - \ No newline at end of file +cubicSymbol alpha beta + -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ + -- In particular, it returns an error if beta == 0 + | (betaNorm `mod` 3 == 0) = error "" + -- It is necessary to check now whether @alpha == 0@ or @betaNorm == 1@ since later, + -- cubic reciprocity will be assumed to invert the arguments. + | betaNorm == 1 = Zero + | alpha == 0 = Zero + | otherwise = cubicSymbolHelper alpha beta + where betaNorm = E.norm beta + + +cubicSymbolHelper :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol +-- This happens when alpha and beta have a common factor. Note that, @alpha@ +-- and @beta@ are swapped because cubic reciprocity is called later on. +-- Note this cannot be called in the first step of the recursion +cubicSymbolHelper beta 0 = Zero +-- This happens when they are coprime. Note that the associated primary number +-- of any unit is 1, hence it is enough to wirte this case. Furthermore, +-- if @beta == 1@, then @alpha == 1@. +-- Note this cannot be called in the first step of the recursion +cubicSymbolHelper beta 1 = One +-- This is the cubic reciprocity law +cubicSymbolHelper alpha beta = (cubicSymbolHelper primaryBeta primaryRemainder) <> newSymbol + where (primaryRemainder, primaryBeta, symbolExponent) = extractPrimaryContributions remainder beta + remainder = A.rem alpha beta + newSymbol = exponentiation Omega (symbolExponent `mod` 3) -- temporary, ideally change to integers modulo 6 + + +-- This function takes two Eisenstein intgers @alpha@ and @beta@ and returns three +-- arguments @(gamma, delta, contribution)@. @gamma@ and @delta@ are the associated +-- primary numbers to alpha and beta respectively. @contribution@ is a an integer +-- defined mod 6 which measures the difference between the cubic residue of @alpha@ +-- and @beta with respect to the cubic residue of @gamma@ and @delta@ +extractPrimaryContributions :: E.EisensteinInteger -> E.EisensteinInteger -> (E.EisensteinInteger, E.EisensteinInteger, Int) +extractPrimaryContributions alpha beta = (gamma, delta, contribution) + where contribution = j*m - i*m -i*n + m = fromIntegral mInt -- Change this to integers modulo 6 (or 3) + n = fromIntegral nInt + mInt E.:+ nInt = A.quot (delta - 1) 3 + (i, gamma) = getPrimaryDecomposition alphaThreeFree + (_, delta) = getPrimaryDecomposition beta + (j, alphaThreeFree) = factoriseBadPrime alpha + + + +-- This function takes an Eisenstein number @e@ and returns @(exponent, quotient)@ +-- where exponent is the largest integer such that @(1 - ω)^exponent@ divides @e@. +-- @quotient@ is the quotient of @e@ by @(1 - ω)^exponent@ +factoriseBadPrime :: E.EisensteinInteger -> (Int, E.EisensteinInteger) +factoriseBadPrime e = (exponent, quotient) + where exponent = divideBy3 norm + norm = E.norm e + quotient = A.quot e badPowerPrime + badPowerPrime = badPrime ^ exponent + badPrime = 1 E.:+ (-1) + +-- CAN AVOID GUARDS? + +-- This function checks how many times 3 divides an integer @x@ +-- It need not check the case when @x <= 0@ as this is never called +divideBy3 :: Integer -> Int +divideBy3 x + | (x `mod` 3 == 0) = 1 + (divideBy3 remainder) + | otherwise = 0 + where remainder = x `div` 3 + + + +-- This function takes an Eisenstein number and returns its primary decomposition @(exponent, factor)@ +-- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @exponent@ and a unique +-- Eisenstein number @factor@ such that @(1 + ω)^exponent * e = 1 + 3*factor@. +-- Note that L.findIndex cannot return Nothing. This happens only if @e@ is +-- not coprime with 3. +getPrimaryDecomposition :: E.EisensteinInteger -> (Int, E.EisensteinInteger) +getPrimaryDecomposition e = (exponent, factor) + where factor = unit * e + unit = (1 E.:+ 1)^exponent + Just exponent = L.findIndex (== 1) listOfRemainders + listOfRemainders = Prelude.map (\x -> A.rem x 3) listOfAssociates + listOfAssociates = E.associates e From d9ea7130657c04c282accb756cdf05fcfed87602 Mon Sep 17 00:00:00 2001 From: folidota Date: Fri, 17 Apr 2020 01:10:02 +0100 Subject: [PATCH 06/18] Added modular arithmetic, imported functions and error messages. --- Math/NumberTheory/Moduli/CubicSymbol.hs | 147 +++++++++++++----------- 1 file changed, 77 insertions(+), 70 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index 849aed217..c8bb123b0 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -1,4 +1,7 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DataKinds #-} + + module Math.NumberTheory.Moduli.CubicSymbol ( CubicSymbol(..) @@ -6,25 +9,38 @@ module Math.NumberTheory.Moduli.CubicSymbol , cubicSymbol ) where + + import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E -import qualified Math.NumberTheory.Primes as P -import qualified Data.Euclidean as A -import qualified Data.Semigroup as S -import qualified Data.List as L + ( EisensteinInteger(..) + , norm + , associates + ) +import qualified Math.NumberTheory.Utils.FromIntegral as T (wordToInt, wordToInteger) +import qualified Math.NumberTheory.Utils as U (splitOff) +import qualified Data.Mod.Word as M (Mod (..), unMod) +import qualified Data.Euclidean as A (quot, rem) +import qualified Data.Semigroup as S (stimes) +import qualified Data.List as L (findIndex) + + data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) -instance S.Semigroup CubicSymbol where - (<>) Zero _ = Zero - (<>) _ Zero = Zero - (<>) One y = y - (<>) x One = x - (<>) Omega Omega = OmegaSquare - (<>) Omega OmegaSquare = One - (<>) OmegaSquare Omega = One - (<>) OmegaSquare OmegaSquare = Omega + + +instance Semigroup CubicSymbol where + Zero <> _ = Zero + _ <> Zero = Zero + One <> y = y + x <> One = x + Omega <> Omega = OmegaSquare + Omega <> OmegaSquare = One + OmegaSquare <> Omega = One + OmegaSquare <> OmegaSquare = Omega + instance Show CubicSymbol where @@ -33,30 +49,21 @@ instance Show CubicSymbol where Omega -> "ω" OmegaSquare -> "ω²" One -> "1" - otherwise -> error "" - - --- CHANGE INT TO INTEGERS MOD 6? --- IS THIS MORE EFFICIENT THAN SEMIRING.STIMES? + otherwise -> error "Math.NumberTheory.Moduli.CubicSymbol:" -exponentiation :: CubicSymbol -> Int -> CubicSymbol -exponentiation Zero _ = Zero -exponentiation One _ = One -exponentiation _ 0 = One -exponentiation Omega 1 = Omega -exponentiation Omega 2 = OmegaSquare -exponentiation OmegaSquare 1 = OmegaSquare -exponentiation OmegaSquare 2 = Omega --- EXHAUST ALL CASES conj :: CubicSymbol -> CubicSymbol conj = \case Zero -> Zero Omega -> OmegaSquare OmegaSquare -> Omega One -> One - otherwise -> error "" + otherwise -> error "Math.NumberTheory.Moduli.CubicSymbol:" + + + + -- The algorithm cubicSymbol takes two Eisentein numbers @alpha@ and @beta@ and returns -- their cubic symbol. It is divided in the following steps. @@ -71,40 +78,42 @@ conj = \case -- 5) If one of the two numbers is a unit or zero stop, -- multiplying by the relevant cubic symbol, else go to 2). --- AVOID USING GUARDS IN FUNCTION? --- CHANGE NAME OF FUNCTION TO CUBICRESIDUE? --- CAN THIS RETURN MAYBE TYPE? + -- This function takes two Eisenstein integers and returns their cubic residue character. --- Note that the second argument must be coprime to 3 else the algorithm returns an error. +-- Note that the second argument must be coprime to 3 else the algorithm returns an error. cubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol cubicSymbol alpha beta -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ -- In particular, it returns an error if beta == 0 - | (betaNorm `mod` 3 == 0) = error "" + | (betaNorm `mod` 3 == 0) = error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." -- It is necessary to check now whether @alpha == 0@ or @betaNorm == 1@ since later, -- cubic reciprocity will be assumed to invert the arguments. - | betaNorm == 1 = Zero | alpha == 0 = Zero + | betaNorm == 1 = One | otherwise = cubicSymbolHelper alpha beta where betaNorm = E.norm beta + cubicSymbolHelper :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol -- This happens when alpha and beta have a common factor. Note that, @alpha@ -- and @beta@ are swapped because cubic reciprocity is called later on. -- Note this cannot be called in the first step of the recursion -cubicSymbolHelper beta 0 = Zero +cubicSymbolHelper _ 0 = Zero -- This happens when they are coprime. Note that the associated primary number -- of any unit is 1, hence it is enough to wirte this case. Furthermore, --- if @beta == 1@, then @alpha == 1@. +-- if @beta == 1@, then @alpha == 1@. -- Note this cannot be called in the first step of the recursion -cubicSymbolHelper beta 1 = One +cubicSymbolHelper _ 1 = One -- This is the cubic reciprocity law cubicSymbolHelper alpha beta = (cubicSymbolHelper primaryBeta primaryRemainder) <> newSymbol where (primaryRemainder, primaryBeta, symbolExponent) = extractPrimaryContributions remainder beta remainder = A.rem alpha beta - newSymbol = exponentiation Omega (symbolExponent `mod` 3) -- temporary, ideally change to integers modulo 6 + newSymbol = exponentiation (unmodularExponent) Omega + unmodularExponent = T.wordToInt (M.unMod symbolExponent) + exponentiation = \k x -> if k == 0 then x else S.stimes k x + -- This function takes two Eisenstein intgers @alpha@ and @beta@ and returns three @@ -112,50 +121,48 @@ cubicSymbolHelper alpha beta = (cubicSymbolHelper primaryBeta primaryRemainder) -- primary numbers to alpha and beta respectively. @contribution@ is a an integer -- defined mod 6 which measures the difference between the cubic residue of @alpha@ -- and @beta with respect to the cubic residue of @gamma@ and @delta@ -extractPrimaryContributions :: E.EisensteinInteger -> E.EisensteinInteger -> (E.EisensteinInteger, E.EisensteinInteger, Int) +extractPrimaryContributions :: E.EisensteinInteger -> E.EisensteinInteger -> (E.EisensteinInteger, E.EisensteinInteger, M.Mod 3) extractPrimaryContributions alpha beta = (gamma, delta, contribution) where contribution = j*m - i*m -i*n - m = fromIntegral mInt -- Change this to integers modulo 6 (or 3) - n = fromIntegral nInt + -- Need to split conversion as [i,j] and [m,n] are of different types + [i, j, m, n] = map (conversion) [iInt, jInt, mInt, nInt] + conversion = \x -> (fromIntegral x) :: M.Mod 3 mInt E.:+ nInt = A.quot (delta - 1) 3 - (i, gamma) = getPrimaryDecomposition alphaThreeFree + (iInt, gamma) = getPrimaryDecomposition alphaThreeFree (_, delta) = getPrimaryDecomposition beta - (j, alphaThreeFree) = factoriseBadPrime alpha + (jInt, alphaThreeFree) = factoriseBadPrime alpha --- This function takes an Eisenstein number @e@ and returns @(exponent, quotient)@ --- where exponent is the largest integer such that @(1 - ω)^exponent@ divides @e@. --- @quotient@ is the quotient of @e@ by @(1 - ω)^exponent@ -factoriseBadPrime :: E.EisensteinInteger -> (Int, E.EisensteinInteger) -factoriseBadPrime e = (exponent, quotient) - where exponent = divideBy3 norm - norm = E.norm e - quotient = A.quot e badPowerPrime - badPowerPrime = badPrime ^ exponent +-- This function takes an Eisenstein number @e@ and returns @(powerPrime, quotient)@ +-- where exponent is the largest integer such that @(1 - ω)^powerPrime@ divides @e@. +-- @quotient@ is the quotient of @e@ by @(1 - ω)^powerPrime@ +factoriseBadPrime :: E.EisensteinInteger -> (Integer, E.EisensteinInteger) +factoriseBadPrime e = (powerPrime, quotient) + where quotient = A.quot e badPowerPrime + badPowerPrime = badPrime ^ powerPrime badPrime = 1 E.:+ (-1) - --- CAN AVOID GUARDS? - --- This function checks how many times 3 divides an integer @x@ --- It need not check the case when @x <= 0@ as this is never called -divideBy3 :: Integer -> Int -divideBy3 x - | (x `mod` 3 == 0) = 1 + (divideBy3 remainder) - | otherwise = 0 - where remainder = x `div` 3 + powerPrime = T.wordToInteger (fst wordExponent) + wordExponent = U.splitOff 3 norm + norm = E.norm e --- This function takes an Eisenstein number and returns its primary decomposition @(exponent, factor)@ --- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @exponent@ and a unique --- Eisenstein number @factor@ such that @(1 + ω)^exponent * e = 1 + 3*factor@. +-- This function takes an Eisenstein number and returns its primary decomposition @(powerUnit, factor)@ +-- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @powerUnit@ and a unique +-- Eisenstein number @factor@ such that @(1 + ω)^powerUnit * e = 1 + 3*factor@. -- Note that L.findIndex cannot return Nothing. This happens only if @e@ is -- not coprime with 3. -getPrimaryDecomposition :: E.EisensteinInteger -> (Int, E.EisensteinInteger) -getPrimaryDecomposition e = (exponent, factor) +getPrimaryDecomposition :: E.EisensteinInteger -> (Integer, E.EisensteinInteger) +getPrimaryDecomposition e = (toInteger powerUnit, factor) where factor = unit * e - unit = (1 E.:+ 1)^exponent - Just exponent = L.findIndex (== 1) listOfRemainders - listOfRemainders = Prelude.map (\x -> A.rem x 3) listOfAssociates + unit = (1 E.:+ 1)^powerUnit + powerUnit = case findPowerUnit of + Just u -> u + Nothing -> error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed." + findPowerUnit = L.findIndex (== 1) listOfRemainders + listOfRemainders = map (\x -> A.rem x 3) listOfAssociates + -- Note that associates are ordered in the following way: + -- The i^th element of associate is @e * (1 + ω)^i@. + -- That is @e@ times the i^th unit counting anticlockwise. listOfAssociates = E.associates e From a05b4b670bc9c5e3e2f4e5b3fd68a87b817790bf Mon Sep 17 00:00:00 2001 From: folidota Date: Fri, 17 Apr 2020 13:00:42 +0100 Subject: [PATCH 07/18] Corrected edge cases. Simplified code by adding cubicReciprocity function. No use of E.associates. --- Math/NumberTheory/Moduli/CubicSymbol.hs | 76 ++++++++++--------- arithmoi.cabal | 1 + .../NumberTheory/Moduli/CubicSymbolTests.hs | 54 +++++++++++++ test-suite/Test.hs | 2 + 4 files changed, 96 insertions(+), 37 deletions(-) create mode 100644 test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index c8bb123b0..065515b23 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -4,17 +4,18 @@ module Math.NumberTheory.Moduli.CubicSymbol - ( CubicSymbol(..) - , conj - , cubicSymbol - ) where + ( CubicSymbol(..) + , conj + , cubicSymbol + )where import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E ( EisensteinInteger(..) + , ω , norm - , associates + , ids ) import qualified Math.NumberTheory.Utils.FromIntegral as T (wordToInt, wordToInteger) import qualified Math.NumberTheory.Utils as U (splitOff) @@ -49,7 +50,6 @@ instance Show CubicSymbol where Omega -> "ω" OmegaSquare -> "ω²" One -> "1" - otherwise -> error "Math.NumberTheory.Moduli.CubicSymbol:" @@ -59,7 +59,6 @@ conj = \case Omega -> OmegaSquare OmegaSquare -> Omega One -> One - otherwise -> error "Math.NumberTheory.Moduli.CubicSymbol:" @@ -83,36 +82,36 @@ conj = \case -- This function takes two Eisenstein integers and returns their cubic residue character. -- Note that the second argument must be coprime to 3 else the algorithm returns an error. cubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol -cubicSymbol alpha beta +cubicSymbol alpha beta = case ((E.norm beta) `mod` 3) of -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ - -- In particular, it returns an error if beta == 0 - | (betaNorm `mod` 3 == 0) = error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." - -- It is necessary to check now whether @alpha == 0@ or @betaNorm == 1@ since later, - -- cubic reciprocity will be assumed to invert the arguments. - | alpha == 0 = Zero - | betaNorm == 1 = One - | otherwise = cubicSymbolHelper alpha beta - where betaNorm = E.norm beta + -- In particular, it returns an error if @beta == 0@ + 0 -> error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." + _ -> cubicSymbolHelper alpha beta cubicSymbolHelper :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol --- This happens when alpha and beta have a common factor. Note that, @alpha@ --- and @beta@ are swapped because cubic reciprocity is called later on. --- Note this cannot be called in the first step of the recursion -cubicSymbolHelper _ 0 = Zero --- This happens when they are coprime. Note that the associated primary number --- of any unit is 1, hence it is enough to wirte this case. Furthermore, --- if @beta == 1@, then @alpha == 1@. --- Note this cannot be called in the first step of the recursion -cubicSymbolHelper _ 1 = One --- This is the cubic reciprocity law -cubicSymbolHelper alpha beta = (cubicSymbolHelper primaryBeta primaryRemainder) <> newSymbol +cubicSymbolHelper alpha beta = (cubicReciprocity primaryRemainder primaryBeta) <> newSymbol where (primaryRemainder, primaryBeta, symbolExponent) = extractPrimaryContributions remainder beta remainder = A.rem alpha beta newSymbol = exponentiation (unmodularExponent) Omega unmodularExponent = T.wordToInt (M.unMod symbolExponent) - exponentiation = \k x -> if k == 0 then x else S.stimes k x + exponentiation = \k x -> if k == 0 then One else S.stimes k x + + + +-- This function first checks if its arguments are zero or units. If they are not, +-- it invokes cubic reciprocity by calling cubicSymbolHelper with swapped arguments. +cubicReciprocity :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol +-- Note @cubicReciprocity 0 1 = One@. It turns out it is better to adopt this convention. +cubicReciprocity _ 1 = One +-- Checks if first argument is zero. Note @betaPrimary@ cannot be zero. +cubicReciprocity 0 _ = Zero +-- This checks if the first argument is a unit. Because it's primary, +-- it is enough to pattern match with 1. +cubicReciprocity 1 _ = One +-- Otherwise, cubic reciprocity is called. +cubicReciprocity alpha beta = cubicSymbolHelper beta alpha @@ -124,7 +123,6 @@ cubicSymbolHelper alpha beta = (cubicSymbolHelper primaryBeta primaryRemainder) extractPrimaryContributions :: E.EisensteinInteger -> E.EisensteinInteger -> (E.EisensteinInteger, E.EisensteinInteger, M.Mod 3) extractPrimaryContributions alpha beta = (gamma, delta, contribution) where contribution = j*m - i*m -i*n - -- Need to split conversion as [i,j] and [m,n] are of different types [i, j, m, n] = map (conversion) [iInt, jInt, mInt, nInt] conversion = \x -> (fromIntegral x) :: M.Mod 3 mInt E.:+ nInt = A.quot (delta - 1) 3 @@ -141,7 +139,7 @@ factoriseBadPrime :: E.EisensteinInteger -> (Integer, E.EisensteinInteger) factoriseBadPrime e = (powerPrime, quotient) where quotient = A.quot e badPowerPrime badPowerPrime = badPrime ^ powerPrime - badPrime = 1 E.:+ (-1) + badPrime = 1 - E.ω powerPrime = T.wordToInteger (fst wordExponent) wordExponent = U.splitOff 3 norm norm = E.norm e @@ -152,17 +150,21 @@ factoriseBadPrime e = (powerPrime, quotient) -- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @powerUnit@ and a unique -- Eisenstein number @factor@ such that @(1 + ω)^powerUnit * e = 1 + 3*factor@. -- Note that L.findIndex cannot return Nothing. This happens only if @e@ is --- not coprime with 3. +-- not coprime with 3. This cannot happen since @factoriseBadPrime@ is called before. getPrimaryDecomposition :: E.EisensteinInteger -> (Integer, E.EisensteinInteger) +-- This is the case where a common factor between @alpha@ and @beta@ is detected. +-- In this instance @cubicReciprocity@ will return @Zero@. +-- Strictly speaking, this is not a primary decomposition. +getPrimaryDecomposition 0 = (0, 0) getPrimaryDecomposition e = (toInteger powerUnit, factor) where factor = unit * e - unit = (1 E.:+ 1)^powerUnit + unit = (1 + E.ω)^powerUnit powerUnit = case findPowerUnit of - Just u -> u + Just u -> u Nothing -> error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed." findPowerUnit = L.findIndex (== 1) listOfRemainders listOfRemainders = map (\x -> A.rem x 3) listOfAssociates - -- Note that associates are ordered in the following way: - -- The i^th element of associate is @e * (1 + ω)^i@. - -- That is @e@ times the i^th unit counting anticlockwise. - listOfAssociates = E.associates e + -- Note that the associates in @listOfAssociates@ are ordered in the following way: + -- The i^th element of @listOfAssociate@ is @e * (1 + ω)^i@ starting from i = 0@ + -- That is @e@ times the i^th unit counting anticlockwise starting with 1. + listOfAssociates = map (*e) E.ids diff --git a/arithmoi.cabal b/arithmoi.cabal index de893e0fc..aa758b28b 100644 --- a/arithmoi.cabal +++ b/arithmoi.cabal @@ -148,6 +148,7 @@ test-suite spec Math.NumberTheory.Moduli.ChineseTests Math.NumberTheory.Moduli.DiscreteLogarithmTests Math.NumberTheory.Moduli.ClassTests + Math.NumberTheory.Moduli.CubicSymbolTests Math.NumberTheory.Moduli.EquationsTests Math.NumberTheory.Moduli.JacobiTests Math.NumberTheory.Moduli.PrimitiveRootTests diff --git a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs new file mode 100644 index 000000000..85e169f06 --- /dev/null +++ b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs @@ -0,0 +1,54 @@ +module Math.NumberTheory.Moduli.CubicSymbolTests + ( testSuite + ) where + +import qualified Math.NumberTheory.Moduli.CubicSymbol as C +import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E + + +import Test.Tasty (TestTree, testGroup) + +import Math.NumberTheory.TestUtils + +-- Checks multiplicative property of the numerator +cubicSymbol1 :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool +cubicSymbol1 alpha1 alpha2 beta = (modularNorm == 0) || cubicSymbolNumerator alpha1 alpha2 beta + where modularNorm = norm `mod` 3 + norm = E.norm beta + +cubicSymbolNumerator :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool +cubicSymbolNumerator alpha1 alpha2 beta = (symbol1 <> symbol2) == symbolProduct + where symbol1 = C.cubicSymbol alpha1 beta + symbol2 = C.cubicSymbol alpha2 beta + symbolProduct = C.cubicSymbol alphaProduct beta + alphaProduct = alpha1 * alpha2 + + + +-- Checks multiplicative property of the denominator +cubicSymbol2 :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool +cubicSymbol2 alpha beta1 beta2 = (modularNorm1 == 0) || (modularNorm2 == 0) || cubicSymbolDenominator alpha beta1 beta2 + where (modularNorm1, modularNorm2) = (norm1 `mod` 3, norm2 `mod` 3) + (norm1, norm2) = (E.norm beta1, E.norm beta2) + +cubicSymbolDenominator :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool +cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct + where symbol1 = C.cubicSymbol alpha beta1 + symbol2 = C.cubicSymbol alpha beta2 + symbolProduct = C.cubicSymbol alpha betaProduct + betaProduct = beta1 * beta2 + + + + + + + + + + +testSuite :: TestTree +testSuite = testGroup "CubicSymbol" $ + [ testSmallAndQuick "Multiplicative property of numerator." cubicSymbol1 + , testSmallAndQuick "Multiplicative property of denominator." cubicSymbol2 + ] diff --git a/test-suite/Test.hs b/test-suite/Test.hs index 4e4260937..1f91c31c6 100644 --- a/test-suite/Test.hs +++ b/test-suite/Test.hs @@ -9,6 +9,7 @@ import qualified Math.NumberTheory.Recurrences.LinearTests as RecurrencesLinear import qualified Math.NumberTheory.Moduli.ChineseTests as ModuliChinese import qualified Math.NumberTheory.Moduli.ClassTests as ModuliClass +import qualified Math.NumberTheory.Moduli.CubicSymbolTests as ModuliCubic import qualified Math.NumberTheory.Moduli.DiscreteLogarithmTests as ModuliDiscreteLogarithm import qualified Math.NumberTheory.Moduli.EquationsTests as ModuliEquations import qualified Math.NumberTheory.Moduli.JacobiTests as ModuliJacobi @@ -63,6 +64,7 @@ tests = testGroup "All" , testGroup "Moduli" [ ModuliChinese.testSuite , ModuliClass.testSuite + , ModuliCubic.testSuite , ModuliDiscreteLogarithm.testSuite , ModuliEquations.testSuite , ModuliJacobi.testSuite From 97f427096e567b19253e26ff658c07d3de63f418 Mon Sep 17 00:00:00 2001 From: folidota Date: Fri, 17 Apr 2020 14:46:16 +0100 Subject: [PATCH 08/18] Got rid of factoriseBadPrime, changed line spacing and updated comments. --- Math/NumberTheory/Moduli/CubicSymbol.hs | 88 +++++-------------- .../NumberTheory/Moduli/CubicSymbolTests.hs | 14 --- 2 files changed, 24 insertions(+), 78 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index 065515b23..3902b0546 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -1,22 +1,14 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DataKinds #-} - - module Math.NumberTheory.Moduli.CubicSymbol ( CubicSymbol(..) , conj , cubicSymbol - )where - - + ) where import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E - ( EisensteinInteger(..) - , ω - , norm - , ids - ) + (EisensteinInteger(..), ω, norm, ids) import qualified Math.NumberTheory.Utils.FromIntegral as T (wordToInt, wordToInteger) import qualified Math.NumberTheory.Utils as U (splitOff) import qualified Data.Mod.Word as M (Mod (..), unMod) @@ -24,14 +16,8 @@ import qualified Data.Euclidean as A (quot, rem) import qualified Data.Semigroup as S (stimes) import qualified Data.List as L (findIndex) - - - - data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) - - instance Semigroup CubicSymbol where Zero <> _ = Zero _ <> Zero = Zero @@ -42,8 +28,6 @@ instance Semigroup CubicSymbol where OmegaSquare <> Omega = One OmegaSquare <> OmegaSquare = Omega - - instance Show CubicSymbol where show = \case Zero -> "0" @@ -51,8 +35,6 @@ instance Show CubicSymbol where OmegaSquare -> "ω²" One -> "1" - - conj :: CubicSymbol -> CubicSymbol conj = \case Zero -> Zero @@ -60,35 +42,30 @@ conj = \case OmegaSquare -> Omega One -> One - - - - -- The algorithm cubicSymbol takes two Eisentein numbers @alpha@ and @beta@ and returns --- their cubic symbol. It is divided in the following steps. +-- their cubic residue. It is divided in the following steps. -- 1) Check whether @beta@ is coprime to 3. -- 2) Replace @alpha@ by the remainder of @alpha@ mod @beta@ -- This does not affect the cubic symbol. -- 3) Replace @alpha@ and @beta@ by their associated primary --- divisors and keep track of how the cubic symbol changes --- 4) Invoke cubic reciprocity and swap @alpha@ with @beta@. --- Note both numbers have to be primary. --- 5) If one of the two numbers is a unit or zero stop, --- multiplying by the relevant cubic symbol, else go to 2). - - +-- divisors and keep track of how their cubic residue changes. +-- 4) Check if any of the two numbers is a zero or a unit. If it +-- is, return their cubic residue. +-- 5) If not, invoke cubic reciprocity by swapping @alpha@ and +-- @beta@. Note both numbers have to be primary. +-- Return to Step 2). -- This function takes two Eisenstein integers and returns their cubic residue character. -- Note that the second argument must be coprime to 3 else the algorithm returns an error. cubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol -cubicSymbol alpha beta = case ((E.norm beta) `mod` 3) of +cubicSymbol alpha beta = case (betaNorm `mod` 3) of -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ -- In particular, it returns an error if @beta == 0@ 0 -> error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." _ -> cubicSymbolHelper alpha beta - + where betaNorm = E.norm beta cubicSymbolHelper :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol cubicSymbolHelper alpha beta = (cubicReciprocity primaryRemainder primaryBeta) <> newSymbol @@ -98,14 +75,12 @@ cubicSymbolHelper alpha beta = (cubicReciprocity primaryRemainder primaryBeta) < unmodularExponent = T.wordToInt (M.unMod symbolExponent) exponentiation = \k x -> if k == 0 then One else S.stimes k x - - --- This function first checks if its arguments are zero or units. If they are not, +-- This function first checks if its arguments are zeros or units. If they are not, -- it invokes cubic reciprocity by calling cubicSymbolHelper with swapped arguments. cubicReciprocity :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol -- Note @cubicReciprocity 0 1 = One@. It turns out it is better to adopt this convention. cubicReciprocity _ 1 = One --- Checks if first argument is zero. Note @betaPrimary@ cannot be zero. +-- Checks if first argument is zero. Note the second argument is never zero. cubicReciprocity 0 _ = Zero -- This checks if the first argument is a unit. Because it's primary, -- it is enough to pattern match with 1. @@ -113,13 +88,11 @@ cubicReciprocity 1 _ = One -- Otherwise, cubic reciprocity is called. cubicReciprocity alpha beta = cubicSymbolHelper beta alpha - - -- This function takes two Eisenstein intgers @alpha@ and @beta@ and returns three -- arguments @(gamma, delta, contribution)@. @gamma@ and @delta@ are the associated -- primary numbers to alpha and beta respectively. @contribution@ is a an integer --- defined mod 6 which measures the difference between the cubic residue of @alpha@ --- and @beta with respect to the cubic residue of @gamma@ and @delta@ +-- defined mod 3 which measures the difference between the cubic residue of @alpha@ +-- and @beta@ with respect to the cubic residue of @gamma@ and @delta@. extractPrimaryContributions :: E.EisensteinInteger -> E.EisensteinInteger -> (E.EisensteinInteger, E.EisensteinInteger, M.Mod 3) extractPrimaryContributions alpha beta = (gamma, delta, contribution) where contribution = j*m - i*m -i*n @@ -128,29 +101,16 @@ extractPrimaryContributions alpha beta = (gamma, delta, contribution) mInt E.:+ nInt = A.quot (delta - 1) 3 (iInt, gamma) = getPrimaryDecomposition alphaThreeFree (_, delta) = getPrimaryDecomposition beta - (jInt, alphaThreeFree) = factoriseBadPrime alpha - - - --- This function takes an Eisenstein number @e@ and returns @(powerPrime, quotient)@ --- where exponent is the largest integer such that @(1 - ω)^powerPrime@ divides @e@. --- @quotient@ is the quotient of @e@ by @(1 - ω)^powerPrime@ -factoriseBadPrime :: E.EisensteinInteger -> (Integer, E.EisensteinInteger) -factoriseBadPrime e = (powerPrime, quotient) - where quotient = A.quot e badPowerPrime - badPowerPrime = badPrime ^ powerPrime - badPrime = 1 - E.ω - powerPrime = T.wordToInteger (fst wordExponent) - wordExponent = U.splitOff 3 norm - norm = E.norm e - - + jInt = T.wordToInteger jIntWord + -- This function outputs data such that + -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@. + (jIntWord, alphaThreeFree) = U.splitOff (1 - E.ω) alpha -- This function takes an Eisenstein number and returns its primary decomposition @(powerUnit, factor)@ -- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @powerUnit@ and a unique -- Eisenstein number @factor@ such that @(1 + ω)^powerUnit * e = 1 + 3*factor@. --- Note that L.findIndex cannot return Nothing. This happens only if @e@ is --- not coprime with 3. This cannot happen since @factoriseBadPrime@ is called before. +-- Note that L.findIndex cannot return Nothing. This happens only if @e@ is not +-- coprime with 3. This cannot happen since @U.splitOff@ is called just before. getPrimaryDecomposition :: E.EisensteinInteger -> (Integer, E.EisensteinInteger) -- This is the case where a common factor between @alpha@ and @beta@ is detected. -- In this instance @cubicReciprocity@ will return @Zero@. @@ -164,7 +124,7 @@ getPrimaryDecomposition e = (toInteger powerUnit, factor) Nothing -> error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed." findPowerUnit = L.findIndex (== 1) listOfRemainders listOfRemainders = map (\x -> A.rem x 3) listOfAssociates - -- Note that the associates in @listOfAssociates@ are ordered in the following way: - -- The i^th element of @listOfAssociate@ is @e * (1 + ω)^i@ starting from i = 0@ - -- That is @e@ times the i^th unit counting anticlockwise starting with 1. + -- Note that the units in @E.ids@ are ordered in the following way: + -- The i^th element of @E.ids@ is @(1 + ω)^i@ starting from i = 0@ + -- That is the i^th unit counting anticlockwise starting with 1. listOfAssociates = map (*e) E.ids diff --git a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs index 85e169f06..f792c3c4e 100644 --- a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs +++ b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs @@ -4,10 +4,7 @@ module Math.NumberTheory.Moduli.CubicSymbolTests import qualified Math.NumberTheory.Moduli.CubicSymbol as C import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E - - import Test.Tasty (TestTree, testGroup) - import Math.NumberTheory.TestUtils -- Checks multiplicative property of the numerator @@ -23,8 +20,6 @@ cubicSymbolNumerator alpha1 alpha2 beta = (symbol1 <> symbol2) == symbolProduct symbolProduct = C.cubicSymbol alphaProduct beta alphaProduct = alpha1 * alpha2 - - -- Checks multiplicative property of the denominator cubicSymbol2 :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool cubicSymbol2 alpha beta1 beta2 = (modularNorm1 == 0) || (modularNorm2 == 0) || cubicSymbolDenominator alpha beta1 beta2 @@ -38,15 +33,6 @@ cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct symbolProduct = C.cubicSymbol alpha betaProduct betaProduct = beta1 * beta2 - - - - - - - - - testSuite :: TestTree testSuite = testGroup "CubicSymbol" $ [ testSmallAndQuick "Multiplicative property of numerator." cubicSymbol1 From 03b7df799b17b8fb31e329d0dbd3332998c5435e Mon Sep 17 00:00:00 2001 From: folidota Date: Fri, 17 Apr 2020 15:16:56 +0100 Subject: [PATCH 09/18] Tidied up code --- Math/NumberTheory/Moduli/CubicSymbol.hs | 35 ++++++++----------- .../NumberTheory/Moduli/CubicSymbolTests.hs | 4 +-- 2 files changed, 16 insertions(+), 23 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index 3902b0546..f9c037118 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -3,18 +3,18 @@ module Math.NumberTheory.Moduli.CubicSymbol ( CubicSymbol(..) - , conj , cubicSymbol ) where import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E (EisensteinInteger(..), ω, norm, ids) import qualified Math.NumberTheory.Utils.FromIntegral as T (wordToInt, wordToInteger) -import qualified Math.NumberTheory.Utils as U (splitOff) import qualified Data.Mod.Word as M (Mod (..), unMod) import qualified Data.Euclidean as A (quot, rem) +import qualified Math.NumberTheory.Utils as U (splitOff) import qualified Data.Semigroup as S (stimes) -import qualified Data.List as L (findIndex) +import qualified Data.List as L (elemIndex) +import qualified Data.Maybe as D (fromMaybe) data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) @@ -35,13 +35,6 @@ instance Show CubicSymbol where OmegaSquare -> "ω²" One -> "1" -conj :: CubicSymbol -> CubicSymbol -conj = \case - Zero -> Zero - Omega -> OmegaSquare - OmegaSquare -> Omega - One -> One - -- The algorithm cubicSymbol takes two Eisentein numbers @alpha@ and @beta@ and returns -- their cubic residue. It is divided in the following steps. @@ -59,7 +52,7 @@ conj = \case -- This function takes two Eisenstein integers and returns their cubic residue character. -- Note that the second argument must be coprime to 3 else the algorithm returns an error. cubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol -cubicSymbol alpha beta = case (betaNorm `mod` 3) of +cubicSymbol alpha beta = case betaNorm `mod` 3 of -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ -- In particular, it returns an error if @beta == 0@ 0 -> error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." @@ -68,12 +61,12 @@ cubicSymbol alpha beta = case (betaNorm `mod` 3) of where betaNorm = E.norm beta cubicSymbolHelper :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol -cubicSymbolHelper alpha beta = (cubicReciprocity primaryRemainder primaryBeta) <> newSymbol +cubicSymbolHelper alpha beta = cubicReciprocity primaryRemainder primaryBeta <> newSymbol where (primaryRemainder, primaryBeta, symbolExponent) = extractPrimaryContributions remainder beta remainder = A.rem alpha beta - newSymbol = exponentiation (unmodularExponent) Omega + newSymbol = exponentiation unmodularExponent Omega unmodularExponent = T.wordToInt (M.unMod symbolExponent) - exponentiation = \k x -> if k == 0 then One else S.stimes k x + exponentiation k x = if k == 0 then One else S.stimes k x -- This function first checks if its arguments are zeros or units. If they are not, -- it invokes cubic reciprocity by calling cubicSymbolHelper with swapped arguments. @@ -96,8 +89,8 @@ cubicReciprocity alpha beta = cubicSymbolHelper beta alpha extractPrimaryContributions :: E.EisensteinInteger -> E.EisensteinInteger -> (E.EisensteinInteger, E.EisensteinInteger, M.Mod 3) extractPrimaryContributions alpha beta = (gamma, delta, contribution) where contribution = j*m - i*m -i*n - [i, j, m, n] = map (conversion) [iInt, jInt, mInt, nInt] - conversion = \x -> (fromIntegral x) :: M.Mod 3 + [i, j, m, n] = map conversion [iInt, jInt, mInt, nInt] + conversion x = fromIntegral x :: M.Mod 3 mInt E.:+ nInt = A.quot (delta - 1) 3 (iInt, gamma) = getPrimaryDecomposition alphaThreeFree (_, delta) = getPrimaryDecomposition beta @@ -119,11 +112,11 @@ getPrimaryDecomposition 0 = (0, 0) getPrimaryDecomposition e = (toInteger powerUnit, factor) where factor = unit * e unit = (1 + E.ω)^powerUnit - powerUnit = case findPowerUnit of - Just u -> u - Nothing -> error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed." - findPowerUnit = L.findIndex (== 1) listOfRemainders - listOfRemainders = map (\x -> A.rem x 3) listOfAssociates + powerUnit = D.fromMaybe + (error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed.") + findPowerUnit + findPowerUnit = L.elemIndex 1 listOfRemainders + listOfRemainders = map (`A.rem` 3) listOfAssociates -- Note that the units in @E.ids@ are ordered in the following way: -- The i^th element of @E.ids@ is @(1 + ω)^i@ starting from i = 0@ -- That is the i^th unit counting anticlockwise starting with 1. diff --git a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs index f792c3c4e..4b161024f 100644 --- a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs +++ b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs @@ -35,6 +35,6 @@ cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct testSuite :: TestTree testSuite = testGroup "CubicSymbol" $ - [ testSmallAndQuick "Multiplicative property of numerator." cubicSymbol1 - , testSmallAndQuick "Multiplicative property of denominator." cubicSymbol2 + [ testSmallAndQuick "multiplicative property of numerators" cubicSymbol1 + , testSmallAndQuick "multiplicative property of denominators" cubicSymbol2 ] From 8ab434bbe2f2d910ff5c04927e2fe26d1c6ea365 Mon Sep 17 00:00:00 2001 From: folidota Date: Fri, 17 Apr 2020 17:54:26 +0100 Subject: [PATCH 10/18] Improvements to getPrimaryDecomposition function --- Math/NumberTheory/Moduli/CubicSymbol.hs | 128 +++++++++--------- .../NumberTheory/Moduli/CubicSymbolTests.hs | 53 ++++---- 2 files changed, 93 insertions(+), 88 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index f9c037118..ceff914fd 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -2,38 +2,37 @@ {-# LANGUAGE DataKinds #-} module Math.NumberTheory.Moduli.CubicSymbol - ( CubicSymbol(..) - , cubicSymbol - ) where + ( CubicSymbol(..) + , cubicSymbol + ) where -import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E - (EisensteinInteger(..), ω, norm, ids) -import qualified Math.NumberTheory.Utils.FromIntegral as T (wordToInt, wordToInteger) -import qualified Data.Mod.Word as M (Mod (..), unMod) -import qualified Data.Euclidean as A (quot, rem) -import qualified Math.NumberTheory.Utils as U (splitOff) -import qualified Data.Semigroup as S (stimes) -import qualified Data.List as L (elemIndex) -import qualified Data.Maybe as D (fromMaybe) +import Math.NumberTheory.Quadratic.EisensteinIntegers +import Math.NumberTheory.Utils.FromIntegral +import qualified Data.Euclidean as A +import Math.NumberTheory.Utils +import Data.Semigroup +import Data.Mod.Word +import Data.Maybe +import Data.List data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) instance Semigroup CubicSymbol where - Zero <> _ = Zero - _ <> Zero = Zero - One <> y = y - x <> One = x - Omega <> Omega = OmegaSquare - Omega <> OmegaSquare = One - OmegaSquare <> Omega = One - OmegaSquare <> OmegaSquare = Omega + Zero <> _ = Zero + _ <> Zero = Zero + One <> y = y + x <> One = x + Omega <> Omega = OmegaSquare + Omega <> OmegaSquare = One + OmegaSquare <> Omega = One + OmegaSquare <> OmegaSquare = Omega instance Show CubicSymbol where - show = \case - Zero -> "0" - Omega -> "ω" - OmegaSquare -> "ω²" - One -> "1" + show = \case + Zero -> "0" + Omega -> "ω" + OmegaSquare -> "ω²" + One -> "1" -- The algorithm cubicSymbol takes two Eisentein numbers @alpha@ and @beta@ and returns -- their cubic residue. It is divided in the following steps. @@ -47,30 +46,31 @@ instance Show CubicSymbol where -- is, return their cubic residue. -- 5) If not, invoke cubic reciprocity by swapping @alpha@ and -- @beta@. Note both numbers have to be primary. --- Return to Step 2). +-- Return to Step 2. -- This function takes two Eisenstein integers and returns their cubic residue character. -- Note that the second argument must be coprime to 3 else the algorithm returns an error. -cubicSymbol :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol +cubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol cubicSymbol alpha beta = case betaNorm `mod` 3 of - -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ - -- In particular, it returns an error if @beta == 0@ - 0 -> error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." - _ -> cubicSymbolHelper alpha beta + -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ + -- In particular, it returns an error if @beta == 0@ + 0 -> error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." + _ -> cubicSymbolHelper alpha beta + where + betaNorm = norm beta - where betaNorm = E.norm beta - -cubicSymbolHelper :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol +cubicSymbolHelper :: EisensteinInteger -> EisensteinInteger -> CubicSymbol cubicSymbolHelper alpha beta = cubicReciprocity primaryRemainder primaryBeta <> newSymbol - where (primaryRemainder, primaryBeta, symbolExponent) = extractPrimaryContributions remainder beta - remainder = A.rem alpha beta - newSymbol = exponentiation unmodularExponent Omega - unmodularExponent = T.wordToInt (M.unMod symbolExponent) - exponentiation k x = if k == 0 then One else S.stimes k x + where + (primaryRemainder, primaryBeta, symbolExponent) = extractPrimaryContributions remainder beta + remainder = A.rem alpha beta + newSymbol = exponentiation unmodularExponent Omega + unmodularExponent = wordToInt (unMod symbolExponent) + exponentiation k x = if k == 0 then One else stimes k x -- This function first checks if its arguments are zeros or units. If they are not, -- it invokes cubic reciprocity by calling cubicSymbolHelper with swapped arguments. -cubicReciprocity :: E.EisensteinInteger -> E.EisensteinInteger -> CubicSymbol +cubicReciprocity :: EisensteinInteger -> EisensteinInteger -> CubicSymbol -- Note @cubicReciprocity 0 1 = One@. It turns out it is better to adopt this convention. cubicReciprocity _ 1 = One -- Checks if first argument is zero. Note the second argument is never zero. @@ -86,38 +86,40 @@ cubicReciprocity alpha beta = cubicSymbolHelper beta alpha -- primary numbers to alpha and beta respectively. @contribution@ is a an integer -- defined mod 3 which measures the difference between the cubic residue of @alpha@ -- and @beta@ with respect to the cubic residue of @gamma@ and @delta@. -extractPrimaryContributions :: E.EisensteinInteger -> E.EisensteinInteger -> (E.EisensteinInteger, E.EisensteinInteger, M.Mod 3) +extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, Mod 3) extractPrimaryContributions alpha beta = (gamma, delta, contribution) - where contribution = j*m - i*m -i*n - [i, j, m, n] = map conversion [iInt, jInt, mInt, nInt] - conversion x = fromIntegral x :: M.Mod 3 - mInt E.:+ nInt = A.quot (delta - 1) 3 - (iInt, gamma) = getPrimaryDecomposition alphaThreeFree - (_, delta) = getPrimaryDecomposition beta - jInt = T.wordToInteger jIntWord - -- This function outputs data such that - -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@. - (jIntWord, alphaThreeFree) = U.splitOff (1 - E.ω) alpha + where + contribution = j*m - i*m -i*n + [i, j, m, n] = map fromIntegral [iInt, jInt, mInt, nInt] + mInt :+ nInt = A.quot (delta - 1) 3 + (iInt, gamma) = getPrimaryDecomposition alphaThreeFree + (_, delta) = getPrimaryDecomposition beta + jInt = wordToInteger jIntWord + -- This function outputs data such that + -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@. + (jIntWord, alphaThreeFree) = splitOff (1 - ω) alpha -- This function takes an Eisenstein number and returns its primary decomposition @(powerUnit, factor)@ -- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @powerUnit@ and a unique -- Eisenstein number @factor@ such that @(1 + ω)^powerUnit * e = 1 + 3*factor@. -- Note that L.findIndex cannot return Nothing. This happens only if @e@ is not -- coprime with 3. This cannot happen since @U.splitOff@ is called just before. -getPrimaryDecomposition :: E.EisensteinInteger -> (Integer, E.EisensteinInteger) +getPrimaryDecomposition :: EisensteinInteger -> (Integer, EisensteinInteger) -- This is the case where a common factor between @alpha@ and @beta@ is detected. -- In this instance @cubicReciprocity@ will return @Zero@. -- Strictly speaking, this is not a primary decomposition. getPrimaryDecomposition 0 = (0, 0) getPrimaryDecomposition e = (toInteger powerUnit, factor) - where factor = unit * e - unit = (1 + E.ω)^powerUnit - powerUnit = D.fromMaybe - (error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed.") - findPowerUnit - findPowerUnit = L.elemIndex 1 listOfRemainders - listOfRemainders = map (`A.rem` 3) listOfAssociates - -- Note that the units in @E.ids@ are ordered in the following way: - -- The i^th element of @E.ids@ is @(1 + ω)^i@ starting from i = 0@ - -- That is the i^th unit counting anticlockwise starting with 1. - listOfAssociates = map (*e) E.ids + where + factor = unit * e + unit = (1 + ω)^powerUnit + -- The @6 - _@ ensures @(1 + ω)^powerUnit * e = 1 (mod 3)@ + powerUnit = 6 - fromMaybe + (error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed.") + findPowerUnit + -- Note that the units in @ids@ are ordered in the following way: + -- The i^th element of @ids@ is @(1 + ω)^i@ starting from i = 0@ + -- That is the i^th unit counting anticlockwise starting with 1. + -- Note that this index is the inverse of what is needed. + findPowerUnit = elemIndex remainder ids + remainder = e `A.rem` 3 diff --git a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs index 4b161024f..58cb47d7a 100644 --- a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs +++ b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs @@ -2,39 +2,42 @@ module Math.NumberTheory.Moduli.CubicSymbolTests ( testSuite ) where -import qualified Math.NumberTheory.Moduli.CubicSymbol as C -import qualified Math.NumberTheory.Quadratic.EisensteinIntegers as E -import Test.Tasty (TestTree, testGroup) +import Math.NumberTheory.Moduli.CubicSymbol +import Math.NumberTheory.Quadratic.EisensteinIntegers +import Test.Tasty import Math.NumberTheory.TestUtils --- Checks multiplicative property of the numerator -cubicSymbol1 :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool +-- Checks multiplicative property of the numerators +cubicSymbol1 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbol1 alpha1 alpha2 beta = (modularNorm == 0) || cubicSymbolNumerator alpha1 alpha2 beta - where modularNorm = norm `mod` 3 - norm = E.norm beta + where + modularNorm = norm beta `mod` 3 -cubicSymbolNumerator :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool +cubicSymbolNumerator :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbolNumerator alpha1 alpha2 beta = (symbol1 <> symbol2) == symbolProduct - where symbol1 = C.cubicSymbol alpha1 beta - symbol2 = C.cubicSymbol alpha2 beta - symbolProduct = C.cubicSymbol alphaProduct beta - alphaProduct = alpha1 * alpha2 + where + symbol1 = cubicSymbol alpha1 beta + symbol2 = cubicSymbol alpha2 beta + symbolProduct = cubicSymbol alphaProduct beta + alphaProduct = alpha1 * alpha2 --- Checks multiplicative property of the denominator -cubicSymbol2 :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool +-- Checks multiplicative property of the denominators +cubicSymbol2 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbol2 alpha beta1 beta2 = (modularNorm1 == 0) || (modularNorm2 == 0) || cubicSymbolDenominator alpha beta1 beta2 - where (modularNorm1, modularNorm2) = (norm1 `mod` 3, norm2 `mod` 3) - (norm1, norm2) = (E.norm beta1, E.norm beta2) + where + (modularNorm1, modularNorm2) = (norm1 `mod` 3, norm2 `mod` 3) + (norm1, norm2) = (norm beta1, norm beta2) -cubicSymbolDenominator :: E.EisensteinInteger -> E.EisensteinInteger -> E.EisensteinInteger -> Bool +cubicSymbolDenominator :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct - where symbol1 = C.cubicSymbol alpha beta1 - symbol2 = C.cubicSymbol alpha beta2 - symbolProduct = C.cubicSymbol alpha betaProduct - betaProduct = beta1 * beta2 + where + symbol1 = cubicSymbol alpha beta1 + symbol2 = cubicSymbol alpha beta2 + symbolProduct = cubicSymbol alpha betaProduct + betaProduct = beta1 * beta2 testSuite :: TestTree -testSuite = testGroup "CubicSymbol" $ - [ testSmallAndQuick "multiplicative property of numerators" cubicSymbol1 - , testSmallAndQuick "multiplicative property of denominators" cubicSymbol2 - ] +testSuite = testGroup "CubicSymbol" + [ testSmallAndQuick "multiplicative property of numerators" cubicSymbol1 + , testSmallAndQuick "multiplicative property of denominators" cubicSymbol2 + ] From 4730d19bcecbd03ce995f4dbb5b22b76ee446876 Mon Sep 17 00:00:00 2001 From: folidota Date: Fri, 17 Apr 2020 18:09:32 +0100 Subject: [PATCH 11/18] More readable code in getPrimaryDecomposition --- Math/NumberTheory/Moduli/CubicSymbol.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index ceff914fd..bf89d8523 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -113,13 +113,13 @@ getPrimaryDecomposition e = (toInteger powerUnit, factor) where factor = unit * e unit = (1 + ω)^powerUnit - -- The @6 - _@ ensures @(1 + ω)^powerUnit * e = 1 (mod 3)@ - powerUnit = 6 - fromMaybe + powerUnit = fromMaybe (error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed.") findPowerUnit -- Note that the units in @ids@ are ordered in the following way: -- The i^th element of @ids@ is @(1 + ω)^i@ starting from i = 0@ -- That is the i^th unit counting anticlockwise starting with 1. - -- Note that this index is the inverse of what is needed. - findPowerUnit = elemIndex remainder ids + findPowerUnit = elemIndex inverseRemainder ids + inverseRemainder = conjugate remainder + -- Note that this number is the inverse of what is needed. remainder = e `A.rem` 3 From eac987bd3f43add6f9a4fbf0d6de463b6d9be9ac Mon Sep 17 00:00:00 2001 From: folidota Date: Fri, 17 Apr 2020 23:27:34 +0100 Subject: [PATCH 12/18] Added test to check cubicSymbol when the denominator is prime --- .../NumberTheory/Moduli/CubicSymbolTests.hs | 47 ++++++++++++++++--- 1 file changed, 40 insertions(+), 7 deletions(-) diff --git a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs index 58cb47d7a..47f4753e1 100644 --- a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs +++ b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs @@ -4,14 +4,15 @@ module Math.NumberTheory.Moduli.CubicSymbolTests import Math.NumberTheory.Moduli.CubicSymbol import Math.NumberTheory.Quadratic.EisensteinIntegers +import Math.NumberTheory.Primes +import qualified Data.Euclidean as A +import Data.List import Test.Tasty import Math.NumberTheory.TestUtils -- Checks multiplicative property of the numerators cubicSymbol1 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool -cubicSymbol1 alpha1 alpha2 beta = (modularNorm == 0) || cubicSymbolNumerator alpha1 alpha2 beta - where - modularNorm = norm beta `mod` 3 +cubicSymbol1 alpha1 alpha2 beta = isBadDenominator beta || cubicSymbolNumerator alpha1 alpha2 beta cubicSymbolNumerator :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbolNumerator alpha1 alpha2 beta = (symbol1 <> symbol2) == symbolProduct @@ -23,10 +24,7 @@ cubicSymbolNumerator alpha1 alpha2 beta = (symbol1 <> symbol2) == symbolProduct -- Checks multiplicative property of the denominators cubicSymbol2 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool -cubicSymbol2 alpha beta1 beta2 = (modularNorm1 == 0) || (modularNorm2 == 0) || cubicSymbolDenominator alpha beta1 beta2 - where - (modularNorm1, modularNorm2) = (norm1 `mod` 3, norm2 `mod` 3) - (norm1, norm2) = (norm beta1, norm beta2) +cubicSymbol2 alpha beta1 beta2 = isBadDenominator beta1 || isBadDenominator beta2 || cubicSymbolDenominator alpha beta1 beta2 cubicSymbolDenominator :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct @@ -36,8 +34,43 @@ cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct symbolProduct = cubicSymbol alpha betaProduct betaProduct = beta1 * beta2 +-- Checks that the cubic symbol is correct when the denominator is primebeta +-- as explanined in § 3.3.2 in https://en.wikipedia.org/wiki/Cubic_reciprocity +cubicSymbol3 :: EisensteinInteger -> Prime EisensteinInteger -> Bool +cubicSymbol3 alpha prime = isBadDenominator beta || isNotDivisible || cubicSymbol alpha beta == cubicSymbolPrime alpha beta + where beta = unPrime prime + isNotDivisible = alpha `A.rem` beta == 0 + +cubicSymbolPrime :: EisensteinInteger -> EisensteinInteger -> CubicSymbol +cubicSymbolPrime alpha beta = findCubicSymbol residue beta + where + residue = foldr f 1 listOfAlphas + f x y = (x * y) `A.rem` beta + listOfAlphas = genericReplicate alphaExponent alpha + -- Exponent is defined to be 1/3*(@betaNorm@ - 1). + alphaExponent = betaNorm `div` 3 + betaNorm = norm beta + +isBadDenominator :: EisensteinInteger -> Bool +isBadDenominator x = modularNorm == 0 + where + modularNorm = norm x `mod` 3 + +-- This complication is necessary because it may happen that the residue field +-- of @beta@ has characteristic two. In this case 1=-1 and the Euclidean algorithm +-- can return both. Therefore it is not enough to pattern match for the values +-- which give a well defined cubicSymbol. +findCubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol +findCubicSymbol residue beta + | residue `A.rem` beta == 0 = Zero + | (residue - ω) `A.rem` beta == 0 = Omega + | (residue + 1 + ω) `A.rem` beta == 0 = OmegaSquare + | (residue - 1) `A.rem` beta == 0 = One + | otherwise = error "Math.NumberTheory.Moduli.CubicSymbol: invalid EisensteinInteger." + testSuite :: TestTree testSuite = testGroup "CubicSymbol" [ testSmallAndQuick "multiplicative property of numerators" cubicSymbol1 , testSmallAndQuick "multiplicative property of denominators" cubicSymbol2 + , testSmallAndQuick "cubic residue with prime denominator" cubicSymbol3 ] From 0533ff66cf64f98a305b115a33b7151914a2d0be Mon Sep 17 00:00:00 2001 From: folidota Date: Sat, 18 Apr 2020 00:35:09 +0100 Subject: [PATCH 13/18] Minor change to cubicSymbol3 test function --- test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs index 47f4753e1..6f797cffb 100644 --- a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs +++ b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs @@ -37,9 +37,8 @@ cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct -- Checks that the cubic symbol is correct when the denominator is primebeta -- as explanined in § 3.3.2 in https://en.wikipedia.org/wiki/Cubic_reciprocity cubicSymbol3 :: EisensteinInteger -> Prime EisensteinInteger -> Bool -cubicSymbol3 alpha prime = isBadDenominator beta || isNotDivisible || cubicSymbol alpha beta == cubicSymbolPrime alpha beta +cubicSymbol3 alpha prime = isBadDenominator beta || cubicSymbol alpha beta == cubicSymbolPrime alpha beta where beta = unPrime prime - isNotDivisible = alpha `A.rem` beta == 0 cubicSymbolPrime :: EisensteinInteger -> EisensteinInteger -> CubicSymbol cubicSymbolPrime alpha beta = findCubicSymbol residue beta From 4043c6cf7faa7711ee78e599fa9c85c488df0e61 Mon Sep 17 00:00:00 2001 From: folidota Date: Sun, 26 Apr 2020 13:45:50 +0100 Subject: [PATCH 14/18] Helper functions return cubic symbols rather than integers --- Math/NumberTheory/Moduli/CubicSymbol.hs | 58 +++++++++++++------------ 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index bf89d8523..e42c5d977 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE DataKinds #-} module Math.NumberTheory.Moduli.CubicSymbol ( CubicSymbol(..) @@ -11,7 +10,6 @@ import Math.NumberTheory.Utils.FromIntegral import qualified Data.Euclidean as A import Math.NumberTheory.Utils import Data.Semigroup -import Data.Mod.Word import Data.Maybe import Data.List @@ -34,6 +32,9 @@ instance Show CubicSymbol where OmegaSquare -> "ω²" One -> "1" +exponentiation :: Integer -> CubicSymbol -> CubicSymbol +exponentiation k x = if k == 0 then One else stimes k x + -- The algorithm cubicSymbol takes two Eisentein numbers @alpha@ and @beta@ and returns -- their cubic residue. It is divided in the following steps. @@ -51,22 +52,16 @@ instance Show CubicSymbol where -- This function takes two Eisenstein integers and returns their cubic residue character. -- Note that the second argument must be coprime to 3 else the algorithm returns an error. cubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol -cubicSymbol alpha beta = case betaNorm `mod` 3 of +cubicSymbol alpha beta = case beta `A.rem` (1 - ω) of -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ -- In particular, it returns an error if @beta == 0@ 0 -> error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." - _ -> cubicSymbolHelper alpha beta - where - betaNorm = norm beta - -cubicSymbolHelper :: EisensteinInteger -> EisensteinInteger -> CubicSymbol -cubicSymbolHelper alpha beta = cubicReciprocity primaryRemainder primaryBeta <> newSymbol + -- In order to apply cubicReciprocity, one has to firt make + -- sure the arguments are primary numbers. + _ -> cubicReciprocity primaryRemainder primaryBeta <> newSymbol where - (primaryRemainder, primaryBeta, symbolExponent) = extractPrimaryContributions remainder beta + (primaryRemainder, primaryBeta, newSymbol) = extractPrimaryContributions remainder beta remainder = A.rem alpha beta - newSymbol = exponentiation unmodularExponent Omega - unmodularExponent = wordToInt (unMod symbolExponent) - exponentiation k x = if k == 0 then One else stimes k x -- This function first checks if its arguments are zeros or units. If they are not, -- it invokes cubic reciprocity by calling cubicSymbolHelper with swapped arguments. @@ -79,41 +74,48 @@ cubicReciprocity 0 _ = Zero -- it is enough to pattern match with 1. cubicReciprocity 1 _ = One -- Otherwise, cubic reciprocity is called. -cubicReciprocity alpha beta = cubicSymbolHelper beta alpha +cubicReciprocity alpha beta = cubicSymbol beta alpha -- This function takes two Eisenstein intgers @alpha@ and @beta@ and returns three -- arguments @(gamma, delta, contribution)@. @gamma@ and @delta@ are the associated --- primary numbers to alpha and beta respectively. @contribution@ is a an integer --- defined mod 3 which measures the difference between the cubic residue of @alpha@ +-- primary numbers to alpha and beta respectively. @contribution@ is the cubicSymbol +-- which measures the difference between the cubic residue of @alpha@ -- and @beta@ with respect to the cubic residue of @gamma@ and @delta@. -extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, Mod 3) +extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, CubicSymbol) extractPrimaryContributions alpha beta = (gamma, delta, contribution) where - contribution = j*m - i*m -i*n - [i, j, m, n] = map fromIntegral [iInt, jInt, mInt, nInt] + contribution = partSymbol1 <> partSymbol2 + partSymbol1 = exponentiation exponent1 alphaSymbol + partSymbol2 = exponentiation exponent2 Omega + -- Multiplying the exponent by 2 is equivalent to subtracting the same quantity. + exponent1 = (2*(mInt + nInt)) `mod` 3 + exponent2 = (jInt*mInt) `mod` 3 mInt :+ nInt = A.quot (delta - 1) 3 - (iInt, gamma) = getPrimaryDecomposition alphaThreeFree + (alphaSymbol, gamma) = getPrimaryDecomposition alphaThreeFree (_, delta) = getPrimaryDecomposition beta jInt = wordToInteger jIntWord -- This function outputs data such that -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@. (jIntWord, alphaThreeFree) = splitOff (1 - ω) alpha --- This function takes an Eisenstein number and returns its primary decomposition @(powerUnit, factor)@ --- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @powerUnit@ and a unique --- Eisenstein number @factor@ such that @(1 + ω)^powerUnit * e = 1 + 3*factor@. --- Note that L.findIndex cannot return Nothing. This happens only if @e@ is not +-- This function takes an Eisenstein number and returns its primary decomposition +-- @(symbolPower, factor)@. That is, given @e@ coprime with 3, it returns a +-- CubicSymbol @symbolPower@ and a unique Eisenstein number @factor@ such that +-- @(1 + ω)^powerUnit * e = 1 + 3*factor@ where @symbolPower = Omega^powerUnit@ +-- Note that L.findIndex never returns Nothing. This happens only if @e@ is not -- coprime with 3. This cannot happen since @U.splitOff@ is called just before. -getPrimaryDecomposition :: EisensteinInteger -> (Integer, EisensteinInteger) +getPrimaryDecomposition :: EisensteinInteger -> (CubicSymbol, EisensteinInteger) -- This is the case where a common factor between @alpha@ and @beta@ is detected. -- In this instance @cubicReciprocity@ will return @Zero@. -- Strictly speaking, this is not a primary decomposition. -getPrimaryDecomposition 0 = (0, 0) -getPrimaryDecomposition e = (toInteger powerUnit, factor) +getPrimaryDecomposition 0 = (Zero, 0) +getPrimaryDecomposition e = (symbolPower, factor) where + symbolPower = exponentiation powerUnit Omega + powerUnit = fromIntegral intPowerUnit factor = unit * e unit = (1 + ω)^powerUnit - powerUnit = fromMaybe + intPowerUnit = fromMaybe (error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed.") findPowerUnit -- Note that the units in @ids@ are ordered in the following way: From 20ab1b8864472ea317244503e1efe569536a5277 Mon Sep 17 00:00:00 2001 From: folidota Date: Sun, 26 Apr 2020 23:21:59 +0100 Subject: [PATCH 15/18] Added symbolToNum and exponentiation. Changed extractPrimaryContributions --- Math/NumberTheory/Moduli/CubicSymbol.hs | 65 +++++++++++++------------ 1 file changed, 35 insertions(+), 30 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index e42c5d977..516a3c4db 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -2,6 +2,7 @@ module Math.NumberTheory.Moduli.CubicSymbol ( CubicSymbol(..) + , symbolToNum , cubicSymbol ) where @@ -24,6 +25,13 @@ instance Semigroup CubicSymbol where Omega <> OmegaSquare = One OmegaSquare <> Omega = One OmegaSquare <> OmegaSquare = Omega + stimes k n = case (k `mod` 3, n) of + (0, _) -> One + (1, symbol) -> symbol + (2, Omega) -> OmegaSquare + (2, OmegaSquare) -> Omega + (2, symbol) -> symbol + _ -> error "Math.NumberTheory.Moduli.CubicSymbol: exponentiation undefined." instance Show CubicSymbol where show = \case @@ -32,9 +40,12 @@ instance Show CubicSymbol where OmegaSquare -> "ω²" One -> "1" -exponentiation :: Integer -> CubicSymbol -> CubicSymbol -exponentiation k x = if k == 0 then One else stimes k x - +symbolToNum :: CubicSymbol -> EisensteinInteger +symbolToNum = \case + Zero -> 0 + Omega -> ω + OmegaSquare -> -1 - ω + One -> 1 -- The algorithm cubicSymbol takes two Eisentein numbers @alpha@ and @beta@ and returns -- their cubic residue. It is divided in the following steps. @@ -56,9 +67,10 @@ cubicSymbol alpha beta = case beta `A.rem` (1 - ω) of -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ -- In particular, it returns an error if @beta == 0@ 0 -> error "Math.NumberTheory.Moduli.CubicSymbol: denominator is not coprime to 3." - -- In order to apply cubicReciprocity, one has to firt make - -- sure the arguments are primary numbers. - _ -> cubicReciprocity primaryRemainder primaryBeta <> newSymbol + _ -> cubicSymbolHelper alpha beta + +cubicSymbolHelper :: EisensteinInteger -> EisensteinInteger -> CubicSymbol +cubicSymbolHelper alpha beta = cubicReciprocity primaryRemainder primaryBeta <> newSymbol where (primaryRemainder, primaryBeta, newSymbol) = extractPrimaryContributions remainder beta remainder = A.rem alpha beta @@ -74,48 +86,41 @@ cubicReciprocity 0 _ = Zero -- it is enough to pattern match with 1. cubicReciprocity 1 _ = One -- Otherwise, cubic reciprocity is called. -cubicReciprocity alpha beta = cubicSymbol beta alpha +cubicReciprocity alpha beta = cubicSymbolHelper beta alpha -- This function takes two Eisenstein intgers @alpha@ and @beta@ and returns three -- arguments @(gamma, delta, contribution)@. @gamma@ and @delta@ are the associated --- primary numbers to alpha and beta respectively. @contribution@ is the cubicSymbol --- which measures the difference between the cubic residue of @alpha@ +-- primary numbers to alpha and beta respectively. @contribution@ is a an integer +-- defined mod 3 which measures the difference between the cubic residue of @alpha@ -- and @beta@ with respect to the cubic residue of @gamma@ and @delta@. extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, CubicSymbol) -extractPrimaryContributions alpha beta = (gamma, delta, contribution) +extractPrimaryContributions alpha beta = (gamma, delta, newSymbol) where - contribution = partSymbol1 <> partSymbol2 - partSymbol1 = exponentiation exponent1 alphaSymbol - partSymbol2 = exponentiation exponent2 Omega - -- Multiplying the exponent by 2 is equivalent to subtracting the same quantity. - exponent1 = (2*(mInt + nInt)) `mod` 3 - exponent2 = (jInt*mInt) `mod` 3 - mInt :+ nInt = A.quot (delta - 1) 3 - (alphaSymbol, gamma) = getPrimaryDecomposition alphaThreeFree + newSymbol = stimes contribution Omega + contribution = j*m - i*m -i*n + m :+ n = A.quot (delta - 1) 3 + (i, gamma) = getPrimaryDecomposition alphaThreeFree (_, delta) = getPrimaryDecomposition beta - jInt = wordToInteger jIntWord + j = wordToInteger jIntWord -- This function outputs data such that -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@. (jIntWord, alphaThreeFree) = splitOff (1 - ω) alpha --- This function takes an Eisenstein number and returns its primary decomposition --- @(symbolPower, factor)@. That is, given @e@ coprime with 3, it returns a --- CubicSymbol @symbolPower@ and a unique Eisenstein number @factor@ such that --- @(1 + ω)^powerUnit * e = 1 + 3*factor@ where @symbolPower = Omega^powerUnit@ --- Note that L.findIndex never returns Nothing. This happens only if @e@ is not +-- This function takes an Eisenstein number and returns its primary decomposition @(powerUnit, factor)@ +-- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @powerUnit@ and a unique +-- Eisenstein number @factor@ such that @(1 + ω)^powerUnit * e = 1 + 3*factor@. +-- Note that L.findIndex cannot return Nothing. This happens only if @e@ is not -- coprime with 3. This cannot happen since @U.splitOff@ is called just before. -getPrimaryDecomposition :: EisensteinInteger -> (CubicSymbol, EisensteinInteger) +getPrimaryDecomposition :: EisensteinInteger -> (Integer, EisensteinInteger) -- This is the case where a common factor between @alpha@ and @beta@ is detected. -- In this instance @cubicReciprocity@ will return @Zero@. -- Strictly speaking, this is not a primary decomposition. -getPrimaryDecomposition 0 = (Zero, 0) -getPrimaryDecomposition e = (symbolPower, factor) +getPrimaryDecomposition 0 = (0, 0) +getPrimaryDecomposition e = (toInteger powerUnit, factor) where - symbolPower = exponentiation powerUnit Omega - powerUnit = fromIntegral intPowerUnit factor = unit * e unit = (1 + ω)^powerUnit - intPowerUnit = fromMaybe + powerUnit = fromMaybe (error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed.") findPowerUnit -- Note that the units in @ids@ are ordered in the following way: From 88a218d1dd733e9cdf284ffc19d2f70a60d29ec4 Mon Sep 17 00:00:00 2001 From: folidota Date: Wed, 29 Apr 2020 17:02:50 +0100 Subject: [PATCH 16/18] Added table lookup for getPrimaryDecomposition --- Math/NumberTheory/Moduli/CubicSymbol.hs | 40 ++++++++++--------------- 1 file changed, 16 insertions(+), 24 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index 516a3c4db..f69cadc99 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -11,8 +11,6 @@ import Math.NumberTheory.Utils.FromIntegral import qualified Data.Euclidean as A import Math.NumberTheory.Utils import Data.Semigroup -import Data.Maybe -import Data.List data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) @@ -96,8 +94,7 @@ cubicReciprocity alpha beta = cubicSymbolHelper beta alpha extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, CubicSymbol) extractPrimaryContributions alpha beta = (gamma, delta, newSymbol) where - newSymbol = stimes contribution Omega - contribution = j*m - i*m -i*n + newSymbol = stimes (j * m) Omega <> stimes (- m - n) i m :+ n = A.quot (delta - 1) 3 (i, gamma) = getPrimaryDecomposition alphaThreeFree (_, delta) = getPrimaryDecomposition beta @@ -106,27 +103,22 @@ extractPrimaryContributions alpha beta = (gamma, delta, newSymbol) -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@. (jIntWord, alphaThreeFree) = splitOff (1 - ω) alpha --- This function takes an Eisenstein number and returns its primary decomposition @(powerUnit, factor)@ --- That is, given @e@ coprime with 3, it returns a unique integer (mod 6) @powerUnit@ and a unique --- Eisenstein number @factor@ such that @(1 + ω)^powerUnit * e = 1 + 3*factor@. --- Note that L.findIndex cannot return Nothing. This happens only if @e@ is not +-- This function takes an Eisenstein number and returns its primary decomposition +-- @(symbol, delta)@. That is, given @e@ coprime with 3, it finds a unique integer +-- x (mod 6) such that (1 + ω)^x * e = 1 (mod 3). +-- It then returns @symbol = x^2@ and @delta = (1 + ω)^x * e@. +-- Note that the error message should not be displayed. This happens only if @e@ is not -- coprime with 3. This cannot happen since @U.splitOff@ is called just before. -getPrimaryDecomposition :: EisensteinInteger -> (Integer, EisensteinInteger) +getPrimaryDecomposition :: EisensteinInteger -> (CubicSymbol, EisensteinInteger) -- This is the case where a common factor between @alpha@ and @beta@ is detected. -- In this instance @cubicReciprocity@ will return @Zero@. -- Strictly speaking, this is not a primary decomposition. -getPrimaryDecomposition 0 = (0, 0) -getPrimaryDecomposition e = (toInteger powerUnit, factor) - where - factor = unit * e - unit = (1 + ω)^powerUnit - powerUnit = fromMaybe - (error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed.") - findPowerUnit - -- Note that the units in @ids@ are ordered in the following way: - -- The i^th element of @ids@ is @(1 + ω)^i@ starting from i = 0@ - -- That is the i^th unit counting anticlockwise starting with 1. - findPowerUnit = elemIndex inverseRemainder ids - inverseRemainder = conjugate remainder - -- Note that this number is the inverse of what is needed. - remainder = e `A.rem` 3 +getPrimaryDecomposition 0 = (Zero, 0) +getPrimaryDecomposition e = case e `A.rem` 3 of + 1 -> (One, e) + 1 :+ 1 -> (OmegaSquare, -ω * e) + 0 :+ 1 -> (Omega, (-1 - ω) * e) + -1 -> (One, -e) + (-1) :+ (-1) -> (OmegaSquare, ω * e) + 0 :+ (-1) -> (Omega, (1 + ω) * e) + _ -> error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed." From eb9e5ee89aef2c2878d35950397e168eb6d5b906 Mon Sep 17 00:00:00 2001 From: folidota Date: Sat, 2 May 2020 16:50:41 +0100 Subject: [PATCH 17/18] Added Haddock comments --- Math/NumberTheory/Moduli/CubicSymbol.hs | 94 +++++++++++++------ .../NumberTheory/Moduli/CubicSymbolTests.hs | 24 ++++- 2 files changed, 83 insertions(+), 35 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index f69cadc99..9850fe070 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -1,9 +1,18 @@ +-- | +-- Module: Math.NumberTheory.Moduli.CubicSymbol +-- Copyright: (c) 2020 Federico Bongiorno +-- Licence: MIT +-- Maintainer: Federico Bongiorno +-- +-- +-- of two Eisenstein Integers. + {-# LANGUAGE LambdaCase #-} module Math.NumberTheory.Moduli.CubicSymbol ( CubicSymbol(..) - , symbolToNum , cubicSymbol + , symbolToNum ) where import Math.NumberTheory.Quadratic.EisensteinIntegers @@ -12,8 +21,19 @@ import qualified Data.Euclidean as A import Math.NumberTheory.Utils import Data.Semigroup +-- | Represents +-- +-- It is either @0@, @ω@, @ω²@ or @1@. data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) +-- | The set of cubic symbols form a semigroup. However @stimes@ +-- is allowed to take non-positive values. In other words, the set +-- of non-zero cubic symbols is regarded as a group. +-- +-- >>> stimes -1 ω +-- ω² +-- >>> stimes 0 0 +-- 1 instance Semigroup CubicSymbol where Zero <> _ = Zero _ <> Zero = Zero @@ -38,28 +58,43 @@ instance Show CubicSymbol where OmegaSquare -> "ω²" One -> "1" +-- | Converts a +-- +-- to an Eisenstein Integer. symbolToNum :: CubicSymbol -> EisensteinInteger symbolToNum = \case Zero -> 0 Omega -> ω OmegaSquare -> -1 - ω One -> 1 --- The algorithm cubicSymbol takes two Eisentein numbers @alpha@ and @beta@ and returns --- their cubic residue. It is divided in the following steps. --- 1) Check whether @beta@ is coprime to 3. --- 2) Replace @alpha@ by the remainder of @alpha@ mod @beta@ --- This does not affect the cubic symbol. --- 3) Replace @alpha@ and @beta@ by their associated primary --- divisors and keep track of how their cubic residue changes. --- 4) Check if any of the two numbers is a zero or a unit. If it --- is, return their cubic residue. --- 5) If not, invoke cubic reciprocity by swapping @alpha@ and --- @beta@. Note both numbers have to be primary. --- Return to Step 2. +-- The algorithm cubicSymbol is divided in the following steps. +-- It is adapted from . +-- +-- (1) Check whether @beta@ is coprime to 3. +-- (2) Replace @alpha@ by the remainder of @alpha@ mod @beta@ +-- This does not affect the cubic symbol. +-- (3) Replace @alpha@ and @beta@ by their associated primary +-- divisors and keep track of how their cubic residue changes. +-- (4) Check if any of the two numbers is a zero or a unit. In this +-- case, it return their cubic residue. +-- (5) Otherwise, it invoke cubic reciprocity by swapping @alpha@ and +-- @beta@. Note both numbers have to be primary. +-- Return to Step 2. --- This function takes two Eisenstein integers and returns their cubic residue character. --- Note that the second argument must be coprime to 3 else the algorithm returns an error. +-- | +-- of two Eisenstein Integers. +-- The first argument is the numerator and the second argument +-- is the denominator. The latter must be coprime to @3@. +-- This condition is checked. +-- +-- If the arguments have a common factor, the result +-- is 'Zero', otherwise it is either 'Omega', 'OmegaSquare' or 'One'. +-- +-- >>> cubicSymbol (45 + 23*ω) (11 - 30*ω) +-- 0 +-- >>> cubicSymbol (31 - ω) (1 +10*ω) +-- ω cubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol cubicSymbol alpha beta = case beta `A.rem` (1 - ω) of -- This checks whether beta is coprime to 3, i.e. divisible by @1 - ω@ @@ -73,10 +108,8 @@ cubicSymbolHelper alpha beta = cubicReciprocity primaryRemainder primaryBeta <> (primaryRemainder, primaryBeta, newSymbol) = extractPrimaryContributions remainder beta remainder = A.rem alpha beta --- This function first checks if its arguments are zeros or units. If they are not, --- it invokes cubic reciprocity by calling cubicSymbolHelper with swapped arguments. cubicReciprocity :: EisensteinInteger -> EisensteinInteger -> CubicSymbol --- Note @cubicReciprocity 0 1 = One@. It turns out it is better to adopt this convention. +-- Note @cubicReciprocity 0 1 = One@. It is better to adopt this convention. cubicReciprocity _ 1 = One -- Checks if first argument is zero. Note the second argument is never zero. cubicReciprocity 0 _ = Zero @@ -86,11 +119,11 @@ cubicReciprocity 1 _ = One -- Otherwise, cubic reciprocity is called. cubicReciprocity alpha beta = cubicSymbolHelper beta alpha --- This function takes two Eisenstein intgers @alpha@ and @beta@ and returns three --- arguments @(gamma, delta, contribution)@. @gamma@ and @delta@ are the associated --- primary numbers to alpha and beta respectively. @contribution@ is a an integer --- defined mod 3 which measures the difference between the cubic residue of @alpha@ --- and @beta@ with respect to the cubic residue of @gamma@ and @delta@. +-- | This function takes two Eisenstein intgers @alpha@ and @beta@ and returns +-- three arguments @(gamma, delta, newSymbol)@. @gamma@ and @delta@ are the +-- associated primary numbers to alpha and beta respectively. @newSymbol@ +-- is a the cubic symbol measuring the discrepancy between the cubic residue +-- of @alpha@ and @beta@, and the cubic residue of @gamma@ and @delta@. extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, CubicSymbol) extractPrimaryContributions alpha beta = (gamma, delta, newSymbol) where @@ -103,15 +136,16 @@ extractPrimaryContributions alpha beta = (gamma, delta, newSymbol) -- @(1 - ω)^jIntWord * alphaThreeFree = alpha@. (jIntWord, alphaThreeFree) = splitOff (1 - ω) alpha --- This function takes an Eisenstein number and returns its primary decomposition --- @(symbol, delta)@. That is, given @e@ coprime with 3, it finds a unique integer --- x (mod 6) such that (1 + ω)^x * e = 1 (mod 3). --- It then returns @symbol = x^2@ and @delta = (1 + ω)^x * e@. --- Note that the error message should not be displayed. This happens only if @e@ is not --- coprime with 3. This cannot happen since @U.splitOff@ is called just before. +-- | This function takes an Eisenstein number @e@ and returns @(symbol, delta)@ +-- where @delta@ is its associated primary integer and @symbol@ is the +-- cubic symbol discrepancy between @e@ and @delta@. @delta@ is defined to be +-- the unique associated Eisenstein Integer to @e@ such that +-- \( \textrm{delta} \equiv 1 (\textrm{mod} 3) \). +-- Note that this is well defined if and only if @e@ is coprime to 3. In this +-- case, an error message is displayed. getPrimaryDecomposition :: EisensteinInteger -> (CubicSymbol, EisensteinInteger) -- This is the case where a common factor between @alpha@ and @beta@ is detected. --- In this instance @cubicReciprocity@ will return @Zero@. +-- In this instance @cubicReciprocity@ will return `Zero`. -- Strictly speaking, this is not a primary decomposition. getPrimaryDecomposition 0 = (Zero, 0) getPrimaryDecomposition e = case e `A.rem` 3 of diff --git a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs index 6f797cffb..0d1e20819 100644 --- a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs +++ b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs @@ -1,3 +1,12 @@ +-- | +-- Module: Math.NumberTheory.Moduli.CubicSymbol +-- Copyright: (c) 2020 Federico Bongiorno +-- Licence: MIT +-- Maintainer: Federico Bongiorno +-- +-- Test for Math.NumberTheory.Moduli.CubicSymbol +-- + module Math.NumberTheory.Moduli.CubicSymbolTests ( testSuite ) where @@ -10,7 +19,9 @@ import Data.List import Test.Tasty import Math.NumberTheory.TestUtils --- Checks multiplicative property of the numerators +-- Checks multiplicative property of numerators. In details, +-- @cubicSymbol1 alpha1 alpha2 beta@ checks that +-- @(cubicSymbol alpha1 beta) <> (cubicSymbol alpha2 beta) == (cubicSymbol alpha1*alpha2 beta)@ cubicSymbol1 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbol1 alpha1 alpha2 beta = isBadDenominator beta || cubicSymbolNumerator alpha1 alpha2 beta @@ -22,7 +33,9 @@ cubicSymbolNumerator alpha1 alpha2 beta = (symbol1 <> symbol2) == symbolProduct symbolProduct = cubicSymbol alphaProduct beta alphaProduct = alpha1 * alpha2 --- Checks multiplicative property of the denominators +-- Checks multiplicative property of denominators. In details, +-- @cubicSymbol2 alpha beta1 beta2@ checks that +-- @(cubicSymbol alpha beta1) <> (cubicSymbol alpha beta2) == (cubicSymbol alpha beta1*beta2)@ cubicSymbol2 :: EisensteinInteger -> EisensteinInteger -> EisensteinInteger -> Bool cubicSymbol2 alpha beta1 beta2 = isBadDenominator beta1 || isBadDenominator beta2 || cubicSymbolDenominator alpha beta1 beta2 @@ -34,8 +47,9 @@ cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct symbolProduct = cubicSymbol alpha betaProduct betaProduct = beta1 * beta2 --- Checks that the cubic symbol is correct when the denominator is primebeta --- as explanined in § 3.3.2 in https://en.wikipedia.org/wiki/Cubic_reciprocity +-- Checks that @cubicSymbol@ agrees with the computational definition +-- +-- when the denominator is prime. cubicSymbol3 :: EisensteinInteger -> Prime EisensteinInteger -> Bool cubicSymbol3 alpha prime = isBadDenominator beta || cubicSymbol alpha beta == cubicSymbolPrime alpha beta where beta = unPrime prime @@ -58,7 +72,7 @@ isBadDenominator x = modularNorm == 0 -- This complication is necessary because it may happen that the residue field -- of @beta@ has characteristic two. In this case 1=-1 and the Euclidean algorithm -- can return both. Therefore it is not enough to pattern match for the values --- which give a well defined cubicSymbol. +-- which give a well defined @cubicSymbol@. findCubicSymbol :: EisensteinInteger -> EisensteinInteger -> CubicSymbol findCubicSymbol residue beta | residue `A.rem` beta == 0 = Zero From c4ad23b18ec083a2850157337c674b46bf3109cf Mon Sep 17 00:00:00 2001 From: folidota Date: Sat, 2 May 2020 17:45:04 +0100 Subject: [PATCH 18/18] Changed comments and avoided compiler warning --- Math/NumberTheory/Moduli/CubicSymbol.hs | 23 ++++++++++--------- .../NumberTheory/Moduli/CubicSymbolTests.hs | 2 +- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/Math/NumberTheory/Moduli/CubicSymbol.hs b/Math/NumberTheory/Moduli/CubicSymbol.hs index 9850fe070..644554f8f 100644 --- a/Math/NumberTheory/Moduli/CubicSymbol.hs +++ b/Math/NumberTheory/Moduli/CubicSymbol.hs @@ -21,12 +21,12 @@ import qualified Data.Euclidean as A import Math.NumberTheory.Utils import Data.Semigroup --- | Represents --- +-- | Represents the +-- -- It is either @0@, @ω@, @ω²@ or @1@. data CubicSymbol = Zero | Omega | OmegaSquare | One deriving (Eq) --- | The set of cubic symbols form a semigroup. However @stimes@ +-- | The set of cubic symbols form a semigroup. Note `stimes` -- is allowed to take non-positive values. In other words, the set -- of non-zero cubic symbols is regarded as a group. -- @@ -68,8 +68,9 @@ symbolToNum = \case OmegaSquare -> -1 - ω One -> 1 --- The algorithm cubicSymbol is divided in the following steps. --- It is adapted from . +-- The algorithm `cubicSymbol` is adapted from +-- . +-- It is divided in the following steps. -- -- (1) Check whether @beta@ is coprime to 3. -- (2) Replace @alpha@ by the remainder of @alpha@ mod @beta@ @@ -77,8 +78,8 @@ symbolToNum = \case -- (3) Replace @alpha@ and @beta@ by their associated primary -- divisors and keep track of how their cubic residue changes. -- (4) Check if any of the two numbers is a zero or a unit. In this --- case, it return their cubic residue. --- (5) Otherwise, it invoke cubic reciprocity by swapping @alpha@ and +-- case, return their cubic residue. +-- (5) Otherwise, invoke cubic reciprocity by swapping @alpha@ and -- @beta@. Note both numbers have to be primary. -- Return to Step 2. @@ -121,8 +122,8 @@ cubicReciprocity alpha beta = cubicSymbolHelper beta alpha -- | This function takes two Eisenstein intgers @alpha@ and @beta@ and returns -- three arguments @(gamma, delta, newSymbol)@. @gamma@ and @delta@ are the --- associated primary numbers to alpha and beta respectively. @newSymbol@ --- is a the cubic symbol measuring the discrepancy between the cubic residue +-- associated primary numbers of alpha and beta respectively. @newSymbol@ +-- is the cubic symbol measuring the discrepancy between the cubic residue -- of @alpha@ and @beta@, and the cubic residue of @gamma@ and @delta@. extractPrimaryContributions :: EisensteinInteger -> EisensteinInteger -> (EisensteinInteger, EisensteinInteger, CubicSymbol) extractPrimaryContributions alpha beta = (gamma, delta, newSymbol) @@ -141,7 +142,7 @@ extractPrimaryContributions alpha beta = (gamma, delta, newSymbol) -- cubic symbol discrepancy between @e@ and @delta@. @delta@ is defined to be -- the unique associated Eisenstein Integer to @e@ such that -- \( \textrm{delta} \equiv 1 (\textrm{mod} 3) \). --- Note that this is well defined if and only if @e@ is coprime to 3. In this +-- Note that @delta@ exists if and only if @e@ is coprime to 3. In this -- case, an error message is displayed. getPrimaryDecomposition :: EisensteinInteger -> (CubicSymbol, EisensteinInteger) -- This is the case where a common factor between @alpha@ and @beta@ is detected. @@ -152,7 +153,7 @@ getPrimaryDecomposition e = case e `A.rem` 3 of 1 -> (One, e) 1 :+ 1 -> (OmegaSquare, -ω * e) 0 :+ 1 -> (Omega, (-1 - ω) * e) - -1 -> (One, -e) + (-1) :+ 0 -> (One, -e) (-1) :+ (-1) -> (OmegaSquare, ω * e) 0 :+ (-1) -> (Omega, (1 + ω) * e) _ -> error "Math.NumberTheory.Moduli.CubicSymbol: primary decomposition failed." diff --git a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs index 0d1e20819..582865a59 100644 --- a/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs +++ b/test-suite/Math/NumberTheory/Moduli/CubicSymbolTests.hs @@ -47,7 +47,7 @@ cubicSymbolDenominator alpha beta1 beta2 = (symbol1 <> symbol2) == symbolProduct symbolProduct = cubicSymbol alpha betaProduct betaProduct = beta1 * beta2 --- Checks that @cubicSymbol@ agrees with the computational definition +-- Checks that `cubicSymbol` agrees with the computational definition -- -- when the denominator is prime. cubicSymbol3 :: EisensteinInteger -> Prime EisensteinInteger -> Bool