{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- SPDX-License-Identifier: MPL-2.0

{- | Algebraic interfaces, exact law checks, checked modular rings, and finite
extension fields GF(p^n). Runtime moduli are deliberately not Num instances:
combining different rings is an explicit error. Finite fields are constructed
only after primality and irreducibility have been proved under a budget.
-}
module HMath.Algebra (
    Semiring (..),
    Ring (..),
    Field (..),
    Group (..),
    Additive (..),
    Module (..),
    VectorSpace,
    linearCombination,
    semiringLaws,
    ringLaws,
    fieldLaws,
    groupLaws,
    moduleLaws,
    Modular,
    modular,
    modularValue,
    modularModulus,
    addModular,
    subtractModular,
    multiplyModular,
    inverseModular,
    powerModular,
    FiniteField,
    finiteField,
    primeField,
    fieldCharacteristic,
    fieldDegree,
    fieldCardinality,
    fieldModulus,
    FieldElement,
    fieldElement,
    fieldElementCoefficients,
    fieldElements,
    addField,
    negateField,
    subtractField,
    multiplyField,
    inverseFieldElement,
    powerField,
    finiteFieldLaws,
) where

import Control.Monad (foldM)
import Data.Ratio ((%))
import HMath.Error (MathError (..))
import HMath.NumberTheory (isPrimeExact, modInverse, modPow)
import HMath.Polynomial (Polynomial, addPolynomial, multiplyPolynomial, polynomial, scalePolynomial)

{- | Commutative addition, associative multiplication, distributivity, additive
identity and absorbing zero. Multiplication need not be commutative.
-}
class Semiring a where
    -- | Additive identity.
    zero :: a

    -- | Multiplicative identity.
    one :: a

    -- | Semiring addition.
    plus :: a -> a -> a

    -- | Semiring multiplication.
    times :: a -> a -> a

-- | A semiring whose additive monoid is an abelian group.
class (Semiring a) => Ring a where
    -- | Additive inverse.
    negateRing :: a -> a

-- | A commutative ring in which each nonzero element has an inverse.
class (Ring a) => Field a where
    -- | Multiplicative inverse; zero returns a domain error.
    inverseField :: a -> Either MathError a

-- | An associative operation with identity and inverse.
class Group a where
    -- | Group identity.
    groupIdentity :: a

    -- | Group operation, not necessarily commutative.
    groupCombine :: a -> a -> a

    -- | Two-sided inverse.
    groupInverse :: a -> a

-- | A ring viewed as its additive group.
newtype Additive a = Additive
    { forall a. Additive a -> a
getAdditive :: a
    -- ^ Recover the underlying ring element.
    }
    deriving (Additive a -> Additive a -> Bool
(Additive a -> Additive a -> Bool)
-> (Additive a -> Additive a -> Bool) -> Eq (Additive a)
forall a. Eq a => Additive a -> Additive a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Additive a -> Additive a -> Bool
== :: Additive a -> Additive a -> Bool
$c/= :: forall a. Eq a => Additive a -> Additive a -> Bool
/= :: Additive a -> Additive a -> Bool
Eq, Int -> Additive a -> ShowS
[Additive a] -> ShowS
Additive a -> String
(Int -> Additive a -> ShowS)
-> (Additive a -> String)
-> ([Additive a] -> ShowS)
-> Show (Additive a)
forall a. Show a => Int -> Additive a -> ShowS
forall a. Show a => [Additive a] -> ShowS
forall a. Show a => Additive a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Additive a -> ShowS
showsPrec :: Int -> Additive a -> ShowS
$cshow :: forall a. Show a => Additive a -> String
show :: Additive a -> String
$cshowList :: forall a. Show a => [Additive a] -> ShowS
showList :: [Additive a] -> ShowS
Show)

instance (Ring a) => Group (Additive a) where
    groupIdentity :: Additive a
groupIdentity = a -> Additive a
forall a. a -> Additive a
Additive a
forall a. Semiring a => a
zero
    groupCombine :: Additive a -> Additive a -> Additive a
groupCombine (Additive a
a) (Additive a
b) = a -> Additive a
forall a. a -> Additive a
Additive (a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
a a
b)
    groupInverse :: Additive a -> Additive a
groupInverse (Additive a
a) = a -> Additive a
forall a. a -> Additive a
Additive (a -> a
forall a. Ring a => a -> a
negateRing a
a)

instance Semiring Integer where
    zero :: Integer
zero = Integer
0
    one :: Integer
one = Integer
1
    plus :: Integer -> Integer -> Integer
plus = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
    times :: Integer -> Integer -> Integer
times = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)
instance Ring Integer where negateRing :: Integer -> Integer
negateRing = Integer -> Integer
forall a. Num a => a -> a
negate
instance Semiring Rational where
    zero :: Rational
zero = Integer
0 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1
    one :: Rational
one = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1
    plus :: Rational -> Rational -> Rational
plus = Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+)
    times :: Rational -> Rational -> Rational
times = Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*)
instance Ring Rational where negateRing :: Rational -> Rational
negateRing = Rational -> Rational
forall a. Num a => a -> a
negate
instance Field Rational where
    inverseField :: Rational -> Either MathError Rational
inverseField Rational
0 = MathError -> Either MathError Rational
forall a b. a -> Either a b
Left (String -> MathError
DomainError String
"zero has no field inverse")
    inverseField Rational
