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(..))
newtype ExtensionField k im = EF (VPoly k)
deriving (Eq, Generic, Ord, Show)
type PolynomialRing = VPoly
class GaloisField k => IrreducibleMonic k im where
{-# MINIMAL split #-}
split :: ExtensionField k im -> VPoly k
deg' :: ExtensionField k im -> Int
deg' = pred . fromIntegral . degree . split
{-# INLINABLE deg' #-}
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
#-}
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 #-}
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."
instance IrreducibleMonic k im => Euclidean (ExtensionField k im) where
quotRem = (flip (,) 0 .) . (/)
{-# INLINE quotRem #-}
degree = panic "not implemented."
instance IrreducibleMonic k im => Field (ExtensionField k im) where
invert = recip
{-# INLINE invert #-}
minus = (-)
{-# INLINE minus #-}
instance IrreducibleMonic k im => GcdDomain (ExtensionField k im)
instance IrreducibleMonic k im => Ring (ExtensionField k im) where
negate = P.negate
{-# INLINE negate #-}
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 #-}
instance IrreducibleMonic k im => Arbitrary (ExtensionField k im) where
arbitrary = toField <$> vector (deg' (witness :: ExtensionField k im))
{-# INLINABLE arbitrary #-}
instance IrreducibleMonic k im => Pretty (ExtensionField k im) where
pretty (EF x) = pretty (toList (unPoly x))
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."
fromField :: ExtensionField k im -> [k]
fromField (EF x) = toList (unPoly x)
{-# INLINABLE fromField #-}
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 X2 :: GaloisField k => VPoly k
pattern X2 <- _ where X2 = toPoly (fromList [0, 0, 1])
pattern X3 :: GaloisField k => VPoly k
pattern X3 <- _ where X3 = toPoly (fromList [0, 0, 0, 1])
pattern Y :: IrreducibleMonic k im => VPoly k -> VPoly (ExtensionField k im)
pattern Y <- _ where Y = monomial 0 . EF
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 #-}
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 #-}