packages feed

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 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)-  ]