x = Rational -> Either MathError Rational
forall a b. b -> Either a b
Right (Rational -> Rational
forall a. Fractional a => a -> a
recip Rational
x)
instance (Eq a, Num a) => Semiring (Polynomial a) where
    zero :: Polynomial a
zero = [a] -> Polynomial a
forall a. (Eq a, Num a) => [a] -> Polynomial a
polynomial []
    one :: Polynomial a
one = [a] -> Polynomial a
forall a. (Eq a, Num a) => [a] -> Polynomial a
polynomial [a
1]
    plus :: Polynomial a -> Polynomial a -> Polynomial a
plus = Polynomial a -> Polynomial a -> Polynomial a
forall a.
(Eq a, Num a) =>
Polynomial a -> Polynomial a -> Polynomial a
addPolynomial
    times :: Polynomial a -> Polynomial a -> Polynomial a
times = Polynomial a -> Polynomial a -> Polynomial a
forall a.
(Eq a, Num a) =>
Polynomial a -> Polynomial a -> Polynomial a
multiplyPolynomial
instance (Eq a, Num a) => Ring (Polynomial a) where negateRing :: Polynomial a -> Polynomial a
negateRing = a -> Polynomial a -> Polynomial a
forall a. (Eq a, Num a) => a -> Polynomial a -> Polynomial a
scalePolynomial (-a
1)

-- | A left module with checked addition for runtime vector shapes.
class (Ring scalar) => Module scalar vector | vector -> scalar where
    -- | Scalar action.
    moduleScale :: scalar -> vector -> vector

    -- | Addition, rejecting incompatible runtime shapes.
    moduleAdd :: vector -> vector -> Either MathError vector

instance Module Integer [Integer] where
    moduleScale :: Integer -> [Integer] -> [Integer]
moduleScale Integer
a = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*)
    moduleAdd :: [Integer] -> [Integer] -> Either MathError [Integer]
moduleAdd = [Integer] -> [Integer] -> Either MathError [Integer]
forall a. Num a => [a] -> [a] -> Either MathError [a]
addVectors
instance Module Rational [Rational] where
    moduleScale :: Rational -> [Rational] -> [Rational]
moduleScale Rational
a = (Rational -> Rational) -> [Rational] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Rational
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*)
    moduleAdd :: [Rational] -> [Rational] -> Either MathError [Rational]
moduleAdd = [Rational] -> [Rational] -> Either MathError [Rational]
forall a. Num a => [a] -> [a] -> Either MathError [a]
addVectors

{- | A module over a field. Rational finite-list vectors are an exact instance;
list lengths define separate spaces, and moduleAdd rejects differing lengths.
-}
class (Field scalar, Module scalar vector) => VectorSpace scalar vector

instance VectorSpace Rational [Rational]

addVectors :: (Num a) => [a] -> [a] -> Either MathError [a]
addVectors :: forall a. Num a => [a] -> [a] -> Either MathError [a]
addVectors [a]
a [a]
b
    | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b = MathError -> Either MathError [a]
forall a b. a -> Either a b
Left (Int -> Int -> MathError
VectorLengthMismatch ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a) ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b))
    | Bool
otherwise = [a] -> Either MathError [a]
forall a b. b -> Either a b
Right ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Num a => a -> a -> a
(+) [a]
a [a]
b)

{- | Checked linear combination. Supply the zero vector explicitly so the empty
combination retains its dimension.
-}
linearCombination :: (Module s v) => v -> [(s, v)] -> Either MathError v
linearCombination :: forall s v. Module s v => v -> [(s, v)] -> Either MathError v
linearCombination = (v -> (s, v) -> Either MathError v)
-> v -> [(s, v)] -> Either MathError v
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\v
acc (s
a, v
v) -> v -> v -> Either MathError v
forall scalar vector.
Module scalar vector =>
vector -> vector -> Either MathError vector
moduleAdd v
acc (s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
a v
v))

{- | Exhaustive semiring identities on the supplied finite sample. This is a
test utility, not a proof for types with an infinite carrier.
-}
semiringLaws :: (Eq a, Semiring a) => [a] -> [(String, Bool)]
semiringLaws :: forall a. (Eq a, Semiring a) => [a] -> [(String, Bool)]
semiringLaws [a]
xs =
    [ (String
"addition identity", (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\a
a -> a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
forall a. Semiring a => a
zero a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a Bool -> Bool -> Bool
&& a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
a a
forall a. Semiring a => a
zero a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a) [a]
xs)
    , (String
"multiplication identity", (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\a
a -> a -> a -> a
forall a. Semiring a => a -> a -> a
times a
forall a. Semiring a => a
one a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a Bool -> Bool -> Bool
&& a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a a
forall a. Semiring a => a
one a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a) [a]
xs)
    , (String
"absorbing zero", (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\a
a -> a -> a -> a
forall a. Semiring a => a -> a -> a
times a
forall a. Semiring a => a
zero a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Semiring a => a
zero Bool -> Bool -> Bool
&& a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a a
forall a. Semiring a => a
zero a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Semiring a => a
zero) [a]
xs)
    , (String
"addition commutativity", [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
a a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
b a
a | a
a <- [a]
xs, a
b <- [a]
xs])
    , (String
"addition associativity", [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [a -> a -> a
forall a. Semiring a => a -> a -> a
plus (a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
a a
b) a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
a (a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
b a
c) | a
a <- [a]
xs, a
b <- [a]
xs, a
c <- [a]
xs])
    ,
        ( String
"multiplication associativity"
        , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [a -> a -> a
forall a. Semiring a => a -> a -> a
times (a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a a
b) a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a (a -> a -> a
forall a. Semiring a => a -> a -> a
times a
b a
c) | a
a <- [a]
xs, a
b <- [a]
xs, a
c <- [a]
xs]
        )
    ,
        ( String
"left distributivity"
        , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a (a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
b a
c) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a
forall a. Semiring a => a -> a -> a
plus (a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a a
b) (a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a a
c) | a
a <- [a]
xs, a
b <- [a]
xs, a
c <- [a]
xs]
        )
    ,
        ( String
"right distributivity"
        , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [a -> a -> a
forall a. Semiring a => a -> a -> a
times (a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
a a
b) a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a
forall a. Semiring a => a -> a -> a
plus (a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a a
c) (a -> a -> a
forall a. Semiring a => a -> a -> a
times a
b a
c) | a
a <- [a]
xs, a
b <- [a]
xs, a
c <- [a]
xs]
        )
    ]

