galois-field 0.4.1 → 1.0.0
raw patch · 36 files changed
+1666/−1207 lines, 36 filesdep +galois-fielddep +groupsdep ~basedep ~polydep ~protoludePVP ok
version bump matches the API change (PVP)
Dependencies added: galois-field, groups
Dependency ranges changed: base, poly, protolude, semirings
API changes (from Hackage documentation)
- BinaryField: data BinaryField (im :: Nat)
- BinaryField: instance GHC.Classes.Eq (BinaryField.BinaryField im)
- BinaryField: instance GHC.Classes.Ord (BinaryField.BinaryField im)
- BinaryField: instance GHC.Generics.Generic (BinaryField.BinaryField im)
- BinaryField: instance GHC.Show.Show (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => Data.Euclidean.Euclidean (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => Data.Euclidean.GcdDomain (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => Data.Semiring.Ring (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => Data.Semiring.Semiring (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => GHC.Num.Num (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => GHC.Real.Fractional (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => GaloisField.Field (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => GaloisField.GaloisField (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => System.Random.Random (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => Test.QuickCheck.Arbitrary.Arbitrary (BinaryField.BinaryField im)
- BinaryField: instance GHC.TypeNats.KnownNat im => Text.PrettyPrint.Leijen.Text.Pretty (BinaryField.BinaryField im)
- ExtensionField: class GaloisField k => IrreducibleMonic k im
- ExtensionField: data ExtensionField k im
- ExtensionField: fromField :: ExtensionField k im -> [k]
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => Data.Euclidean.Euclidean (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => Data.Euclidean.GcdDomain (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => Data.Semiring.Ring (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => Data.Semiring.Semiring (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => GHC.Num.Num (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => GHC.Real.Fractional (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => GaloisField.Field (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => GaloisField.GaloisField (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => System.Random.Random (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => Test.QuickCheck.Arbitrary.Arbitrary (ExtensionField.ExtensionField k im)
- ExtensionField: instance ExtensionField.IrreducibleMonic k im => Text.PrettyPrint.Leijen.Text.Pretty (ExtensionField.ExtensionField k im)
- ExtensionField: instance GHC.Classes.Eq k => GHC.Classes.Eq (ExtensionField.ExtensionField k im)
- ExtensionField: instance GHC.Classes.Ord k => GHC.Classes.Ord (ExtensionField.ExtensionField k im)
- ExtensionField: instance GHC.Generics.Generic (ExtensionField.ExtensionField k im)
- ExtensionField: instance GHC.Show.Show k => GHC.Show.Show (ExtensionField.ExtensionField k im)
- ExtensionField: pattern X :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a, Eq (v a)) => () => Poly v a
- ExtensionField: pattern Y :: IrreducibleMonic k im => VPoly k -> VPoly (ExtensionField k im)
- ExtensionField: split :: IrreducibleMonic k im => ExtensionField k im -> VPoly k
- ExtensionField: toField :: forall k im. IrreducibleMonic k im => [k] -> ExtensionField k im
- ExtensionField: type PolynomialRing = VPoly
- GaloisField: char :: GaloisField k => k -> Integer
- GaloisField: class (Euclidean k, Ring k) => Field k
- GaloisField: class (Arbitrary k, Field k, Fractional k, Generic k, Ord k, Pretty k, Random k, Show k) => GaloisField k
- GaloisField: deg :: GaloisField k => k -> Int
- GaloisField: divide :: Field k => k -> k -> k
- GaloisField: frob :: GaloisField k => k -> k
- GaloisField: invert :: Field k => k -> k
- GaloisField: minus :: Field k => k -> k -> k
- GaloisField: order :: GaloisField k => k -> Integer
- GaloisField: pow :: GaloisField k => k -> Integer -> k
- GaloisField: qnr :: GaloisField k => k
- GaloisField: qr :: GaloisField k => k -> Bool
- GaloisField: quad :: GaloisField k => k -> k -> k -> Maybe k
- GaloisField: rnd :: (GaloisField k, MonadRandom m) => m k
- GaloisField: sr :: GaloisField k => k -> Maybe k
- PrimeField: data PrimeField (p :: Nat)
- PrimeField: instance Data.Bits.Bits (PrimeField.PrimeField p)
- PrimeField: instance GHC.Classes.Eq (PrimeField.PrimeField p)
- PrimeField: instance GHC.Classes.Ord (PrimeField.PrimeField p)
- PrimeField: instance GHC.Generics.Generic (PrimeField.PrimeField p)
- PrimeField: instance GHC.Show.Show (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => Data.Euclidean.Euclidean (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => Data.Euclidean.GcdDomain (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => Data.Semiring.Ring (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => Data.Semiring.Semiring (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => GHC.Num.Num (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => GHC.Real.Fractional (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => GaloisField.Field (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => GaloisField.GaloisField (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => System.Random.Random (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => Test.QuickCheck.Arbitrary.Arbitrary (PrimeField.PrimeField p)
- PrimeField: instance GHC.TypeNats.KnownNat p => Text.PrettyPrint.Leijen.Text.Pretty (PrimeField.PrimeField p)
- PrimeField: toInt :: PrimeField p -> Integer
+ Data.Field.Galois: (*^) :: TowerOfFields k l => k -> l -> l
+ Data.Field.Galois: cardinality :: forall n k. (KnownNat n, GaloisField k) => RootsOfUnity n k -> Natural
+ Data.Field.Galois: char :: GaloisField k => k -> Natural
+ Data.Field.Galois: class GaloisField k => BinaryField k
+ Data.Field.Galois: class Group g => CyclicSubgroup g
+ Data.Field.Galois: class GaloisField k => ExtensionField k
+ Data.Field.Galois: class (Arbitrary k, Field k, Fractional k, Generic k, Group k, NFData k, Ord k, Pretty k, Random k, Show k) => GaloisField k
+ Data.Field.Galois: class GaloisField k => IrreducibleMonic p k
+ Data.Field.Galois: class GaloisField k => PrimeField k
+ Data.Field.Galois: class (GaloisField k, GaloisField l) => TowerOfFields k l
+ Data.Field.Galois: cofactor :: forall n k. (KnownNat n, GaloisField k) => RootsOfUnity n k -> Natural
+ Data.Field.Galois: conj :: IrreducibleMonic p k => Extension p k -> Extension p k
+ Data.Field.Galois: data Binary (p :: Nat)
+ Data.Field.Galois: data Extension p k
+ Data.Field.Galois: data Prime (p :: Nat)
+ Data.Field.Galois: data RootsOfUnity (n :: Nat) k
+ Data.Field.Galois: deg :: GaloisField k => k -> Word
+ Data.Field.Galois: embed :: TowerOfFields k l => k -> l
+ Data.Field.Galois: frob :: GaloisField k => k -> k
+ Data.Field.Galois: fromB :: BinaryField k => k -> Integer
+ Data.Field.Galois: fromE :: (ExtensionField k, GaloisField l, IrreducibleMonic p l, k ~ Extension p l) => k -> [l]
+ Data.Field.Galois: fromP :: PrimeField k => k -> Integer
+ Data.Field.Galois: gen :: CyclicSubgroup g => g
+ Data.Field.Galois: infixl 7 *^
+ Data.Field.Galois: isPrimitiveRootOfUnity :: (KnownNat n, GaloisField k) => RootsOfUnity n k -> Bool
+ Data.Field.Galois: isRootOfUnity :: (KnownNat n, GaloisField k) => RootsOfUnity n k -> Bool
+ Data.Field.Galois: order :: GaloisField k => k -> Natural
+ Data.Field.Galois: pattern U3 :: IrreducibleMonic p k => Extension p k
+ Data.Field.Galois: pattern Y :: IrreducibleMonic p k => VPoly k -> VPoly (Extension p k)
+ Data.Field.Galois: pattern V :: IrreducibleMonic p k => k -> Extension p k
+ Data.Field.Galois: poly :: IrreducibleMonic p k => Extension p k -> VPoly k
+ Data.Field.Galois: pow :: (GaloisField k, Integral n) => k -> n -> k
+ Data.Field.Galois: qnr :: GaloisField k => Maybe k
+ Data.Field.Galois: qr :: GaloisField k => k -> Bool
+ Data.Field.Galois: quad :: GaloisField k => k -> k -> k -> Maybe k
+ Data.Field.Galois: rnd :: (GaloisField k, MonadRandom m) => m k
+ Data.Field.Galois: rndR :: (GaloisField k, MonadRandom m) => (k, k) -> m k
+ Data.Field.Galois: sr :: GaloisField k => k -> Maybe k
+ Data.Field.Galois: toB :: KnownNat p => Integer -> Binary p
+ Data.Field.Galois: toB' :: KnownNat p => Integer -> Binary p
+ Data.Field.Galois: toE :: forall k p. IrreducibleMonic p k => [k] -> Extension p k
+ Data.Field.Galois: toE' :: forall k p. IrreducibleMonic p k => [k] -> Extension p k
+ Data.Field.Galois: toP :: KnownNat p => Integer -> Prime p
+ Data.Field.Galois: toP' :: KnownNat p => Integer -> Prime p
+ Data.Field.Galois: toU :: forall n k. (KnownNat n, GaloisField k) => k -> RootsOfUnity n k
+ Data.Field.Galois: toU' :: forall n k. (KnownNat n, GaloisField k) => k -> RootsOfUnity n k
Files
- ChangeLog.md +29/−1
- README.md +37/−54
- bench/Bench/Binary.hs +20/−0
- bench/Bench/Extension.hs +34/−0
- bench/Bench/Galois.hs +27/−0
- bench/Bench/Prime.hs +20/−0
- bench/Main.hs +13/−0
- benchmarks/BinaryFieldBenchmarks.hs +0/−17
- benchmarks/ExtensionFieldBenchmarks.hs +0/−91
- benchmarks/GaloisFieldBenchmarks.hs +0/−23
- benchmarks/Main.hs +0/−13
- benchmarks/PrimeFieldBenchmarks.hs +0/−17
- galois-field.cabal +41/−42
- src/BinaryField.hs +0/−179
- src/Data/Field/Galois.hs +26/−0
- src/Data/Field/Galois/Base.hs +47/−0
- src/Data/Field/Galois/Binary.hs +272/−0
- src/Data/Field/Galois/Extension.hs +257/−0
- src/Data/Field/Galois/Frobenius.hs +41/−0
- src/Data/Field/Galois/Prime.hs +215/−0
- src/Data/Field/Galois/Sqrt.hs +134/−0
- src/Data/Field/Galois/Tower.hs +68/−0
- src/Data/Field/Galois/Unity.hs +117/−0
- src/ExtensionField.hs +0/−193
- src/GaloisField.hs +0/−184
- src/PrimeField.hs +0/−140
- test/Main.hs +13/−0
- test/Test/Binary.hs +31/−0
- test/Test/Extension.hs +107/−0
- test/Test/Galois.hs +76/−0
- test/Test/Prime.hs +41/−0
- tests/BinaryFieldTests.hs +0/−31
- tests/ExtensionFieldTests.hs +0/−107
- tests/GaloisFieldTests.hs +0/−61
- tests/Main.hs +0/−13
- tests/PrimeFieldTests.hs +0/−41
ChangeLog.md view
@@ -1,12 +1,39 @@ # Change log for galois-field +## 1.0.0++* Refactor library structure from `GaloisField` to `Data.Field.Galois`.+* Add `Field` export for Galois fields.+* Add `Semiring` dependency for Galois fields.+* Rename `PrimeField` to `Prime` and add `PrimeField` class.+* Rename `ExtensionField` to `Extension` and add `ExtensionField` class.+* Rename `BinaryField` to `Binary` and add `BinaryField` class.+* Rename `split` to `poly` and swap `IrreducibleMonic` parameters.+* Rename `toInt`, `toField`, `fromField` to `from`, `to` conversion functions.+* Replace `Integer` with `Natural`.+* Add `CyclicSubgroup` class with generator function.+* Add `RootsOfUnity` type with cofactor, check, and conversion functions.+* Add `TowerOfFields` class with embed and scalar multiplication functions.+* Add `Bounded` instances for prime fields and binary fields.+* Add `Enum` instances for prime fields and binary fields.+* Add `Group` instances for Galois fields.+* Add `Hashable` instances for prime fields and binary fields.+* Add `Integral` instances for prime fields and binary fields.+* Add `IsList` instances for Galois fields.+* Add `Real` instances for prime fields and binary fields.+* Add `rndR` function for Galois fields.+* Add `conj` function for extension fields.+* Add minor optimisations to exponentiation with `SPECIALISE`.+* Add major optimisations to `frob` function.+* Add pattern synonyms for field elements.+ ## 0.4.1 * Add compilation optimisations with `INLINABLE`. ## 0.4.0 -* Add `Vector` implementation of extension fields.+* Add `Poly` dependency for extension fields. * Add `qnr` function for Galois fields. * Add `qr` function for Galois fields. * Add `quad` function for extension fields and binary fields.@@ -14,6 +41,7 @@ * Add `Semiring` instances for Galois fields. * Add `Ord` instances for Galois fields. * Add minor optimisations to exponentiation with `RULES`.+* Add pattern synonyms for monic monomials. ## 0.3.0
README.md view
@@ -27,9 +27,9 @@ ### Extension fields -Any Galois field has order a prime power p^q for prime p and positive q, and there is a Galois field GF(p^q) of any prime power order p^q that is *unique up to non-unique isomorphism*. Any Galois field GF(p^q) can be constructed as an **extension field** over a smaller Galois subfield GF(p^r), through the identification GF(p^q) = GF(p^r)[X] / \<f(X)\> for an *irreducible monic splitting polynomial* f(X) of degree q - r + 1 in the *polynomial ring* GF(p^r)[X].+Any Galois field has order a prime power p^q for prime p and positive q, and there is a Galois field GF(p^q) of any prime power order p^q that is *unique up to non-unique isomorphism*. Any Galois field GF(p^q) can be constructed as an **extension field** over a smaller Galois subfield GF(p^r), through the identification GF(p^q) = GF(p^r)[X] / \<f(X)\> for an *irreducible monic polynomial* f(X) of degree q - r + 1 in the *polynomial ring* GF(p^r)[X]. -For example, GF(4) has order 2^2 and can be constructed as an extension field GF(2)[X] / \<f(X)\> where f(X) = X^2 + X + 1 is an irreducible monic splitting quadratic polynomial in GF(2)[X].+For example, GF(4) has order 2^2 and can be constructed as an extension field GF(2)[X] / \<f(X)\> where f(X) = X^2 + X + 1 is an irreducible monic quadratic polynomial in GF(2)[X]. ### Binary fields @@ -44,21 +44,20 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE PatternSynonyms #-} ``` Import the following functions at minimum. ```haskell-import PrimeField (PrimeField)-import ExtensionField (ExtensionField, IrreducibleMonic(split), toField,- pattern X, pattern X2, pattern X3, pattern Y)-import BinaryField (BinaryField)+import Data.Field.Galois (Prime, Extension, IrreducibleMonic(poly), Binary,+ pattern X, pattern X2, pattern X3, pattern Y) ``` ### Prime fields The following type declaration creates a prime field of a given characteristic. ```haskell-type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583+type Fq = Prime 21888242871839275222246405745257275088696311157297823662689037894645226208583 ``` Note that the characteristic given *must* be prime. @@ -76,95 +75,79 @@ ### Extension fields -The following data type declaration creates a splitting polynomial given an irreducible monic polynomial.+The following data type declaration creates a polynomial given an irreducible monic polynomial. ```haskell data P2-instance IrreducibleMonic Fq P2 where- split _ = X2 + 1+instance IrreducibleMonic P2 Fq where+ poly _ = X2 + 1 ```-The following type declaration then creates an extension field with this splitting polynomial.+The following type declaration then creates an extension field with this polynomial. ```haskell-type Fq2 = ExtensionField Fq P2+type Fq2 = Extension P2 Fq ```-Note that the splitting polynomial given *must* be irreducible and monic in the prime field.+Note that the polynomial given *must* be irreducible and monic in the prime field. Similarly, further extension fields can be constructed iteratively as follows. ```haskell data P6-instance IrreducibleMonic Fq2 P6 where- split _ = X3 - (9 + Y X)+instance IrreducibleMonic P6 Fq2 where+ poly _ = X3 - (9 + Y X) -type Fq6 = ExtensionField Fq2 P6+type Fq6 = Extension P6 Fq2 data P12-instance IrreducibleMonic Fq6 P12 where- split _ = X2 - Y X+instance IrreducibleMonic P12 Fq6 where+ poly _ = X2 - Y X -type Fq12 = ExtensionField Fq6 P12+type Fq12 = Extension P12 Fq6 ``` Note that `X, X2, X3` accesses the current indeterminate variables and `Y` descends the tower of indeterminate variables. Galois field arithmetic can then be performed in this extension field. ```haskell fq12 :: Fq12-fq12 = toField- [ toField- [ toField- [ 4025484419428246835913352650763180341703148406593523188761836807196412398582+fq12 =+ [ [ [ 4025484419428246835913352650763180341703148406593523188761836807196412398582 , 5087667423921547416057913184603782240965080921431854177822601074227980319916 ]- , toField- [ 8868355606921194740459469119392835913522089996670570126495590065213716724895+ , [ 8868355606921194740459469119392835913522089996670570126495590065213716724895 , 12102922015173003259571598121107256676524158824223867520503152166796819430680 ]- , toField- [ 92336131326695228787620679552727214674825150151172467042221065081506740785+ , [ 92336131326695228787620679552727214674825150151172467042221065081506740785 , 5482141053831906120660063289735740072497978400199436576451083698548025220729 ] ]- , toField- [ toField- [ 7642691434343136168639899684817459509291669149586986497725240920715691142493+ , [ [ 7642691434343136168639899684817459509291669149586986497725240920715691142493 , 1211355239100959901694672926661748059183573115580181831221700974591509515378 ]- , toField- [ 20725578899076721876257429467489710434807801418821512117896292558010284413176+ , [ 20725578899076721876257429467489710434807801418821512117896292558010284413176 , 17642016461759614884877567642064231230128683506116557502360384546280794322728 ]- , toField- [ 17449282511578147452934743657918270744212677919657988500433959352763226500950+ , [ 17449282511578147452934743657918270744212677919657988500433959352763226500950 , 1205855382909824928004884982625565310515751070464736233368671939944606335817 ] ] ] fq12' :: Fq12-fq12' = toField- [ toField- [ toField- [ 495492586688946756331205475947141303903957329539236899715542920513774223311+fq12' =+ [ [ [ 495492586688946756331205475947141303903957329539236899715542920513774223311 , 9283314577619389303419433707421707208215462819919253486023883680690371740600 ]- , toField- [ 11142072730721162663710262820927009044232748085260948776285443777221023820448+ , [ 11142072730721162663710262820927009044232748085260948776285443777221023820448 , 1275691922864139043351956162286567343365697673070760209966772441869205291758 ]- , toField- [ 20007029371545157738471875537558122753684185825574273033359718514421878893242+ , [ 20007029371545157738471875537558122753684185825574273033359718514421878893242 , 9839139739201376418106411333971304469387172772449235880774992683057627654905 ] ]- , toField- [ toField- [ 9503058454919356208294350412959497499007919434690988218543143506584310390240+ , [ [ 9503058454919356208294350412959497499007919434690988218543143506584310390240 , 19236630380322614936323642336645412102299542253751028194541390082750834966816 ]- , toField- [ 18019769232924676175188431592335242333439728011993142930089933693043738917983+ , [ 18019769232924676175188431592335242333439728011993142930089933693043738917983 , 11549213142100201239212924317641009159759841794532519457441596987622070613872 ]- , toField- [ 9656683724785441232932664175488314398614795173462019188529258009817332577664+ , [ 9656683724785441232932664175488314398614795173462019188529258009817332577664 , 20666848762667934776817320505559846916719041700736383328805334359135638079015 ] ]@@ -179,17 +162,17 @@ ``` where `X, Y, Z` is a tower of indeterminate variables, is constructed by ```haskell-toField [ toField [toField [a, b], toField [c, d], toField [e, f]]- , toField [toField [g, h], toField [i, j], toField [k, l]] ] :: Fq12+[ [ [a, b], [c, d], [e, f] ]+, [ [g, h], [i, j], [k, l] ] ] :: Fq12 ``` ### Binary fields -The following type declaration creates a binary field modulo a given splitting irreducible binary polynomial.+The following type declaration creates a binary field modulo a given irreducible binary polynomial. ```haskell-type F2m = BinaryField 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425+type F2m = Binary 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425 ```-Note that the splitting polynomial given *must* be irreducible in F2.+Note that the polynomial given *must* be irreducible in F2. Galois field arithmetic can then be performed in this binary field. ```haskell
+ bench/Bench/Binary.hs view
@@ -0,0 +1,20 @@+module Bench.Binary where++import Protolude++import Control.Monad.Random+import Criterion.Main+import Data.Field.Galois++import Bench.Galois++type F2m = Binary 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425++f2m :: F2m+f2m = evalRand getRandom $ mkStdGen 0++f2m' :: F2m+f2m' = evalRand getRandom $ mkStdGen 1++benchBinary :: Benchmark+benchBinary = benchmark "Binary" f2m f2m'
+ bench/Bench/Extension.hs view
@@ -0,0 +1,34 @@+module Bench.Extension where++import Protolude++import Control.Monad.Random+import Criterion.Main+import Data.Field.Galois++import Bench.Galois+import Bench.Prime++data PU+instance IrreducibleMonic PU Fq where+ poly _ = X2 + 1+type Fq2 = Extension PU Fq++data PV+instance IrreducibleMonic PV Fq2 where+ poly _ = X3 - 9 - Y X+type Fq6 = Extension PV Fq2++data PW+instance IrreducibleMonic PW Fq6 where+ poly _ = X2 - Y X+type Fq12 = Extension PW Fq6++fq12 :: Fq12+fq12 = evalRand getRandom $ mkStdGen 0++fq12' :: Fq12+fq12' = evalRand getRandom $ mkStdGen 1++benchExtension :: Benchmark+benchExtension = benchmark "Extension" fq12 fq12'
+ bench/Bench/Galois.hs view
@@ -0,0 +1,27 @@+module Bench.Galois where++import Protolude++import Criterion.Main+import Data.Field.Galois hiding (recip, (/))+import GHC.Base++benchmark :: GaloisField k => String -> k -> k -> Benchmark+benchmark s a b = bgroup s+ [ bench "Addition" $+ nf (uncurry (+)) (a, b)+ , bench "Multiplication" $+ nf (uncurry (*)) (a, b)+ , bench "Negation" $+ nf negate a+ , bench "Subtraction" $+ nf (uncurry (-)) (a, b)+ , bench "Inversion" $+ nf recip a+ , bench "Division" $+ nf (uncurry (/)) (a, b)+ , bench "Frobenius endomorphism" $+ nf frob a+ , bench "Square root" $+ nf sr a+ ]
+ bench/Bench/Prime.hs view
@@ -0,0 +1,20 @@+module Bench.Prime where++import Protolude++import Control.Monad.Random+import Criterion.Main+import Data.Field.Galois++import Bench.Galois++type Fq = Prime 21888242871839275222246405745257275088696311157297823662689037894645226208583++fq :: Fq+fq = evalRand getRandom $ mkStdGen 0++fq' :: Fq+fq' = evalRand getRandom $ mkStdGen 1++benchPrime :: Benchmark+benchPrime = benchmark "Prime" fq fq'
+ bench/Main.hs view
@@ -0,0 +1,13 @@+module Main where++import Protolude++import Criterion.Main++import Bench.Binary+import Bench.Extension+import Bench.Prime++main :: IO ()+main = defaultMain+ [benchBinary, benchExtension, benchPrime]
− benchmarks/BinaryFieldBenchmarks.hs
@@ -1,17 +0,0 @@-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'
− benchmarks/ExtensionFieldBenchmarks.hs
@@ -1,91 +0,0 @@-module ExtensionFieldBenchmarks where--import Protolude--import Criterion.Main-import ExtensionField--import GaloisFieldBenchmarks-import PrimeFieldBenchmarks--data Pu-instance IrreducibleMonic Fq Pu where- split _ = X2 + 1-type Fq2 = ExtensionField Fq Pu--data Pv-instance IrreducibleMonic Fq2 Pv where- split _ = X3 - 9 - Y X-type Fq6 = ExtensionField Fq2 Pv--data Pw-instance IrreducibleMonic Fq6 Pw where- split _ = X2 - Y X-type Fq12 = ExtensionField Fq6 Pw--fq12 :: Fq12-fq12 = toField- [ toField- [ toField- [ 4025484419428246835913352650763180341703148406593523188761836807196412398582- , 5087667423921547416057913184603782240965080921431854177822601074227980319916- ]- , toField- [ 8868355606921194740459469119392835913522089996670570126495590065213716724895- , 12102922015173003259571598121107256676524158824223867520503152166796819430680- ]- , toField- [ 92336131326695228787620679552727214674825150151172467042221065081506740785- , 5482141053831906120660063289735740072497978400199436576451083698548025220729- ]- ]- , toField- [ toField- [ 7642691434343136168639899684817459509291669149586986497725240920715691142493- , 1211355239100959901694672926661748059183573115580181831221700974591509515378- ]- , toField- [ 20725578899076721876257429467489710434807801418821512117896292558010284413176- , 17642016461759614884877567642064231230128683506116557502360384546280794322728- ]- , toField- [ 17449282511578147452934743657918270744212677919657988500433959352763226500950- , 1205855382909824928004884982625565310515751070464736233368671939944606335817- ]- ]- ]--fq12' :: Fq12-fq12' = toField- [ toField- [ toField- [ 495492586688946756331205475947141303903957329539236899715542920513774223311- , 9283314577619389303419433707421707208215462819919253486023883680690371740600- ]- , toField- [ 11142072730721162663710262820927009044232748085260948776285443777221023820448- , 1275691922864139043351956162286567343365697673070760209966772441869205291758- ]- , toField- [ 20007029371545157738471875537558122753684185825574273033359718514421878893242- , 9839139739201376418106411333971304469387172772449235880774992683057627654905- ]- ]- , toField- [ toField- [ 9503058454919356208294350412959497499007919434690988218543143506584310390240- , 19236630380322614936323642336645412102299542253751028194541390082750834966816- ]- , toField- [ 18019769232924676175188431592335242333439728011993142930089933693043738917983- , 11549213142100201239212924317641009159759841794532519457441596987622070613872- ]- , toField- [ 9656683724785441232932664175488314398614795173462019188529258009817332577664- , 20666848762667934776817320505559846916719041700736383328805334359135638079015- ]- ]- ]--benchmarkExtensionField :: Benchmark-benchmarkExtensionField = benchmark "ExtensionField Fq12" fq12 fq12'
− benchmarks/GaloisFieldBenchmarks.hs
@@ -1,23 +0,0 @@-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)- ]
− benchmarks/Main.hs
@@ -1,13 +0,0 @@-module Main where--import Protolude--import Criterion.Main--import BinaryFieldBenchmarks-import ExtensionFieldBenchmarks-import PrimeFieldBenchmarks--main :: IO ()-main = defaultMain- [benchmarkBinaryField, benchmarkExtensionField, benchmarkPrimeField]
− benchmarks/PrimeFieldBenchmarks.hs
@@ -1,17 +0,0 @@-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'
galois-field.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4e436d9365d8254a628fd2f0a1ce476eb6073af326050f22b8aac993adf97375+-- hash: 4ec66cf45e03db7c043a78fe75435c0909e60ebf77e5ef4a2adef098ba4b12b9 name: galois-field-version: 0.4.1+version: 1.0.0 synopsis: Galois field library description: An efficient implementation of Galois fields used in cryptography research category: Cryptography@@ -27,23 +27,28 @@ library exposed-modules:- BinaryField- ExtensionField- GaloisField- PrimeField+ Data.Field.Galois other-modules:- Paths_galois_field+ Data.Field.Galois.Base+ Data.Field.Galois.Binary+ Data.Field.Galois.Extension+ Data.Field.Galois.Frobenius+ Data.Field.Galois.Prime+ Data.Field.Galois.Sqrt+ Data.Field.Galois.Tower+ Data.Field.Galois.Unity hs-source-dirs: src- default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms- ghc-options: -Wall+ default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveFunctor DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses OverloadedLists PatternSynonyms TypeFamilies+ ghc-options: -freverse-errors -O2 -Wall build-depends: MonadRandom , base >=4.10 && <5+ , groups , integer-gmp- , poly- , protolude- , semirings+ , poly >=0.3.2+ , protolude >=0.2 && <0.3+ , semirings >=0.5 , tasty-quickcheck , vector , wl-pprint-text@@ -53,27 +58,24 @@ type: exitcode-stdio-1.0 main-is: Main.hs other-modules:- BinaryFieldTests- ExtensionFieldTests- GaloisFieldTests- PrimeFieldTests- BinaryField- ExtensionField- GaloisField- PrimeField+ Test.Binary+ Test.Extension+ Test.Galois+ Test.Prime Paths_galois_field hs-source-dirs:- tests- src- default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms- ghc-options: -Wall -main-is Main+ test+ default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveFunctor DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses OverloadedLists PatternSynonyms TypeFamilies+ ghc-options: -freverse-errors -O2 -Wall -main-is Main build-depends: MonadRandom , base >=4.10 && <5+ , galois-field+ , groups , integer-gmp- , poly- , protolude- , semirings+ , poly >=0.3.2+ , protolude >=0.2 && <0.3+ , semirings >=0.5 , tasty , tasty-quickcheck , vector@@ -84,28 +86,25 @@ type: exitcode-stdio-1.0 main-is: Main.hs other-modules:- BinaryFieldBenchmarks- ExtensionFieldBenchmarks- GaloisFieldBenchmarks- PrimeFieldBenchmarks- BinaryField- ExtensionField- GaloisField- PrimeField+ Bench.Binary+ Bench.Extension+ Bench.Galois+ Bench.Prime Paths_galois_field hs-source-dirs:- benchmarks- src- default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms- ghc-options: -Wall -main-is Main+ bench+ default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveFunctor DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses OverloadedLists PatternSynonyms TypeFamilies+ ghc-options: -freverse-errors -O2 -Wall -main-is Main build-depends: MonadRandom , base >=4.10 && <5 , criterion+ , galois-field+ , groups , integer-gmp- , poly- , protolude- , semirings+ , poly >=0.3.2+ , protolude >=0.2 && <0.3+ , semirings >=0.5 , tasty-quickcheck , vector , wl-pprint-text
− src/BinaryField.hs
@@ -1,179 +0,0 @@-module BinaryField- ( BinaryField- ) where--import Protolude as P hiding (Semiring)--import Control.Monad.Random (Random(..))-import Data.Euclidean (Euclidean(..), GcdDomain(..))-import Data.Semiring (Ring(..), Semiring(..))-import Test.Tasty.QuickCheck (Arbitrary(..), choose)-import Text.PrettyPrint.Leijen.Text (Pretty(..))--import GaloisField (Field(..), GaloisField(..))------------------------------------------------------------------------------------ Data types------------------------------------------------------------------------------------ | Binary fields @GF(2^q)[X]/\<f(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, Ord, Show)---- Binary fields are Galois fields.-instance KnownNat im => GaloisField (BinaryField im) where- char = const 2- {-# INLINABLE char #-}- deg = binLog . natVal- {-# INLINABLE deg #-}- frob = flip pow 2- {-# INLINABLE frob #-}--{-# RULES "BinaryField/pow"- forall (k :: KnownNat im => BinaryField im) n . (^) k n = pow k n- #-}------------------------------------------------------------------------------------ Numeric instances------------------------------------------------------------------------------------ Binary fields are fractional.-instance KnownNat im => Fractional (BinaryField im) where- recip (BF x) = BF (binInv x (natVal (witness :: BinaryField im)))- {-# INLINE recip #-}- fromRational (x:%y) = fromInteger x / fromInteger y- {-# INLINABLE fromRational #-}---- Binary fields are numeric.-instance KnownNat im => Num (BinaryField im) where- BF x + BF y = BF (xor x y)- {-# INLINE (+) #-}- BF x * BF y = BF (binMul (natVal (witness :: BinaryField im)) x y)- {-# INLINE (*) #-}- BF x - BF y = BF (xor x y)- {-# INLINE (-) #-}- negate = identity- {-# INLINE negate #-}- fromInteger = BF . binMod (natVal (witness :: BinaryField im))- {-# INLINABLE fromInteger #-}- 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."---- 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- {-# INLINABLE fromNatural #-}------------------------------------------------------------------------------------ Other instances------------------------------------------------------------------------------------ Binary fields are arbitrary.-instance KnownNat im => Arbitrary (BinaryField im) where- arbitrary = BF <$> choose (0, order (witness :: BinaryField im) - 1)- {-# INLINABLE arbitrary #-}---- Binary fields are pretty.-instance KnownNat im => Pretty (BinaryField im) where- pretty (BF x) = pretty x---- Binary fields are random.-instance KnownNat im => Random (BinaryField im) where- random = first BF . randomR (0, order (witness :: BinaryField im) - 1)- {-# INLINABLE random #-}- randomR = panic "not implemented."------------------------------------------------------------------------------------ Binary arithmetic------------------------------------------------------------------------------------ Binary logarithm.-binLog :: Integer -> Int-binLog = binLog' 2- where- binLog' :: Integer -> Integer -> Int- binLog' p x- | x < p = 0- | otherwise = case binLog' (p * p) x of- 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'' (P.quot y p) (n + 1)-{-# INLINE binLog #-}---- Binary multiplication.-binMul :: Integer -> Integer -> Integer -> Integer-binMul = (. binMul' 0) . (.) . binMod- where- binMul' :: Integer -> Integer -> Integer -> Integer- binMul' n x y- | y == 0 = n- | testBit y 0 = binMul' (xor n x) x' y'- | otherwise = binMul' n x' y'- where- x' = shiftL x 1 :: Integer- y' = shiftR y 1 :: Integer-{-# INLINE binMul #-}---- Binary modulus.-binMod :: Integer -> Integer -> Integer-binMod f = binMod'- where- m = binLog f :: Int- binMod' :: Integer -> Integer- binMod' x- | n < 0 = x- | otherwise = binMod' (xor x (shiftL f n))- where- n = binLog x - m :: Int-{-# INLINE binMod #-}---- Binary inversion.-binInv :: Integer -> Integer -> Integer-binInv f x = case binInv' 0 1 x f of- (y, 1) -> y- _ -> panic "no multiplicative inverse."- where- binInv' :: Integer -> Integer -> Integer -> Integer -> (Integer, Integer)- binInv' s s' r r'- | r' == 0 = (s, r)- | otherwise = binInv' s' (xor s (shift s' q)) r' (xor r (shift r' q))- where- q = max 0 (binLog r - binLog r') :: Int-{-# INLINE binInv #-}
+ src/Data/Field/Galois.hs view
@@ -0,0 +1,26 @@+module Data.Field.Galois+ ( module Data.Field+ -- * Galois fields+ , module Data.Field.Galois.Base+ -- ** Prime fields+ , module Data.Field.Galois.Prime+ -- ** Extension fields+ , module Data.Field.Galois.Extension+ -- ** Binary fields+ , module Data.Field.Galois.Binary+ -- ** Square roots+ , module Data.Field.Galois.Sqrt+ -- ** Towers of fields+ , module Data.Field.Galois.Tower+ -- ** Roots of unity+ , module Data.Field.Galois.Unity+ ) where++import Data.Field+import Data.Field.Galois.Base+import Data.Field.Galois.Binary+import Data.Field.Galois.Extension+import Data.Field.Galois.Prime+import Data.Field.Galois.Sqrt+import Data.Field.Galois.Tower+import Data.Field.Galois.Unity
+ src/Data/Field/Galois/Base.hs view
@@ -0,0 +1,47 @@+module Data.Field.Galois.Base+ ( module Data.Field.Galois.Base+ ) where++import Protolude hiding ((-), one, quot)++import Control.Monad.Random (Random)+import Data.Field (Field)+import qualified Data.Group as G (Group(..))+import GHC.Natural (Natural)+import Test.Tasty.QuickCheck (Arbitrary)+import Text.PrettyPrint.Leijen.Text (Pretty)++-------------------------------------------------------------------------------+-- Classes+-------------------------------------------------------------------------------++-- | Galois fields @GF(p^q)@ for @p@ prime and @q@ non-negative.+class (Arbitrary k, Field k, Fractional k, Generic k, G.Group k,+ NFData k, Ord k, Pretty k, Random k, Show k) => GaloisField k where+ {-# MINIMAL char, deg, frob #-}++ -- | Characteristic @p@ of field and order of prime subfield.+ char :: k -> Natural++ -- | Degree @q@ of field as extension field over prime subfield.+ deg :: k -> Word++ -- | Frobenius endomorphism @x -> x^p@ of prime subfield.+ frob :: k -> k++ -- | Order @p^q@ of field.+ order :: k -> Natural+ order = (^) <$> char <*> deg+ {-# INLINABLE order #-}++-- | Exponentiation of field element to integer.+pow :: (GaloisField k, Integral n) => k -> n -> k+pow = G.pow+{-# INLINABLE pow #-}++{-# SPECIALISE pow ::+ GaloisField k => k -> Int -> k,+ GaloisField k => k -> Integer -> k,+ GaloisField k => k -> Natural -> k,+ GaloisField k => k -> Word -> k+ #-}
+ src/Data/Field/Galois/Binary.hs view
@@ -0,0 +1,272 @@+module Data.Field.Galois.Binary+ ( Binary+ , BinaryField+ , fromB+ , toB+ , toB'+ ) where++import Protolude as P hiding (Semiring, natVal)++import Control.Monad.Random (Random(..))+import Data.Euclidean as S (Euclidean(..), GcdDomain)+import Data.Field (Field)+import Data.Group (Group(..))+import Data.Semiring (Ring(..), Semiring(..))+import GHC.Exts (IsList(..))+import GHC.Natural (Natural, naturalFromInteger, naturalToInteger)+import GHC.TypeNats (natVal)+import Test.Tasty.QuickCheck (Arbitrary(..), choose)+import Text.PrettyPrint.Leijen.Text (Pretty(..))++import Data.Field.Galois.Base (GaloisField(..))++-------------------------------------------------------------------------------+-- Data types+-------------------------------------------------------------------------------++-- | Binary fields @GF(2^q)[X]/\<f(X)\>@ for @q@ positive and+-- @f(X)@ irreducible monic in @GF(2^q)[X]@ encoded as an integer.+class GaloisField k => BinaryField k where+ {-# MINIMAL fromB #-}+ -- | Convert from @GF(2^q)[X]/\<f(X)\>@ to @Z@.+ fromB :: k -> Integer++-- | Binary field elements.+newtype Binary (p :: Nat) = B Natural+ deriving (Bits, Eq, Generic, Hashable, NFData, Ord, Show)++-- Binary fields are convertible.+instance KnownNat p => BinaryField (Binary p) where+ fromB (B x) = naturalToInteger x+ {-# INLINABLE fromB #-}++-- Binary fields are Galois fields.+instance KnownNat p => GaloisField (Binary p) where+ char = const 2+ {-# INLINABLE char #-}+ deg = binLog . natVal+ {-# INLINABLE deg #-}+ frob = join (*)+ {-# INLINABLE frob #-}++{-# RULES "Binary.pow"+ forall (k :: KnownNat p => Binary p) n . (^) k n = pow k n+ #-}++-------------------------------------------------------------------------------+-- Group instances+-------------------------------------------------------------------------------++-- Binary fields are multiplicative groups.+instance KnownNat p => Group (Binary p) where+ invert = recip+ {-# INLINE invert #-}+ pow x n+ | n >= 0 = x ^ n+ | otherwise = recip x ^ P.negate n+ {-# INLINE pow #-}++-- Binary fields are multiplicative monoids.+instance KnownNat p => Monoid (Binary p) where+ mempty = B 1+ {-# INLINE mempty #-}++-- Binary fields are multiplicative semigroups.+instance KnownNat p => Semigroup (Binary p) where+ (<>) = (*)+ {-# INLINE (<>) #-}+ stimes = flip pow+ {-# INLINE stimes #-}++-------------------------------------------------------------------------------+-- Numeric instances+-------------------------------------------------------------------------------++-- Binary fields are fractional.+instance KnownNat p => Fractional (Binary p) where+ recip (B x) = B $ binInv x $ natVal (witness :: Binary p)+ {-# INLINE recip #-}+ fromRational (x:%y) = fromInteger x / fromInteger y+ {-# INLINABLE fromRational #-}++-- Binary fields are numeric.+instance KnownNat p => Num (Binary p) where+ B x + B y = B $ xor x y+ {-# INLINE (+) #-}+ B x * B y = B $ binMul (natVal (witness :: Binary p)) x y+ {-# INLINE (*) #-}+ B x - B y = B $ xor x y+ {-# INLINE (-) #-}+ negate = identity+ {-# INLINE negate #-}+ fromInteger = B . binMod (natVal (witness :: Binary p)) . naturalFromInteger+ {-# INLINABLE fromInteger #-}+ abs = panic "Binary.abs: not implemented."+ signum = panic "Binary.signum: not implemented."++-------------------------------------------------------------------------------+-- Semiring instances+-------------------------------------------------------------------------------++-- Binary fields are Euclidean domains.+instance KnownNat p => Euclidean (Binary p) where+ degree = panic "Binary.degree: not implemented."+ quotRem = (flip (,) 0 .) . (/)+ {-# INLINE quotRem #-}++-- Binary fields are fields.+instance KnownNat p => Field (Binary p) where++-- Binary fields are GCD domains.+instance KnownNat p => GcdDomain (Binary p)++-- Binary fields are rings.+instance KnownNat p => Ring (Binary p) where+ negate = P.negate+ {-# INLINE negate #-}++-- Binary fields are semirings.+instance KnownNat p => Semiring (Binary p) where+ fromNatural = fromIntegral+ {-# INLINABLE fromNatural #-}+ one = B 1+ {-# INLINE one #-}+ plus = (+)+ {-# INLINE plus #-}+ times = (*)+ {-# INLINE times #-}+ zero = B 0+ {-# INLINE zero #-}++-------------------------------------------------------------------------------+-- Other instances+-------------------------------------------------------------------------------++-- Binary fields are arbitrary.+instance KnownNat p => Arbitrary (Binary p) where+ arbitrary = B . naturalFromInteger <$>+ choose (0, naturalToInteger $ order (witness :: Binary p) - 1)+ {-# INLINABLE arbitrary #-}++-- Binary fields are lists.+instance KnownNat p => IsList (Binary p) where+ type instance Item (Binary p) = Natural+ fromList = fromIntegral . foldr' ((. flip shiftL 1) . (+)) 0+ {-# INLINABLE fromList #-}+ toList (B x) = unfoldr unfold x+ where+ unfold y = if y == 0 then Nothing else Just (y .&. 1, shiftR y 1)+ {-# INLINABLE toList #-}++-- Binary fields are bounded.+instance KnownNat p => Bounded (Binary p) where+ maxBound = B $ order (witness :: Binary p) - 1+ {-# INLINE maxBound #-}+ minBound = B 0+ {-# INLINE minBound #-}++-- Binary fields are enumerable.+instance KnownNat p => Enum (Binary p) where+ fromEnum = fromIntegral+ {-# INLINABLE fromEnum #-}+ toEnum = fromIntegral+ {-# INLINABLE toEnum #-}++-- Binary fields are integral.+instance KnownNat p => Integral (Binary p) where+ quotRem = S.quotRem+ {-# INLINE quotRem #-}+ toInteger = fromB+ {-# INLINABLE toInteger #-}++-- Binary fields are pretty.+instance KnownNat p => Pretty (Binary p) where+ pretty (B x) = pretty $ naturalToInteger x++-- Binary fields are random.+instance KnownNat p => Random (Binary p) where+ random = randomR (B 0, B $ natVal (witness :: Binary p) - 1)+ {-# INLINABLE random #-}+ randomR (a, b) = first (B . naturalFromInteger) . randomR (fromB a, fromB b)+ {-# INLINABLE randomR #-}++-- Binary fields are real.+instance KnownNat p => Real (Binary p) where+ toRational = fromIntegral+ {-# INLINABLE toRational #-}++-------------------------------------------------------------------------------+-- Auxiliary functions+-------------------------------------------------------------------------------++-- | Safe convert from @Z@ to @GF(2^q)[X]/\<f(X)\>@.+toB :: KnownNat p => Integer -> Binary p+toB = fromInteger+{-# INLINABLE toB #-}++-- | Unsafe convert from @Z@ to @GF(2^q)[X]/\<f(X)\>@.+toB' :: KnownNat p => Integer -> Binary p+toB' = B . naturalFromInteger+{-# INLINABLE toB' #-}++-------------------------------------------------------------------------------+-- Binary arithmetic+-------------------------------------------------------------------------------++-- Binary logarithm.+binLog :: Natural -> Word+binLog = binLog' 2+ where+ binLog' :: Natural -> Natural -> Word+ binLog' p x+ | x < p = 0+ | otherwise = case binLog' (p * p) x of+ l -> let l' = 2 * l in binLog'' (P.quot x $ p ^ l') l'+ where+ binLog'' :: Natural -> Word -> Word+ binLog'' y n+ | y < p = n+ | otherwise = binLog'' (P.quot y p) (n + 1)+{-# INLINE binLog #-}++-- Binary multiplication.+binMul :: Natural -> Natural -> Natural -> Natural+binMul = (. binMul' 0) . (.) . binMod+ where+ binMul' :: Natural -> Natural -> Natural -> Natural+ binMul' n x y+ | y == 0 = n+ | testBit y 0 = binMul' (xor n x) x' y'+ | otherwise = binMul' n x' y'+ where+ x' = shiftL x 1 :: Natural+ y' = shiftR y 1 :: Natural+{-# INLINE binMul #-}++-- Binary modulus.+binMod :: Natural -> Natural -> Natural+binMod f = binMod'+ where+ m = fromIntegral $ binLog f :: Int+ binMod' :: Natural -> Natural+ binMod' x+ | n < 0 = x+ | otherwise = binMod' (xor x $ shiftL f n)+ where+ n = fromIntegral (binLog x) - m :: Int+{-# INLINE binMod #-}++-- Binary inversion.+binInv :: Natural -> Natural -> Natural+binInv f x = case binInv' 0 1 x f of+ (y, 1) -> y+ _ -> divZeroError+ where+ binInv' :: Natural -> Natural -> Natural -> Natural -> (Natural, Natural)+ binInv' s s' r r'+ | r' == 0 = (s, r)+ | otherwise = binInv' s' (xor s $ shift s' q) r' (xor r $ shift r' q)+ where+ q = max 0 $ fromIntegral (binLog r) - fromIntegral (binLog r') :: Int+{-# INLINE binInv #-}
+ src/Data/Field/Galois/Extension.hs view
@@ -0,0 +1,257 @@+module Data.Field.Galois.Extension+ ( Extension+ , ExtensionField+ , IrreducibleMonic(..)+ , fromE+ , conj+ , toE+ , toE'+ , pattern U+ , pattern U2+ , pattern U3+ , pattern V+ , pattern X+ , pattern X2+ , pattern X3+ , pattern Y+ ) where++import Protolude as P hiding (Semiring, rem, toList)++import Control.Monad.Random (Random(..))+import Data.Euclidean (Euclidean(..), GcdDomain)+import Data.Field (Field)+import Data.Group (Group(..))+import Data.Poly (VPoly, gcdExt, monomial, toPoly, unPoly)+import Data.Semiring (Ring(..), Semiring(..))+import GHC.Exts (IsList(..))+import Test.Tasty.QuickCheck (Arbitrary(..), vector)+import Text.PrettyPrint.Leijen.Text (Pretty(..))++import Data.Field.Galois.Base (GaloisField(..))+import Data.Field.Galois.Frobenius (frobenius)++-------------------------------------------------------------------------------+-- Data types+-------------------------------------------------------------------------------++-- | Irreducible monic polynomial @f(X)@ of extension field.+class GaloisField k => IrreducibleMonic p k where+ {-# MINIMAL poly #-}+ -- | Polynomial @f(X)@.+ poly :: Extension p k -> VPoly k++-- | Extension fields @GF(p^q)[X]/\<f(X)\>@ for @p@ prime, @q@ positive, and+-- @f(X)@ irreducible monic in @GF(p^q)[X]@.+class GaloisField k => ExtensionField k where+ {-# MINIMAL fromE #-}+ -- | Convert from @GF(p^q)[X]/\<f(X)\>@ to @GF(p^q)[X]@.+ fromE :: (GaloisField l, IrreducibleMonic p l, k ~ Extension p l) => k -> [l]++-- | Extension field elements.+newtype Extension p k = E (VPoly k)+ deriving (Eq, Generic, NFData, Ord, Show)++-- Extension fields are convertible.+instance IrreducibleMonic p k => ExtensionField (Extension p k) where+ fromE = toList+ {-# INLINABLE fromE #-}++-- Extension fields are Galois fields.+instance IrreducibleMonic p k => GaloisField (Extension p k) where+ char = const $ char (witness :: k)+ {-# INLINABLE char #-}+ deg = (deg (witness :: k) *) . deg'+ {-# INLINABLE deg #-}+ frob y@(E x) = case frobenius (unPoly x) (unPoly $ poly y) of+ Just z -> E $ toPoly z+ Nothing -> pow y $ char y+ {-# INLINABLE frob #-}++{-# RULES "Extension.pow"+ forall (k :: IrreducibleMonic p k => Extension p k) n . (^) k n = pow k n+ #-}++-------------------------------------------------------------------------------+-- Group instances+-------------------------------------------------------------------------------++-- Extension fields are multiplicative groups.+instance IrreducibleMonic p k => Group (Extension p k) where+ invert = recip+ {-# INLINE invert #-}+ pow x n+ | n >= 0 = x ^ n+ | otherwise = recip x ^ P.negate n+ {-# INLINE pow #-}++-- Extension fields are multiplicative monoids.+instance IrreducibleMonic p k => Monoid (Extension p k) where+ mempty = E 1+ {-# INLINE mempty #-}++-- Extension fields are multiplicative semigroups.+instance IrreducibleMonic p k => Semigroup (Extension p k) where+ (<>) = (*)+ {-# INLINE (<>) #-}+ stimes = flip pow+ {-# INLINE stimes #-}++-------------------------------------------------------------------------------+-- Numeric instances+-------------------------------------------------------------------------------++-- Extension fields are fractional.+instance IrreducibleMonic p k => Fractional (Extension p k) where+ recip (E x) = case gcdExt x $ poly (witness :: Extension p k) of+ (1, y) -> E y+ _ -> divZeroError+ {-# INLINABLE recip #-}+ fromRational (x:%y) = fromInteger x / fromInteger y+ {-# INLINABLE fromRational #-}++-- Extension fields are numeric.+instance IrreducibleMonic p k => Num (Extension p k) where+ E x + E y = E $ x + y+ {-# INLINE (+) #-}+ E x * E y = E $ rem (x * y) $ poly (witness :: Extension p k)+ {-# INLINABLE (*) #-}+ E x - E y = E $ x - y+ {-# INLINE (-) #-}+ negate (E x) = E $ P.negate x+ {-# INLINE negate #-}+ fromInteger = E . fromInteger+ {-# INLINABLE fromInteger #-}+ abs = panic "Extension.abs: not implemented."+ signum = panic "Extension.signum: not implemented."++-------------------------------------------------------------------------------+-- Semiring instances+-------------------------------------------------------------------------------++-- Extension fields are Euclidean domains.+instance IrreducibleMonic p k => Euclidean (Extension p k) where+ degree = panic "Extension.degree: not implemented."+ quotRem = (flip (,) 0 .) . (/)+ {-# INLINE quotRem #-}++-- Extension fields are fields.+instance IrreducibleMonic p k => Field (Extension p k)++-- Extension fields are GCD domains.+instance IrreducibleMonic p k => GcdDomain (Extension p k)++-- Extension fields are rings.+instance IrreducibleMonic p k => Ring (Extension p k) where+ negate = P.negate+ {-# INLINE negate #-}++-- Extension fields are semirings.+instance IrreducibleMonic p k => Semiring (Extension p k) where+ fromNatural = fromIntegral+ {-# INLINABLE fromNatural #-}+ one = E 1+ {-# INLINE one #-}+ plus = (+)+ {-# INLINE plus #-}+ times = (*)+ {-# INLINE times #-}+ zero = E 0+ {-# INLINE zero #-}++-------------------------------------------------------------------------------+-- Other instances+-------------------------------------------------------------------------------++-- Extension fields are arbitrary.+instance IrreducibleMonic p k => Arbitrary (Extension p k) where+ arbitrary = fromList <$> vector (fromIntegral $ deg' (witness :: Extension p k))+ {-# INLINABLE arbitrary #-}++-- Extension fields are lists.+instance IrreducibleMonic p k => IsList (Extension p k) where+ type instance Item (Extension p k) = k+ fromList = E . fromList+ {-# INLINABLE fromList #-}+ toList (E x) = toList $ unPoly x+ {-# INLINABLE toList #-}++-- Extension fields are pretty.+instance IrreducibleMonic p k => Pretty (Extension p k) where+ pretty (E x) = pretty $ toList x++-- Extension fields are random.+instance IrreducibleMonic p k => Random (Extension p k) where+ random = first fromList . unfold (deg' (witness :: Extension p k)) []+ where+ unfold n xs g+ | n <= 0 = (xs, g)+ | otherwise = case random g of+ (x, g') -> unfold (n - 1) (x : xs) g'+ {-# INLINABLE random #-}+ randomR = panic "Extension.randomR: not implemented."++-------------------------------------------------------------------------------+-- Auxiliary functions+-------------------------------------------------------------------------------++-- Polynomial degree.+deg' :: IrreducibleMonic p k => Extension p k -> Word+deg' = pred . fromIntegral . degree . poly+{-# INLINABLE deg' #-}++-- | Complex conjugation @a+bi -> a-bi@ of quadratic extension field.+conj :: IrreducibleMonic p k => Extension p k -> Extension p k+conj y@(E x) = case unPoly $ poly y of+ [_, 0, 1] -> case x of+ [a, b] -> [a, P.negate b]+ [a] -> [a]+ _ -> []+ _ -> panic "Extension.conj: extension degree is not two."+{-# INLINABLE conj #-}++-- | Safe convert from @GF(p^q)[X]@ to @GF(p^q)[X]/\<f(X)\>@.+toE :: forall k p . IrreducibleMonic p k => [k] -> Extension p k+toE = E . flip rem (poly (witness :: Extension p k)) . fromList+{-# INLINABLE toE #-}++-- | Unsafe convert from @GF(p^q)[X]@ to @GF(p^q)[X]/\<f(X)\>@.+toE' :: forall k p . IrreducibleMonic p k => [k] -> Extension p k+toE' = fromList+{-# INLINABLE toE' #-}++-------------------------------------------------------------------------------+-- Pattern synonyms+-------------------------------------------------------------------------------++-- | Pattern for field element @U@.+pattern U :: IrreducibleMonic p k => Extension p k+pattern U <- _ where U = [0, 1]++-- | Pattern for field element @U^2@.+pattern U2 :: IrreducibleMonic p k => Extension p k+pattern U2 <- _ where U2 = toE [0, 0, 1]++-- | Pattern for field element @U^3@.+pattern U3 :: IrreducibleMonic p k => Extension p k+pattern U3 <- _ where U3 = toE [0, 0, 0, 1]++-- | Pattern for descending tower of indeterminate variables for field elements.+pattern V :: IrreducibleMonic p k => k -> Extension p k+pattern V <- _ where V = E . monomial 0++-- | Pattern for monic monomial @X@.+pattern X :: GaloisField k => VPoly k+pattern X <- _ where X = [0, 1]++-- | Pattern for monic monomial @X^2@.+pattern X2 :: GaloisField k => VPoly k+pattern X2 <- _ where X2 = [0, 0, 1]++-- | Pattern for monic monomial @X^3@.+pattern X3 :: GaloisField k => VPoly k+pattern X3 <- _ where X3 = [0, 0, 0, 1]++-- | Pattern for descending tower of indeterminate variables for monic monomials.+pattern Y :: IrreducibleMonic p k => VPoly k -> VPoly (Extension p k)+pattern Y <- _ where Y = monomial 0 . E
+ src/Data/Field/Galois/Frobenius.hs view
@@ -0,0 +1,41 @@+module Data.Field.Galois.Frobenius+ ( frobenius+ ) where++import Protolude++import Data.Vector (Vector)++import Data.Field.Galois.Base (GaloisField(..))++-------------------------------------------------------------------------------+-- Functions+-------------------------------------------------------------------------------++-- | Frobenius endomorphism precomputation.+frobenius :: GaloisField k => Vector k -> Vector k -> Maybe (Vector k)+frobenius [ ] _ = Just []+frobenius [a] _ = Just [frob a]+frobenius [a, b] [x, 0, 1]+ | deg x == 2 = Just [a, negate b]+ | char x == 2 = Just [frob a - frob b * x]+ | otherwise = Just [frob a, frob b * nxq]+ where+ nxq = negate x ^ shiftR (char x) 1+frobenius [a, b] [x, 0, 0, 1]+ | char x == 3 = Just [frob a - frob b * x]+ | r == 1 = Just [frob a, frob b * nxq]+ | otherwise = Just [frob a, 0, frob b * nxq]+ where+ (q, r) = quotRem (char x) 3+ nxq = negate x ^ q+frobenius [a, b, c] [x, 0, 0, 1]+ | char x == 3 = Just [frob a - (frob b - frob c * x) * x]+ | r == 1 = Just [frob a, frob b * nxq, frob c * nxq * nxq]+ | otherwise = Just [frob a, frob c * nx * nxq * nxq, frob b * nxq]+ where+ (q, r) = quotRem (char x) 3+ nx = negate x+ nxq = nx ^ q+frobenius _ _ = Nothing+{-# INLINABLE frobenius #-}
+ src/Data/Field/Galois/Prime.hs view
@@ -0,0 +1,215 @@+module Data.Field.Galois.Prime+ ( Prime+ , PrimeField+ , fromP+ , toP+ , toP'+ ) where++import Protolude as P hiding (Semiring, natVal, rem)++import Control.Monad.Random (Random(..))+import Data.Euclidean as S (Euclidean(..), GcdDomain)+import Data.Field (Field)+import Data.Group (Group(..))+import Data.Semiring (Ring(..), Semiring(..))+import GHC.Integer.GMP.Internals (recipModInteger)+import GHC.Natural (Natural, naturalFromInteger, naturalToInteger, powModNatural)+import GHC.TypeNats (natVal)+import Test.Tasty.QuickCheck (Arbitrary(..), choose)+import Text.PrettyPrint.Leijen.Text (Pretty(..))++import Data.Field.Galois.Base (GaloisField(..))++-------------------------------------------------------------------------------+-- Data types+-------------------------------------------------------------------------------++-- | Prime fields @GF(p) = Z/pZ@ for @p@ prime.+class GaloisField k => PrimeField k where+ {-# MINIMAL fromP #-}+ -- | Convert from @GF(p)@ to @Z@.+ fromP :: k -> Integer++-- | Prime field elements.+newtype Prime (p :: Nat) = P Natural+ deriving (Bits, Eq, Generic, Hashable, NFData, Ord, Show)++-- Prime fields are convertible.+instance KnownNat p => PrimeField (Prime p) where+ fromP (P x) = naturalToInteger x+ {-# INLINABLE fromP #-}++-- Prime fields are Galois fields.+instance KnownNat p => GaloisField (Prime p) where+ char = natVal+ {-# INLINABLE char #-}+ deg = const 1+ {-# INLINABLE deg #-}+ frob = identity+ {-# INLINABLE frob #-}++{-# RULES "Prime.pow"+ forall (k :: KnownNat p => Prime p) n . (^) k n = pow k n+ #-}++-------------------------------------------------------------------------------+-- Group instances+-------------------------------------------------------------------------------++-- Prime fields are multiplicative groups.+instance KnownNat p => Group (Prime p) where+ invert = recip+ {-# INLINE invert #-}+ pow y@(P x) n+ | n >= 0 = P $ powModNatural x (fromIntegral n) $ natVal (witness :: Prime p)+ | otherwise = pow (recip y) $ P.negate n+ {-# INLINE pow #-}++-- Prime fields are multiplicative monoids.+instance KnownNat p => Monoid (Prime p) where+ mempty = P 1+ {-# INLINE mempty #-}++-- Prime fields are multiplicative semigroups.+instance KnownNat p => Semigroup (Prime p) where+ (<>) = (*)+ {-# INLINE (<>) #-}+ stimes = flip pow+ {-# INLINE stimes #-}++-------------------------------------------------------------------------------+-- Numeric instances+-------------------------------------------------------------------------------++-- Prime fields are fractional.+instance KnownNat p => Fractional (Prime p) where+ recip (P 0) = divZeroError+ recip (P x) = P $ recipModNatural x $ natVal (witness :: Prime p)+ {-# INLINE recip #-}+ fromRational (x:%y) = fromInteger x / fromInteger y+ {-# INLINABLE fromRational #-}++-- Prime fields are numeric.+instance KnownNat p => Num (Prime p) where+ P x + P y = P $ if xy >= p then xy - p else xy+ where+ xy = x + y+ p = natVal (witness :: Prime p)+ {-# INLINE (+) #-}+ P x * P y = P $ rem (x * y) $ natVal (witness :: Prime p)+ {-# INLINE (*) #-}+ P x - P y = P $ if x >= y then x - y else natVal (witness :: Prime p) + x - y+ {-# INLINE (-) #-}+ negate (P 0) = P 0+ negate (P x) = P $ natVal (witness :: Prime p) - x+ {-# INLINE negate #-}+ fromInteger x = P $ naturalFromInteger $ mod x $ naturalToInteger $ natVal (witness :: Prime p)+ {-# INLINABLE fromInteger #-}+ abs = panic "Prime.abs: not implemented."+ signum = panic "Prime.signum: not implemented."++-------------------------------------------------------------------------------+-- Semiring instances+-------------------------------------------------------------------------------++-- Prime fields are Euclidean domains.+instance KnownNat p => Euclidean (Prime p) where+ degree = panic "Prime.degree: not implemented."+ quotRem = (flip (,) 0 .) . (/)+ {-# INLINE quotRem #-}++-- Prime fields are fields.+instance KnownNat p => Field (Prime p)++-- Prime fields are GCD domains.+instance KnownNat p => GcdDomain (Prime p)++-- Prime fields are rings.+instance KnownNat p => Ring (Prime p) where+ negate = P.negate+ {-# INLINE negate #-}++-- Prime fields are semirings.+instance KnownNat p => Semiring (Prime p) where+ fromNatural = fromIntegral+ {-# INLINABLE fromNatural #-}+ one = P 1+ {-# INLINE one #-}+ plus = (+)+ {-# INLINE plus #-}+ times = (*)+ {-# INLINE times #-}+ zero = P 0+ {-# INLINE zero #-}++-------------------------------------------------------------------------------+-- Other instances+-------------------------------------------------------------------------------++-- Prime fields are arbitrary.+instance KnownNat p => Arbitrary (Prime p) where+ arbitrary = P . naturalFromInteger <$>+ choose (0, naturalToInteger $ natVal (witness :: Prime p) - 1)+ {-# INLINABLE arbitrary #-}++-- Prime fields are bounded.+instance KnownNat p => Bounded (Prime p) where+ maxBound = P $ natVal (witness :: Prime p) - 1+ {-# INLINE maxBound #-}+ minBound = P 0+ {-# INLINE minBound #-}++-- Prime fields are enumerable.+instance KnownNat p => Enum (Prime p) where+ fromEnum = fromIntegral+ {-# INLINABLE fromEnum #-}+ toEnum = fromIntegral+ {-# INLINABLE toEnum #-}++-- Prime fields are integral.+instance KnownNat p => Integral (Prime p) where+ quotRem = S.quotRem+ {-# INLINE quotRem #-}+ toInteger = fromP+ {-# INLINABLE toInteger #-}++-- Prime fields are pretty.+instance KnownNat p => Pretty (Prime p) where+ pretty (P x) = pretty $ naturalToInteger x++-- Prime fields are random.+instance KnownNat p => Random (Prime p) where+ random = randomR (P 0, P $ natVal (witness :: Prime p) - 1)+ {-# INLINABLE random #-}+ randomR (a, b) = first (P . naturalFromInteger) . randomR (fromP a, fromP b)+ {-# INLINABLE randomR #-}++-- Prime fields are real.+instance KnownNat p => Real (Prime p) where+ toRational = fromIntegral+ {-# INLINABLE toRational #-}++-------------------------------------------------------------------------------+-- Auxiliary functions+-------------------------------------------------------------------------------++-- | Safe convert from @Z@ to @GF(p)@.+toP :: KnownNat p => Integer -> Prime p+toP = fromInteger+{-# INLINABLE toP #-}++-- | Unsafe convert from @Z@ to @GF(p)@.+toP' :: KnownNat p => Integer -> Prime p+toP' = P . naturalFromInteger+{-# INLINABLE toP' #-}++-------------------------------------------------------------------------------+-- Prime arithmetic+-------------------------------------------------------------------------------++-- Reciprocals modulo naturals.+recipModNatural :: Natural -> Natural -> Natural+recipModNatural x p = naturalFromInteger $+ recipModInteger (naturalToInteger x) (naturalToInteger p)+{-# INLINE recipModNatural #-}
+ src/Data/Field/Galois/Sqrt.hs view
@@ -0,0 +1,134 @@+module Data.Field.Galois.Sqrt+ ( qnr+ , qr+ , quad+ , rnd+ , rndR+ , sr+ ) where++import Protolude++import Control.Monad.Random (MonadRandom, StdGen, getRandom, getRandomR, mkStdGen, runRand)+import GHC.Natural (Natural)++import Data.Field.Galois.Base (GaloisField(..), pow)++-------------------------------------------------------------------------------+-- Main functions+-------------------------------------------------------------------------------++-- | Get randomised quadratic nonresidue.+qnr :: GaloisField k => Maybe k+qnr = getQNR+{-# INLINABLE qnr #-}++-- | Check if quadratic residue.+qr :: GaloisField k => k -> Bool+qr = not . isQNR+{-# INLINABLE qr #-}++-- | Solve quadratic @ax^2 + bx + c = 0@ over field.+quad :: GaloisField k => k -> k -> k -> Maybe k+quad = solveQuadratic+{-# INLINABLE quad #-}++-- | Randomised field element.+rnd :: (GaloisField k, MonadRandom m) => m k+rnd = getRandom+{-# INLINABLE rnd #-}++-- | Randomised field element in range.+rndR :: (GaloisField k, MonadRandom m) => (k, k) -> m k+rndR = getRandomR+{-# INLINABLE rndR #-}++-- | Square root of field element.+sr :: GaloisField k => k -> Maybe k+sr = squareRoot+{-# INLINABLE sr #-}++-------------------------------------------------------------------------------+-- Auxiliary functions+-------------------------------------------------------------------------------++-- | Check if an element is a quadratic nonresidue.+isQNR :: GaloisField k => k -> Bool+isQNR n = n == 0 || char n /= 2 && pow n (shiftR (order n) 1) /= 1+{-# INLINABLE isQNR #-}++-- Get a random quadratic nonresidue.+getQNR :: forall k . GaloisField k => Maybe k+getQNR+ | char (witness :: k) == 2 = Nothing+ | otherwise = Just $ getQNR' $ runRand rnd $ mkStdGen 0+ where+ getQNR' :: (k, StdGen) -> k+ getQNR' (x, g)+ | x /= 0 && isQNR x = x+ | otherwise = getQNR' $ runRand rnd g+{-# INLINABLE getQNR #-}++-- Factor the order @p - 1@ to get @q@ and @s@ such that @p - 1 = q2^s@.+factorOrder :: GaloisField k => k -> (Natural, Word)+factorOrder w = factorOrder' (order w - 1, 0)+ where+ factorOrder' :: (Natural, Word) -> (Natural, Word)+ factorOrder' qs@(q, s)+ | testBit q 0 = qs+ | otherwise = factorOrder' (shiftR q 1, s + 1)+{-# INLINABLE factorOrder #-}++-- 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), Just z) -> let zq = pow z q+ nq = pow n $ shiftR q 1+ nnq = n * nq+ in loop s zq (nq * nnq) nnq+ _ -> panic "Sqrt.squareRoot: no quadratic nonresidue."+ where+ power :: k -> k+ power = next $ deg n+ where+ next :: Word -> k -> k+ next 1 m = m+ next i m = next (i - 1) (m * m)+ loop :: Word -> 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 (fromIntegral $ m - i - 1) :: Int)+ b2 = b * b+ in loop i b2 (t * b2) (r * b)+ where+ least :: k -> Word -> Word+ least 1 j = j+ least ti j = least (ti * ti) (j + 1)+{-# INLINABLE squareRoot #-}++-- Solve a quadratic equation @ax^2 + bx + c = 0@.+solveQuadratic :: forall k . GaloisField k => k -> k -> k -> Maybe k+solveQuadratic 0 _ _ = Nothing+solveQuadratic _ _ 0 = Just 0+solveQuadratic a 0 c = squareRoot $ -c / a+solveQuadratic a b c+ | char a == 2 = (<$>) (* (b / a)) $ solveQuadratic' $ ac / bb+ | otherwise = (<$>) ((/ (2 * a)) . subtract b) $ squareRoot $ bb - 4 * ac+ where+ ac = a * c+ bb = b * b+ solveQuadratic' :: k -> Maybe k+ solveQuadratic' x+ | sum xs /= 0 = Nothing+ | odd m = Just $ sum h+ | otherwise = panic "Base.solveQuadratic: to be implemented."+ where+ m = deg x+ xs = take (fromIntegral m) $ iterate (join (*)) x+ h = zipWith ($) (cycle [identity, const 0]) xs+{-# INLINABLE solveQuadratic #-}
+ src/Data/Field/Galois/Tower.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE UndecidableInstances #-}++module Data.Field.Galois.Tower+ ( TowerOfFields(..)+ , (*^)+ ) where++import Protolude++import Data.Field.Galois.Base (GaloisField)+import Data.Field.Galois.Prime (Prime, fromP)+import Data.Field.Galois.Extension (Extension, IrreducibleMonic, pattern V)+import Data.Field.Galois.Binary (Binary, toB')++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------++-- | Tower of fields @L@ over @K@ strict partial ordering.+class (GaloisField k, GaloisField l) => TowerOfFields k l where+ {-# MINIMAL embed #-}+ -- | Embed @K@ into @L@ naturally.+ embed :: k -> l++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++-- Prime field towers are reflexive.+instance KnownNat p => TowerOfFields (Prime p) (Prime p) where+ embed = identity+ {-# INLINABLE embed #-}++-- Extension field towers are reflexive.+instance IrreducibleMonic p k => TowerOfFields (Extension p k) (Extension p k) where+ embed = identity+ {-# INLINABLE embed #-}++-- Extension fields are towers of fields.+instance {-# OVERLAPPING #-} IrreducibleMonic p k => TowerOfFields k (Extension p k) where+ embed = V+ {-# INLINABLE embed #-}++-- Extension field towers are transitive.+instance {-# OVERLAPPABLE #-} (TowerOfFields k l, IrreducibleMonic p l, TowerOfFields l (Extension p l))+ => TowerOfFields k (Extension p l) where+ embed = embed . (embed :: k -> l)+ {-# INLINABLE embed #-}++-- Binary field towers are reflexive.+instance KnownNat p => TowerOfFields (Binary p) (Binary p) where+ embed = identity+ {-# INLINABLE embed #-}++-- Binary fields are towers of fields.+instance KnownNat p => TowerOfFields (Prime 2) (Binary p) where+ embed = toB' . fromP+ {-# INLINABLE embed #-}++-------------------------------------------------------------------------------+-- Functions+-------------------------------------------------------------------------------++-- | Scalar multiplication.+infixl 7 *^+(*^) :: TowerOfFields k l => k -> l -> l+(*^) = (*) . embed+{-# INLINE (*^) #-}
+ src/Data/Field/Galois/Unity.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE UndecidableInstances #-}++module Data.Field.Galois.Unity+ ( CyclicSubgroup(..)+ , RootsOfUnity+ , cardinality+ , cofactor+ , isPrimitiveRootOfUnity+ , isRootOfUnity+ , toU+ , toU'+ ) where++import Protolude hiding (natVal)++import Control.Monad.Random (Random(..))+import Data.Group (Group(..))+import GHC.Natural (Natural, naturalToInteger)+import GHC.TypeNats (natVal)+import Test.Tasty.QuickCheck (Arbitrary(..), choose)+import Text.PrettyPrint.Leijen.Text (Pretty(..))++import Data.Field.Galois.Base (GaloisField(..))+import Data.Field.Galois.Prime (Prime)++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------++-- | Cyclic subgroups of finite groups.+class Group g => CyclicSubgroup g where+ {-# MINIMAL gen #-}+ -- | Generator of subgroup.+ gen :: g++-- | @n@-th roots of unity of Galois fields.+newtype RootsOfUnity (n :: Nat) k = U k+ deriving (Bits, Eq, Functor, Generic, NFData, Ord, Show)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++-- Roots of unity cyclic subgroups are arbitrary.+instance (KnownNat n, GaloisField k, CyclicSubgroup (RootsOfUnity n k),+ Group (RootsOfUnity n k)) => Arbitrary (RootsOfUnity n k) where+ arbitrary = pow gen <$> choose (0, naturalToInteger $ order (witness :: Prime n) - 1)+ {-# INLINABLE arbitrary #-}++-- Roots of unity are groups.+instance (KnownNat n, GaloisField k) => Group (RootsOfUnity n k) where+ invert (U x) = U $ recip x+ {-# INLINABLE invert #-}+ pow (U x) n = U $ pow x n+ {-# INLINABLE pow #-}++-- Roots of unity are monoids.+instance (KnownNat n, GaloisField k) => Monoid (RootsOfUnity n k) where+ mempty = U 1+ {-# INLINABLE mempty #-}++-- Roots of unity are pretty.+instance (KnownNat n, GaloisField k) => Pretty (RootsOfUnity n k) where+ pretty (U x) = pretty x++-- Roots of unity cyclic subgroups are random.+instance (KnownNat n, GaloisField k, CyclicSubgroup (RootsOfUnity n k),+ Group (RootsOfUnity n k)) => Random (RootsOfUnity n k) where+ random = first (pow gen) . randomR (0, naturalToInteger $ order (witness :: Prime n) - 1)+ {-# INLINABLE random #-}+ randomR = panic "Unity.randomR: not implemented."++-- Roots of unity are semigroups.+instance (KnownNat n, GaloisField k) => Semigroup (RootsOfUnity n k) where+ U x <> U y = U $ x * y+ {-# INLINABLE (<>) #-}++-------------------------------------------------------------------------------+-- Functions+-------------------------------------------------------------------------------++-- | Cardinality of subgroup.+cardinality :: forall n k . (KnownNat n, GaloisField k) => RootsOfUnity n k -> Natural+cardinality = const $ natVal (witness :: Prime n)+{-# INLINABLE cardinality #-}++-- | Cofactor of subgroup in group.+cofactor :: forall n k . (KnownNat n, GaloisField k) => RootsOfUnity n k -> Natural+cofactor = quot (order (witness :: k)) . cardinality+{-# INLINABLE cofactor #-}++-- | Check if element is primitive root of unity.+isPrimitiveRootOfUnity :: (KnownNat n, GaloisField k) => RootsOfUnity n k -> Bool+isPrimitiveRootOfUnity u@(U x) = isRootOfUnity u+ && not (any (isUnity x) ([1 .. cardinality u - 1] :: [Natural]))+{-# INLINABLE isPrimitiveRootOfUnity #-}++-- | Check if element is root of unity.+isRootOfUnity :: (KnownNat n, GaloisField k) => RootsOfUnity n k -> Bool+isRootOfUnity u@(U x) = isUnity x $ cardinality u+{-# INLINABLE isRootOfUnity #-}++-- | Check if element is unity.+isUnity :: (Integral n, GaloisField k) => k -> n -> Bool+isUnity = ((==) 1 .) . pow+{-# INLINABLE isUnity #-}++-- | Safe convert from field to roots of unity.+toU :: forall n k . (KnownNat n, GaloisField k) => k -> RootsOfUnity n k+toU x = let u = U x :: RootsOfUnity n k in+ if isRootOfUnity u then u else panic "Unity.toUnity: element is not a root of unity."+{-# INLINABLE toU #-}++-- | Unsafe convert from field to roots of unity.+toU' :: forall n k . (KnownNat n, GaloisField k) => k -> RootsOfUnity n k+toU' = U+{-# INLINABLE toU' #-}
− src/ExtensionField.hs
@@ -1,193 +0,0 @@-module ExtensionField- ( ExtensionField- , PolynomialRing- , IrreducibleMonic(split)- , fromField- , toField- , pattern X- , pattern X2- , pattern X3- , pattern Y- ) where--import Protolude as P hiding (Semiring, quot, quotRem, rem)--import Control.Monad.Random (Random(..))-import Data.Euclidean (Euclidean(..), GcdDomain(..))-import Data.Poly.Semiring (VPoly, leading, monomial, scale, toPoly, unPoly, pattern X)-import Data.Semiring as S (Ring(..), Semiring(..))-import Data.Vector (fromList)-import Test.Tasty.QuickCheck (Arbitrary(..), vector)-import Text.PrettyPrint.Leijen.Text (Pretty(..))--import GaloisField (Field(..), GaloisField(..))------------------------------------------------------------------------------------ Data types------------------------------------------------------------------------------------ | Extension fields @GF(p^q)[X]/\<f(X)\>@ for @p@ prime, @q@ positive, and--- @f(X)@ irreducible monic in @GF(p^q)[X]@.-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 #-}- -- | Splitting polynomial @f(X)@.- split :: ExtensionField k im -> VPoly k- -- Splitting polynomial degree.- deg' :: ExtensionField k im -> Int- deg' = pred . fromIntegral . degree . split- {-# INLINABLE deg' #-}---- Extension fields are Galois fields.-instance IrreducibleMonic k im => GaloisField (ExtensionField k im) where- char = const (char (witness :: k))- {-# INLINABLE char #-}- deg = (deg (witness :: k) *) . deg'- {-# INLINABLE deg #-}- frob = pow <*> char- {-# INLINABLE frob #-}--{-# RULES "ExtensionField/pow"- forall (k :: IrreducibleMonic k im => ExtensionField k im) n . (^) k n = pow k n- #-}------------------------------------------------------------------------------------ Numeric instances------------------------------------------------------------------------------------ Extension fields are fractional.-instance IrreducibleMonic k im => Fractional (ExtensionField k im) where- recip (EF x) = EF (polyInv x (split (witness :: ExtensionField k im)))- {-# INLINABLE 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 (plus x y)- {-# INLINE (+) #-}- EF x * EF y = EF (rem (times x y) (split (witness :: ExtensionField k im)))- {-# INLINABLE (*) #-}- EF x - EF y = EF (x - y)- {-# INLINE (-) #-}- negate (EF x) = EF (S.negate x)- {-# INLINE negate #-}- fromInteger = EF . fromInteger- {-# INLINABLE fromInteger #-}- 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."---- 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- {-# INLINABLE fromNatural #-}------------------------------------------------------------------------------------ Other instances------------------------------------------------------------------------------------ Extension fields are arbitrary.-instance IrreducibleMonic k im => Arbitrary (ExtensionField k im) where- arbitrary = toField <$> vector (deg' (witness :: ExtensionField k im))- {-# INLINABLE arbitrary #-}---- Extension fields are pretty.-instance IrreducibleMonic k im => Pretty (ExtensionField k im) where- pretty (EF x) = pretty (toList (unPoly x))---- Extension fields are random.-instance IrreducibleMonic k im => Random (ExtensionField k im) where- random = first toField . unfold (deg' (witness :: ExtensionField k im)) []- where- unfold n xs g- | n <= 0 = (xs, g)- | otherwise = case random g of- (x, g') -> unfold (n - 1) (x : xs) g'- {-# INLINABLE random #-}- randomR = panic "not implemented."------------------------------------------------------------------------------------ Type conversions------------------------------------------------------------------------------------ | Convert from field element to list representation.-fromField :: ExtensionField k im -> [k]-fromField (EF x) = toList (unPoly x)-{-# INLINABLE fromField #-}---- | Convert from list representation to field element.-toField :: forall k im . IrreducibleMonic k im => [k] -> ExtensionField k im-toField = EF . flip rem (split (witness :: ExtensionField k im)) . toPoly . fromList-{-# INLINABLE toField #-}---- | Pattern for @X^2@.-pattern X2 :: GaloisField k => VPoly k-pattern X2 <- _ where X2 = toPoly (fromList [0, 0, 1])---- | Pattern for @X^3@.-pattern X3 :: GaloisField k => VPoly k-pattern X3 <- _ where X3 = toPoly (fromList [0, 0, 0, 1])---- | Pattern for descending tower of indeterminate variables.-pattern Y :: IrreducibleMonic k im => VPoly k -> VPoly (ExtensionField k im)-pattern Y <- _ where Y = monomial 0 . EF------------------------------------------------------------------------------------ Polynomial arithmetic------------------------------------------------------------------------------------ Polynomial inversion algorithm.-polyInv :: GaloisField k => VPoly k -> VPoly k -> VPoly k-polyInv xs ps = case first leading (polyGCD xs ps) of- (Just (0, x), ys) -> scale 0 (recip x) ys- _ -> panic "no multiplicative inverse."-{-# INLINABLE polyInv #-}---- Polynomial extended greatest common divisor algorithm.-polyGCD :: forall k . GaloisField k => VPoly k -> VPoly k -> (VPoly k, VPoly k)-polyGCD x y = polyGCD' 0 1 y x- where- polyGCD' :: VPoly k -> VPoly k -> VPoly k -> VPoly k -> (VPoly k, VPoly k)- polyGCD' s _ r 0 = (r, s)- polyGCD' s s' r r' = case quot r r' of- q -> polyGCD' s' (s - times q s') r' (r - times q r')-{-# INLINABLE polyGCD #-}
− src/GaloisField.hs
@@ -1,184 +0,0 @@-module GaloisField- ( Field(..)- , GaloisField(..)- ) where--import Protolude hiding ((-), one, quot)--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)------------------------------------------------------------------------------------ Classes------------------------------------------------------------------------------------ | Fields.-class (Euclidean k, Ring k) => Field k where-- -- Operations-- -- | Division.- divide :: k -> k -> k- divide = quot- {-# INLINABLE divide #-}-- -- | Inversion.- invert :: k -> k- invert = quot one- {-# INLINABLE invert #-}-- -- | Subtraction.- minus :: k -> k -> k- minus = (-)- {-# INLINABLE minus #-}---- | Galois fields @GF(p^q)@ for @p@ prime and @q@ non-negative.-class (Arbitrary k, Field k, Fractional k,- Generic k, Ord k, Pretty k, Random k, Show k) => GaloisField k where- {-# MINIMAL char, deg, frob #-}-- -- Characteristics-- -- | Characteristic @p@ of field and order of prime subfield.- char :: k -> Integer-- -- | Degree @q@ of field as extension field over prime subfield.- deg :: k -> Int-- -- | Order @p^q@ of field.- order :: k -> Integer- order = (^) <$> char <*> deg- {-# INLINABLE order #-}-- -- | Frobenius endomorphism @x -> x^p@ of prime subfield.- frob :: k -> k-- -- Functions-- -- | Exponentiation of field element to integer.- pow :: k -> Integer -> k- pow x n- | n < 0 = pow (recip x) (negate n)- | otherwise = pow' 1 x n- where- pow' z y m- | m == 0 = z- | m == 1 = z'- | even m = pow' z y' m'- | otherwise = pow' z' y' m'- where- z' = z * y- y' = y * y- m' = div m 2- {-# INLINABLE pow #-}-- -- | Get randomised quadratic nonresidue.- qnr :: k- qnr = getQNR- {-# INLINABLE qnr #-}-- -- | Check if quadratic residue.- qr :: k -> Bool- qr = not . isQNR- {-# INLINABLE qr #-}-- -- | Solve quadratic @ax^2 + bx + c = 0@ over field.- quad :: k -> k -> k -> Maybe k- quad = solveQuadratic- {-# INLINABLE quad #-}-- -- | Randomised field element.- rnd :: MonadRandom m => m k- rnd = getRandom- {-# INLINABLE rnd #-}-- -- | Square root of field element.- sr :: k -> Maybe k- sr = squareRoot- {-# INLINABLE 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-{-# INLINABLE 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)-{-# INLINABLE 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)-{-# INLINABLE 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)-{-# INLINABLE squareRoot #-}---- Solve a quadratic equation @ax^2 + bx + c = 0@.-solveQuadratic :: forall k . GaloisField k => k -> k -> k -> Maybe k-solveQuadratic 0 _ _ = Nothing-solveQuadratic _ _ 0 = Just 0-solveQuadratic a 0 c = squareRoot (-c / a)-solveQuadratic a b c- | char a == 2 = (* (b / a)) <$> solveQuadratic' (ac / bb)- | otherwise = (/ (2 * a)) . subtract b <$> squareRoot (bb - 4 * ac)- where- ac = a * c- bb = b * b- solveQuadratic' :: k -> Maybe k- solveQuadratic' x- | sum xs /= 0 = Nothing- | odd m = Just (sum h)- | otherwise = panic "not implemented."- where- m = deg x- xs = take m (iterate (join (*)) x)- h = zipWith ($) (cycle [identity, const 0]) xs-{-# INLINABLE solveQuadratic #-}
− src/PrimeField.hs
@@ -1,140 +0,0 @@-module PrimeField- ( PrimeField- , toInt- ) where--import Protolude as P hiding (Semiring)--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(..), choose)-import Text.PrettyPrint.Leijen.Text (Pretty(..))--import GaloisField (Field(..), GaloisField(..))------------------------------------------------------------------------------------ Data types------------------------------------------------------------------------------------ | Prime fields @GF(p)@ for @p@ prime.-newtype PrimeField (p :: Nat) = PF Integer- deriving (Bits, Eq, Generic, Ord, Show)---- Prime fields are Galois fields.-instance KnownNat p => GaloisField (PrimeField p) where- char = natVal- {-# INLINABLE char #-}- deg = const 1- {-# INLINABLE deg #-}- frob = identity- {-# INLINABLE frob #-}- 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------------------------------------------------------------------------------------ Prime fields are fractional.-instance KnownNat p => Fractional (PrimeField p) where- 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- PF x + PF y = PF (if xyp >= 0 then xyp else xy)- where- xy = x + y- xyp = xy - natVal (witness :: PrimeField p)- {-# INLINE (+) #-}- PF x * PF y = PF (P.rem (x * y) (natVal (witness :: PrimeField p)))- {-# INLINE (*) #-}- PF x - PF y = PF (if xy >= 0 then xy else xy + natVal (witness :: PrimeField p))- where- xy = x - y- {-# INLINE (-) #-}- 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)- where- y = P.rem x p- p = natVal (witness :: PrimeField p)- {-# INLINABLE fromInteger #-}- abs = panic "not implemented."- signum = panic "not implemented."------------------------------------------------------------------------------------ Semiring instances------------------------------------------------------------------------------------ Prime fields are Euclidean domains.-instance KnownNat p => Euclidean (PrimeField p) where- quotRem = (flip (,) 0 .) . (/)- {-# INLINE quotRem #-}- degree = panic "not implemented."---- 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- {-# INLINABLE fromNatural #-}------------------------------------------------------------------------------------ Other instances------------------------------------------------------------------------------------ Prime fields are arbitrary.-instance KnownNat p => Arbitrary (PrimeField p) where- arbitrary = PF <$> choose (0, natVal (witness :: PrimeField p) - 1)- {-# INLINABLE arbitrary #-}---- Prime fields are pretty.-instance KnownNat p => Pretty (PrimeField p) where- pretty (PF x) = pretty x---- Prime fields are random.-instance KnownNat p => Random (PrimeField p) where- random = first PF . randomR (0, natVal (witness :: PrimeField p) - 1)- {-# INLINABLE random #-}- randomR = panic "not implemented."------------------------------------------------------------------------------------ Type conversions------------------------------------------------------------------------------------ | Embed field element to integers.-toInt :: PrimeField p -> Integer-toInt (PF x) = x-{-# INLINABLE toInt #-}
+ test/Main.hs view
@@ -0,0 +1,13 @@+module Main where++import Protolude++import Test.Tasty++import Test.Binary+import Test.Extension+import Test.Prime++main :: IO ()+main = defaultMain $+ testGroup "Tests" [testPrime, testExtension, testBinary]
+ test/Test/Binary.hs view
@@ -0,0 +1,31 @@+module Test.Binary where++import Protolude++import Data.Field.Galois+import Test.Tasty++import Test.Galois++type F2A = Binary 0x20000000000000000000000000201+type F2B = Binary 0x80000000000000000000000000000010d+type F2C = Binary 0x800000000000000000000000000000000000000c9+type F2D = Binary 0x2000000000000000000000000000000000000000000008001+type F2E = Binary 0x20000000000000000000000000000000000000004000000000000000001+type F2F = Binary 0x800000000000000000004000000000000000000000000000000000000001+type F2G = Binary 0x800000000000000000000000000000000000000000000000000000000000000000010a1+type F2H = Binary 0x2000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001+type F2I = Binary 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425++testBinary :: TestTree+testBinary = testGroup "Binary fields"+ [ 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)+ ]
+ test/Test/Extension.hs view
@@ -0,0 +1,107 @@+module Test.Extension where++import Protolude++import Data.Field.Galois+import Test.Tasty++import Test.Galois+import Test.Prime++data P111+instance IrreducibleMonic P111 FS2 where+ poly _ = X2 + X + 1+type FS4 = Extension P111 FS2++data P1101+instance IrreducibleMonic P1101 FS2 where+ poly _ = X3 + X + 1+type FS8 = Extension P1101 FS2++data P1011+instance IrreducibleMonic P1011 FS2 where+ poly _ = X3 + X2 + 1+type FS8' = Extension P1011 FS2++data P101+instance IrreducibleMonic P101 FS3 where+ poly _ = X2 + 1+type FS9 = Extension P101 FS3++data P211+instance IrreducibleMonic P211 FS3 where+ poly _ = X2 + X - 1+type FS9' = Extension P211 FS3++data P221+instance IrreducibleMonic P221 FS3 where+ poly _ = X2 - X - 1+type FS9'' = Extension P221 FS3++instance IrreducibleMonic P101 FM0 where+ poly _ = X2 + 1+type FL0 = Extension P101 FM0++instance IrreducibleMonic P101 FM1 where+ poly _ = X2 + 1+type FL1 = Extension P101 FM1++instance IrreducibleMonic P101 FM2 where+ poly _ = X2 + 1+type FL2 = Extension P101 FM2++instance IrreducibleMonic P101 FM3 where+ poly _ = X2 + 1+type FL3 = Extension P101 FM3++instance IrreducibleMonic P101 FM4 where+ poly _ = X2 + 1+type FL4 = Extension P101 FM4++instance IrreducibleMonic P101 FVL where+ poly _ = X2 + 17+type FV2 = Extension P101 FVL++instance IrreducibleMonic P101 FXL where+ poly _ = X2 + 17+type FX2 = Extension P101 FXL++instance IrreducibleMonic P101 FZL where+ poly _ = X2 + 17+type FZ2 = Extension P101 FZL++data PU+instance IrreducibleMonic PU Fq where+ poly _ = X2 + 1+type Fq2 = Extension PU Fq++data PV+instance IrreducibleMonic PV Fq2 where+ poly _ = X3 - 9 - Y X+type Fq6 = Extension PV Fq2++data PW+instance IrreducibleMonic PW Fq6 where+ poly _ = X2 - Y X+type Fq12 = Extension PW Fq6++testExtension :: TestTree+testExtension = testGroup "Extension fields"+ [ 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.+ ]
+ test/Test/Galois.hs view
@@ -0,0 +1,76 @@+module Test.Galois where++import Protolude++import Data.Field.Galois hiding (recip)+import Test.Tasty+import Test.Tasty.QuickCheck++annihilation :: Eq a => (a -> a -> a) -> a -> a -> Bool+annihilation op e x = op x e == e && op e x == e++associativity :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool+associativity op x y z = op x (op y z) == op (op x y) z++commutativity :: Eq a => (a -> a -> a) -> a -> a -> Bool+commutativity op x y = op x y == op y x++distributivity :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+distributivity op op' x y z = op (op' x y) z == op' (op x z) (op y z)+ && op x (op' y z) == op' (op x y) (op x z)++identities :: Eq a => (a -> a -> a) -> a -> a -> Bool+identities op e x = op x e == x && op e x == x++inverses :: Eq a => (a -> a -> a) -> (a -> a) -> a -> a -> Bool+inverses op inv e x = op x (inv x) == e && op (inv x) x == e++groupAxioms :: forall g . (Arbitrary g, Eq g, Show g)+ => (g -> g -> g) -> (g -> g) -> g -> (g -> Bool) -> [TestTree]+groupAxioms add inv id cond =+ [ testProperty "associativity" $+ associativity add+ , testProperty "commutativity" $+ commutativity add+ , testProperty "identity" $+ identities add id+ , testProperty "inverses" $+ \x -> cond x ==> inverses add inv id x+ ]++fieldAxioms :: forall k . GaloisField k => k -> TestTree+fieldAxioms _ = testGroup "Field axioms"+ [ testGroup "additive group axioms" $+ groupAxioms (+) negate (0 :: k) (const True)+ , testGroup "multiplicative group axioms" $+ groupAxioms (*) recip (1 :: k) (/= 0)+ , testProperty "distributivity of multiplication over addition" $+ distributivity ((*) :: k -> k -> k) (+)+ , testProperty "multiplicative annihilation" $+ annihilation ((*) :: k -> k -> k) 0+ ]++frobeniusEndomorphisms :: forall k . GaloisField k => k -> TestTree+frobeniusEndomorphisms _ = testGroup "Frobenius endomorphisms"+ [ testProperty "frobenius endomorphisms are characteristic powers" $+ \(x :: k) -> frob x == pow x (char (witness :: k))+ , testProperty "frobenius endomorphisms are ring homomorphisms" $+ \(x :: k) (y :: k) (z :: k) -> frob (x * y + z) == frob x * frob y + frob z+ ]++squareRoots :: forall k . GaloisField k => k -> TestTree+squareRoots _ = localOption (QuickCheckMaxRatio 100)+ . localOption (QuickCheckTests 10) $ testGroup "Square roots"+ [ testProperty "squares of square roots" $+ \(x :: k) -> qr x+ ==> ((join (*) <$> sr x) == Just x)+ , testProperty "solutions of quadratic equations" $+ \(a :: k) (b :: k) (c :: k) -> a /= 0 && isJust (quad a b c)+ ==> (((\x -> (a * 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, frobeniusEndomorphisms x, squareRoots x]++test' :: forall k . GaloisField k => TestName -> k -> TestTree+test' s x = testGroup s [fieldAxioms x, frobeniusEndomorphisms x]
+ test/Test/Prime.hs view
@@ -0,0 +1,41 @@+module Test.Prime where++import Protolude++import Data.Field.Galois+import Test.Tasty++import Test.Galois++type FS2 = Prime 2+type FS3 = Prime 3+type FS5 = Prime 5+type FS7 = Prime 7++type FM0 = Prime 2147483647+type FM1 = Prime 2305843009213693951+type FM2 = Prime 618970019642690137449562111+type FM3 = Prime 162259276829213363391578010288127+type FM4 = Prime 170141183460469231731687303715884105727++type FVL = Prime 20988936657440586486151264256610222593863921+type FXL = Prime 5210644015679228794060694325390955853335898483908056458352183851018372555735221+type FZL = Prime 741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737++type Fq = Prime 21888242871839275222246405745257275088696311157297823662689037894645226208583++testPrime :: TestTree+testPrime = testGroup "Prime fields"+ [ test "FS2" (witness :: FS2)+ , test "FS3" (witness :: FS3)+ , test "FS5" (witness :: FS5)+ , test "FS7" (witness :: FS7)+ , test "FM0" (witness :: FM0)+ , test "FM1" (witness :: FM1)+ , test "FM2" (witness :: FM2)+ , test "FM3" (witness :: FM3)+ , test "FM4" (witness :: FM4)+ , test "FVL" (witness :: FVL)+ , test "FXL" (witness :: FXL)+ , test "FZL" (witness :: FZL)+ ]
− tests/BinaryFieldTests.hs
@@ -1,31 +0,0 @@-module BinaryFieldTests where--import Protolude--import BinaryField-import Test.Tasty--import GaloisFieldTests--type F2A = BinaryField 0x20000000000000000000000000201-type F2B = BinaryField 0x80000000000000000000000000000010d-type F2C = BinaryField 0x800000000000000000000000000000000000000c9-type F2D = BinaryField 0x2000000000000000000000000000000000000000000008001-type F2E = BinaryField 0x20000000000000000000000000000000000000004000000000000000001-type F2F = BinaryField 0x800000000000000000004000000000000000000000000000000000000001-type F2G = BinaryField 0x800000000000000000000000000000000000000000000000000000000000000000010a1-type F2H = BinaryField 0x2000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001-type F2I = BinaryField 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425--testBinaryField :: TestTree-testBinaryField = testGroup "Binary fields"- [ 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)- ]
− tests/ExtensionFieldTests.hs
@@ -1,107 +0,0 @@-module ExtensionFieldTests where--import Protolude--import ExtensionField-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-type FS9 = ExtensionField FS3 P101--data P211-instance IrreducibleMonic FS3 P211 where- split _ = X2 + X - 1-type FS9' = ExtensionField FS3 P211--data P221-instance IrreducibleMonic FS3 P221 where- split _ = X2 - X - 1-type FS9'' = ExtensionField FS3 P221--instance IrreducibleMonic FM0 P101 where- split _ = X2 + 1-type FL0 = ExtensionField FM0 P101--instance IrreducibleMonic FM1 P101 where- split _ = X2 + 1-type FL1 = ExtensionField FM1 P101--instance IrreducibleMonic FM2 P101 where- split _ = X2 + 1-type FL2 = ExtensionField FM2 P101--instance IrreducibleMonic FM3 P101 where- split _ = X2 + 1-type FL3 = ExtensionField FM3 P101--instance IrreducibleMonic FM4 P101 where- split _ = X2 + 1-type FL4 = ExtensionField FM4 P101--instance IrreducibleMonic FVL P101 where- split _ = X2 + 17-type FV2 = ExtensionField FVL P101--instance IrreducibleMonic FXL P101 where- split _ = X2 + 17-type FX2 = ExtensionField FXL P101--instance IrreducibleMonic FZL P101 where- split _ = X2 + 17-type FZ2 = ExtensionField FZL P101--data Pu-instance IrreducibleMonic Fq Pu where- split _ = X2 + 1-type Fq2 = ExtensionField Fq Pu--data Pv-instance IrreducibleMonic Fq2 Pv where- split _ = X3 - 9 - Y X-type Fq6 = ExtensionField Fq2 Pv--data Pw-instance IrreducibleMonic Fq6 Pw where- split _ = X2 - Y X-type Fq12 = ExtensionField Fq6 Pw--testExtensionField :: TestTree-testExtensionField = testGroup "Extension fields"- [ 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.- ]
− tests/GaloisFieldTests.hs
@@ -1,61 +0,0 @@-module GaloisFieldTests where--import Protolude--import GaloisField-import Test.Tasty-import Test.Tasty.QuickCheck--associativity :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool-associativity op x y z = op x (op y z) == op (op x y) z--commutativity :: Eq a => (a -> a -> a) -> a -> a -> Bool-commutativity op x y = op x y == op y x--distributivity :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool-distributivity op op' x y z = op (op' x y) z == op' (op x z) (op y z)- && op x (op' y z) == op' (op x y) (op x z)--identities :: Eq a => (a -> a -> a) -> a -> a -> Bool-identities op e x = op x e == x && op e x == x--inverses :: Eq a => (a -> a -> a) -> (a -> a) -> a -> a -> Bool-inverses op inv e x = op x (inv x) == e && op (inv x) x == e--fieldAxioms :: forall k . GaloisField k => k -> TestTree-fieldAxioms _ = testGroup ("Field axioms")- [ testProperty "commutativity of addition"- $ commutativity ((+) :: k -> k -> k)- , testProperty "commutativity of multiplication"- $ commutativity ((*) :: k -> k -> k)- , testProperty "associativity of addition"- $ associativity ((+) :: k -> k -> k)- , testProperty "associativity of multiplication"- $ associativity ((*) :: k -> k -> k)- , testProperty "distributivity of multiplication over addition"- $ distributivity ((*) :: k -> k -> k) (+)- , testProperty "additive identity"- $ identities ((+) :: k -> k -> k) 0- , testProperty "multiplicative identity"- $ identities ((*) :: k -> k -> k) 1- , testProperty "additive inverses"- $ inverses ((+) :: k -> k -> k) negate 0- , testProperty "multiplicative inverses"- $ \x -> x /= 0 ==> inverses ((*) :: k -> k -> k) recip 1 x- ]--squareRoots :: forall k . GaloisField k => k -> TestTree-squareRoots _ = localOption (QuickCheckTests 10) $ testGroup "Square roots"- [ testProperty "squares of square roots"- $ \(x :: k) -> isJust (sr x)- ==> (((^ (2 :: Int)) <$> sr x) == Just x)- , 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]--test' :: forall k . GaloisField k => TestName -> k -> TestTree-test' s x = testGroup s [fieldAxioms x]
− tests/Main.hs
@@ -1,13 +0,0 @@-module Main where--import Protolude--import Test.Tasty--import BinaryFieldTests-import ExtensionFieldTests-import PrimeFieldTests--main :: IO ()-main = defaultMain $- testGroup "Tests" [testPrimeField, testExtensionField, testBinaryField]
− tests/PrimeFieldTests.hs
@@ -1,41 +0,0 @@-module PrimeFieldTests where--import Protolude--import PrimeField-import Test.Tasty--import GaloisFieldTests--type FS2 = PrimeField 2-type FS3 = PrimeField 3-type FS5 = PrimeField 5-type FS7 = PrimeField 7--type FM0 = PrimeField 2147483647-type FM1 = PrimeField 2305843009213693951-type FM2 = PrimeField 618970019642690137449562111-type FM3 = PrimeField 162259276829213363391578010288127-type FM4 = PrimeField 170141183460469231731687303715884105727--type FVL = PrimeField 20988936657440586486151264256610222593863921-type FXL = PrimeField 5210644015679228794060694325390955853335898483908056458352183851018372555735221-type FZL = PrimeField 741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737--type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583--testPrimeField :: TestTree-testPrimeField = testGroup "Prime fields"- [ test "FS2" (witness :: FS2)- , test "FS3" (witness :: FS3)- , test "FS5" (witness :: FS5)- , test "FS7" (witness :: FS7)- , test "FM0" (witness :: FM0)- , test "FM1" (witness :: FM1)- , test "FM2" (witness :: FM2)- , test "FM3" (witness :: FM3)- , test "FM4" (witness :: FM4)- , test "FVL" (witness :: FVL)- , test "FXL" (witness :: FXL)- , test "FZL" (witness :: FZL)- ]