From c4f04cec22515bdc3962491a8452abef159294e2 Mon Sep 17 00:00:00 2001 From: Multramate Date: Mon, 22 Jul 2019 10:30:01 +0100 Subject: [PATCH 01/17] Restructure benchmarks layout --- benchmarks/BinaryFieldBenchmarks.hs | 17 ++++ benchmarks/ExtensionFieldBenchmarks.hs | 91 ++++++++++++++++++ benchmarks/GaloisFieldBenchmarks.hs | 23 +++++ benchmarks/Main.hs | 123 +------------------------ benchmarks/PrimeFieldBenchmarks.hs | 17 ++++ 5 files changed, 152 insertions(+), 119 deletions(-) create mode 100644 benchmarks/BinaryFieldBenchmarks.hs create mode 100644 benchmarks/ExtensionFieldBenchmarks.hs create mode 100644 benchmarks/GaloisFieldBenchmarks.hs create mode 100644 benchmarks/PrimeFieldBenchmarks.hs 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..f945d92 --- /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 _ = 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 + ] + ] + ] + +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' From 44edeebd9b619cc4b7757519708723a38d9b534c Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 24 Jul 2019 17:58:54 +0100 Subject: [PATCH 02/17] Add Ord instance --- src/PrimeField.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/PrimeField.hs b/src/PrimeField.hs index d50fd54..5a8d28f 100644 --- a/src/PrimeField.hs +++ b/src/PrimeField.hs @@ -18,7 +18,7 @@ import GaloisField (GaloisField(..)) -- | Prime fields @GF(p)@ for @p@ prime. newtype PrimeField (p :: Nat) = PF Integer - deriving (Bits, Eq, Generic, NFData, Read, Show) + deriving (Bits, Eq, Generic, NFData, Ord, Read, Show) -- Prime fields are Galois fields. instance KnownNat p => GaloisField (PrimeField p) where From 94b5be3656810232dd15ea35048764125bf7ff8e Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 31 Jul 2019 13:31:17 +0100 Subject: [PATCH 03/17] Evaluate normal forms in benchmarks --- benchmarks/GaloisFieldBenchmarks.hs | 12 ++++++------ src/GaloisField.hs | 4 ++-- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/benchmarks/GaloisFieldBenchmarks.hs b/benchmarks/GaloisFieldBenchmarks.hs index a974b42..8b8800d 100644 --- a/benchmarks/GaloisFieldBenchmarks.hs +++ b/benchmarks/GaloisFieldBenchmarks.hs @@ -9,15 +9,15 @@ import GHC.Base benchmark :: GaloisField k => String -> k -> k -> Benchmark benchmark s a b = bgroup s [ bench "Addition" $ - whnf (uncurry (+)) (a, b) + nf (uncurry (+)) (a, b) , bench "Multiplication" $ - whnf (uncurry (*)) (a, b) + nf (uncurry (*)) (a, b) , bench "Negation" $ - whnf negate a + nf negate a , bench "Subtraction" $ - whnf (uncurry (-)) (a, b) + nf (uncurry (-)) (a, b) , bench "Inversion" $ - whnf recip a + nf recip a , bench "Division" $ - whnf (uncurry (/)) (a, b) + nf (uncurry (/)) (a, b) ] diff --git a/src/GaloisField.hs b/src/GaloisField.hs index dec5eea..f91454f 100644 --- a/src/GaloisField.hs +++ b/src/GaloisField.hs @@ -13,8 +13,8 @@ import Text.PrettyPrint.Leijen.Text (Pretty) ------------------------------------------------------------------------------- -- | 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 +class (Arbitrary k, Eq k, Fractional k, Generic k, + NFData k, Pretty k, Random k, Read k, Show k) => GaloisField k where {-# MINIMAL char, deg, frob, pow, quad, rnd, sr #-} -- Characteristics From 2fe9d4da678772545ce1204ce872028d1f1dc22f Mon Sep 17 00:00:00 2001 From: Multramate Date: Fri, 2 Aug 2019 17:57:09 +0100 Subject: [PATCH 04/17] Add Ord instance --- src/ExtensionField.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ExtensionField.hs b/src/ExtensionField.hs index d5177f1..cab78dd 100644 --- a/src/ExtensionField.hs +++ b/src/ExtensionField.hs @@ -22,7 +22,7 @@ import GaloisField (GaloisField(..)) -- | 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) + deriving (Eq, Generic, NFData, Ord, Read, Show) -- | Irreducible monic splitting polynomial @f(X)@ of extension field. class IrreducibleMonic k im where @@ -66,7 +66,7 @@ instance (GaloisField k, IrreducibleMonic k im) -- Polynomial rings. newtype Polynomial k = X [k] - deriving (Eq, Generic, NFData, Read, Show) + deriving (Eq, Generic, NFData, Ord, Read, Show) -- Polynomial rings are rings. instance GaloisField k => Num (Polynomial k) where From 9cbe5a50b7d4f8e22639bb95d946c33a7b6d621a Mon Sep 17 00:00:00 2001 From: Multramate Date: Mon, 5 Aug 2019 14:00:10 +0100 Subject: [PATCH 05/17] Add Semiring and Field interface --- package.yaml | 1 + src/ExtensionField.hs | 92 +++++++++++++++++++++---------------------- src/GaloisField.hs | 59 ++++++++++++++++++++++++++- src/PrimeField.hs | 34 ++++++++-------- 4 files changed, 121 insertions(+), 65 deletions(-) diff --git a/package.yaml b/package.yaml index 2a63923..6b6302b 100644 --- a/package.yaml +++ b/package.yaml @@ -27,6 +27,7 @@ dependencies: - protolude >= 0.2 - integer-gmp - MonadRandom + - semirings - tasty-quickcheck - wl-pprint-text diff --git a/src/ExtensionField.hs b/src/ExtensionField.hs index cab78dd..5f08a0b 100644 --- a/src/ExtensionField.hs +++ b/src/ExtensionField.hs @@ -60,52 +60,6 @@ instance (GaloisField k, IrreducibleMonic k im) sr = panic "not implemented." {-# INLINE sr #-} -------------------------------------------------------------------------------- --- Extension field conversions -------------------------------------------------------------------------------- - --- Polynomial rings. -newtype Polynomial k = X [k] - deriving (Eq, Generic, NFData, Ord, Read, Show) - --- Polynomial rings are rings. -instance GaloisField k => Num (Polynomial k) where - X y + X z = X (polyAdd y z) - {-# INLINE (+) #-} - X y * X z = X (polyMul y z) - {-# INLINE (*) #-} - X y - X z = X (polySub y z) - {-# INLINE (-) #-} - negate (X y) = X (map negate y) - {-# INLINE negate #-} - fromInteger n = X (let m = fromInteger n in if m == 0 then [] else [m]) - {-# 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 ------------------------------------------------------------------------------- @@ -158,6 +112,52 @@ instance (GaloisField k, IrreducibleMonic k im) {-# INLINE random #-} randomR = panic "not implemented." +------------------------------------------------------------------------------- +-- Extension field conversions +------------------------------------------------------------------------------- + +-- Polynomial rings. +newtype Polynomial k = X [k] + deriving (Eq, Generic, NFData, Ord, Read, Show) + +-- Polynomial rings are rings. +instance GaloisField k => Num (Polynomial k) where + X y + X z = X (polyAdd y z) + {-# INLINE (+) #-} + X y * X z = X (polyMul y z) + {-# INLINE (*) #-} + X y - X z = X (polySub y z) + {-# INLINE (-) #-} + negate (X y) = X (map negate y) + {-# INLINE negate #-} + fromInteger n = X (let m = fromInteger n in if m == 0 then [] else [m]) + {-# 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 arithmetic ------------------------------------------------------------------------------- diff --git a/src/GaloisField.hs b/src/GaloisField.hs index f91454f..21c4fa3 100644 --- a/src/GaloisField.hs +++ b/src/GaloisField.hs @@ -1,13 +1,68 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS -fno-warn-orphans #-} + module GaloisField - ( GaloisField(..) + ( Field(..) + , GaloisField(..) ) where -import Protolude +import Protolude hiding (Semiring, one, zero) import Control.Monad.Random (MonadRandom, Random) +import Data.Semiring (Semiring(..)) import Test.Tasty.QuickCheck (Arbitrary) import Text.PrettyPrint.Leijen.Text (Pretty) +------------------------------------------------------------------------------- +-- Field class +------------------------------------------------------------------------------- + +-- | Fields. +class Semiring k => Field k where + {-# MINIMAL (divide | inv), (minus | neg) #-} + + -- | Negation. + neg :: k -> k + neg = minus zero + {-# INLINE neg #-} + + -- | Subtraction. + minus :: k -> k -> k + minus = (. neg) . plus + {-# INLINE minus #-} + + -- | Inversion. + inv :: k -> k + inv = divide one + {-# INLINE inv #-} + + -- | Division. + divide :: k -> k -> k + divide = (. inv) . times + {-# INLINE divide #-} + +-- Fractionals are semirings. +instance GaloisField k => Semiring k where + zero = 0 + {-# INLINE zero #-} + plus = (+) + {-# INLINE plus #-} + one = 1 + {-# INLINE one #-} + times = (*) + {-# INLINE times #-} + +-- Fields are fractionals. +instance GaloisField k => Field k where + neg = negate + {-# INLINE neg #-} + minus = (-) + {-# INLINE minus #-} + inv = recip + {-# INLINE inv #-} + divide = (/) + {-# INLINE divide #-} + ------------------------------------------------------------------------------- -- Galois field class ------------------------------------------------------------------------------- diff --git a/src/PrimeField.hs b/src/PrimeField.hs index 5a8d28f..a2da4eb 100644 --- a/src/PrimeField.hs +++ b/src/PrimeField.hs @@ -38,23 +38,6 @@ instance KnownNat p => GaloisField (PrimeField p) where 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 #-} - -------------------------------------------------------------------------------- --- Prime field instances -------------------------------------------------------------------------------- - --- Prime fields are arbitrary. -instance KnownNat p => Arbitrary (PrimeField p) where - arbitrary = fromInteger <$> arbitrary - -- Prime fields are fields. instance KnownNat p => Fractional (PrimeField p) where recip w@(PF x) = PF (if x == 0 then panic "no multiplicative inverse." @@ -86,6 +69,14 @@ instance KnownNat p => Num (PrimeField p) where abs = panic "not implemented." signum = panic "not implemented." +------------------------------------------------------------------------------- +-- Prime field instances +------------------------------------------------------------------------------- + +-- Prime fields are arbitrary. +instance KnownNat p => Arbitrary (PrimeField p) where + arbitrary = fromInteger <$> arbitrary + -- Prime fields are pretty. instance KnownNat p => Pretty (PrimeField p) where pretty (PF x) = pretty x @@ -96,6 +87,15 @@ instance KnownNat p => Random (PrimeField p) where {-# INLINE random #-} randomR = panic "not implemented." +------------------------------------------------------------------------------- +-- Prime field conversions +------------------------------------------------------------------------------- + +-- | Embed field element to integers. +toInt :: PrimeField p -> Integer +toInt (PF x) = x +{-# INLINABLE toInt #-} + ------------------------------------------------------------------------------- -- Prime field quadratics ------------------------------------------------------------------------------- From 3aade6f8959acebbdb1ea327d9aeb86df3d480d7 Mon Sep 17 00:00:00 2001 From: Multramate Date: Mon, 5 Aug 2019 18:14:42 +0100 Subject: [PATCH 06/17] Add vector and polynomial dependencies --- benchmarks/ExtensionFieldBenchmarks.hs | 6 +- benchmarks/GaloisFieldBenchmarks.hs | 12 +- package.yaml | 3 + src/BinaryField.hs | 75 +++++-- src/ExtensionField.hs | 272 +++++++++++-------------- src/GaloisField.hs | 67 ++---- src/PrimeField.hs | 79 +++++-- stack.yaml | 3 + tests/ExtensionFieldTests.hs | 34 ++-- 9 files changed, 286 insertions(+), 265 deletions(-) diff --git a/benchmarks/ExtensionFieldBenchmarks.hs b/benchmarks/ExtensionFieldBenchmarks.hs index f945d92..a2a6fc9 100644 --- a/benchmarks/ExtensionFieldBenchmarks.hs +++ b/benchmarks/ExtensionFieldBenchmarks.hs @@ -10,17 +10,17 @@ import PrimeFieldBenchmarks data Pu instance IrreducibleMonic Fq Pu where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type Fq2 = ExtensionField Fq Pu data Pv instance IrreducibleMonic Fq2 Pv where - split _ = x ^ (3 :: Int) - 9 - t x + 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 + split _ = X ^ (2 :: Int) - t X type Fq12 = ExtensionField Fq6 Pw fq12 :: Fq12 diff --git a/benchmarks/GaloisFieldBenchmarks.hs b/benchmarks/GaloisFieldBenchmarks.hs index 8b8800d..a974b42 100644 --- a/benchmarks/GaloisFieldBenchmarks.hs +++ b/benchmarks/GaloisFieldBenchmarks.hs @@ -9,15 +9,15 @@ import GHC.Base benchmark :: GaloisField k => String -> k -> k -> Benchmark benchmark s a b = bgroup s [ bench "Addition" $ - nf (uncurry (+)) (a, b) + whnf (uncurry (+)) (a, b) , bench "Multiplication" $ - nf (uncurry (*)) (a, b) + whnf (uncurry (*)) (a, b) , bench "Negation" $ - nf negate a + whnf negate a , bench "Subtraction" $ - nf (uncurry (-)) (a, b) + whnf (uncurry (-)) (a, b) , bench "Inversion" $ - nf recip a + whnf recip a , bench "Division" $ - nf (uncurry (/)) (a, b) + whnf (uncurry (/)) (a, b) ] diff --git a/package.yaml b/package.yaml index 6b6302b..3577661 100644 --- a/package.yaml +++ b/package.yaml @@ -21,14 +21,17 @@ default-extensions: - GeneralizedNewtypeDeriving - KindSignatures - MultiParamTypeClasses + - PatternSynonyms dependencies: - base >= 4.7 && < 5 - protolude >= 0.2 - 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..44fca46 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 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 @@ -48,21 +50,17 @@ instance KnownNat im => GaloisField (BinaryField im) where {-# INLINE sr #-} ------------------------------------------------------------------------------- --- 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)) {-# 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 (+) #-} @@ -77,6 +75,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 +133,7 @@ instance KnownNat im => Random (BinaryField im) where randomR = panic "not implemented." ------------------------------------------------------------------------------- --- Binary field arithmetic +-- Binary arithmetic ------------------------------------------------------------------------------- -- Binary logarithm. @@ -99,12 +144,12 @@ 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. @@ -149,7 +194,7 @@ binInv f x = case binInv' 0 1 x f of {-# INLINE binInv #-} ------------------------------------------------------------------------------- --- Binary field quadratics +-- Quadratic equations ------------------------------------------------------------------------------- -- Binary quadratic @y^2+y+x=0@. diff --git a/src/ExtensionField.hs b/src/ExtensionField.hs index 5f08a0b..60871a3 100644 --- a/src/ExtensionField.hs +++ b/src/ExtensionField.hs @@ -4,227 +4,183 @@ module ExtensionField , fromField , fromList , t - , x + , pattern X ) where -import Protolude +import Protolude as P hiding (Semiring, quot, quotRem, rem) import Control.Monad.Random (Random(..), getRandom) +import Data.Euclidean (Euclidean(..), GcdDomain(..)) +import Data.Semiring (Ring(..), Semiring(..)) +import Data.Poly.Semiring (VPoly, leading, monomial, scale, toPoly, unPoly, pattern X) +import qualified Data.Vector as V 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, Ord, Read, Show) +newtype ExtensionField k im = EF (VPoly k) + deriving (Eq, Generic, Ord, Show) -- | 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 - char = const (char (witness :: k)) +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 w = deg (witness :: k) * deg' w {-# INLINE deg #-} - frob = pow <*> char + 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) + pow = (^) {-# INLINE pow #-} - quad = panic "not implemented." + quad = panic "not implemented." {-# INLINE quad #-} - rnd = getRandom + rnd = getRandom {-# INLINE rnd #-} - sr = panic "not implemented." + sr = panic "not implemented." {-# INLINE sr #-} ------------------------------------------------------------------------------- --- Extension field instances +-- Numeric 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 fields. -instance (GaloisField k, IrreducibleMonic k im) - => Fractional (ExtensionField k im) where - recip w@(EF (X y)) = EF (X (polyInv y (plist w))) +-- Extension fields are fractional. +instance IrreducibleMonic k im => Fractional (ExtensionField k im) where + recip w@(EF x) = EF (polyInv x (split w)) {-# INLINE recip #-} - fromRational (y:%z) = fromInteger y / fromInteger z + fromRational (x:%y) = fromInteger x / fromInteger y {-# INLINABLE fromRational #-} --- Extension fields are rings. -instance (GaloisField k, IrreducibleMonic k im) - => Num (ExtensionField k im) where - EF y + EF z = EF (y + z) +-- Extension fields are numeric. +instance IrreducibleMonic k im => Num (ExtensionField k im) where + EF x + EF y = EF (x + y) {-# INLINE (+) #-} - w@(EF (X y)) * EF (X z) = EF (X (snd (polyQR (polyMul y z) (plist w)))) + w@(EF x) * EF y = EF (rem (x * y) (split w)) {-# INLINE (*) #-} - EF y - EF z = EF (y - z) + EF x - EF y = EF (x - y) {-# INLINE (-) #-} - negate (EF y) = EF (-y) + negate (EF x) = EF (P.negate x) {-# INLINE negate #-} - fromInteger = EF . fromInteger + fromInteger = EF . fromInteger {-# INLINABLE fromInteger #-} - abs = panic "not implemented." - signum = panic "not implemented." + abs = panic "not implemented." + signum = panic "not implemented." + +------------------------------------------------------------------------------- +-- Semiring instances +------------------------------------------------------------------------------- + +-- 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 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 IrreducibleMonic k im => Ring (ExtensionField k im) where + negate = P.negate + {-# INLINE negate #-} + +-- 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 = fromList <$> 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 (show x :: Text) -- 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 fromList . 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 conversions +-- Type conversions ------------------------------------------------------------------------------- --- Polynomial rings. -newtype Polynomial k = X [k] - deriving (Eq, Generic, NFData, Ord, Read, Show) - --- Polynomial rings are rings. -instance GaloisField k => Num (Polynomial k) where - X y + X z = X (polyAdd y z) - {-# INLINE (+) #-} - X y * X z = X (polyMul y z) - {-# INLINE (*) #-} - X y - X z = X (polySub y z) - {-# INLINE (-) #-} - negate (X y) = X (map negate y) - {-# INLINE negate #-} - fromInteger n = X (let m = fromInteger n in if m == 0 then [] else [m]) - {-# 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 +fromField (EF x) = toList (unPoly x) {-# INLINABLE fromField #-} -- | Convert from list representation to field element. -fromList :: forall k im . (GaloisField k, IrreducibleMonic k im) +fromList :: forall k im . IrreducibleMonic k im => [k] -> ExtensionField k im -fromList = EF . X . snd . flip polyQR (plist w) . dropZero - where - w = witness :: ExtensionField k im +fromList = EF . flip rem (split (witness :: ExtensionField k im)) . toPoly . V.fromList {-# INLINABLE fromList #-} -- | Descend tower of indeterminate variables. -t :: Polynomial k -> Polynomial (ExtensionField k im) -t = X . return . EF +t :: IrreducibleMonic k im => VPoly k -> VPoly (ExtensionField k im) +t = monomial 0 . EF {-# INLINE t #-} --- | Current indeterminate variable. -x :: GaloisField k => Polynomial k -x = X [0, 1] -{-# INLINE x #-} - ------------------------------------------------------------------------------- --- Extension field arithmetic +-- Polynomial arithmetic ------------------------------------------------------------------------------- --- 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." +-- 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 = flip (polyGCD' 0 1) where - extGCD :: ([k], [k]) -> ([k], ([k], [k])) - extGCD (y, []) = (y, ([], [1])) - extGCD (y, z) = (g, (polySub v (polyMul u q), u)) + polyGCD' :: VPoly k -> VPoly k -> VPoly k -> VPoly k -> (VPoly k, VPoly k) + polyGCD' s s' r r' + | r' == 0 = (r, s) + | otherwise = polyGCD' s' (s - q * s') r' (r - q * r') where - (q, r) = polyQR y z - (g, (u, v)) = extGCD (z, r) -{-# INLINE polyInv #-} + q = quot r r' +{-# INLINE polyGCD #-} diff --git a/src/GaloisField.hs b/src/GaloisField.hs index 21c4fa3..e68ac4e 100644 --- a/src/GaloisField.hs +++ b/src/GaloisField.hs @@ -1,75 +1,44 @@ -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS -fno-warn-orphans #-} - module GaloisField ( Field(..) , GaloisField(..) ) where -import Protolude hiding (Semiring, one, zero) +import Protolude hiding ((-), one) import Control.Monad.Random (MonadRandom, Random) -import Data.Semiring (Semiring(..)) +import Data.Euclidean (Euclidean) +import Data.Semiring (Ring, (-), one, times) import Test.Tasty.QuickCheck (Arbitrary) import Text.PrettyPrint.Leijen.Text (Pretty) ------------------------------------------------------------------------------- --- Field class +-- Types ------------------------------------------------------------------------------- -- | Fields. -class Semiring k => Field k where - {-# MINIMAL (divide | inv), (minus | neg) #-} - - -- | Negation. - neg :: k -> k - neg = minus zero - {-# INLINE neg #-} - - -- | Subtraction. - minus :: k -> k -> k - minus = (. neg) . plus - {-# INLINE minus #-} +class (Euclidean k, Ring k) => Field k where + {-# MINIMAL (divide | invert) #-} - -- | Inversion. - inv :: k -> k - inv = divide one - {-# INLINE inv #-} + -- Operations -- | Division. divide :: k -> k -> k - divide = (. inv) . times + divide = (. invert) . times {-# INLINE divide #-} --- Fractionals are semirings. -instance GaloisField k => Semiring k where - zero = 0 - {-# INLINE zero #-} - plus = (+) - {-# INLINE plus #-} - one = 1 - {-# INLINE one #-} - times = (*) - {-# INLINE times #-} - --- Fields are fractionals. -instance GaloisField k => Field k where - neg = negate - {-# INLINE neg #-} - minus = (-) - {-# INLINE minus #-} - inv = recip - {-# INLINE inv #-} - divide = (/) - {-# INLINE divide #-} + -- | Inversion. + invert :: k -> k + invert = divide one + {-# INLINE invert #-} -------------------------------------------------------------------------------- --- Galois field class -------------------------------------------------------------------------------- + -- | 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, Generic k, - NFData k, Pretty k, Random k, Read k, Show k) => GaloisField k where +class (Arbitrary k, Eq k, Field k, Fractional k, + Generic k, Ord k, Pretty k, Random k, Show k) => GaloisField k where {-# MINIMAL char, deg, frob, pow, quad, rnd, sr #-} -- Characteristics diff --git a/src/PrimeField.hs b/src/PrimeField.hs index a2da4eb..a8faa69 100644 --- a/src/PrimeField.hs +++ b/src/PrimeField.hs @@ -3,22 +3,24 @@ module PrimeField , toInt ) where -import Protolude +import Protolude as P hiding (Semiring) import Control.Monad.Random (Random(..), getRandom) +import Data.Euclidean (Euclidean(..), GcdDomain(..)) +import Data.Semiring (Ring(..), Semiring(..)) import GHC.Integer.GMP.Internals (powModInteger, recipModInteger) import Test.Tasty.QuickCheck (Arbitrary(..)) 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, Ord, Read, Show) + deriving (Bits, Eq, Generic, Ord, Show) -- Prime fields are Galois fields. instance KnownNat p => GaloisField (PrimeField p) where @@ -38,7 +40,11 @@ instance KnownNat p => GaloisField (PrimeField p) where in if p == 2 || x == 0 then Just w else PF <$> primeSqrt p x {-# INLINE sr #-} --- Prime fields are fields. +------------------------------------------------------------------------------- +-- Numeric instances +------------------------------------------------------------------------------- + +-- 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)) @@ -46,14 +52,14 @@ instance KnownNat p => Fractional (PrimeField p) where 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) where xy = x + y xyp = xy - natVal w {-# INLINE (+) #-} - w@(PF x) * PF y = PF (rem (x * y) (natVal w)) + w@(PF x) * PF y = PF (P.rem (x * y) (natVal w)) {-# INLINE (*) #-} w@(PF x) - PF y = PF (if xy >= 0 then xy else xy + natVal w) where @@ -63,14 +69,53 @@ instance KnownNat p => Num (PrimeField p) where {-# INLINE negate #-} 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." ------------------------------------------------------------------------------- --- Prime field instances +-- 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. @@ -88,7 +133,7 @@ instance KnownNat p => Random (PrimeField p) where randomR = panic "not implemented." ------------------------------------------------------------------------------- --- Prime field conversions +-- Type conversions ------------------------------------------------------------------------------- -- | Embed field element to integers. @@ -97,7 +142,7 @@ toInt (PF x) = x {-# INLINABLE toInt #-} ------------------------------------------------------------------------------- --- Prime field quadratics +-- Quadratic equations ------------------------------------------------------------------------------- -- Check quadratic nonresidue. @@ -133,9 +178,9 @@ 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 + nq = powModInteger n (P.quot q 2) p + nnq = P.rem (n * nq) p + in loop s zq (P.rem (nq * nnq) p) nnq where loop :: Int -> Integer -> Integer -> Integer -> Maybe Integer loop m c t r @@ -143,12 +188,12 @@ primeSqrt p n | 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) + b2 = P.rem (b * b) p + in loop i b2 (P.rem (t * b2) p) (P.rem (r * b) p) where least :: Integer -> Int -> Int least 1 j = j - least ti j = least (rem (ti * ti) p) (j + 1) + least ti j = least (P.rem (ti * ti) p) (j + 1) {-# INLINE primeSqrt #-} -- Prime quadratic @ax^2+bx+c=0@. 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/ExtensionFieldTests.hs b/tests/ExtensionFieldTests.hs index 2e23b42..8e15e0b 100644 --- a/tests/ExtensionFieldTests.hs +++ b/tests/ExtensionFieldTests.hs @@ -10,79 +10,79 @@ import PrimeFieldTests data P111 instance IrreducibleMonic FS2 P111 where - split _ = x ^ (2 :: Int) + x + 1 + split _ = X ^ (2 :: Int) + X + 1 type FS4 = ExtensionField FS2 P111 data P1101 instance IrreducibleMonic FS2 P1101 where - split _ = x ^ (3 :: Int) + x + 1 + split _ = X ^ (3 :: Int) + X + 1 type FS8 = ExtensionField FS2 P1101 data P1011 instance IrreducibleMonic FS2 P1011 where - split _ = x ^ (3 :: Int) + x ^ (2 :: Int) + 1 + split _ = X ^ (3 :: Int) + X ^ (2 :: Int) + 1 type FS8' = ExtensionField FS2 P1011 data P101 instance IrreducibleMonic FS3 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FS9 = ExtensionField FS3 P101 data P211 instance IrreducibleMonic FS3 P211 where - split _ = x ^ (2 :: Int) + x - 1 + split _ = X ^ (2 :: Int) + X - 1 type FS9' = ExtensionField FS3 P211 data P221 instance IrreducibleMonic FS3 P221 where - split _ = x ^ (2 :: Int) - x - 1 + split _ = X ^ (2 :: Int) - X - 1 type FS9'' = ExtensionField FS3 P221 instance IrreducibleMonic FM0 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FL0 = ExtensionField FM0 P101 instance IrreducibleMonic FM1 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FL1 = ExtensionField FM1 P101 instance IrreducibleMonic FM2 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FL2 = ExtensionField FM2 P101 instance IrreducibleMonic FM3 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FL3 = ExtensionField FM3 P101 instance IrreducibleMonic FM4 P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FL4 = ExtensionField FM4 P101 instance IrreducibleMonic FVL P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FV2 = ExtensionField FVL P101 instance IrreducibleMonic FXL P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FX2 = ExtensionField FXL P101 instance IrreducibleMonic FZL P101 where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type FZ2 = ExtensionField FZL P101 data Pu instance IrreducibleMonic Fq Pu where - split _ = x ^ (2 :: Int) + 1 + split _ = X ^ (2 :: Int) + 1 type Fq2 = ExtensionField Fq Pu data Pv instance IrreducibleMonic Fq2 Pv where - split _ = x ^ (3 :: Int) - 9 - t x + 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 + split _ = X ^ (2 :: Int) - t X type Fq12 = ExtensionField Fq6 Pw testExtensionField :: TestTree From c3b75a08c78a585252a3cf9600028a6d315a1249 Mon Sep 17 00:00:00 2001 From: Multramate Date: Mon, 5 Aug 2019 18:22:39 +0100 Subject: [PATCH 07/17] Update README --- README.md | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index e2ff764..464c8c1 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. For example, X^8 + X^4 + X^3 + X + 1 can be represented as the integer 283 that represents the bit string 100011011. @@ -48,7 +48,8 @@ Include the following required language extensions. Import the following functions at minimum. ```haskell import PrimeField (PrimeField) -import ExtensionField (ExtensionField, IrreducibleMonic(split), fromList, t, x) +import ExtensionField (ExtensionField, IrreducibleMonic(split), fromList, t, X) +import BinaryField (BinaryField) ``` ### Prime fields @@ -77,7 +78,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 _ = X^2 + 1 ``` The following type declaration then creates an extension field with this splitting polynomial. ```haskell @@ -89,17 +90,17 @@ 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 _ = X^3 - (9 + t X) type Fq6 = ExtensionField Fq2 P6 data P12 instance IrreducibleMonic Fq6 P12 where - split _ = x^2 - t x + split _ = X^2 - t 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` accesses the current indeterminate variable and `t` descends the tower of indeterminate variables. Galois field arithmetic can then be performed in this extension field. ```haskell @@ -172,9 +173,9 @@ 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 From 610efa7d888a90fb07ec78992313ee0deb48425c Mon Sep 17 00:00:00 2001 From: Multramate Date: Tue, 6 Aug 2019 11:54:57 +0100 Subject: [PATCH 08/17] Add further optimisations for polynomials --- benchmarks/ExtensionFieldBenchmarks.hs | 42 ++++++------ src/BinaryField.hs | 22 +++--- src/ExtensionField.hs | 95 ++++++++++++++++---------- src/PrimeField.hs | 41 ++++++----- tests/ExtensionFieldTests.hs | 34 ++++----- 5 files changed, 133 insertions(+), 101 deletions(-) diff --git a/benchmarks/ExtensionFieldBenchmarks.hs b/benchmarks/ExtensionFieldBenchmarks.hs index a2a6fc9..069352e 100644 --- a/benchmarks/ExtensionFieldBenchmarks.hs +++ b/benchmarks/ExtensionFieldBenchmarks.hs @@ -10,45 +10,45 @@ import PrimeFieldBenchmarks 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 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 ] @@ -56,31 +56,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 ] diff --git a/src/BinaryField.hs b/src/BinaryField.hs index 44fca46..67a6b1a 100644 --- a/src/BinaryField.hs +++ b/src/BinaryField.hs @@ -29,16 +29,20 @@ 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) + pow w@(BF x) n + | n < 0 = pow (recip w) (P.negate n) + | otherwise = BF (pow' 1 x n) where - mul = (.) (binMod (natVal w)) . binMul - pow' ws zs m + pow' ws xs 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) + | m == 1 = ws' + | even m = pow' ws xs' m' + | otherwise = pow' ws' xs' m' + where + mul = (binMod (natVal w) .) . binMul + ws' = mul ws xs + xs' = mul xs xs + m' = div m 2 {-# INLINE pow #-} quad a b c | b == 0 = sr c @@ -55,7 +59,7 @@ instance KnownNat im => GaloisField (BinaryField im) where -- 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 #-} diff --git a/src/ExtensionField.hs b/src/ExtensionField.hs index 60871a3..46e34c0 100644 --- a/src/ExtensionField.hs +++ b/src/ExtensionField.hs @@ -1,19 +1,22 @@ module ExtensionField ( ExtensionField + , PolynomialRing , IrreducibleMonic(split) , fromField - , fromList - , t + , toField , pattern X + , pattern X2 + , pattern X3 + , pattern Y ) where import Protolude as P hiding (Semiring, quot, quotRem, rem) import Control.Monad.Random (Random(..), getRandom) import Data.Euclidean (Euclidean(..), GcdDomain(..)) -import Data.Semiring (Ring(..), Semiring(..)) import Data.Poly.Semiring (VPoly, leading, monomial, scale, toPoly, unPoly, pattern X) -import qualified Data.Vector as V +import Data.Semiring as S (Ring(..), Semiring(..)) +import Data.Vector (fromList) import Test.Tasty.QuickCheck (Arbitrary(..), vector) import Text.PrettyPrint.Leijen.Text (Pretty(..)) @@ -28,6 +31,9 @@ import GaloisField (Field(..), GaloisField(..)) 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 GaloisField k => IrreducibleMonic k im where {-# MINIMAL split #-} @@ -39,19 +45,32 @@ class GaloisField k => IrreducibleMonic k im where -- Extension fields are Galois fields. instance IrreducibleMonic k im => GaloisField (ExtensionField k im) where - char = const (char (witness :: k)) + char = const (char (witness :: k)) {-# INLINE char #-} - deg w = deg (witness :: k) * deg' w + deg = (deg (witness :: k) *) . deg' {-# INLINE deg #-} - frob = pow <*> char + frob = pow <*> char {-# INLINE frob #-} - pow = (^) + pow w@(EF x) n + | n < 0 = pow (recip w) (P.negate n) + | otherwise = EF (pow' 1 x n) + where + pow' ws xs m + | m == 0 = ws + | m == 1 = ws' + | even m = pow' ws xs' m' + | otherwise = pow' ws' xs' m' + where + mul = (flip rem (split w) .) . times + ws' = mul ws xs + xs' = mul xs xs + m' = div m 2 {-# INLINE pow #-} - quad = panic "not implemented." + quad = panic "not implemented." {-# INLINE quad #-} - rnd = getRandom + rnd = getRandom {-# INLINE rnd #-} - sr = panic "not implemented." + sr = panic "not implemented." {-# INLINE sr #-} ------------------------------------------------------------------------------- @@ -60,25 +79,25 @@ instance IrreducibleMonic k im => GaloisField (ExtensionField k im) where -- Extension fields are fractional. instance IrreducibleMonic k im => Fractional (ExtensionField k im) where - recip w@(EF x) = EF (polyInv x (split w)) + recip (EF x) = EF (polyInv x (split (witness :: ExtensionField k im))) {-# INLINE recip #-} fromRational (x:%y) = fromInteger x / fromInteger y {-# INLINABLE fromRational #-} -- Extension fields are numeric. instance IrreducibleMonic k im => Num (ExtensionField k im) where - EF x + EF y = EF (x + y) + EF x + EF y = EF (plus x y) {-# INLINE (+) #-} - w@(EF x) * EF y = EF (rem (x * y) (split w)) + EF x * EF y = EF (rem (times x y) (split (witness :: ExtensionField k im))) {-# INLINE (*) #-} - EF x - EF y = EF (x - y) + EF x - EF y = EF (x - y) {-# INLINE (-) #-} - negate (EF x) = EF (P.negate x) + negate (EF x) = EF (S.negate x) {-# INLINE negate #-} - fromInteger = EF . fromInteger + fromInteger = EF . fromInteger {-# INLINABLE fromInteger #-} - abs = panic "not implemented." - signum = panic "not implemented." + abs = panic "not implemented." + signum = panic "not implemented." ------------------------------------------------------------------------------- -- Semiring instances @@ -125,15 +144,15 @@ instance IrreducibleMonic k im => Semiring (ExtensionField k im) where -- Extension fields are arbitrary. instance IrreducibleMonic k im => Arbitrary (ExtensionField k im) where - arbitrary = fromList <$> vector (deg' (witness :: ExtensionField k im)) + arbitrary = toField <$> vector (deg' (witness :: ExtensionField k im)) -- Extension fields are pretty. instance IrreducibleMonic k im => Pretty (ExtensionField k im) where - pretty (EF x) = pretty (show x :: Text) + pretty (EF x) = pretty (toList (unPoly x)) -- Extension fields are random. instance IrreducibleMonic k im => Random (ExtensionField k im) where - random = first fromList . unfold (deg' (witness :: ExtensionField k im)) [] + random = first toField . unfold (deg' (witness :: ExtensionField k im)) [] where unfold n xs g | n <= 0 = (xs, g) @@ -152,15 +171,21 @@ fromField (EF x) = toList (unPoly x) {-# INLINABLE fromField #-} -- | Convert from list representation to field element. -fromList :: forall k im . IrreducibleMonic k im - => [k] -> ExtensionField k im -fromList = EF . flip rem (split (witness :: ExtensionField k im)) . toPoly . V.fromList -{-# INLINABLE fromList #-} +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]) --- | Descend tower of indeterminate variables. -t :: IrreducibleMonic k im => VPoly k -> VPoly (ExtensionField k im) -t = monomial 0 . EF -{-# INLINE t #-} +-- | 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 @@ -175,12 +200,10 @@ polyInv xs ps = case first leading (polyGCD xs ps) of -- Polynomial extended greatest common divisor algorithm. polyGCD :: forall k . GaloisField k => VPoly k -> VPoly k -> (VPoly k, VPoly k) -polyGCD = flip (polyGCD' 0 1) +polyGCD x y = polyGCD' 0 1 y x where polyGCD' :: VPoly k -> VPoly k -> VPoly k -> VPoly k -> (VPoly k, VPoly k) - polyGCD' s s' r r' - | r' == 0 = (r, s) - | otherwise = polyGCD' s' (s - q * s') r' (r - q * r') - where - q = quot r r' + 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/PrimeField.hs b/src/PrimeField.hs index a8faa69..50a7717 100644 --- a/src/PrimeField.hs +++ b/src/PrimeField.hs @@ -24,20 +24,24 @@ newtype PrimeField (p :: Nat) = PF Integer -- 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 + quad = primeQuad {-# INLINE quad #-} - rnd = getRandom + 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 + sr w@(PF x) + | p == 2 = Just w + | x == 0 = Just w + | otherwise = PF <$> primeSqrt p x + where + p = natVal (witness :: PrimeField p) {-# INLINE sr #-} ------------------------------------------------------------------------------- @@ -46,34 +50,35 @@ instance KnownNat p => GaloisField (PrimeField p) where -- 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 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 (P.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 = 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 diff --git a/tests/ExtensionFieldTests.hs b/tests/ExtensionFieldTests.hs index 8e15e0b..5db24d5 100644 --- a/tests/ExtensionFieldTests.hs +++ b/tests/ExtensionFieldTests.hs @@ -10,79 +10,79 @@ 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 + 1 type FV2 = ExtensionField FVL P101 instance IrreducibleMonic FXL P101 where - split _ = X ^ (2 :: Int) + 1 + split _ = X2 + 1 type FX2 = ExtensionField FXL P101 instance IrreducibleMonic FZL P101 where - split _ = X ^ (2 :: Int) + 1 + split _ = X2 + 1 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 From 33255e07c8375c5881e745661a7b06063db8980f Mon Sep 17 00:00:00 2001 From: Multramate Date: Tue, 6 Aug 2019 12:02:01 +0100 Subject: [PATCH 09/17] Update README --- README.md | 53 +++++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/README.md b/README.md index 464c8c1..a16cc6c 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. @@ -48,7 +48,8 @@ Include the following required language extensions. 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) ``` @@ -78,7 +79,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 @@ -90,46 +91,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` accesses the current indeterminate variable 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 ] @@ -137,31 +138,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 ] @@ -177,8 +178,8 @@ 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 ```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 From b2fefecbfad20410c039a8b177d9b6deff1b730b Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 7 Aug 2019 10:47:20 +0100 Subject: [PATCH 10/17] Add square roots for extension fields --- src/BinaryField.hs | 13 ++++--- src/ExtensionField.hs | 70 +++++++++++++++++++++++++++++++++--- src/PrimeField.hs | 50 +++++++++++--------------- tests/ExtensionFieldTests.hs | 48 ++++++++----------------- tests/PrimeFieldTests.hs | 4 +-- 5 files changed, 109 insertions(+), 76 deletions(-) diff --git a/src/BinaryField.hs b/src/BinaryField.hs index 67a6b1a..b5ebfef 100644 --- a/src/BinaryField.hs +++ b/src/BinaryField.hs @@ -39,14 +39,13 @@ instance KnownNat im => GaloisField (BinaryField im) where | even m = pow' ws xs' m' | otherwise = pow' ws' xs' m' where - mul = (binMod (natVal w) .) . binMul + mul = binMul (natVal (witness :: BinaryField im)) ws' = mul ws xs xs' = mul xs xs m' = div m 2 {-# INLINE pow #-} - quad a b c - | b == 0 = sr c - | otherwise = (* (b / a)) <$> binQuad (a * c / (b * b)) + quad _ 0 c = sr c + quad a b c = (* (b / a)) <$> binQuad (a * c / (b * b)) {-# INLINE quad #-} rnd = getRandom {-# INLINE rnd #-} @@ -68,7 +67,7 @@ instance KnownNat im => Fractional (BinaryField im) where 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 (-) #-} @@ -157,8 +156,8 @@ binLog = binLog' 2 {-# 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 diff --git a/src/ExtensionField.hs b/src/ExtensionField.hs index 46e34c0..9add801 100644 --- a/src/ExtensionField.hs +++ b/src/ExtensionField.hs @@ -12,7 +12,7 @@ module ExtensionField import Protolude as P hiding (Semiring, quot, quotRem, rem) -import Control.Monad.Random (Random(..), getRandom) +import Control.Monad.Random (Random(..), StdGen, getRandom, mkStdGen, runRand) import Data.Euclidean (Euclidean(..), GcdDomain(..)) import Data.Poly.Semiring (VPoly, leading, monomial, scale, toPoly, unPoly, pattern X) import Data.Semiring as S (Ring(..), Semiring(..)) @@ -66,11 +66,12 @@ instance IrreducibleMonic k im => GaloisField (ExtensionField k im) where xs' = mul xs xs m' = div m 2 {-# INLINE pow #-} - quad = panic "not implemented." + quad = extensionQuad {-# INLINE quad #-} rnd = getRandom {-# INLINE rnd #-} - sr = panic "not implemented." + sr 0 = Just 0 + sr x = extensionSqrt x {-# INLINE sr #-} ------------------------------------------------------------------------------- @@ -192,7 +193,7 @@ pattern Y <- _ where Y = monomial 0 . EF ------------------------------------------------------------------------------- -- Polynomial inversion algorithm. -polyInv :: GaloisField k => VPoly k -> VPoly k -> VPoly k +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." @@ -207,3 +208,64 @@ polyGCD x y = polyGCD' 0 1 y x polyGCD' s s' r r' = case quot r r' of q -> polyGCD' s' (s - times q s') r' (r - times q r') {-# INLINE polyGCD #-} + +------------------------------------------------------------------------------- +-- Quadratic equations +------------------------------------------------------------------------------- + +-- Check quadratic nonresidue. +isQNR :: IrreducibleMonic k im => ExtensionField k im -> Bool +isQNR x = pow x (shiftR (order x) 1) /= 1 +{-# INLINE isQNR #-} + +-- Factor binary powers. +factor2 :: IrreducibleMonic k im => ExtensionField k im -> (Integer, Int) +factor2 w = factor (order w - 1, 0) + where + factor :: (Integer, Int) -> (Integer, Int) + factor qs@(q, s) + | testBit q 0 = qs + | otherwise = factor (shiftR q 1, s + 1) +{-# INLINE factor2 #-} + +-- Get quadratic nonresidue. +getQNR :: forall k im . IrreducibleMonic k im => ExtensionField k im +getQNR = qnr (runRand rnd (mkStdGen 0)) + where + qnr :: (ExtensionField k im, StdGen) -> ExtensionField k im + qnr (x, g) + | x /= 0 && isQNR x = x + | otherwise = qnr (runRand rnd g) +{-# INLINE getQNR #-} + +-- Extension square root. +extensionSqrt :: forall k im . IrreducibleMonic k im + => ExtensionField k im -> Maybe (ExtensionField k im) +extensionSqrt n + | isQNR n = Nothing + | otherwise = case (factor2 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 + loop :: Int -> ExtensionField k im -> ExtensionField k im + -> ExtensionField k im -> Maybe (ExtensionField k im) + 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 :: ExtensionField k im -> Int -> Int + least 1 j = j + least ti j = least (ti * ti) (j + 1) +{-# INLINE extensionSqrt #-} + +-- Extension quadratic @ax^2+bx+c=0@. +extensionQuad :: IrreducibleMonic k im + => ExtensionField k im -> ExtensionField k im -> ExtensionField k im -> Maybe (ExtensionField k im) +extensionQuad 0 _ _ = Nothing +extensionQuad a b c = (/ (2 * a)) . subtract b <$> sr (b * b - 4 * a * c) +{-# INLINE extensionQuad #-} diff --git a/src/PrimeField.hs b/src/PrimeField.hs index 50a7717..35e3240 100644 --- a/src/PrimeField.hs +++ b/src/PrimeField.hs @@ -36,12 +36,8 @@ instance KnownNat p => GaloisField (PrimeField p) where {-# INLINE quad #-} rnd = getRandom {-# INLINE rnd #-} - sr w@(PF x) - | p == 2 = Just w - | x == 0 = Just w - | otherwise = PF <$> primeSqrt p x - where - p = natVal (witness :: PrimeField p) + sr 0 = Just 0 + sr (PF x) = PF <$> primeSqrt (natVal (witness :: PrimeField p)) x {-# INLINE sr #-} ------------------------------------------------------------------------------- @@ -152,24 +148,25 @@ toInt (PF x) = x -- Check quadratic nonresidue. isQNR :: Integer -> Integer -> Bool -isQNR p n = powModInteger n (shiftR (p - 1) 1) p /= 1 +isQNR p n = powModInteger n (shiftR p 1) p /= 1 {-# INLINE isQNR #-} -- Factor binary powers. factor2 :: Integer -> (Integer, Int) -factor2 p = factor 0 (p - 1) +factor2 p = factor (p - 1, 0) where - factor :: Int -> Integer -> (Integer, Int) - factor s q - | testBit q 0 = (q, s) - | otherwise = factor (s + 1) (shiftR q 1) + factor :: (Integer, Int) -> (Integer, Int) + factor qs@(q, s) + | testBit q 0 = qs + | otherwise = factor (shiftR q 1, s + 1) {-# INLINE factor2 #-} -- Get quadratic nonresidue. getQNR :: Integer -> Integer getQNR p - | p7 == 3 || p7 == 5 = 2 - | otherwise = case find (isQNR p) ps of + | p7 == 3 = 2 + | p7 == 5 = 2 + | otherwise = case find (isQNR p) ps of Just q -> q _ -> panic "no quadratic nonresidue." where @@ -181,20 +178,19 @@ getQNR p primeSqrt :: Integer -> Integer -> Maybe Integer primeSqrt p n | isQNR p n = Nothing - | otherwise = min <*> (-) p <$> case (factor2 p, getQNR p) of + | otherwise = case (factor2 p, getQNR p) of ((q, s), z) -> let zq = powModInteger z q p - nq = powModInteger n (P.quot q 2) p + nq = powModInteger n (shiftR q 1) p nnq = P.rem (n * nq) p in loop s zq (P.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 = P.rem (b * b) p - in loop i b2 (P.rem (t * b2) p) (P.rem (r * b) p) + loop _ _ 0 _ = Just 0 + loop _ _ 1 r = Just r + loop m c t r = let i = least t 0 + b = powModInteger c (bit (m - i - 1)) p + b2 = P.rem (b * b) p + in loop i b2 (P.rem (t * b2) p) (P.rem (r * b) p) where least :: Integer -> Int -> Int least 1 j = j @@ -204,10 +200,6 @@ primeSqrt p n -- 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 +primeQuad 0 _ _ = Nothing +primeQuad a b c = (/ (2 * a)) . subtract b <$> sr (b * b - 4 * a * c) {-# INLINE primeQuad #-} diff --git a/tests/ExtensionFieldTests.hs b/tests/ExtensionFieldTests.hs index 5db24d5..ea9ed97 100644 --- a/tests/ExtensionFieldTests.hs +++ b/tests/ExtensionFieldTests.hs @@ -8,21 +8,6 @@ import Test.Tasty import GaloisFieldTests import PrimeFieldTests -data P111 -instance IrreducibleMonic FS2 P111 where - split _ = X2 + X + 1 -type FS4 = ExtensionField FS2 P111 - -data P1101 -instance IrreducibleMonic FS2 P1101 where - split _ = X3 + X + 1 -type FS8 = ExtensionField FS2 P1101 - -data P1011 -instance IrreducibleMonic FS2 P1011 where - split _ = X3 + X2 + 1 -type FS8' = ExtensionField FS2 P1011 - data P101 instance IrreducibleMonic FS3 P101 where split _ = X2 + 1 @@ -59,15 +44,15 @@ instance IrreducibleMonic FM4 P101 where type FL4 = ExtensionField FM4 P101 instance IrreducibleMonic FVL P101 where - split _ = X2 + 1 + split _ = X2 + 17 type FV2 = ExtensionField FVL P101 instance IrreducibleMonic FXL P101 where - split _ = X2 + 1 + split _ = X2 + 17 type FX2 = ExtensionField FXL P101 instance IrreducibleMonic FZL P101 where - split _ = X2 + 1 + split _ = X2 + 17 type FZ2 = ExtensionField FZL P101 data Pu @@ -87,21 +72,18 @@ 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 ) + [ 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 ) , testEF "Fq6" (witness :: Fq6 ) , testEF "Fq12" (witness :: Fq12 ) ] diff --git a/tests/PrimeFieldTests.hs b/tests/PrimeFieldTests.hs index e6081c0..223abbc 100644 --- a/tests/PrimeFieldTests.hs +++ b/tests/PrimeFieldTests.hs @@ -7,7 +7,6 @@ import Test.Tasty import GaloisFieldTests -type FS2 = PrimeField 2 type FS3 = PrimeField 3 type FS5 = PrimeField 5 type FS7 = PrimeField 7 @@ -26,8 +25,7 @@ type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689 testPrimeField :: TestTree testPrimeField = testGroup "Prime fields" - [ test "FS2" (witness :: FS2) - , test "FS3" (witness :: FS3) + [ test "FS3" (witness :: FS3) , test "FS5" (witness :: FS5) , test "FS7" (witness :: FS7) , test "FM0" (witness :: FM0) From f108994b8c67eaf66c98250d17d071a8c1695a37 Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 7 Aug 2019 11:00:26 +0100 Subject: [PATCH 11/17] Replace division with Euclidean division --- src/GaloisField.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/GaloisField.hs b/src/GaloisField.hs index e68ac4e..0cfb7ae 100644 --- a/src/GaloisField.hs +++ b/src/GaloisField.hs @@ -3,11 +3,11 @@ module GaloisField , GaloisField(..) ) where -import Protolude hiding ((-), one) +import Protolude hiding ((-), one, quot) import Control.Monad.Random (MonadRandom, Random) -import Data.Euclidean (Euclidean) -import Data.Semiring (Ring, (-), one, times) +import Data.Euclidean (Euclidean(..)) +import Data.Semiring (Ring, (-), one) import Test.Tasty.QuickCheck (Arbitrary) import Text.PrettyPrint.Leijen.Text (Pretty) @@ -17,18 +17,17 @@ import Text.PrettyPrint.Leijen.Text (Pretty) -- | Fields. class (Euclidean k, Ring k) => Field k where - {-# MINIMAL (divide | invert) #-} -- Operations -- | Division. divide :: k -> k -> k - divide = (. invert) . times + divide = quot {-# INLINE divide #-} -- | Inversion. invert :: k -> k - invert = divide one + invert = quot one {-# INLINE invert #-} -- | Subtraction. From 1ab9e2ccf4c69040664be113f4b8e9af190d9a00 Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 7 Aug 2019 15:53:36 +0100 Subject: [PATCH 12/17] Add square roots for binary fields and refactor square roots --- src/BinaryField.hs | 41 +----------- src/ExtensionField.hs | 85 +---------------------- src/GaloisField.hs | 126 +++++++++++++++++++++++++++++++++-- src/PrimeField.hs | 83 ++--------------------- tests/BinaryFieldTests.hs | 18 ++--- tests/ExtensionFieldTests.hs | 46 +++++++++---- tests/GaloisFieldTests.hs | 11 ++- tests/PrimeFieldTests.hs | 4 +- 8 files changed, 176 insertions(+), 238 deletions(-) diff --git a/src/BinaryField.hs b/src/BinaryField.hs index b5ebfef..2163830 100644 --- a/src/BinaryField.hs +++ b/src/BinaryField.hs @@ -4,7 +4,7 @@ module BinaryField 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) @@ -29,28 +29,6 @@ instance KnownNat im => GaloisField (BinaryField im) where {-# INLINE deg #-} frob = flip pow 2 {-# INLINE frob #-} - pow w@(BF x) n - | n < 0 = pow (recip w) (P.negate n) - | otherwise = BF (pow' 1 x n) - where - pow' ws xs m - | m == 0 = ws - | m == 1 = ws' - | even m = pow' ws xs' m' - | otherwise = pow' ws' xs' m' - where - mul = binMul (natVal (witness :: BinaryField im)) - ws' = mul ws xs - xs' = mul xs xs - m' = div m 2 - {-# INLINE pow #-} - quad _ 0 c = sr c - quad a b c = (* (b / a)) <$> binQuad (a * c / (b * b)) - {-# INLINE quad #-} - rnd = getRandom - {-# INLINE rnd #-} - sr = panic "not implemented." - {-# INLINE sr #-} ------------------------------------------------------------------------------- -- Numeric instances @@ -195,20 +173,3 @@ binInv f x = case binInv' 0 1 x f of where q = max 0 (binLog r - binLog r') :: Int {-# INLINE binInv #-} - -------------------------------------------------------------------------------- --- Quadratic equations -------------------------------------------------------------------------------- - --- 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 9add801..905157a 100644 --- a/src/ExtensionField.hs +++ b/src/ExtensionField.hs @@ -12,7 +12,7 @@ module ExtensionField import Protolude as P hiding (Semiring, quot, quotRem, rem) -import Control.Monad.Random (Random(..), StdGen, getRandom, mkStdGen, runRand) +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(..)) @@ -51,28 +51,6 @@ instance IrreducibleMonic k im => GaloisField (ExtensionField k im) where {-# INLINE deg #-} frob = pow <*> char {-# INLINE frob #-} - pow w@(EF x) n - | n < 0 = pow (recip w) (P.negate n) - | otherwise = EF (pow' 1 x n) - where - pow' ws xs m - | m == 0 = ws - | m == 1 = ws' - | even m = pow' ws xs' m' - | otherwise = pow' ws' xs' m' - where - mul = (flip rem (split w) .) . times - ws' = mul ws xs - xs' = mul xs xs - m' = div m 2 - {-# INLINE pow #-} - quad = extensionQuad - {-# INLINE quad #-} - rnd = getRandom - {-# INLINE rnd #-} - sr 0 = Just 0 - sr x = extensionSqrt x - {-# INLINE sr #-} ------------------------------------------------------------------------------- -- Numeric instances @@ -208,64 +186,3 @@ polyGCD x y = polyGCD' 0 1 y x polyGCD' s s' r r' = case quot r r' of q -> polyGCD' s' (s - times q s') r' (r - times q r') {-# INLINE polyGCD #-} - -------------------------------------------------------------------------------- --- Quadratic equations -------------------------------------------------------------------------------- - --- Check quadratic nonresidue. -isQNR :: IrreducibleMonic k im => ExtensionField k im -> Bool -isQNR x = pow x (shiftR (order x) 1) /= 1 -{-# INLINE isQNR #-} - --- Factor binary powers. -factor2 :: IrreducibleMonic k im => ExtensionField k im -> (Integer, Int) -factor2 w = factor (order w - 1, 0) - where - factor :: (Integer, Int) -> (Integer, Int) - factor qs@(q, s) - | testBit q 0 = qs - | otherwise = factor (shiftR q 1, s + 1) -{-# INLINE factor2 #-} - --- Get quadratic nonresidue. -getQNR :: forall k im . IrreducibleMonic k im => ExtensionField k im -getQNR = qnr (runRand rnd (mkStdGen 0)) - where - qnr :: (ExtensionField k im, StdGen) -> ExtensionField k im - qnr (x, g) - | x /= 0 && isQNR x = x - | otherwise = qnr (runRand rnd g) -{-# INLINE getQNR #-} - --- Extension square root. -extensionSqrt :: forall k im . IrreducibleMonic k im - => ExtensionField k im -> Maybe (ExtensionField k im) -extensionSqrt n - | isQNR n = Nothing - | otherwise = case (factor2 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 - loop :: Int -> ExtensionField k im -> ExtensionField k im - -> ExtensionField k im -> Maybe (ExtensionField k im) - 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 :: ExtensionField k im -> Int -> Int - least 1 j = j - least ti j = least (ti * ti) (j + 1) -{-# INLINE extensionSqrt #-} - --- Extension quadratic @ax^2+bx+c=0@. -extensionQuad :: IrreducibleMonic k im - => ExtensionField k im -> ExtensionField k im -> ExtensionField k im -> Maybe (ExtensionField k im) -extensionQuad 0 _ _ = Nothing -extensionQuad a b c = (/ (2 * a)) . subtract b <$> sr (b * b - 4 * a * c) -{-# INLINE extensionQuad #-} diff --git a/src/GaloisField.hs b/src/GaloisField.hs index 0cfb7ae..dfb706f 100644 --- a/src/GaloisField.hs +++ b/src/GaloisField.hs @@ -5,14 +5,15 @@ module GaloisField 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) ------------------------------------------------------------------------------- --- Types +-- Classes ------------------------------------------------------------------------------- -- | Fields. @@ -38,7 +39,7 @@ class (Euclidean k, Ring k) => Field k where -- | Galois fields @GF(p^q)@ for @p@ prime and @q@ non-negative. class (Arbitrary k, Eq k, Field k, Fractional k, Generic k, Ord k, Pretty k, Random k, Show k) => GaloisField k where - {-# MINIMAL char, deg, frob, pow, quad, rnd, sr #-} + {-# MINIMAL char, deg, frob #-} -- Characteristics @@ -58,14 +59,125 @@ class (Arbitrary k, Eq k, Field k, Fractional k, -- Functions - -- | Exponentiation of a field element to an integer. + -- | Exponentiation of field element to integer. pow :: k -> Integer -> k - - -- | Solve quadratic @ax^2+bx+c=0@ over field. + 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 #-} + + -- | 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 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 35e3240..855656e 100644 --- a/src/PrimeField.hs +++ b/src/PrimeField.hs @@ -5,11 +5,11 @@ module PrimeField 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 (Field(..), GaloisField(..)) @@ -24,21 +24,14 @@ newtype PrimeField (p :: Nat) = PF Integer -- 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 (PF x) n = PF (powModInteger x n (natVal (witness :: PrimeField p))) + pow (PF x) n = PF (powModInteger x n (natVal (witness :: PrimeField p))) {-# INLINE pow #-} - quad = primeQuad - {-# INLINE quad #-} - rnd = getRandom - {-# INLINE rnd #-} - sr 0 = Just 0 - sr (PF x) = PF <$> primeSqrt (natVal (witness :: PrimeField p)) x - {-# INLINE sr #-} ------------------------------------------------------------------------------- -- Numeric instances @@ -121,7 +114,7 @@ instance KnownNat p => Semiring (PrimeField p) where -- Prime fields are arbitrary. instance KnownNat p => Arbitrary (PrimeField p) where - arbitrary = fromInteger <$> arbitrary + arbitrary = PF <$> choose (0, natVal (witness :: PrimeField p) - 1) -- Prime fields are pretty. instance KnownNat p => Pretty (PrimeField p) where @@ -141,65 +134,3 @@ instance KnownNat p => Random (PrimeField p) where toInt :: PrimeField p -> Integer toInt (PF x) = x {-# INLINABLE toInt #-} - -------------------------------------------------------------------------------- --- Quadratic equations -------------------------------------------------------------------------------- - --- Check quadratic nonresidue. -isQNR :: Integer -> Integer -> Bool -isQNR p n = powModInteger n (shiftR p 1) p /= 1 -{-# INLINE isQNR #-} - --- Factor binary powers. -factor2 :: Integer -> (Integer, Int) -factor2 p = factor (p - 1, 0) - where - factor :: (Integer, Int) -> (Integer, Int) - factor qs@(q, s) - | testBit q 0 = qs - | otherwise = factor (shiftR q 1, s + 1) -{-# INLINE factor2 #-} - --- Get quadratic nonresidue. -getQNR :: Integer -> Integer -getQNR p - | p7 == 3 = 2 - | 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 = case (factor2 p, getQNR p) of - ((q, s), z) -> let zq = powModInteger z q p - nq = powModInteger n (shiftR q 1) p - nnq = P.rem (n * nq) p - in loop s zq (P.rem (nq * nnq) p) nnq - where - loop :: Int -> Integer -> Integer -> Integer -> Maybe Integer - loop _ _ 0 _ = Just 0 - loop _ _ 1 r = Just r - loop m c t r = let i = least t 0 - b = powModInteger c (bit (m - i - 1)) p - b2 = P.rem (b * b) p - in loop i b2 (P.rem (t * b2) p) (P.rem (r * b) p) - where - least :: Integer -> Int -> Int - least 1 j = j - least ti j = least (P.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 0 _ _ = Nothing -primeQuad a b c = (/ (2 * a)) . subtract b <$> sr (b * b - 4 * a * c) -{-# INLINE primeQuad #-} 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 ea9ed97..30d1db7 100644 --- a/tests/ExtensionFieldTests.hs +++ b/tests/ExtensionFieldTests.hs @@ -8,6 +8,21 @@ import Test.Tasty import GaloisFieldTests import PrimeFieldTests +data P111 +instance IrreducibleMonic FS2 P111 where + split _ = X2 + X + 1 +type FS4 = ExtensionField FS2 P111 + +data P1101 +instance IrreducibleMonic FS2 P1101 where + split _ = X3 + X + 1 +type FS8 = ExtensionField FS2 P1101 + +data P1011 +instance IrreducibleMonic FS2 P1011 where + split _ = X3 + X2 + 1 +type FS8' = ExtensionField FS2 P1011 + data P101 instance IrreducibleMonic FS3 P101 where split _ = X2 + 1 @@ -72,18 +87,21 @@ type Fq12 = ExtensionField Fq6 Pw testExtensionField :: TestTree testExtensionField = testGroup "Extension fields" - [ 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 ) - , 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..77a4a40 100644 --- a/tests/GaloisFieldTests.hs +++ b/tests/GaloisFieldTests.hs @@ -45,14 +45,14 @@ 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" +quadraticEquations _ = localOption (QuickCheckTests 10) $ testGroup "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) @@ -61,8 +61,5 @@ quadraticEquations _ = testGroup "Quadratic equations" 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] - -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] diff --git a/tests/PrimeFieldTests.hs b/tests/PrimeFieldTests.hs index 223abbc..e6081c0 100644 --- a/tests/PrimeFieldTests.hs +++ b/tests/PrimeFieldTests.hs @@ -7,6 +7,7 @@ import Test.Tasty import GaloisFieldTests +type FS2 = PrimeField 2 type FS3 = PrimeField 3 type FS5 = PrimeField 5 type FS7 = PrimeField 7 @@ -25,7 +26,8 @@ type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689 testPrimeField :: TestTree testPrimeField = testGroup "Prime fields" - [ test "FS3" (witness :: FS3) + [ test "FS2" (witness :: FS2) + , test "FS3" (witness :: FS3) , test "FS5" (witness :: FS5) , test "FS7" (witness :: FS7) , test "FM0" (witness :: FM0) From d8b8abbde30acea02e44c0a0e1667063f15cbb7f Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 7 Aug 2019 16:43:19 +0100 Subject: [PATCH 13/17] Update README --- README.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index a16cc6c..e8c975f 100644 --- a/README.md +++ b/README.md @@ -44,6 +44,7 @@ Include the following required language extensions. {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} ``` Import the following functions at minimum. ```haskell @@ -101,7 +102,7 @@ instance IrreducibleMonic Fq6 P12 where type Fq12 = ExtensionField Fq6 P12 ``` -Note that `X` accesses the current indeterminate variable and `Y` 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 From 1b3f0f3532f9402092c08d98909812a71768e0de Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 7 Aug 2019 17:01:44 +0100 Subject: [PATCH 14/17] Add rewrite rules for exponentiation --- src/BinaryField.hs | 4 ++++ src/ExtensionField.hs | 4 ++++ src/GaloisField.hs | 2 +- src/PrimeField.hs | 4 ++++ 4 files changed, 13 insertions(+), 1 deletion(-) diff --git a/src/BinaryField.hs b/src/BinaryField.hs index 2163830..9c32f59 100644 --- a/src/BinaryField.hs +++ b/src/BinaryField.hs @@ -30,6 +30,10 @@ instance KnownNat im => GaloisField (BinaryField im) where frob = flip pow 2 {-# INLINE frob #-} +{-# RULES "BinaryField/pow" + forall (k :: BinaryField im) => BinaryField im) n . (^) k n = pow k n + #-} + ------------------------------------------------------------------------------- -- Numeric instances ------------------------------------------------------------------------------- diff --git a/src/ExtensionField.hs b/src/ExtensionField.hs index 905157a..73a7f69 100644 --- a/src/ExtensionField.hs +++ b/src/ExtensionField.hs @@ -52,6 +52,10 @@ instance IrreducibleMonic k im => GaloisField (ExtensionField k im) where frob = pow <*> char {-# INLINE frob #-} +{-# RULES "ExtensionField/pow" + forall (k :: IrreducibleMonic k im => ExtensionField k im) n . (^) k n = pow k n + #-} + ------------------------------------------------------------------------------- -- Numeric instances ------------------------------------------------------------------------------- diff --git a/src/GaloisField.hs b/src/GaloisField.hs index dfb706f..0bcae7c 100644 --- a/src/GaloisField.hs +++ b/src/GaloisField.hs @@ -37,7 +37,7 @@ class (Euclidean k, Ring k) => Field k where {-# INLINE minus #-} -- | Galois fields @GF(p^q)@ for @p@ prime and @q@ non-negative. -class (Arbitrary k, Eq k, Field k, Fractional k, +class (Arbitrary k, Field k, Fractional k, Generic k, Ord k, Pretty k, Random k, Show k) => GaloisField k where {-# MINIMAL char, deg, frob #-} diff --git a/src/PrimeField.hs b/src/PrimeField.hs index 855656e..382d61e 100644 --- a/src/PrimeField.hs +++ b/src/PrimeField.hs @@ -33,6 +33,10 @@ instance KnownNat p => GaloisField (PrimeField p) where pow (PF x) n = PF (powModInteger x n (natVal (witness :: PrimeField p))) {-# INLINE pow #-} +{-# RULES "PrimeField/pow" + forall (k :: KnownNat p => PrimeField p) (n :: Integer) . (^) k n = pow k n + #-} + ------------------------------------------------------------------------------- -- Numeric instances ------------------------------------------------------------------------------- From b6623b772d65a109d950ab65adfa12add0de2590 Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 7 Aug 2019 17:03:09 +0100 Subject: [PATCH 15/17] Fix compilation error --- src/BinaryField.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/BinaryField.hs b/src/BinaryField.hs index 9c32f59..e02c6b0 100644 --- a/src/BinaryField.hs +++ b/src/BinaryField.hs @@ -31,7 +31,7 @@ instance KnownNat im => GaloisField (BinaryField im) where {-# INLINE frob #-} {-# RULES "BinaryField/pow" - forall (k :: BinaryField im) => BinaryField im) n . (^) k n = pow k n + forall (k :: KnownNat im => BinaryField im) n . (^) k n = pow k n #-} ------------------------------------------------------------------------------- From b4c7e91a9a1bdbf87d66f10c3de396a0f35ddd4c Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 7 Aug 2019 17:26:49 +0100 Subject: [PATCH 16/17] Fix prime field square roots --- src/GaloisField.hs | 1 + tests/GaloisFieldTests.hs | 8 ++------ 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/src/GaloisField.hs b/src/GaloisField.hs index 0bcae7c..4ff3081 100644 --- a/src/GaloisField.hs +++ b/src/GaloisField.hs @@ -164,6 +164,7 @@ squareRoot n -- 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) diff --git a/tests/GaloisFieldTests.hs b/tests/GaloisFieldTests.hs index 77a4a40..06a9d55 100644 --- a/tests/GaloisFieldTests.hs +++ b/tests/GaloisFieldTests.hs @@ -49,17 +49,13 @@ 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 _ = localOption (QuickCheckTests 10) $ 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] +test s x = testGroup s [fieldAxioms x, squareRoots x] test' :: forall k . GaloisField k => TestName -> k -> TestTree test' s x = testGroup s [fieldAxioms x] From 41e295d20acd6a91ca680cd1482bdbaa02969a5f Mon Sep 17 00:00:00 2001 From: Multramate Date: Wed, 7 Aug 2019 17:27:40 +0100 Subject: [PATCH 17/17] Update change log --- ChangeLog.md | 11 +++++++++++ package.yaml | 6 +++--- 2 files changed, 14 insertions(+), 3 deletions(-) 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/package.yaml b/package.yaml index 3577661..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) @@ -24,8 +24,8 @@ default-extensions: - PatternSynonyms dependencies: - - base >= 4.7 && < 5 - - protolude >= 0.2 + - base + - protolude - integer-gmp - MonadRandom - poly