-- | Semiring laws plus additive inverses on a finite sample.
ringLaws :: (Eq a, Ring a) => [a] -> [(String, Bool)]
ringLaws :: forall a. (Eq a, Ring a) => [a] -> [(String, Bool)]
ringLaws [a]
xs = [a] -> [(String, Bool)]
forall a. (Eq a, Semiring a) => [a] -> [(String, Bool)]
semiringLaws [a]
xs [(String, Bool)] -> [(String, Bool)] -> [(String, Bool)]
forall a. [a] -> [a] -> [a]
++ [(String
"additive inverses", (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\a
a -> a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
a (a -> a
forall a. Ring a => a -> a
negateRing a
a) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Semiring a => a
zero) [a]
xs)]

-- | Ring laws, commutative multiplication and nonzero inverses.
fieldLaws :: (Eq a, Field a) => [a] -> [(String, Bool)]
fieldLaws :: forall a. (Eq a, Field a) => [a] -> [(String, Bool)]
fieldLaws [a]
xs =
    [a] -> [(String, Bool)]
forall a. (Eq a, Ring a) => [a] -> [(String, Bool)]
ringLaws [a]
xs
        [(String, Bool)] -> [(String, Bool)] -> [(String, Bool)]
forall a. [a] -> [a] -> [a]
++ [ (String
"multiplication commutativity", [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a
forall a. Semiring a => a -> a -> a
times a
b a
a | a
a <- [a]
xs, a
b <- [a]
xs])
           ,
               ( String
"nonzero inverses"
               , (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
                    ( \a
a ->
                        a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Semiring a => a
zero Bool -> Bool -> Bool
|| case a -> Either MathError a
forall a. Field a => a -> Either MathError a
inverseField a
a of
                            Left MathError
_ -> Bool
False
                            Right a
b -> a -> a -> a
forall a. Semiring a => a -> a -> a
times a
a a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Semiring a => a
one
                    )
                    [a]
xs
               )
           ]

-- | Group identities on a finite sample.
groupLaws :: (Eq a, Group a) => [a] -> [(String, Bool)]
groupLaws :: forall a. (Eq a, Group a) => [a] -> [(String, Bool)]
groupLaws [a]
xs =
    [
        ( String
"group identity"
        , (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\a
a -> a -> a -> a
forall a. Group a => a -> a -> a
groupCombine a
forall a. Group a => a
groupIdentity a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a Bool -> Bool -> Bool
&& a -> a -> a
forall a. Group a => a -> a -> a
groupCombine a
a a
forall a. Group a => a
groupIdentity a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a) [a]
xs
        )
    ,
        ( String
"group inverses"
        , (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            ( \a
a ->
                a -> a -> a
forall a. Group a => a -> a -> a
groupCombine a
a (a -> a
forall a. Group a => a -> a
groupInverse a
a) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Group a => a
groupIdentity
                    Bool -> Bool -> Bool
&& a -> a -> a
forall a. Group a => a -> a -> a
groupCombine (a -> a
forall a. Group a => a -> a
groupInverse a
a) a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Group a => a
groupIdentity
            )
            [a]
xs
        )
    ,
        ( String
"group associativity"
        , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [a -> a -> a
forall a. Group a => a -> a -> a
groupCombine (a -> a -> a
forall a. Group a => a -> a -> a
groupCombine a
a a
b) a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a
forall a. Group a => a -> a -> a
groupCombine a
a (a -> a -> a
forall a. Group a => a -> a -> a
groupCombine a
b a
c) | a
a <- [a]
xs, a
b <- [a]
xs, a
c <- [a]
xs]
        )
    ]

{- | Check module scalar identity, composition, and both distributive laws.
Vectors in the sample must belong to the same runtime space.
-}
moduleLaws :: (Eq v, Module s v) => [s] -> [v] -> [(String, Bool)]
moduleLaws :: forall v s. (Eq v, Module s v) => [s] -> [v] -> [(String, Bool)]
moduleLaws [s]
scalars [v]
vectors =
    [ (String
"module identity", (v -> Bool) -> [v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\v
v -> s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
forall a. Semiring a => a
one v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v) [v]
vectors)
    ,
        ( String
"module composition"
        , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale (s -> s -> s
forall a. Semiring a => a -> a -> a
times s
a s
b) v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
a (s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
b v
v)
            | s
a <- [s]
scalars
            , s
b <- [s]
scalars
            , v
v <- [v]
vectors
            ]
        )
    ,
        ( String
"scalar distributivity"
        , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ v -> v -> Either MathError v
forall scalar vector.
Module scalar vector =>
vector -> vector -> Either MathError vector
moduleAdd (s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
a v
v) (s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
b v
v) Either MathError v -> Either MathError v -> Bool
forall a. Eq a => a -> a -> Bool
== v -> Either MathError v
forall a b. b -> Either a b
Right (s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale (s -> s -> s
forall a. Semiring a => a -> a -> a
plus s
a s
b) v
v)
            | s
a <- [s]
scalars
            , s
b <- [s]
scalars
            , v
v <- [v]
vectors
            ]
        )
    ,
        ( String
"vector distributivity"
        , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ (v -> v) -> Either MathError v -> Either MathError v
forall a b. (a -> b) -> Either MathError a -> Either MathError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
a) (v -> v -> Either MathError v
forall scalar vector.
Module scalar vector =>
vector -> vector -> Either MathError vector
moduleAdd v
u v
v)
                Either MathError v -> Either MathError v -> Bool
forall a. Eq a => a -> a -> Bool
== v -> v -> Either MathError v
forall scalar vector.
Module scalar vector =>
vector -> vector -> Either MathError vector
moduleAdd (s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
a v
u) (s -> v -> v
forall scalar vector.
Module scalar vector =>
scalar -> vector -> vector
moduleScale s
a v
v)
            | s
a <- [s]
scalars
            , v
u <- [v]
vectors
            , v
v <- [v]
vectors
            ]
        )
    ]

