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, gcdExt)
import Data.Field (Field)
import Data.Group (Group(..))
import Data.Poly (VPoly, monomial, toPoly, unPoly, scale, leading)
import Data.Semiring (Ring(..), Semiring(..))
import GHC.Exts (IsList(..))
import Test.QuickCheck (Arbitrary(..), vector)
import Text.PrettyPrint.Leijen.Text (Pretty(..))
import Data.Field.Galois.Base (GaloisField(..))
import Data.Field.Galois.Frobenius (frobenius)
class GaloisField k => IrreducibleMonic p k where
{-# MINIMAL poly #-}
poly :: Extension p k -> VPoly k
class GaloisField k => ExtensionField k where
{-# MINIMAL fromE #-}
fromE :: (GaloisField l, IrreducibleMonic p l, k ~ Extension p l) => k -> [l]
newtype Extension p k = E (VPoly k)
deriving (Eq, Generic, NFData, Ord, Show)
instance IrreducibleMonic p k => ExtensionField (Extension p k) where
fromE = toList
{-# INLINABLE fromE #-}
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
#-}
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 #-}
instance IrreducibleMonic p k => Monoid (Extension p k) where
mempty = E 1
{-# INLINE mempty #-}
instance IrreducibleMonic p k => Semigroup (Extension p k) where
(<>) = (*)
{-# INLINE (<>) #-}
stimes = flip pow
{-# INLINE stimes #-}
instance IrreducibleMonic p k => Fractional (Extension p k) where
recip (E x) = case leading g of
Just (0, c) -> E $ scale 0 (recip c) y
_ -> divZeroError
where
(g, y) = gcdExt x $ poly (witness :: Extension p k)
{-# INLINABLE recip #-}
fromRational (x:%y) = fromInteger x / fromInteger y
{-# INLINABLE fromRational #-}
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."
instance IrreducibleMonic p k => Euclidean (Extension p k) where
degree = panic "Extension.degree: not implemented."
quotRem = (flip (,) 0 .) . (/)
{-# INLINE quotRem #-}
instance IrreducibleMonic p k => Field (Extension p k)
instance IrreducibleMonic p k => GcdDomain (Extension p k)
instance IrreducibleMonic p k => Ring (Extension p k) where
negate = P.negate
{-# INLINE negate #-}
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 #-}
instance IrreducibleMonic p k => Arbitrary (Extension p k) where
arbitrary = fromList <$> vector (fromIntegral $ deg' (witness :: Extension p k))
{-# INLINABLE arbitrary #-}
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 #-}
instance IrreducibleMonic p k => Pretty (Extension p k) where
pretty (E x) = pretty $ toList x
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."
deg' :: IrreducibleMonic p k => Extension p k -> Word
deg' = pred . fromIntegral . degree . poly
{-# INLINABLE deg' #-}
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 #-}
toE :: forall k p . IrreducibleMonic p k => [k] -> Extension p k
toE = E . flip rem (poly (witness :: Extension p k)) . fromList
{-# INLINABLE toE #-}
toE' :: forall k p . IrreducibleMonic p k => [k] -> Extension p k
toE' = fromList
{-# INLINABLE toE' #-}
pattern U :: IrreducibleMonic p k => Extension p k
pattern U <- _ where U = [0, 1]
pattern U2 :: IrreducibleMonic p k => Extension p k
pattern U2 <- _ where U2 = toE [0, 0, 1]
pattern U3 :: IrreducibleMonic p k => Extension p k
pattern U3 <- _ where U3 = toE [0, 0, 0, 1]
pattern V :: IrreducibleMonic p k => k -> Extension p k
pattern V <- _ where V = E . monomial 0
pattern X :: GaloisField k => VPoly k
pattern X <- _ where X = [0, 1]
pattern X2 :: GaloisField k => VPoly k
pattern X2 <- _ where X2 = [0, 0, 1]
pattern X3 :: GaloisField k => VPoly k
pattern X3 <- _ where X3 = [0, 0, 0, 1]
pattern Y :: IrreducibleMonic p k => VPoly k -> VPoly (Extension p k)
pattern Y <- _ where Y = monomial 0 . E