diff --git a/ChangeLog.md b/ChangeLog.md index fdab40b..4c27621 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,16 @@ # Change log for galois-field +## 0.4.0 + +* Add `Vector` implementation of extension fields. +* Add `qnr` function for Galois fields. +* Add `qr` function for Galois fields. +* Add `quad` function for extension fields and binary fields. +* Add `sr` function for extension fields and binary fields. +* Add `Semiring` instances for Galois fields. +* Add `Ord` instances for Galois fields. +* Add minor optimisations to exponentiation with `RULES`. + ## 0.3.0 * Add complete implementation of binary fields. diff --git a/README.md b/README.md index e2ff764..e8c975f 100644 --- a/README.md +++ b/README.md @@ -33,7 +33,7 @@ For example, GF(4) has order 2^2 and can be constructed as an extension field GF ### Binary fields -A Galois field of the form GF(2^m) for big positive m is a sum of x^n for a non-empty set of 0 \< n \< m. For computational efficiency in cryptography, an element of a **binary field** can be represented by an integer that represents a bit string. +A Galois field of the form GF(2^m) for big positive m is a sum of X^n for a non-empty set of 0 \< n \< m. For computational efficiency in cryptography, an element of a **binary field** can be represented by an integer that represents a bit string. It should always be used when the field characteristic is 2. For example, X^8 + X^4 + X^3 + X + 1 can be represented as the integer 283 that represents the bit string 100011011. @@ -44,11 +44,14 @@ Include the following required language extensions. {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} ``` Import the following functions at minimum. ```haskell import PrimeField (PrimeField) -import ExtensionField (ExtensionField, IrreducibleMonic(split), fromList, t, x) +import ExtensionField (ExtensionField, IrreducibleMonic(split), toField, + pattern X, pattern X2, pattern X3, pattern Y) +import BinaryField (BinaryField) ``` ### Prime fields @@ -77,7 +80,7 @@ The following data type declaration creates a splitting polynomial given an irre ```haskell data P2 instance IrreducibleMonic Fq P2 where - split _ = x^2 + 1 + split _ = X2 + 1 ``` The following type declaration then creates an extension field with this splitting polynomial. ```haskell @@ -89,46 +92,46 @@ Similarly, further extension fields can be constructed iteratively as follows. ```haskell data P6 instance IrreducibleMonic Fq2 P6 where - split _ = x^3 - (9 + t x) + split _ = X3 - (9 + Y X) type Fq6 = ExtensionField Fq2 P6 data P12 instance IrreducibleMonic Fq6 P12 where - split _ = x^2 - t x + split _ = X2 - Y X type Fq12 = ExtensionField Fq6 P12 ``` -Note that `x` accesses the current indeterminate variable and `t` descends the tower of indeterminate variables. +Note that `X, X2, X3` accesses the current indeterminate variables and `Y` descends the tower of indeterminate variables. Galois field arithmetic can then be performed in this extension field. ```haskell fq12 :: Fq12 -fq12 = fromList - [ fromList - [ fromList +fq12 = toField + [ toField + [ toField [ 4025484419428246835913352650763180341703148406593523188761836807196412398582 , 5087667423921547416057913184603782240965080921431854177822601074227980319916 ] - , fromList + , toField [ 8868355606921194740459469119392835913522089996670570126495590065213716724895 , 12102922015173003259571598121107256676524158824223867520503152166796819430680 ] - , fromList + , toField [ 92336131326695228787620679552727214674825150151172467042221065081506740785 , 5482141053831906120660063289735740072497978400199436576451083698548025220729 ] ] - , fromList - [ fromList + , toField + [ toField [ 7642691434343136168639899684817459509291669149586986497725240920715691142493 , 1211355239100959901694672926661748059183573115580181831221700974591509515378 ] - , fromList + , toField [ 20725578899076721876257429467489710434807801418821512117896292558010284413176 , 17642016461759614884877567642064231230128683506116557502360384546280794322728 ] - , fromList + , toField [ 17449282511578147452934743657918270744212677919657988500433959352763226500950 , 1205855382909824928004884982625565310515751070464736233368671939944606335817 ] @@ -136,31 +139,31 @@ fq12 = fromList ] fq12' :: Fq12 -fq12' = fromList - [ fromList - [ fromList +fq12' = toField + [ toField + [ toField [ 495492586688946756331205475947141303903957329539236899715542920513774223311 , 9283314577619389303419433707421707208215462819919253486023883680690371740600 ] - , fromList + , toField [ 11142072730721162663710262820927009044232748085260948776285443777221023820448 , 1275691922864139043351956162286567343365697673070760209966772441869205291758 ] - , fromList + , toField [ 20007029371545157738471875537558122753684185825574273033359718514421878893242 , 9839139739201376418106411333971304469387172772449235880774992683057627654905 ] ] - , fromList - [ fromList + , toField + [ toField [ 9503058454919356208294350412959497499007919434690988218543143506584310390240 , 19236630380322614936323642336645412102299542253751028194541390082750834966816 ] - , fromList + , toField [ 18019769232924676175188431592335242333439728011993142930089933693043738917983 , 11549213142100201239212924317641009159759841794532519457441596987622070613872 ] - , fromList + , toField [ 9656683724785441232932664175488314398614795173462019188529258009817332577664 , 20666848762667934776817320505559846916719041700736383328805334359135638079015 ] @@ -172,12 +175,12 @@ arithmeticFq12 = (fq12 + fq12', fq12 - fq12', fq12 * fq12', fq12 / fq12') ``` Note that ``` -a + bx + (c + dx)y + (e + fx)y^2 + (g + hx + (i + jx)y + (k + lx)y^2)z +a + bX + (c + dX)Y + (e + fX)Y^2 + (g + hX + (i + jX)Y + (k + lX)Y^2)Z ``` -where `x, y, z` is a tower of indeterminate variables is constructed by +where `X, Y, Z` is a tower of indeterminate variables, is constructed by ```haskell -fromList [ fromList [fromList [a, b], fromList [c, d], fromList [e, f]] - , fromList [fromList [g, h], fromList [i, j], fromList [k, l]] ] :: Fq12 +toField [ toField [toField [a, b], toField [c, d], toField [e, f]] + , toField [toField [g, h], toField [i, j], toField [k, l]] ] :: Fq12 ``` ### Binary fields diff --git a/benchmarks/BinaryFieldBenchmarks.hs b/benchmarks/BinaryFieldBenchmarks.hs new file mode 100644 index 0000000..4e590d8 --- /dev/null +++ b/benchmarks/BinaryFieldBenchmarks.hs @@ -0,0 +1,17 @@ +module BinaryFieldBenchmarks where + +import BinaryField +import Criterion.Main + +import GaloisFieldBenchmarks + +type F2m = BinaryField 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425 + +f2m :: F2m +f2m = 0x303001d34b856296c16c0d40d3cd7750a93d1d2955fa80aa5f40fc8db7b2abdbde53950f4c0d293cdd711a35b67fb1499ae60038614f1394abfa3b4c850d927e1e7769c8eec2d19 + +f2m' :: F2m +f2m' = 0x37bf27342da639b6dccfffeb73d69d78c6c27a6009cbbca1980f8533921e8a684423e43bab08a576291af8f461bb2a8b3531d2f0485c19b16e2f1516e23dd3c1a4827af1b8ac15b + +benchmarkBinaryField :: Benchmark +benchmarkBinaryField = benchmark "BinaryField F2m" f2m f2m' diff --git a/benchmarks/ExtensionFieldBenchmarks.hs b/benchmarks/ExtensionFieldBenchmarks.hs new file mode 100644 index 0000000..069352e --- /dev/null +++ b/benchmarks/ExtensionFieldBenchmarks.hs @@ -0,0 +1,91 @@ +module ExtensionFieldBenchmarks where + +import Protolude + +import Criterion.Main +import ExtensionField + +import GaloisFieldBenchmarks +import PrimeFieldBenchmarks + +data Pu +instance IrreducibleMonic Fq Pu where + split _ = X2 + 1 +type Fq2 = ExtensionField Fq Pu + +data Pv +instance IrreducibleMonic Fq2 Pv where + split _ = X3 - 9 - Y X +type Fq6 = ExtensionField Fq2 Pv + +data Pw +instance IrreducibleMonic Fq6 Pw where + split _ = X2 - Y X +type Fq12 = ExtensionField Fq6 Pw + +fq12 :: Fq12 +fq12 = toField + [ toField + [ toField + [ 4025484419428246835913352650763180341703148406593523188761836807196412398582 + , 5087667423921547416057913184603782240965080921431854177822601074227980319916 + ] + , toField + [ 8868355606921194740459469119392835913522089996670570126495590065213716724895 + , 12102922015173003259571598121107256676524158824223867520503152166796819430680 + ] + , toField + [ 92336131326695228787620679552727214674825150151172467042221065081506740785 + , 5482141053831906120660063289735740072497978400199436576451083698548025220729 + ] + ] + , toField + [ toField + [ 7642691434343136168639899684817459509291669149586986497725240920715691142493 + , 1211355239100959901694672926661748059183573115580181831221700974591509515378 + ] + , toField + [ 20725578899076721876257429467489710434807801418821512117896292558010284413176 + , 17642016461759614884877567642064231230128683506116557502360384546280794322728 + ] + , toField + [ 17449282511578147452934743657918270744212677919657988500433959352763226500950 + , 1205855382909824928004884982625565310515751070464736233368671939944606335817 + ] + ] + ] + +fq12' :: Fq12 +fq12' = toField + [ toField + [ toField + [ 495492586688946756331205475947141303903957329539236899715542920513774223311 + , 9283314577619389303419433707421707208215462819919253486023883680690371740600 + ] + , toField + [ 11142072730721162663710262820927009044232748085260948776285443777221023820448 + , 1275691922864139043351956162286567343365697673070760209966772441869205291758 + ] + , toField + [ 20007029371545157738471875537558122753684185825574273033359718514421878893242 + , 9839139739201376418106411333971304469387172772449235880774992683057627654905 + ] + ] + , toField + [ toField + [ 9503058454919356208294350412959497499007919434690988218543143506584310390240 + , 19236630380322614936323642336645412102299542253751028194541390082750834966816 + ] + , toField + [ 18019769232924676175188431592335242333439728011993142930089933693043738917983 + , 11549213142100201239212924317641009159759841794532519457441596987622070613872 + ] + , toField + [ 9656683724785441232932664175488314398614795173462019188529258009817332577664 + , 20666848762667934776817320505559846916719041700736383328805334359135638079015 + ] + ] + ] + +benchmarkExtensionField :: Benchmark +benchmarkExtensionField = benchmark "ExtensionField Fq12" fq12 fq12' diff --git a/benchmarks/GaloisFieldBenchmarks.hs b/benchmarks/GaloisFieldBenchmarks.hs new file mode 100644 index 0000000..a974b42 --- /dev/null +++ b/benchmarks/GaloisFieldBenchmarks.hs @@ -0,0 +1,23 @@ +module GaloisFieldBenchmarks where + +import Protolude + +import Criterion.Main +import GaloisField +import GHC.Base + +benchmark :: GaloisField k => String -> k -> k -> Benchmark +benchmark s a b = bgroup s + [ bench "Addition" $ + whnf (uncurry (+)) (a, b) + , bench "Multiplication" $ + whnf (uncurry (*)) (a, b) + , bench "Negation" $ + whnf negate a + , bench "Subtraction" $ + whnf (uncurry (-)) (a, b) + , bench "Inversion" $ + whnf recip a + , bench "Division" $ + whnf (uncurry (/)) (a, b) + ] diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs index 353d7f8..0a15296 100644 --- a/benchmarks/Main.hs +++ b/benchmarks/Main.hs @@ -2,127 +2,12 @@ module Main where import Protolude -import BinaryField import Criterion.Main -import ExtensionField -import GaloisField -import GHC.Base -import PrimeField -type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583 - -fq :: Fq -fq = 5216004179354450092383934373463611881445186046129513844852096383579774061693 - -fq' :: Fq -fq' = 10757805228921058098980668000791497318123219899766237205512608761387909753942 - -data Pu -instance IrreducibleMonic Fq Pu where - split _ = x ^ (2 :: Int) + 1 -type Fq2 = ExtensionField Fq Pu - -data Pv -instance IrreducibleMonic Fq2 Pv where - split _ = x ^ (3 :: Int) - 9 - t x -type Fq6 = ExtensionField Fq2 Pv - -data Pw -instance IrreducibleMonic Fq6 Pw where - split _ = x ^ (2 :: Int) - t x -type Fq12 = ExtensionField Fq6 Pw - -fq12 :: Fq12 -fq12 = fromList - [ fromList - [ fromList - [ 4025484419428246835913352650763180341703148406593523188761836807196412398582 - , 5087667423921547416057913184603782240965080921431854177822601074227980319916 - ] - , fromList - [ 8868355606921194740459469119392835913522089996670570126495590065213716724895 - , 12102922015173003259571598121107256676524158824223867520503152166796819430680 - ] - , fromList - [ 92336131326695228787620679552727214674825150151172467042221065081506740785 - , 5482141053831906120660063289735740072497978400199436576451083698548025220729 - ] - ] - , fromList - [ fromList - [ 7642691434343136168639899684817459509291669149586986497725240920715691142493 - , 1211355239100959901694672926661748059183573115580181831221700974591509515378 - ] - , fromList - [ 20725578899076721876257429467489710434807801418821512117896292558010284413176 - , 17642016461759614884877567642064231230128683506116557502360384546280794322728 - ] - , fromList - [ 17449282511578147452934743657918270744212677919657988500433959352763226500950 - , 1205855382909824928004884982625565310515751070464736233368671939944606335817 - ] - ] - ] - -fq12' :: Fq12 -fq12' = fromList - [ fromList - [ fromList - [ 495492586688946756331205475947141303903957329539236899715542920513774223311 - , 9283314577619389303419433707421707208215462819919253486023883680690371740600 - ] - , fromList - [ 11142072730721162663710262820927009044232748085260948776285443777221023820448 - , 1275691922864139043351956162286567343365697673070760209966772441869205291758 - ] - , fromList - [ 20007029371545157738471875537558122753684185825574273033359718514421878893242 - , 9839139739201376418106411333971304469387172772449235880774992683057627654905 - ] - ] - , fromList - [ fromList - [ 9503058454919356208294350412959497499007919434690988218543143506584310390240 - , 19236630380322614936323642336645412102299542253751028194541390082750834966816 - ] - , fromList - [ 18019769232924676175188431592335242333439728011993142930089933693043738917983 - , 11549213142100201239212924317641009159759841794532519457441596987622070613872 - ] - , fromList - [ 9656683724785441232932664175488314398614795173462019188529258009817332577664 - , 20666848762667934776817320505559846916719041700736383328805334359135638079015 - ] - ] - ] - -type F2m = BinaryField 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425 - -f2m :: F2m -f2m = 0x303001d34b856296c16c0d40d3cd7750a93d1d2955fa80aa5f40fc8db7b2abdbde53950f4c0d293cdd711a35b67fb1499ae60038614f1394abfa3b4c850d927e1e7769c8eec2d19 - -f2m' :: F2m -f2m' = 0x37bf27342da639b6dccfffeb73d69d78c6c27a6009cbbca1980f8533921e8a684423e43bab08a576291af8f461bb2a8b3531d2f0485c19b16e2f1516e23dd3c1a4827af1b8ac15b - -benchmark :: GaloisField k => String -> k -> k -> Benchmark -benchmark s a b = bgroup s - [ bench "Addition" $ - whnf (uncurry (+)) (a, b) - , bench "Multiplication" $ - whnf (uncurry (*)) (a, b) - , bench "Negation" $ - whnf negate a - , bench "Subtraction" $ - whnf (uncurry (-)) (a, b) - , bench "Inversion" $ - whnf recip a - , bench "Division" $ - whnf (uncurry (/)) (a, b) - ] +import BinaryFieldBenchmarks +import ExtensionFieldBenchmarks +import PrimeFieldBenchmarks main :: IO () main = defaultMain - [ benchmark "PrimeField Fq" fq fq' - , benchmark "ExtensionField Fq12" fq12 fq12' - , benchmark "BinaryField F2m" f2m f2m' - ] + [benchmarkBinaryField, benchmarkExtensionField, benchmarkPrimeField] diff --git a/benchmarks/PrimeFieldBenchmarks.hs b/benchmarks/PrimeFieldBenchmarks.hs new file mode 100644 index 0000000..a6e31e0 --- /dev/null +++ b/benchmarks/PrimeFieldBenchmarks.hs @@ -0,0 +1,17 @@ +module PrimeFieldBenchmarks where + +import Criterion.Main +import PrimeField + +import GaloisFieldBenchmarks + +type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583 + +fq :: Fq +fq = 5216004179354450092383934373463611881445186046129513844852096383579774061693 + +fq' :: Fq +fq' = 10757805228921058098980668000791497318123219899766237205512608761387909753942 + +benchmarkPrimeField :: Benchmark +benchmarkPrimeField = benchmark "PrimeField Fq" fq fq' diff --git a/package.yaml b/package.yaml index 2a63923..c9727ba 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: galois-field -version: 0.3.0 +version: 0.4.0 synopsis: Galois field library description: An efficient implementation of Galois fields used in cryptography research maintainer: Adjoint Inc (info@adjoint.io) @@ -21,13 +21,17 @@ default-extensions: - GeneralizedNewtypeDeriving - KindSignatures - MultiParamTypeClasses + - PatternSynonyms dependencies: - - base >= 4.7 && < 5 - - protolude >= 0.2 + - base + - protolude - integer-gmp - MonadRandom + - poly + - semirings - tasty-quickcheck + - vector - wl-pprint-text extra-source-files: diff --git a/src/BinaryField.hs b/src/BinaryField.hs index 9e4bb4d..e02c6b0 100644 --- a/src/BinaryField.hs +++ b/src/BinaryField.hs @@ -2,22 +2,24 @@ module BinaryField ( BinaryField ) where -import Protolude +import Protolude as P hiding (Semiring) -import Control.Monad.Random (Random(..), getRandom) +import Control.Monad.Random (Random(..)) +import Data.Euclidean (Euclidean(..), GcdDomain(..)) +import Data.Semiring (Ring(..), Semiring(..)) import Test.Tasty.QuickCheck (Arbitrary(..), choose) import Text.PrettyPrint.Leijen.Text (Pretty(..)) -import GaloisField (GaloisField(..)) +import GaloisField (Field(..), GaloisField(..)) ------------------------------------------------------------------------------- --- Binary field type +-- Data types ------------------------------------------------------------------------------- -- | Binary fields @GF(2^q)[X]/\@ for @q@ positive and -- @f(X)@ irreducible monic in @GF(2^q)[X]@ encoded as an integer. newtype BinaryField (im :: Nat) = BF Integer - deriving (Eq, Generic, NFData, Read, Show) + deriving (Eq, Generic, Ord, Show) -- Binary fields are Galois fields. instance KnownNat im => GaloisField (BinaryField im) where @@ -27,46 +29,27 @@ instance KnownNat im => GaloisField (BinaryField im) where {-# INLINE deg #-} frob = flip pow 2 {-# INLINE frob #-} - pow w@(BF y) n - | n < 0 = pow (recip w) (-n) - | otherwise = BF (pow' 1 y n) - where - mul = (.) (binMod (natVal w)) . binMul - pow' ws zs m - | m == 0 = ws - | m == 1 = mul ws zs - | even m = pow' ws (mul zs zs) (div m 2) - | otherwise = pow' (mul ws zs) (mul zs zs) (div m 2) - {-# INLINE pow #-} - quad a b c - | b == 0 = sr c - | otherwise = (* (b / a)) <$> binQuad (a * c / (b * b)) - {-# INLINE quad #-} - rnd = getRandom - {-# INLINE rnd #-} - sr = panic "not implemented." - {-# INLINE sr #-} + +{-# RULES "BinaryField/pow" + forall (k :: KnownNat im => BinaryField im) n . (^) k n = pow k n + #-} ------------------------------------------------------------------------------- --- Binary field instances +-- Numeric instances ------------------------------------------------------------------------------- --- Binary fields are arbitrary. -instance KnownNat im => Arbitrary (BinaryField im) where - arbitrary = BF <$> choose (0, order (witness :: BinaryField im) - 1) - --- Binary fields are fields. +-- Binary fields are fractional. instance KnownNat im => Fractional (BinaryField im) where - recip w@(BF x) = BF (binInv x (natVal w)) + recip (BF x) = BF (binInv x (natVal (witness :: BinaryField im))) {-# INLINE recip #-} fromRational (x:%y) = fromInteger x / fromInteger y {-# INLINABLE fromRational #-} --- Binary fields are rings. +-- Binary fields are numeric. instance KnownNat im => Num (BinaryField im) where BF x + BF y = BF (xor x y) {-# INLINE (+) #-} - BF x * BF y = fromInteger (binMul x y) + BF x * BF y = BF (binMul (natVal (witness :: BinaryField im)) x y) {-# INLINE (*) #-} BF x - BF y = BF (xor x y) {-# INLINE (-) #-} @@ -77,6 +60,53 @@ instance KnownNat im => Num (BinaryField im) where abs = panic "not implemented." signum = panic "not implemented." +------------------------------------------------------------------------------- +-- Semiring instances +------------------------------------------------------------------------------- + +-- Binary fields are Euclidean domains. +instance KnownNat im => Euclidean (BinaryField im) where + quotRem = (flip (,) 0 .) . (/) + {-# INLINE quotRem #-} + degree = panic "not implemented." + {-# INLINE degree #-} + +-- Binary fields are fields. +instance KnownNat im => Field (BinaryField im) where + invert = recip + {-# INLINE invert #-} + minus = (-) + {-# INLINE minus #-} + +-- Binary fields are GCD domains. +instance KnownNat im => GcdDomain (BinaryField im) + +-- Binary fields are rings. +instance KnownNat im => Ring (BinaryField im) where + negate = P.negate + {-# INLINE negate #-} + +-- Binary fields are semirings. +instance KnownNat im => Semiring (BinaryField im) where + zero = 0 + {-# INLINE zero #-} + plus = (+) + {-# INLINE plus #-} + one = 1 + {-# INLINE one #-} + times = (*) + {-# INLINE times #-} + fromNatural = fromIntegral + {-# INLINE fromNatural #-} + +------------------------------------------------------------------------------- +-- Other instances +------------------------------------------------------------------------------- + +-- Binary fields are arbitrary. +instance KnownNat im => Arbitrary (BinaryField im) where + arbitrary = BF <$> choose (0, order (witness :: BinaryField im) - 1) + -- Binary fields are pretty. instance KnownNat im => Pretty (BinaryField im) where pretty (BF x) = pretty x @@ -88,7 +118,7 @@ instance KnownNat im => Random (BinaryField im) where randomR = panic "not implemented." ------------------------------------------------------------------------------- --- Binary field arithmetic +-- Binary arithmetic ------------------------------------------------------------------------------- -- Binary logarithm. @@ -99,17 +129,17 @@ binLog = binLog' 2 binLog' p x | x < p = 0 | otherwise = case binLog' (p * p) x of - l -> let l' = 2 * l in binLog'' (quot x (p ^ l')) l' + l -> let l' = 2 * l in binLog'' (P.quot x (p ^ l')) l' where binLog'' :: Integer -> Int -> Int binLog'' y n | y < p = n - | otherwise = binLog'' (quot y p) (n + 1) + | otherwise = binLog'' (P.quot y p) (n + 1) {-# INLINE binLog #-} -- Binary multiplication. -binMul :: Integer -> Integer -> Integer -binMul = binMul' 0 +binMul :: Integer -> Integer -> Integer -> Integer +binMul = (. binMul' 0) . (.) . binMod where binMul' :: Integer -> Integer -> Integer -> Integer binMul' n x y @@ -147,20 +177,3 @@ binInv f x = case binInv' 0 1 x f of where q = max 0 (binLog r - binLog r') :: Int {-# INLINE binInv #-} - -------------------------------------------------------------------------------- --- Binary field quadratics -------------------------------------------------------------------------------- - --- Binary quadratic @y^2+y+x=0@. -binQuad :: forall im . KnownNat im - => BinaryField im -> Maybe (BinaryField im) -binQuad x - | sum xs /= 0 = Nothing - | odd m = Just (sum h) - | otherwise = panic "not implemented." - where - m = deg x :: Int - xs = take m (iterate (^ (2 :: Int)) x) :: [BinaryField im] - h = zipWith ($) (cycle [identity, const 0]) xs :: [BinaryField im] -{-# INLINE binQuad #-} diff --git a/src/ExtensionField.hs b/src/ExtensionField.hs index d5177f1..73a7f69 100644 --- a/src/ExtensionField.hs +++ b/src/ExtensionField.hs @@ -1,230 +1,192 @@ module ExtensionField ( ExtensionField + , PolynomialRing , IrreducibleMonic(split) , fromField - , fromList - , t - , x + , toField + , pattern X + , pattern X2 + , pattern X3 + , pattern Y ) where -import Protolude +import Protolude as P hiding (Semiring, quot, quotRem, rem) -import Control.Monad.Random (Random(..), getRandom) +import Control.Monad.Random (Random(..)) +import Data.Euclidean (Euclidean(..), GcdDomain(..)) +import Data.Poly.Semiring (VPoly, leading, monomial, scale, toPoly, unPoly, pattern X) +import Data.Semiring as S (Ring(..), Semiring(..)) +import Data.Vector (fromList) import Test.Tasty.QuickCheck (Arbitrary(..), vector) import Text.PrettyPrint.Leijen.Text (Pretty(..)) -import GaloisField (GaloisField(..)) +import GaloisField (Field(..), GaloisField(..)) ------------------------------------------------------------------------------- --- Extension field type +-- Data types ------------------------------------------------------------------------------- -- | Extension fields @GF(p^q)[X]/\@ for @p@ prime, @q@ positive, and -- @f(X)@ irreducible monic in @GF(p^q)[X]@. -newtype ExtensionField k im = EF (Polynomial k) - deriving (Eq, Generic, NFData, Read, Show) +newtype ExtensionField k im = EF (VPoly k) + deriving (Eq, Generic, Ord, Show) + +-- | Polynomial rings. +type PolynomialRing = VPoly -- | Irreducible monic splitting polynomial @f(X)@ of extension field. -class IrreducibleMonic k im where +class GaloisField k => IrreducibleMonic k im where {-# MINIMAL split #-} -- | Splitting polynomial @f(X)@. - split :: ExtensionField k im -> Polynomial k - -- | Splitting polynomial list. - plist :: ExtensionField k im -> [k] - plist = (\(X xs) -> xs) . split + split :: ExtensionField k im -> VPoly k + -- | Splitting polynomial degree. + deg' :: ExtensionField k im -> Int + deg' = pred . fromIntegral . degree . split -- Extension fields are Galois fields. -instance (GaloisField k, IrreducibleMonic k im) - => GaloisField (ExtensionField k im) where +instance IrreducibleMonic k im => GaloisField (ExtensionField k im) where char = const (char (witness :: k)) {-# INLINE char #-} - deg w = deg (witness :: k) * (length (plist w) - 1) + deg = (deg (witness :: k) *) . deg' {-# INLINE deg #-} frob = pow <*> char {-# INLINE frob #-} - pow w@(EF (X y)) n - | n < 0 = pow (recip w) (-n) - | otherwise = EF (X (pow' [1] y n)) - where - mul = (.) (snd . flip polyQR (plist w)) . polyMul - pow' ws zs m - | m == 0 = ws - | m == 1 = mul ws zs - | even m = pow' ws (mul zs zs) (div m 2) - | otherwise = pow' (mul ws zs) (mul zs zs) (div m 2) - {-# INLINE pow #-} - quad = panic "not implemented." - {-# INLINE quad #-} - rnd = getRandom - {-# INLINE rnd #-} - sr = panic "not implemented." - {-# INLINE sr #-} + +{-# RULES "ExtensionField/pow" + forall (k :: IrreducibleMonic k im => ExtensionField k im) n . (^) k n = pow k n + #-} ------------------------------------------------------------------------------- --- Extension field conversions +-- Numeric instances ------------------------------------------------------------------------------- --- Polynomial rings. -newtype Polynomial k = X [k] - deriving (Eq, Generic, NFData, Read, Show) +-- Extension fields are fractional. +instance IrreducibleMonic k im => Fractional (ExtensionField k im) where + recip (EF x) = EF (polyInv x (split (witness :: ExtensionField k im))) + {-# INLINE recip #-} + fromRational (x:%y) = fromInteger x / fromInteger y + {-# INLINABLE fromRational #-} --- Polynomial rings are rings. -instance GaloisField k => Num (Polynomial k) where - X y + X z = X (polyAdd y z) +-- Extension fields are numeric. +instance IrreducibleMonic k im => Num (ExtensionField k im) where + EF x + EF y = EF (plus x y) {-# INLINE (+) #-} - X y * X z = X (polyMul y z) + EF x * EF y = EF (rem (times x y) (split (witness :: ExtensionField k im))) {-# INLINE (*) #-} - X y - X z = X (polySub y z) + EF x - EF y = EF (x - y) {-# INLINE (-) #-} - negate (X y) = X (map negate y) + negate (EF x) = EF (S.negate x) {-# INLINE negate #-} - fromInteger n = X (let m = fromInteger n in if m == 0 then [] else [m]) + fromInteger = EF . fromInteger {-# INLINABLE fromInteger #-} abs = panic "not implemented." signum = panic "not implemented." --- | Convert from field element to list representation. -fromField :: ExtensionField k im -> [k] -fromField (EF (X y)) = y -{-# INLINABLE fromField #-} - --- | Convert from list representation to field element. -fromList :: forall k im . (GaloisField k, IrreducibleMonic k im) - => [k] -> ExtensionField k im -fromList = EF . X . snd . flip polyQR (plist w) . dropZero - where - w = witness :: ExtensionField k im -{-# INLINABLE fromList #-} - --- | Descend tower of indeterminate variables. -t :: Polynomial k -> Polynomial (ExtensionField k im) -t = X . return . EF -{-# INLINE t #-} - --- | Current indeterminate variable. -x :: GaloisField k => Polynomial k -x = X [0, 1] -{-# INLINE x #-} - ------------------------------------------------------------------------------- --- Extension field instances +-- Semiring instances ------------------------------------------------------------------------------- --- Extension fields are arbitrary. -instance (Arbitrary k, GaloisField k, IrreducibleMonic k im) - => Arbitrary (ExtensionField k im) where - arbitrary = fromList <$> - vector (length (plist (witness :: ExtensionField k im)) - 1) +-- Extension fields are Euclidean domains. +instance IrreducibleMonic k im => Euclidean (ExtensionField k im) where + quotRem = (flip (,) 0 .) . (/) + {-# INLINE quotRem #-} + degree = panic "not implemented." + {-# INLINE degree #-} -- Extension fields are fields. -instance (GaloisField k, IrreducibleMonic k im) - => Fractional (ExtensionField k im) where - recip w@(EF (X y)) = EF (X (polyInv y (plist w))) - {-# INLINE recip #-} - fromRational (y:%z) = fromInteger y / fromInteger z - {-# INLINABLE fromRational #-} +instance IrreducibleMonic k im => Field (ExtensionField k im) where + invert = recip + {-# INLINE invert #-} + minus = (-) + {-# INLINE minus #-} + +-- Extension fields are GCD domains. +instance IrreducibleMonic k im => GcdDomain (ExtensionField k im) -- Extension fields are rings. -instance (GaloisField k, IrreducibleMonic k im) - => Num (ExtensionField k im) where - EF y + EF z = EF (y + z) - {-# INLINE (+) #-} - w@(EF (X y)) * EF (X z) = EF (X (snd (polyQR (polyMul y z) (plist w)))) - {-# INLINE (*) #-} - EF y - EF z = EF (y - z) - {-# INLINE (-) #-} - negate (EF y) = EF (-y) +instance IrreducibleMonic k im => Ring (ExtensionField k im) where + negate = P.negate {-# INLINE negate #-} - fromInteger = EF . fromInteger - {-# INLINABLE fromInteger #-} - abs = panic "not implemented." - signum = panic "not implemented." + +-- Extension fields are semirings. +instance IrreducibleMonic k im => Semiring (ExtensionField k im) where + zero = 0 + {-# INLINE zero #-} + plus = (+) + {-# INLINE plus #-} + one = 1 + {-# INLINE one #-} + times = (*) + {-# INLINE times #-} + fromNatural = fromIntegral + {-# INLINE fromNatural #-} + +------------------------------------------------------------------------------- +-- Other instances +------------------------------------------------------------------------------- + +-- Extension fields are arbitrary. +instance IrreducibleMonic k im => Arbitrary (ExtensionField k im) where + arbitrary = toField <$> vector (deg' (witness :: ExtensionField k im)) -- Extension fields are pretty. -instance (GaloisField k, IrreducibleMonic k im) - => Pretty (ExtensionField k im) where - pretty (EF (X y)) = pretty y +instance IrreducibleMonic k im => Pretty (ExtensionField k im) where + pretty (EF x) = pretty (toList (unPoly x)) -- Extension fields are random. -instance (GaloisField k, IrreducibleMonic k im) - => Random (ExtensionField k im) where - random = first (EF . X . dropZero) . unfold (length (plist w) - 1) [] +instance IrreducibleMonic k im => Random (ExtensionField k im) where + random = first toField . unfold (deg' (witness :: ExtensionField k im)) [] where - w = witness :: ExtensionField k im - unfold n ys g - | n <= 0 = (ys, g) + unfold n xs g + | n <= 0 = (xs, g) | otherwise = case random g of - (y, g') -> unfold (n - 1) (y : ys) g' + (x, g') -> unfold (n - 1) (x : xs) g' {-# INLINE random #-} randomR = panic "not implemented." ------------------------------------------------------------------------------- --- Extension field arithmetic +-- Type conversions ------------------------------------------------------------------------------- --- Polynomial drop zeroes. -dropZero :: GaloisField k => [k] -> [k] -dropZero = reverse . dropWhile (== 0) . reverse -{-# INLINABLE dropZero #-} - --- Polynomial addition. -polyAdd :: GaloisField k => [k] -> [k] -> [k] -polyAdd ys [] = ys -polyAdd [] zs = zs -polyAdd (y:ys) (z:zs) = let w = y + z - ws = polyAdd ys zs - in if w == 0 && null ws then [] else w : ws -{-# INLINE polyAdd #-} - --- Polynomial multiplication. -polyMul :: GaloisField k => [k] -> [k] -> [k] -polyMul _ [] = [] -polyMul [] _ = [] -polyMul (y:ys) zs = let ws = map (* y) zs - ws' = polyMul ys zs - in if null ys then ws else polyAdd ws (0 : ws') -{-# INLINE polyMul #-} - --- Polynomial subtraction. -polySub :: GaloisField k => [k] -> [k] -> [k] -polySub ys [] = ys -polySub [] zs = map negate zs -polySub (y:ys) (z:zs) = let w = y - z - ws = polySub ys zs - in if w == 0 && null ws then [] else w : ws -{-# INLINE polySub #-} - --- Polynomial quotient and remainder. -polyQR :: forall k . GaloisField k => [k] -> [k] -> ([k], [k]) -polyQR ys zs = polyGCD ([], ys) - where - z = last zs :: k - m = length zs :: Int - last :: [k] -> k - last [] = 0 - last [w] = w - last (_:ws) = last ws - polyGCD :: ([k], [k]) -> ([k], [k]) - polyGCD qr@(qs, rs) - | n < 0 = qr - | otherwise = polyGCD (polyAdd qs ts, polySub rs (polyMul ts zs)) - where - r = last rs :: k - n = length rs - m :: Int - ts = replicate n 0 ++ [r / z] :: [k] -{-# INLINE polyQR #-} - --- Polynomial inverse. -polyInv :: forall k . GaloisField k => [k] -> [k] -> [k] -polyInv [y] _ = [recip y] -polyInv ys zs = case extGCD (zs, ys) of - ([w], (ws, _)) -> map (/ w) ws - _ -> panic "no multiplicative inverse." - where - extGCD :: ([k], [k]) -> ([k], ([k], [k])) - extGCD (y, []) = (y, ([], [1])) - extGCD (y, z) = (g, (polySub v (polyMul u q), u)) - where - (q, r) = polyQR y z - (g, (u, v)) = extGCD (z, r) +-- | Convert from field element to list representation. +fromField :: ExtensionField k im -> [k] +fromField (EF x) = toList (unPoly x) +{-# INLINABLE fromField #-} + +-- | Convert from list representation to field element. +toField :: forall k im . IrreducibleMonic k im => [k] -> ExtensionField k im +toField = EF . flip rem (split (witness :: ExtensionField k im)) . toPoly . fromList +{-# INLINABLE toField #-} + +-- | Pattern for @X^2@. +pattern X2 :: GaloisField k => VPoly k +pattern X2 <- _ where X2 = toPoly (fromList [0, 0, 1]) + +-- | Pattern for @X^3@. +pattern X3 :: GaloisField k => VPoly k +pattern X3 <- _ where X3 = toPoly (fromList [0, 0, 0, 1]) + +-- | Pattern for descending tower of indeterminate variables. +pattern Y :: IrreducibleMonic k im => VPoly k -> VPoly (ExtensionField k im) +pattern Y <- _ where Y = monomial 0 . EF + +------------------------------------------------------------------------------- +-- Polynomial arithmetic +------------------------------------------------------------------------------- + +-- Polynomial inversion algorithm. +polyInv :: GaloisField k => VPoly k -> VPoly k -> VPoly k +polyInv xs ps = case first leading (polyGCD xs ps) of + (Just (0, x), ys) -> scale 0 (recip x) ys + _ -> panic "no multiplicative inverse." {-# INLINE polyInv #-} + +-- Polynomial extended greatest common divisor algorithm. +polyGCD :: forall k . GaloisField k => VPoly k -> VPoly k -> (VPoly k, VPoly k) +polyGCD x y = polyGCD' 0 1 y x + where + polyGCD' :: VPoly k -> VPoly k -> VPoly k -> VPoly k -> (VPoly k, VPoly k) + polyGCD' s _ r 0 = (r, s) + polyGCD' s s' r r' = case quot r r' of + q -> polyGCD' s' (s - times q s') r' (r - times q r') +{-# INLINE polyGCD #-} diff --git a/src/GaloisField.hs b/src/GaloisField.hs index dec5eea..4ff3081 100644 --- a/src/GaloisField.hs +++ b/src/GaloisField.hs @@ -1,21 +1,45 @@ module GaloisField - ( GaloisField(..) + ( Field(..) + , GaloisField(..) ) where -import Protolude +import Protolude hiding ((-), one, quot) -import Control.Monad.Random (MonadRandom, Random) +import Control.Monad.Random (MonadRandom, Random, StdGen, + getRandom, mkStdGen, runRand) +import Data.Euclidean (Euclidean(..)) +import Data.Semiring (Ring, (-), one) import Test.Tasty.QuickCheck (Arbitrary) import Text.PrettyPrint.Leijen.Text (Pretty) ------------------------------------------------------------------------------- --- Galois field class +-- Classes ------------------------------------------------------------------------------- +-- | Fields. +class (Euclidean k, Ring k) => Field k where + + -- Operations + + -- | Division. + divide :: k -> k -> k + divide = quot + {-# INLINE divide #-} + + -- | Inversion. + invert :: k -> k + invert = quot one + {-# INLINE invert #-} + + -- | Subtraction. + minus :: k -> k -> k + minus = (-) + {-# INLINE minus #-} + -- | Galois fields @GF(p^q)@ for @p@ prime and @q@ non-negative. -class (Arbitrary k, Eq k, Fractional k, Pretty k, Random k, Read k, Show k) - => GaloisField k where - {-# MINIMAL char, deg, frob, pow, quad, rnd, sr #-} +class (Arbitrary k, Field k, Fractional k, + Generic k, Ord k, Pretty k, Random k, Show k) => GaloisField k where + {-# MINIMAL char, deg, frob #-} -- Characteristics @@ -35,14 +59,126 @@ class (Arbitrary k, Eq k, Fractional k, Pretty k, Random k, Read k, Show k) -- Functions - -- | Exponentiation of a field element to an integer. + -- | Exponentiation of field element to integer. pow :: k -> Integer -> k + pow x n + | n < 0 = pow (recip x) (negate n) + | otherwise = pow' 1 x n + where + pow' z y m + | m == 0 = z + | m == 1 = z' + | even m = pow' z y' m' + | otherwise = pow' z' y' m' + where + z' = z * y + y' = y * y + m' = div m 2 + {-# INLINE pow #-} + + -- | Get randomised quadratic nonresidue. + qnr :: k + qnr = getQNR + {-# INLINE qnr #-} - -- | Solve quadratic @ax^2+bx+c=0@ over field. + -- | Check if quadratic residue. + qr :: k -> Bool + qr = not . isQNR + {-# INLINE qr #-} + + -- | Solve quadratic @ax^2 + bx + c = 0@ over field. quad :: k -> k -> k -> Maybe k + quad = solveQuadratic + {-# INLINE quad #-} -- | Randomised field element. rnd :: MonadRandom m => m k + rnd = getRandom + {-# INLINE rnd #-} - -- | Square root of a field element. + -- | Square root of field element. sr :: k -> Maybe k + sr = squareRoot + {-# INLINE sr #-} + +------------------------------------------------------------------------------- +-- Square roots +------------------------------------------------------------------------------- + +-- Check if an element is a quadratic nonresidue. +isQNR :: GaloisField k => k -> Bool +isQNR n = pow n (shiftR (order n) 1) /= 1 +{-# INLINE isQNR #-} + +-- Factor the order @p - 1@ to get @q@ and @s@ such that @p - 1 = q2^s@. +factorOrder :: GaloisField k => k -> (Integer, Int) +factorOrder w = factorOrder' (order w - 1, 0) + where + factorOrder' :: (Integer, Int) -> (Integer, Int) + factorOrder' qs@(q, s) + | testBit q 0 = qs + | otherwise = factorOrder' (shiftR q 1, s + 1) +{-# INLINE factorOrder #-} + +-- Get a random quadratic nonresidue. +getQNR :: forall k . GaloisField k => k +getQNR = getQNR' (runRand rnd (mkStdGen 0)) + where + getQNR' :: (k, StdGen) -> k + getQNR' (x, g) + | x /= 0 && isQNR x = x + | otherwise = getQNR' (runRand rnd g) +{-# INLINE getQNR #-} + +-- Get a square root of @n@ with the Tonelli-Shanks algorithm. +squareRoot :: forall k . GaloisField k => k -> Maybe k +squareRoot 0 = Just 0 +squareRoot n + | char n == 2 = Just (power n) + | isQNR n = Nothing + | otherwise = case (factorOrder n, getQNR) of + ((q, s), z) -> let zq = pow z q + nq = pow n (shiftR q 1) + nnq = n * nq + in loop s zq (nq * nnq) nnq + where + power :: k -> k + power = next (deg n) + where + next :: Int -> k -> k + next 1 m = m + next i m = next (i - 1) (m * m) + loop :: Int -> k -> k -> k -> Maybe k + loop _ _ 0 _ = Just 0 + loop _ _ 1 r = Just r + loop m c t r = let i = least t 0 + b = pow c (bit (m - i - 1)) + b2 = b * b + in loop i b2 (t * b2) (r * b) + where + least :: k -> Int -> Int + least 1 j = j + least ti j = least (ti * ti) (j + 1) +{-# INLINE squareRoot #-} + +-- Solve a quadratic equation @ax^2 + bx + c = 0@. +solveQuadratic :: forall k . GaloisField k => k -> k -> k -> Maybe k +solveQuadratic 0 _ _ = Nothing +solveQuadratic _ _ 0 = Just 0 +solveQuadratic a 0 c = squareRoot (-c / a) +solveQuadratic a b c + | char a == 2 = (* (b / a)) <$> solveQuadratic' (ac / bb) + | otherwise = (/ (2 * a)) . subtract b <$> squareRoot (bb - 4 * ac) + where + ac = a * c + bb = b * b + solveQuadratic' :: k -> Maybe k + solveQuadratic' x + | sum xs /= 0 = Nothing + | odd m = Just (sum h) + | otherwise = panic "not implemented." + where + m = deg x + xs = take m (iterate (join (*)) x) + h = zipWith ($) (cycle [identity, const 0]) xs +{-# INLINE solveQuadratic #-} diff --git a/src/PrimeField.hs b/src/PrimeField.hs index d50fd54..382d61e 100644 --- a/src/PrimeField.hs +++ b/src/PrimeField.hs @@ -3,88 +3,122 @@ module PrimeField , toInt ) where -import Protolude +import Protolude as P hiding (Semiring) -import Control.Monad.Random (Random(..), getRandom) +import Control.Monad.Random (Random(..)) +import Data.Euclidean (Euclidean(..), GcdDomain(..)) +import Data.Semiring (Ring(..), Semiring(..)) import GHC.Integer.GMP.Internals (powModInteger, recipModInteger) -import Test.Tasty.QuickCheck (Arbitrary(..)) +import Test.Tasty.QuickCheck (Arbitrary(..), choose) import Text.PrettyPrint.Leijen.Text (Pretty(..)) -import GaloisField (GaloisField(..)) +import GaloisField (Field(..), GaloisField(..)) ------------------------------------------------------------------------------- --- Prime field type +-- Data types ------------------------------------------------------------------------------- -- | Prime fields @GF(p)@ for @p@ prime. newtype PrimeField (p :: Nat) = PF Integer - deriving (Bits, Eq, Generic, NFData, Read, Show) + deriving (Bits, Eq, Generic, Ord, Show) -- Prime fields are Galois fields. instance KnownNat p => GaloisField (PrimeField p) where - char = natVal + char = natVal {-# INLINE char #-} - deg = const 1 + deg = const 1 {-# INLINE deg #-} - frob = identity + frob = identity {-# INLINE frob #-} - pow w@(PF x) n = PF (powModInteger x n (natVal w)) + pow (PF x) n = PF (powModInteger x n (natVal (witness :: PrimeField p))) {-# INLINE pow #-} - quad = primeQuad - {-# INLINE quad #-} - rnd = getRandom - {-# INLINE rnd #-} - sr w@(PF x) = let p = natVal w - in if p == 2 || x == 0 then Just w else PF <$> primeSqrt p x - {-# INLINE sr #-} -------------------------------------------------------------------------------- --- Prime field conversions -------------------------------------------------------------------------------- - --- | Embed field element to integers. -toInt :: PrimeField p -> Integer -toInt (PF x) = x -{-# INLINABLE toInt #-} +{-# RULES "PrimeField/pow" + forall (k :: KnownNat p => PrimeField p) (n :: Integer) . (^) k n = pow k n + #-} ------------------------------------------------------------------------------- --- Prime field instances +-- Numeric instances ------------------------------------------------------------------------------- --- Prime fields are arbitrary. -instance KnownNat p => Arbitrary (PrimeField p) where - arbitrary = fromInteger <$> arbitrary - --- Prime fields are fields. +-- Prime fields are fractional. instance KnownNat p => Fractional (PrimeField p) where - recip w@(PF x) = PF (if x == 0 then panic "no multiplicative inverse." - else recipModInteger x (natVal w)) + recip (PF 0) = panic "no multiplicative inverse." + recip (PF x) = PF (recipModInteger x (natVal (witness :: PrimeField p))) {-# INLINE recip #-} fromRational (x:%y) = fromInteger x / fromInteger y {-# INLINABLE fromRational #-} --- Prime fields are rings. +-- Prime fields are numeric. instance KnownNat p => Num (PrimeField p) where - w@(PF x) + PF y = PF (if xyp >= 0 then xyp else xy) + PF x + PF y = PF (if xyp >= 0 then xyp else xy) where xy = x + y - xyp = xy - natVal w + xyp = xy - natVal (witness :: PrimeField p) {-# INLINE (+) #-} - w@(PF x) * PF y = PF (rem (x * y) (natVal w)) + PF x * PF y = PF (P.rem (x * y) (natVal (witness :: PrimeField p))) {-# INLINE (*) #-} - w@(PF x) - PF y = PF (if xy >= 0 then xy else xy + natVal w) + PF x - PF y = PF (if xy >= 0 then xy else xy + natVal (witness :: PrimeField p)) where xy = x - y {-# INLINE (-) #-} - negate w@(PF x) = PF (if x == 0 then 0 else -x + natVal w) + negate (PF 0) = PF 0 + negate (PF x) = PF (natVal (witness :: PrimeField p) - x) {-# INLINE negate #-} - fromInteger x = PF (if y >= 0 then y else y + p) + fromInteger x = PF (if y >= 0 then y else y + p) where - y = rem x p + y = P.rem x p p = natVal (witness :: PrimeField p) {-# INLINABLE fromInteger #-} - abs = panic "not implemented." - signum = panic "not implemented." + abs = panic "not implemented." + signum = panic "not implemented." + +------------------------------------------------------------------------------- +-- Semiring instances +------------------------------------------------------------------------------- + +-- Prime fields are Euclidean domains. +instance KnownNat p => Euclidean (PrimeField p) where + quotRem = (flip (,) 0 .) . (/) + {-# INLINE quotRem #-} + degree = panic "not implemented." + {-# INLINE degree #-} + +-- Prime fields are fields. +instance KnownNat p => Field (PrimeField p) where + invert = recip + {-# INLINE invert #-} + minus = (-) + {-# INLINE minus #-} + +-- Prime fields are GCD domains. +instance KnownNat p => GcdDomain (PrimeField p) + +-- Prime fields are rings. +instance KnownNat p => Ring (PrimeField p) where + negate = P.negate + {-# INLINE negate #-} + +-- Prime fields are semirings. +instance KnownNat p => Semiring (PrimeField p) where + zero = 0 + {-# INLINE zero #-} + plus = (+) + {-# INLINE plus #-} + one = 1 + {-# INLINE one #-} + times = (*) + {-# INLINE times #-} + fromNatural = fromIntegral + {-# INLINE fromNatural #-} + +------------------------------------------------------------------------------- +-- Other instances +------------------------------------------------------------------------------- + +-- Prime fields are arbitrary. +instance KnownNat p => Arbitrary (PrimeField p) where + arbitrary = PF <$> choose (0, natVal (witness :: PrimeField p) - 1) -- Prime fields are pretty. instance KnownNat p => Pretty (PrimeField p) where @@ -97,67 +131,10 @@ instance KnownNat p => Random (PrimeField p) where randomR = panic "not implemented." ------------------------------------------------------------------------------- --- Prime field quadratics +-- Type conversions ------------------------------------------------------------------------------- --- Check quadratic nonresidue. -isQNR :: Integer -> Integer -> Bool -isQNR p n = powModInteger n (shiftR (p - 1) 1) p /= 1 -{-# INLINE isQNR #-} - --- Factor binary powers. -factor2 :: Integer -> (Integer, Int) -factor2 p = factor 0 (p - 1) - where - factor :: Int -> Integer -> (Integer, Int) - factor s q - | testBit q 0 = (q, s) - | otherwise = factor (s + 1) (shiftR q 1) -{-# INLINE factor2 #-} - --- Get quadratic nonresidue. -getQNR :: Integer -> Integer -getQNR p - | p7 == 3 || p7 == 5 = 2 - | otherwise = case find (isQNR p) ps of - Just q -> q - _ -> panic "no quadratic nonresidue." - where - p7 = p .&. 7 - ps = 3 : 5 : 7 : 11 : 13 : concatMap (\x -> [x - 1, x + 1]) [18, 24 ..] -{-# INLINE getQNR #-} - --- Prime square root. -primeSqrt :: Integer -> Integer -> Maybe Integer -primeSqrt p n - | isQNR p n = Nothing - | otherwise = min <*> (-) p <$> case (factor2 p, getQNR p) of - ((q, s), z) -> let zq = powModInteger z q p - nq = powModInteger n (quot q 2) p - nnq = rem (n * nq) p - in loop s zq (rem (nq * nnq) p) nnq - where - loop :: Int -> Integer -> Integer -> Integer -> Maybe Integer - loop m c t r - | t == 0 = Just 0 - | t == 1 = Just r - | otherwise = let i = least t 0 - b = powModInteger c (bit (m - i - 1)) p - b2 = rem (b * b) p - in loop i b2 (rem (t * b2) p) (rem (r * b) p) - where - least :: Integer -> Int -> Int - least 1 j = j - least ti j = least (rem (ti * ti) p) (j + 1) -{-# INLINE primeSqrt #-} - --- Prime quadratic @ax^2+bx+c=0@. -primeQuad :: KnownNat p - => PrimeField p -> PrimeField p -> PrimeField p -> Maybe (PrimeField p) -primeQuad a b c - | a == 0 = Nothing - | p == 2 = if c == 0 then Just 0 else if b == 0 then Just 1 else Nothing - | otherwise = (/ (2 * a)) . subtract b <$> sr (b * b - 4 * a * c) - where - p = char a :: Integer -{-# INLINE primeQuad #-} +-- | Embed field element to integers. +toInt :: PrimeField p -> Integer +toInt (PF x) = x +{-# INLINABLE toInt #-} diff --git a/stack.yaml b/stack.yaml index 7c3fcc6..4901dd2 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1,4 @@ resolver: lts-13.19 +extra-deps: +- poly-0.3.1.0 +- semirings-0.4.2 diff --git a/tests/BinaryFieldTests.hs b/tests/BinaryFieldTests.hs index 75db82c..b0360b6 100644 --- a/tests/BinaryFieldTests.hs +++ b/tests/BinaryFieldTests.hs @@ -19,13 +19,13 @@ type F2I = BinaryField 0x8000000000000000000000000000000000000000000000000000000 testBinaryField :: TestTree testBinaryField = testGroup "Binary fields" - [ testBF "F2A" (witness :: F2A) - , testBF "F2B" (witness :: F2B) - , testBF "F2C" (witness :: F2C) - , testBF "F2D" (witness :: F2D) - , testBF "F2E" (witness :: F2E) - , testBF "F2F" (witness :: F2F) - , testBF "F2G" (witness :: F2G) - , testBF "F2H" (witness :: F2H) - , testBF "F2I" (witness :: F2I) + [ test "F2A" (witness :: F2A) + , test "F2B" (witness :: F2B) + , test "F2C" (witness :: F2C) + , test "F2D" (witness :: F2D) + , test "F2E" (witness :: F2E) + , test "F2F" (witness :: F2F) + , test "F2G" (witness :: F2G) + , test "F2H" (witness :: F2H) + , test "F2I" (witness :: F2I) ] diff --git a/tests/ExtensionFieldTests.hs b/tests/ExtensionFieldTests.hs index 2e23b42..30d1db7 100644 --- a/tests/ExtensionFieldTests.hs +++ b/tests/ExtensionFieldTests.hs @@ -10,98 +10,98 @@ import PrimeFieldTests data P111 instance IrreducibleMonic FS2 P111 where - split _ = x ^ (2 :: Int) + x + 1 + split _ = X2 + X + 1 type FS4 = ExtensionField FS2 P111 data P1101 instance IrreducibleMonic FS2 P1101 where - split _ = x ^ (3 :: Int) + x + 1 + split _ = X3 + X + 1 type FS8 = ExtensionField FS2 P1101 data P1011 instance IrreducibleMonic FS2 P1011 where - split _ = x ^ (3 :: Int) + x ^ (2 :: Int) + 1 + split _ = X3 + X2 + 1 type FS8' = ExtensionField FS2 P1011 data P101 instance IrreducibleMonic FS3 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 1 type FS9 = ExtensionField FS3 P101 data P211 instance IrreducibleMonic FS3 P211 where - split _ = x ^ (2 :: Int) + x - 1 + split _ = X2 + X - 1 type FS9' = ExtensionField FS3 P211 data P221 instance IrreducibleMonic FS3 P221 where - split _ = x ^ (2 :: Int) - x - 1 + split _ = X2 - X - 1 type FS9'' = ExtensionField FS3 P221 instance IrreducibleMonic FM0 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 1 type FL0 = ExtensionField FM0 P101 instance IrreducibleMonic FM1 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 1 type FL1 = ExtensionField FM1 P101 instance IrreducibleMonic FM2 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 1 type FL2 = ExtensionField FM2 P101 instance IrreducibleMonic FM3 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 1 type FL3 = ExtensionField FM3 P101 instance IrreducibleMonic FM4 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 1 type FL4 = ExtensionField FM4 P101 instance IrreducibleMonic FVL P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 17 type FV2 = ExtensionField FVL P101 instance IrreducibleMonic FXL P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 17 type FX2 = ExtensionField FXL P101 instance IrreducibleMonic FZL P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 17 type FZ2 = ExtensionField FZL P101 data Pu instance IrreducibleMonic Fq Pu where - split _ = x ^ (2 :: Int) + 1 + split _ = X2 + 1 type Fq2 = ExtensionField Fq Pu data Pv instance IrreducibleMonic Fq2 Pv where - split _ = x ^ (3 :: Int) - 9 - t x + split _ = X3 - 9 - Y X type Fq6 = ExtensionField Fq2 Pv data Pw instance IrreducibleMonic Fq6 Pw where - split _ = x ^ (2 :: Int) - t x + split _ = X2 - Y X type Fq12 = ExtensionField Fq6 Pw testExtensionField :: TestTree testExtensionField = testGroup "Extension fields" - [ testEF "FS4" (witness :: FS4 ) - , testEF "FS8" (witness :: FS8 ) - , testEF "FS8'" (witness :: FS8' ) - , testEF "FS9" (witness :: FS9 ) - , testEF "FS9'" (witness :: FS9' ) - , testEF "FS9''" (witness :: FS9'') - , testEF "FL0" (witness :: FL0 ) - , testEF "FL1" (witness :: FL1 ) - , testEF "FL2" (witness :: FL2 ) - , testEF "FL3" (witness :: FL3 ) - , testEF "FL4" (witness :: FL4 ) - , testEF "FV2" (witness :: FV2 ) - , testEF "FX2" (witness :: FX2 ) - , testEF "FZ2" (witness :: FZ2 ) - , testEF "Fq2" (witness :: Fq2 ) - , testEF "Fq6" (witness :: Fq6 ) - , testEF "Fq12" (witness :: Fq12 ) + [ test' "FS4" (witness :: FS4 ) -- not implemented. + , test "FS8" (witness :: FS8 ) + , test "FS8'" (witness :: FS8' ) + , test "FS9" (witness :: FS9 ) + , test "FS9'" (witness :: FS9' ) + , test "FS9''" (witness :: FS9'') + , test "FL0" (witness :: FL0 ) + , test "FL1" (witness :: FL1 ) + , test "FL2" (witness :: FL2 ) + , test "FL3" (witness :: FL3 ) + , test "FL4" (witness :: FL4 ) + , test "FV2" (witness :: FV2 ) + , test "FX2" (witness :: FX2 ) + , test "FZ2" (witness :: FZ2 ) + , test "Fq2" (witness :: Fq2 ) + , test' "Fq6" (witness :: Fq6 ) -- time out. + , test' "Fq12" (witness :: Fq12 ) -- time out. ] diff --git a/tests/GaloisFieldTests.hs b/tests/GaloisFieldTests.hs index 38f95ca..06a9d55 100644 --- a/tests/GaloisFieldTests.hs +++ b/tests/GaloisFieldTests.hs @@ -45,24 +45,17 @@ fieldAxioms _ = testGroup ("Field axioms") ] squareRoots :: forall k . GaloisField k => k -> TestTree -squareRoots _ = testGroup "Square roots" +squareRoots _ = localOption (QuickCheckTests 10) $ testGroup "Square roots" [ testProperty "squares of square roots" $ \(x :: k) -> isJust (sr x) ==> (((^ (2 :: Int)) <$> sr x) == Just x) - ] - -quadraticEquations :: forall k . GaloisField k => k -> TestTree -quadraticEquations _ = testGroup "Quadratic equations" - [ testProperty "solutions of quadratic equations" + , testProperty "solutions of quadratic equations" $ \(a :: k) (b :: k) (c :: k) -> a /= 0 && b /= 0 && isJust (quad a b c) ==> (((\x -> a * x * x + b * x + c) <$> quad a b c) == Just 0) ] test :: forall k . GaloisField k => TestName -> k -> TestTree -test s x = testGroup s [fieldAxioms x, squareRoots x, quadraticEquations x] - -testEF :: forall k . GaloisField k => TestName -> k -> TestTree -testEF s x = testGroup s [fieldAxioms x] +test s x = testGroup s [fieldAxioms x, squareRoots x] -testBF :: forall k . GaloisField k => TestName -> k -> TestTree -testBF s x = testGroup s [fieldAxioms x] +test' :: forall k . GaloisField k => TestName -> k -> TestTree +test' s x = testGroup s [fieldAxioms x]