-- | A canonical residue in Z/mZ, retaining its runtime modulus.
data Modular = Modular Integer Integer deriving (Modular -> Modular -> Bool
(Modular -> Modular -> Bool)
-> (Modular -> Modular -> Bool) -> Eq Modular
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Modular -> Modular -> Bool
== :: Modular -> Modular -> Bool
$c/= :: Modular -> Modular -> Bool
/= :: Modular -> Modular -> Bool
Eq, Int -> Modular -> ShowS
[Modular] -> ShowS
Modular -> String
(Int -> Modular -> ShowS)
-> (Modular -> String) -> ([Modular] -> ShowS) -> Show Modular
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Modular -> ShowS
showsPrec :: Int -> Modular -> ShowS
$cshow :: Modular -> String
show :: Modular -> String
$cshowList :: [Modular] -> ShowS
showList :: [Modular] -> ShowS
Show)

-- | Construct a residue, requiring m>1; arbitrary signed values are reduced.
modular :: Integer -> Integer -> Either MathError Modular
modular :: Integer -> Integer -> Either MathError Modular
modular Integer
modulus Integer
value
    | Integer
modulus Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
1 = MathError -> Either MathError Modular
forall a b. a -> Either a b
Left (String -> MathError
DomainError String
"modular modulus must exceed one")
    | Bool
otherwise = Modular -> Either MathError Modular
forall a b. b -> Either a b
Right (Integer -> Integer -> Modular
Modular Integer
modulus (Integer
value Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
modulus))

-- | Canonical value in [0,m).
modularValue :: Modular -> Integer
modularValue :: Modular -> Integer
modularValue (Modular Integer
_ Integer
a) = Integer
a

-- | Modulus greater than one.
modularModulus :: Modular -> Integer
modularModulus :: Modular -> Integer
modularModulus (Modular Integer
m Integer
_) = Integer
m

binaryModular :: (Integer -> Integer -> Integer) -> Modular -> Modular -> Either MathError Modular
binaryModular :: (Integer -> Integer -> Integer)
-> Modular -> Modular -> Either MathError Modular
binaryModular Integer -> Integer -> Integer
f (Modular Integer
m Integer
a) (Modular Integer
n Integer
b)
    | Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
n = MathError -> Either MathError Modular
forall a b. a -> Either a b
Left (String -> MathError
DomainError String
"different modular rings")
    | Bool
otherwise = Integer -> Integer -> Either MathError Modular
modular Integer
m (Integer -> Integer -> Integer
f Integer
a Integer
b)

-- | Checked residue addition.
addModular :: Modular -> Modular -> Either MathError Modular
addModular :: Modular -> Modular -> Either MathError Modular
addModular = (Integer -> Integer -> Integer)
-> Modular -> Modular -> Either MathError Modular
binaryModular Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)

-- | Checked residue subtraction.
subtractModular :: Modular -> Modular -> Either MathError Modular
subtractModular :: Modular -> Modular -> Either MathError Modular
subtractModular = (Integer -> Integer -> Integer)
-> Modular -> Modular -> Either MathError Modular
binaryModular (-)

-- | Checked residue multiplication.
multiplyModular :: Modular -> Modular -> Either MathError Modular
multiplyModular :: Modular -> Modular -> Either MathError Modular
multiplyModular = (Integer -> Integer -> Integer)
-> Modular -> Modular -> Either MathError Modular
binaryModular Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)

-- | Invert a unit; zero and nonunits are domain errors.
inverseModular :: Modular -> Either MathError Modular
inverseModular :: Modular -> Either MathError Modular
inverseModular (Modular Integer
m Integer
a) = Integer -> Integer -> Either MathError Integer
modInverse Integer
a Integer
m Either MathError Integer
-> (Integer -> Either MathError Modular)
-> Either MathError Modular
forall a b.
Either MathError a
-> (a -> Either MathError b) -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Integer -> Either MathError Modular
modular Integer
m

-- | Integer power, with negative powers supported for units.
powerModular :: Modular -> Integer -> Either MathError Modular
powerModular :: Modular -> Integer -> Either MathError Modular
powerModular (Modular Integer
m Integer
a) Integer
e = Integer -> Integer -> Integer -> Either MathError Integer
modPow Integer
a Integer
e Integer
m Either MathError Integer
-> (Integer -> Either MathError Modular)
-> Either MathError Modular
forall a b.
Either MathError a
-> (a -> Either MathError b) -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Integer -> Either MathError Modular
modular Integer
m

{- | An irreducible monic modulus over the proven prime field F_p.
Coefficients are ascending canonical residues.
-}
data FiniteField = FiniteField Integer [Integer] deriving (FiniteField -> FiniteField -> Bool
(FiniteField -> FiniteField -> Bool)
-> (FiniteField -> FiniteField -> Bool) -> Eq FiniteField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FiniteField -> FiniteField -> Bool
== :: FiniteField -> FiniteField -> Bool
$c/= :: FiniteField -> FiniteField -> Bool
/= :: FiniteField -> FiniteField -> Bool
Eq, Int -> FiniteField -> ShowS
[FiniteField] -> ShowS
FiniteField -> String
(Int -> FiniteField -> ShowS)
-> (FiniteField -> String)
-> ([FiniteField] -> ShowS)
-> Show FiniteField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FiniteField -> ShowS
showsPrec :: Int -> FiniteField -> ShowS
$cshow :: FiniteField -> String
show :: FiniteField -> String
$cshowList :: [FiniteField] -> ShowS
showList :: [FiniteField] -> ShowS
Show)

{- | Construct GF(p^n) from an irreducible polynomial of positive degree.
Primality is proven by trial division. Irreducibility uses successive
Frobenius powers and polynomial gcds; n must not exceed the proof budget.
-}
finiteField :: Int -> Integer -> [Integer] -> Either MathError FiniteField
finiteField :: Int -> Integer -> [Integer] -> Either MathError FiniteField
finiteField Int
budget Integer
p [Integer]
cs = do
    prime <- Int -> Integer -> Either MathError Bool
isPrimeExact Int
budget Integer
p
    if not prime
        then Left (DomainError "field characteristic must be prime")
        else do
            let reduced = [Integer] -> [Integer]
trim ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p) [Integer]
cs)
                degree = [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
reduced Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            if degree < 1
                then Left (DomainError "field modulus needs positive degree")
                else
                    if degree > budget
                        then Left (NonConvergence "finite-field irreducibility" budget)
                        else do
                            inv <- modInverse (leading reduced) p
                            let f = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
a -> Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
inv Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p) [Integer]
reduced
                                x = Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p [Integer
0, Integer
1] [Integer]
f
                                powers = Int -> [[Integer]] -> [[Integer]]
forall a. Int -> [a] -> [a]
take (Int
degree Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (([Integer] -> [Integer]) -> [Integer] -> [[Integer]]
forall a. (a -> a) -> a -> [a]
iterate (\[Integer]
a -> Integer -> [Integer] -> Integer -> [Integer] -> [Integer]
polyPow Integer
p [Integer]
a Integer
p [Integer]
f) [Integer]
x)
                                proper =
                                    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
                                        [ [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Integer -> [Integer] -> [Integer] -> [Integer]
polyGCD Integer
p (Integer -> [Integer] -> [Integer] -> [Integer]
polySub Integer
p [Integer]
h [Integer]
x) [Integer]
f) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                        | [Integer]
h <- Int -> [[Integer]] -> [[Integer]]
forall a. Int -> [a] -> [a]
take (Int
degree Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Int -> [[Integer]] -> [[Integer]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Integer]]
powers)
                                        ]
                                final = [[Integer]] -> [Integer]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [[Integer]] -> [[Integer]]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [[Integer]] -> [[Integer]]
forall a. Int -> [a] -> [a]
drop Int
degree [[Integer]]
powers))
                            if proper && final == x
                                then Right (FiniteField p f)
                                else Left (DomainError "reducible finite-field modulus")

-- | Prime field GF(p), represented as F_p[x]/(x).
primeField :: Int -> Integer -> Either MathError FiniteField
primeField :: Int -> Integer -> Either MathError FiniteField
primeField Int
budget Integer
p = Int -> Integer -> [Integer] -> Either MathError FiniteField
finiteField Int
budget Integer
p [Integer
0, Integer
1]

-- | Prime characteristic p.
fieldCharacteristic :: FiniteField -> Integer
fieldCharacteristic :: FiniteField -> Integer
fieldCharacteristic (FiniteField Integer
p [Integer]
_) = Integer
p

-- | Extension degree n.
fieldDegree :: FiniteField -> Int
fieldDegree :: FiniteField -> Int
fieldDegree (FiniteField Integer
_ [Integer]
f) = [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Exact carrier size p^n.
fieldCardinality :: FiniteField -> Integer
fieldCardinality :: FiniteField -> Integer
fieldCardinality FiniteField
f = FiniteField -> Integer
fieldCharacteristic FiniteField
f Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ FiniteField -> Int
fieldDegree FiniteField
f

-- | Ascending coefficients of the monic irreducible defining polynomial.
fieldModulus :: FiniteField -> [Integer]
fieldModulus :: FiniteField -> [Integer]
fieldModulus (FiniteField Integer
_ [Integer]
f) = [Integer]
f

-- | A canonical residue polynomial of degree smaller than its field degree.
data FieldElement = FieldElement FiniteField [Integer] deriving (FieldElement -> FieldElement -> Bool
(FieldElement -> FieldElement -> Bool)
-> (FieldElement -> FieldElement -> Bool) -> Eq FieldElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldElement -> FieldElement -> Bool
== :: FieldElement -> FieldElement -> Bool
$c/= :: FieldElement -> FieldElement -> Bool
/= :: FieldElement -> FieldElement -> Bool
Eq, Int -> FieldElement -> ShowS
[FieldElement] -> ShowS
FieldElement -> String
(Int -> FieldElement -> ShowS)
-> (FieldElement -> String)
-> ([FieldElement] -> ShowS)
-> Show FieldElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldElement -> ShowS
showsPrec :: Int -> FieldElement -> ShowS
$cshow :: FieldElement -> String
show :: FieldElement -> String
$cshowList :: [FieldElement] -> ShowS
showList :: [FieldElement] -> ShowS
Show)

-- | Reduce an arbitrary integer polynomial into a finite field.
fieldElement :: FiniteField -> [Integer] -> FieldElement
fieldElement :: FiniteField -> [Integer] -> FieldElement
fieldElement f :: FiniteField
f@(FiniteField Integer
p [Integer]
modulus) [Integer]
xs = FiniteField -> [Integer] -> FieldElement
FieldElement FiniteField
f (Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p ([Integer] -> [Integer]
trim ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p) [Integer]
xs)) [Integer]
modulus)

-- | Canonical ascending residue coefficients (trailing zeros removed).
fieldElementCoefficients :: FieldElement -> [Integer]
fieldElementCoefficients :: FieldElement -> [Integer]
fieldElementCoefficients (FieldElement FiniteField
_ [Integer]
xs) = [Integer]
xs

{- | Enumerate the complete carrier, rejecting sizes above an explicit storage
budget. Enumeration is coefficient-lexicographic and deterministic.
-}
fieldElements :: Int -> FiniteField -> Either MathError [FieldElement]
fieldElements :: Int -> FiniteField -> Either MathError [FieldElement]
fieldElements Int
budget FiniteField
f
    | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = MathError -> Either MathError [FieldElement]
forall a b. a -> Either a b
Left (String -> MathError
InvalidArgument String
"negative finite-field enumeration budget")
    | FiniteField -> Integer
fieldCardinality FiniteField
f Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
budget = MathError -> Either MathError [FieldElement]
forall a b. a -> Either a b
Left (String -> Int -> MathError
NonConvergence String
"finite-field enumeration" Int
budget)
    | Bool
otherwise =
        [FieldElement] -> Either MathError [FieldElement]
forall a b. b -> Either a b
Right
            [FiniteField -> [Integer] -> FieldElement
fieldElement FiniteField
f [Integer]
xs | [Integer]
xs <- [[Integer]] -> [[Integer]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Int -> [Integer] -> [[Integer]]
forall a. Int -> a -> [a]
replicate (FiniteField -> Int
fieldDegree FiniteField
f) [Integer
0 .. FiniteField -> Integer
fieldCharacteristic FiniteField
f Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1])]

binaryField ::
    (Integer -> [Integer] -> [Integer] -> [Integer]) ->
    FieldElement ->
    FieldElement ->
    Either MathError FieldElement
binaryField :: (Integer -> [Integer] -> [Integer] -> [Integer])
-> FieldElement -> FieldElement -> Either MathError FieldElement
binaryField Integer -> [Integer] -> [Integer] -> [Integer]
op (FieldElement FiniteField
f [Integer]
a) (FieldElement FiniteField
g [Integer]
b)
    | FiniteField
f FiniteField -> FiniteField -> Bool
forall a. Eq a => a -> a -> Bool
/= FiniteField
g = MathError -> Either MathError FieldElement
forall a b. a -> Either a b
Left (String -> MathError
DomainError String
"different finite fields")
    | Bool
otherwise = FieldElement -> Either MathError FieldElement
forall a b. b -> Either a b
Right (FiniteField -> [Integer] -> FieldElement
fieldElement FiniteField
f (Integer -> [Integer] -> [Integer] -> [Integer]
op (FiniteField -> Integer
fieldCharacteristic FiniteField
f) [Integer]
a [Integer]
b))

-- | Addition; different defining fields are rejected even if isomorphic.
addField :: FieldElement -> FieldElement -> Either MathError FieldElement
addField :: FieldElement -> FieldElement -> Either MathError FieldElement
addField = (Integer -> [Integer] -> [Integer] -> [Integer])
-> FieldElement -> FieldElement -> Either MathError FieldElement
binaryField Integer -> [Integer] -> [Integer] -> [Integer]
polyAdd

-- | Additive inverse in the same field.
negateField :: FieldElement -> FieldElement
negateField :: FieldElement -> FieldElement
negateField (FieldElement FiniteField
f [Integer]
xs) = FiniteField -> [Integer] -> FieldElement
fieldElement FiniteField
f ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Integer
forall a. Num a => a -> a
negate [Integer]
xs)

-- | Checked field subtraction.
subtractField :: FieldElement -> FieldElement -> Either MathError FieldElement
subtractField :: FieldElement -> FieldElement -> Either MathError FieldElement
subtractField FieldElement
a FieldElement
b = FieldElement -> FieldElement -> Either MathError FieldElement
addField FieldElement
a (FieldElement -> FieldElement
negateField FieldElement
b)

-- | Checked field multiplication, reduced modulo the defining polynomial.
multiplyField :: FieldElement -> FieldElement -> Either MathError FieldElement
multiplyField :: FieldElement -> FieldElement -> Either MathError FieldElement
multiplyField = (Integer -> [Integer] -> [Integer] -> [Integer])
-> FieldElement -> FieldElement -> Either MathError FieldElement
binaryField Integer -> [Integer] -> [Integer] -> [Integer]
polyMul

-- | Nonzero inverse via the finite-field identity a^(q-2).
inverseFieldElement :: FieldElement -> Either MathError FieldElement
inverseFieldElement :: FieldElement -> Either MathError FieldElement
inverseFieldElement (FieldElement FiniteField
_ []) = MathError -> Either MathError FieldElement
forall a b. a -> Either a b
Left (String -> MathError
DomainError String
"zero finite-field inverse")
inverseFieldElement a :: FieldElement
a@(FieldElement FiniteField
f [Integer]
_) = FieldElement -> Integer -> Either MathError FieldElement
powerField FieldElement
a (FiniteField -> Integer
fieldCardinality FiniteField
f Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2)

-- | Binary exponentiation, with inverses for negative exponents.
powerField :: FieldElement -> Integer -> Either MathError FieldElement
powerField :: FieldElement -> Integer -> Either MathError FieldElement
powerField a :: FieldElement
a@(FieldElement FiniteField
f [Integer]
xs) Integer
k
    | Integer
k Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = do inv <- FieldElement -> Either MathError FieldElement
inverseFieldElement FieldElement
a; powerField inv (-k)
    | Bool
otherwise = case FiniteField
f of
        FiniteField Integer
p [Integer]
modulus -> FieldElement -> Either MathError FieldElement
forall a b. b -> Either a b
Right (FiniteField -> [Integer] -> FieldElement
fieldElement FiniteField
f (Integer -> [Integer] -> Integer -> [Integer] -> [Integer]
polyPow Integer
p [Integer]
xs Integer
k [Integer]
modulus))

{- | Exhaustive carrier checks for small fields, including distributivity,
associativity, identities and every nonzero inverse. Budget bounds enumeration;
the cubic law checks are intended for small validation fields.
-}
finiteFieldLaws :: Int -> FiniteField -> Either MathError [(String, Bool)]
finiteFieldLaws :: Int -> FiniteField -> Either MathError [(String, Bool)]
finiteFieldLaws Int
budget FiniteField
f = do
    xs <- Int -> FiniteField -> Either MathError [FieldElement]
fieldElements Int
budget FiniteField
f
    let z = FiniteField -> [Integer] -> FieldElement
fieldElement FiniteField
f []
        o = FiniteField -> [Integer] -> FieldElement
fieldElement FiniteField
f [Integer
1]
        plusF FieldElement
a FieldElement
b = FieldElement -> FieldElement -> Either MathError FieldElement
addField FieldElement
a FieldElement
b
        mulF FieldElement
a FieldElement
b = FieldElement -> FieldElement -> Either MathError FieldElement
multiplyField FieldElement
a FieldElement
b
    pure
        [ ("field additive identity", all (\FieldElement
a -> FieldElement -> FieldElement -> Either MathError FieldElement
plusF FieldElement
a FieldElement
z Either MathError FieldElement
-> Either MathError FieldElement -> Bool
forall a. Eq a => a -> a -> Bool
== FieldElement -> Either MathError FieldElement
forall a b. b -> Either a b
Right FieldElement
a) xs)
        , ("field multiplicative identity", all (\FieldElement
a -> FieldElement -> FieldElement -> Either MathError FieldElement
mulF FieldElement
a FieldElement
o Either MathError FieldElement
-> Either MathError FieldElement -> Bool
forall a. Eq a => a -> a -> Bool
== FieldElement -> Either MathError FieldElement
forall a b. b -> Either a b
Right FieldElement
a) xs)
        , ("field additive inverses", all (\FieldElement
a -> FieldElement -> FieldElement -> Either MathError FieldElement
plusF FieldElement
a (FieldElement -> FieldElement
negateField FieldElement
a) Either MathError FieldElement
-> Either MathError FieldElement -> Bool
forall a. Eq a => a -> a -> Bool
== FieldElement -> Either MathError FieldElement
forall a b. b -> Either a b
Right FieldElement
z) xs)
        ,
            ( "field multiplicative inverses"
            , all (\FieldElement
a -> FieldElement
a FieldElement -> FieldElement -> Bool
forall a. Eq a => a -> a -> Bool
== FieldElement
z Bool -> Bool -> Bool
|| (FieldElement -> Either MathError FieldElement
inverseFieldElement FieldElement
a Either MathError FieldElement
-> (FieldElement -> Either MathError FieldElement)
-> Either MathError FieldElement
forall a b.
Either MathError a
-> (a -> Either MathError b) -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldElement -> FieldElement -> Either MathError FieldElement
mulF FieldElement
a) Either MathError FieldElement
-> Either MathError FieldElement -> Bool
forall a. Eq a => a -> a -> Bool
== FieldElement -> Either MathError FieldElement
forall a b. b -> Either a b
Right FieldElement
o) xs
            )
        ,
            ( "field additive associativity"
            , and [(plusF a b >>= (`plusF` c)) == (plusF b c >>= plusF a) | a <- xs, b <- xs, c <- xs]
            )
        ,
            ( "field multiplicative associativity"
            , and [(mulF a b >>= (`mulF` c)) == (mulF b c >>= mulF a) | a <- xs, b <- xs, c <- xs]
            )
        ,
            ( "field distributivity"
            , and
                [ (plusF b c >>= mulF a) == (do ab <- mulF a b; ac <- mulF a c; plusF ab ac)
                | a <- xs
                , b <- xs
                , c <- xs
                ]
            )
        ]

trim :: [Integer] -> [Integer]
trim :: [Integer] -> [Integer]
trim = [Integer] -> [Integer]
forall a. [a] -> [a]
reverse ([Integer] -> [Integer])
-> ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) ([Integer] -> [Integer])
-> ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Integer]
forall a. [a] -> [a]
reverse

leading :: [Integer] -> Integer
leading :: [Integer] -> Integer
leading = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
_ Integer
x -> Integer
x) Integer
0

polyAdd :: Integer -> [Integer] -> [Integer] -> [Integer]
polyAdd :: Integer -> [Integer] -> [Integer] -> [Integer]
polyAdd Integer
p [Integer]
a [Integer]
b = [Integer] -> [Integer]
trim ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p) ([Integer] -> [Integer] -> [Integer]
forall {a}. Num a => [a] -> [a] -> [a]
add [Integer]
a [Integer]
b))
  where
    add :: [a] -> [a] -> [a]
add [] [a]
ys = [a]
ys; add [a]
xs [] = [a]
xs; add (a
x : [a]
xs) (a
y : [a]
ys) = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
add [a]
xs [a]
ys

polySub :: Integer -> [Integer] -> [Integer] -> [Integer]
polySub :: Integer -> [Integer] -> [Integer] -> [Integer]
polySub Integer
p [Integer]
a [Integer]
b = Integer -> [Integer] -> [Integer] -> [Integer]
polyAdd Integer
p [Integer]
a ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Integer
forall a. Num a => a -> a
negate [Integer]
b)

polyMul :: Integer -> [Integer] -> [Integer] -> [Integer]
polyMul :: Integer -> [Integer] -> [Integer] -> [Integer]
polyMul Integer
p [Integer]
a [Integer]
b = ([Integer] -> [Integer] -> [Integer])
-> [Integer] -> [[Integer]] -> [Integer]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Integer -> [Integer] -> [Integer] -> [Integer]
polyAdd Integer
p) [] [Int -> Integer -> [Integer]
forall a. Int -> a -> [a]
replicate Int
i Integer
0 [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*) [Integer]
b | (Int
i, Integer
x) <- [Int] -> [Integer] -> [(Int, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Integer]
a]

polyRemainder :: Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder :: Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p [Integer]
a [Integer]
b
    | [Integer] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Integer]
b = []
    | [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
b = [Integer] -> [Integer]
trim ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p) [Integer]
a)
    | Bool
otherwise =
        let inv :: Integer
inv = (MathError -> Integer)
-> (Integer -> Integer) -> Either MathError Integer -> Integer
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Integer -> MathError -> Integer
forall a b. a -> b -> a
const Integer
0) Integer -> Integer
forall a. a -> a
id (Integer -> Integer -> Either MathError Integer
modInverse ([Integer] -> Integer
leading [Integer]
b) Integer
p)
            factor :: Integer
factor = [Integer] -> Integer
leading [Integer]
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
inv Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p
            result :: [Integer]
result = Integer -> [Integer] -> [Integer] -> [Integer]
polySub Integer
p [Integer]
a (Int -> Integer -> [Integer]
forall a. Int -> a -> [a]
replicate ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
b) Integer
0 [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer
factor Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*) [Integer]
b)
         in Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p [Integer]
result [Integer]
b

polyGCD :: Integer -> [Integer] -> [Integer] -> [Integer]
polyGCD :: Integer -> [Integer] -> [Integer] -> [Integer]
polyGCD Integer
p [Integer]
a [] =
    let inv :: Integer
inv = (MathError -> Integer)
-> (Integer -> Integer) -> Either MathError Integer -> Integer
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Integer -> MathError -> Integer
forall a b. a -> b -> a
const Integer
0) Integer -> Integer
forall a. a -> a
id (Integer -> Integer -> Either MathError Integer
modInverse ([Integer] -> Integer
leading [Integer]
a) Integer
p)
     in (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
x -> Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
inv Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p) [Integer]
a
polyGCD Integer
p [Integer]
a [Integer]
b = Integer -> [Integer] -> [Integer] -> [Integer]
polyGCD Integer
p [Integer]
b (Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p [Integer]
a [Integer]
b)

polyPow :: Integer -> [Integer] -> Integer -> [Integer] -> [Integer]
polyPow :: Integer -> [Integer] -> Integer -> [Integer] -> [Integer]
polyPow Integer
p [Integer]
a Integer
e [Integer]
modulus = [Integer] -> Integer -> [Integer] -> [Integer]
forall {a}. Integral a => [Integer] -> a -> [Integer] -> [Integer]
go (Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p [Integer]
a [Integer]
modulus) Integer
e [Integer
1]
  where
    go :: [Integer] -> a -> [Integer] -> [Integer]
go [Integer]
_ a
0 [Integer]
r = Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p [Integer]
r [Integer]
modulus
    go [Integer]
x a
k [Integer]
r =
        [Integer] -> a -> [Integer] -> [Integer]
go
            (Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p (Integer -> [Integer] -> [Integer] -> [Integer]
polyMul Integer
p [Integer]
x [Integer]
x) [Integer]
modulus)
            (a
k a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2)
            (if a -> Bool
forall a. Integral a => a -> Bool
odd a
k then Integer -> [Integer] -> [Integer] -> [Integer]
polyRemainder Integer
p (Integer -> [Integer] -> [Integer] -> [Integer]
polyMul Integer
p [Integer]
r [Integer]
x) [Integer]
modulus else [Integer]
r)