{-# LANGUAGE BangPatterns, DataKinds, KindSignatures, PatternSynonyms       #-}
{-# LANGUAGE PolyKinds, RankNTypes, ScopedTypeVariables                     #-}
{-# LANGUAGE StandaloneDeriving, TypeApplications, TypeInType, ViewPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
-- | Signature-based Groebner basis algorithms, such as Faugère's \(F_5\).
--
--   You can import "Algebra.Algorithms.Groebner.Signature.Rules" to
--   replace every occurence of @'Algebra.Algorithms.Groebner.calcGroebnerBasis'@ with @'f5'@;
--   but its effect is pervasive, you should not import in the /library-site/.
module Algebra.Algorithms.Groebner.Signature
  ( -- * Algorithms
    f5, f5With, calcSignatureGB, calcSignatureGBWith,
    withDegreeWeights, withTermWeights,
    reifyDegreeWeights, reifyTermWeights,
    -- * Classes
    ModuleOrdering(..),
    POT(..), TOP(..), Signature(..), OrdSig(OrdSig, MkOrdSig),
    DegreeWeighted(..), TermWeighted(..),
    DegreeWeightedPOT,DegreeWeightedTOP,
    TermWeightedPOT, TermWeightedTOP,
    -- * References
    -- $refs
  ) where
import           Algebra.Prelude.Core         hiding (Vector)
import qualified Control.Foldl                as Fl
import           Control.Monad.Loops          (whileJust_)
import           Control.Monad.ST.Combinators (ST, STRef, modifySTRef',
                                               newSTRef, readSTRef, runST,
                                               writeSTRef, (.%=))
import qualified Data.Coerce                  as DC
import qualified Data.Foldable                as F
import qualified Data.Heap                    as H
import           Data.Monoid                  (First (..))
import           Data.Reflection              (Reifies (..), reify)
import qualified Data.Set                     as Set
import qualified Data.Vector                  as V
import qualified Data.Vector.Generic          as GV
import qualified Data.Vector.Mutable          as MV
import qualified Data.Vector.Unboxed          as UV

data Entry a b = Entry { Entry a b -> a
priority :: !a
                       , Entry a b -> b
payload :: !b
                       } deriving (Int -> Entry a b -> ShowS
[Entry a b] -> ShowS
Entry a b -> String
(Int -> Entry a b -> ShowS)
-> (Entry a b -> String)
-> ([Entry a b] -> ShowS)
-> Show (Entry a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Entry a b -> ShowS
forall a b. (Show a, Show b) => [Entry a b] -> ShowS
forall a b. (Show a, Show b) => Entry a b -> String
showList :: [Entry a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Entry a b] -> ShowS
show :: Entry a b -> String
$cshow :: forall a b. (Show a, Show b) => Entry a b -> String
showsPrec :: Int -> Entry a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Entry a b -> ShowS
Show)

instance Eq a => Eq (Entry a b) where
  == :: Entry a b -> Entry a b -> Bool
(==) = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool)
-> (Entry a b -> a) -> Entry a b -> Entry a b -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entry a b -> a
forall a b. Entry a b -> a
priority
  {-# INLINE (==) #-}
  /= :: Entry a b -> Entry a b -> Bool
(/=) = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (a -> a -> Bool)
-> (Entry a b -> a) -> Entry a b -> Entry a b -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entry a b -> a
forall a b. Entry a b -> a
priority
  {-# INLINE (/=) #-}

instance Ord a => Ord (Entry a b) where
  compare :: Entry a b -> Entry a b -> Ordering
compare = (Entry a b -> a) -> Entry a b -> Entry a b -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Entry a b -> a
forall a b. Entry a b -> a
priority

-- | Calculates a Gröbner basis of a given ideal using
--   the signature-based algorithm as described in [Gao-Iv-Wang](#gao-iv-wang).
--
--   This is the fastest implementation in this library so far.
f5 :: (IsOrderedPolynomial a, Field (Coefficient a), Foldable t)
   => t a -> [a]
f5 :: t a -> [a]
f5 t a
ideal = let sideal :: Vector a
sideal = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> [a] -> Vector a
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t a
ideal
  in Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> Vector a -> [a]
forall a b. (a -> b) -> a -> b
$ ((Signature a, a) -> a) -> Vector (Signature a, a) -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Signature a, a) -> a
forall a b. (a, b) -> b
snd (Vector (Signature a, a) -> Vector a)
-> Vector (Signature a, a) -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector (Signature a, a)
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Vector poly -> Vector (Signature poly, poly)
calcSignatureGB Vector a
sideal
{-# INLINE [1] f5 #-}

f5With :: forall ord a pxy t. (IsOrderedPolynomial a, Field (Coefficient a), ModuleOrdering a ord, Foldable t)
       => pxy ord -> t a -> [a]
f5With :: pxy ord -> t a -> [a]
f5With pxy ord
pxy t a
ideal = let sideal :: Vector a
sideal = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> [a] -> Vector a
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t a
ideal
  in Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> Vector a -> [a]
forall a b. (a -> b) -> a -> b
$ ((Signature a, a) -> a) -> Vector (Signature a, a) -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Signature a, a) -> a
forall a b. (a, b) -> b
snd (Vector (Signature a, a) -> Vector a)
-> Vector (Signature a, a) -> Vector a
forall a b. (a -> b) -> a -> b
$ pxy ord -> Vector a -> Vector (Signature a, a)
forall k (pxy :: k -> *) (ord :: k) poly.
(Field (Coefficient poly), ModuleOrdering poly ord,
 IsOrderedPolynomial poly) =>
pxy ord -> Vector poly -> Vector (Signature poly, poly)
calcSignatureGBWith pxy ord
pxy Vector a
sideal
{-# INLINE [1] f5With #-}
{-# RULES
"f5With/Vector" forall pxy.
  f5With pxy = V.toList . V.map snd . calcSignatureGBWith pxy
"f5/Vector"
  f5 = V.toList . V.map snd . calcSignatureGB  #-}

calcSignatureGB :: forall poly.
                   (Field (Coefficient poly), IsOrderedPolynomial poly)
                => V.Vector poly -> V.Vector (Signature poly, poly)
calcSignatureGB :: Vector poly -> Vector (Signature poly, poly)
calcSignatureGB = Proxy POT
-> (forall k (gs :: k).
    Reifies gs (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
    Proxy (TermWeighted gs POT)
    -> Vector poly -> Vector (Signature poly, poly))
-> Vector poly
-> Vector (Signature poly, poly)
forall ord poly (proxy :: * -> *) a (t :: * -> *).
(IsOrderedPolynomial poly, ModuleOrdering poly ord, Foldable t) =>
proxy ord
-> (forall k (gs :: k).
    Reifies gs (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
    Proxy (TermWeighted gs ord) -> t poly -> a)
-> t poly
-> a
withTermWeights (Proxy POT
forall k (t :: k). Proxy t
Proxy @POT) ((forall k (gs :: k).
  Reifies gs (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
  Proxy (TermWeighted gs POT)
  -> Vector poly -> Vector (Signature poly, poly))
 -> Vector poly -> Vector (Signature poly, poly))
-> (forall k (gs :: k).
    Reifies gs (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
    Proxy (TermWeighted gs POT)
    -> Vector poly -> Vector (Signature poly, poly))
-> Vector poly
-> Vector (Signature poly, poly)
forall a b. (a -> b) -> a -> b
$ \Proxy (TermWeighted gs POT)
pxy Vector poly
gs -> Proxy (TermWeighted gs POT)
-> Vector poly -> Vector (Signature poly, poly)
forall k (pxy :: k -> *) (ord :: k) poly.
(Field (Coefficient poly), ModuleOrdering poly ord,
 IsOrderedPolynomial poly) =>
pxy ord -> Vector poly -> Vector (Signature poly, poly)
calcSignatureGBWith Proxy (TermWeighted gs POT)
pxy Vector poly
gs
{-# INLINE CONLIKE calcSignatureGB #-}

class IsOrderedPolynomial poly => ModuleOrdering poly ord where
  cmpModule :: proxy ord -> Signature poly -> Signature poly -> Ordering
  syzygyBase :: Field (Coefficient poly) => (Int, poly) -> (Int, poly) -> OrdSig ord poly
  syzygyBase (Int
i, poly
gi) (Int
j, poly
gj) =
    let u1' :: OrdSig ord poly
u1' = Int -> OMonom poly -> OrdSig ord poly
forall k poly (ord :: k). Int -> OMonom poly -> OrdSig ord poly
MkOrdSig Int
i (OMonom poly -> OrdSig ord poly) -> OMonom poly -> OrdSig ord poly
forall a b. (a -> b) -> a -> b
$ poly -> OMonom poly
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
gj
        u2' :: OrdSig ord poly
u2' = Int -> OMonom poly -> OrdSig ord poly
forall k poly (ord :: k). Int -> OMonom poly -> OrdSig ord poly
MkOrdSig Int
j (OMonom poly -> OrdSig ord poly) -> OMonom poly -> OrdSig ord poly
forall a b. (a -> b) -> a -> b
$ poly -> OMonom poly
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
gi
    in case OrdSig ord poly -> OrdSig ord poly -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OrdSig ord poly
u1' OrdSig ord poly
u2' of
      Ordering
LT -> OrdSig ord poly
u2'
      Ordering
_  -> OrdSig ord poly
u1'
  {-# INLINE syzygyBase #-}

data POT = POT deriving (ReadPrec [POT]
ReadPrec POT
Int -> ReadS POT
ReadS [POT]
(Int -> ReadS POT)
-> ReadS [POT] -> ReadPrec POT -> ReadPrec [POT] -> Read POT
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [POT]
$creadListPrec :: ReadPrec [POT]
readPrec :: ReadPrec POT
$creadPrec :: ReadPrec POT
readList :: ReadS [POT]
$creadList :: ReadS [POT]
readsPrec :: Int -> ReadS POT
$creadsPrec :: Int -> ReadS POT
Read, Int -> POT -> ShowS
[POT] -> ShowS
POT -> String
(Int -> POT -> ShowS)
-> (POT -> String) -> ([POT] -> ShowS) -> Show POT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [POT] -> ShowS
$cshowList :: [POT] -> ShowS
show :: POT -> String
$cshow :: POT -> String
showsPrec :: Int -> POT -> ShowS
$cshowsPrec :: Int -> POT -> ShowS
Show, POT -> POT -> Bool
(POT -> POT -> Bool) -> (POT -> POT -> Bool) -> Eq POT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: POT -> POT -> Bool
$c/= :: POT -> POT -> Bool
== :: POT -> POT -> Bool
$c== :: POT -> POT -> Bool
Eq, Eq POT
Eq POT
-> (POT -> POT -> Ordering)
-> (POT -> POT -> Bool)
-> (POT -> POT -> Bool)
-> (POT -> POT -> Bool)
-> (POT -> POT -> Bool)
-> (POT -> POT -> POT)
-> (POT -> POT -> POT)
-> Ord POT
POT -> POT -> Bool
POT -> POT -> Ordering
POT -> POT -> POT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: POT -> POT -> POT
$cmin :: POT -> POT -> POT
max :: POT -> POT -> POT
$cmax :: POT -> POT -> POT
>= :: POT -> POT -> Bool
$c>= :: POT -> POT -> Bool
> :: POT -> POT -> Bool
$c> :: POT -> POT -> Bool
<= :: POT -> POT -> Bool
$c<= :: POT -> POT -> Bool
< :: POT -> POT -> Bool
$c< :: POT -> POT -> Bool
compare :: POT -> POT -> Ordering
$ccompare :: POT -> POT -> Ordering
$cp1Ord :: Eq POT
Ord)

instance IsOrderedPolynomial poly => ModuleOrdering poly POT where
  cmpModule :: proxy POT -> Signature poly -> Signature poly -> Ordering
cmpModule proxy POT
_ (Signature Int
i OrderedMonomial (MOrder poly) (Arity poly)
m) (Signature Int
j OrderedMonomial (MOrder poly) (Arity poly)
n) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OrderedMonomial (MOrder poly) (Arity poly)
m OrderedMonomial (MOrder poly) (Arity poly)
n
  {-# INLINE cmpModule #-}
  syzygyBase :: (Int, poly) -> (Int, poly) -> OrdSig POT poly
syzygyBase (Int
i, poly
gi) (Int
j, poly
gj) =
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j
    then Int
-> OrderedMonomial (MOrder poly) (Arity poly) -> OrdSig POT poly
forall k poly (ord :: k). Int -> OMonom poly -> OrdSig ord poly
MkOrdSig Int
j (OrderedMonomial (MOrder poly) (Arity poly) -> OrdSig POT poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> OrdSig POT poly
forall a b. (a -> b) -> a -> b
$ poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
gi
    else Int
-> OrderedMonomial (MOrder poly) (Arity poly) -> OrdSig POT poly
forall k poly (ord :: k). Int -> OMonom poly -> OrdSig ord poly
MkOrdSig Int
i (OrderedMonomial (MOrder poly) (Arity poly) -> OrdSig POT poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> OrdSig POT poly
forall a b. (a -> b) -> a -> b
$ poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
gj
  {-# INLINE syzygyBase #-}

data TOP = TOP deriving (ReadPrec [TOP]
ReadPrec TOP
Int -> ReadS TOP
ReadS [TOP]
(Int -> ReadS TOP)
-> ReadS [TOP] -> ReadPrec TOP -> ReadPrec [TOP] -> Read TOP
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TOP]
$creadListPrec :: ReadPrec [TOP]
readPrec :: ReadPrec TOP
$creadPrec :: ReadPrec TOP
readList :: ReadS [TOP]
$creadList :: ReadS [TOP]
readsPrec :: Int -> ReadS TOP
$creadsPrec :: Int -> ReadS TOP
Read, Int -> TOP -> ShowS
[TOP] -> ShowS
TOP -> String
(Int -> TOP -> ShowS)
-> (TOP -> String) -> ([TOP] -> ShowS) -> Show TOP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TOP] -> ShowS
$cshowList :: [TOP] -> ShowS
show :: TOP -> String
$cshow :: TOP -> String
showsPrec :: Int -> TOP -> ShowS
$cshowsPrec :: Int -> TOP -> ShowS
Show, TOP -> TOP -> Bool
(TOP -> TOP -> Bool) -> (TOP -> TOP -> Bool) -> Eq TOP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TOP -> TOP -> Bool
$c/= :: TOP -> TOP -> Bool
== :: TOP -> TOP -> Bool
$c== :: TOP -> TOP -> Bool
Eq, Eq TOP
Eq TOP
-> (TOP -> TOP -> Ordering)
-> (TOP -> TOP -> Bool)
-> (TOP -> TOP -> Bool)
-> (TOP -> TOP -> Bool)
-> (TOP -> TOP -> Bool)
-> (TOP -> TOP -> TOP)
-> (TOP -> TOP -> TOP)
-> Ord TOP
TOP -> TOP -> Bool
TOP -> TOP -> Ordering
TOP -> TOP -> TOP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TOP -> TOP -> TOP
$cmin :: TOP -> TOP -> TOP
max :: TOP -> TOP -> TOP
$cmax :: TOP -> TOP -> TOP
>= :: TOP -> TOP -> Bool
$c>= :: TOP -> TOP -> Bool
> :: TOP -> TOP -> Bool
$c> :: TOP -> TOP -> Bool
<= :: TOP -> TOP -> Bool
$c<= :: TOP -> TOP -> Bool
< :: TOP -> TOP -> Bool
$c< :: TOP -> TOP -> Bool
compare :: TOP -> TOP -> Ordering
$ccompare :: TOP -> TOP -> Ordering
$cp1Ord :: Eq TOP
Ord)

instance IsOrderedPolynomial poly => ModuleOrdering poly TOP where
  cmpModule :: proxy TOP -> Signature poly -> Signature poly -> Ordering
cmpModule proxy TOP
_ (Signature Int
i OrderedMonomial (MOrder poly) (Arity poly)
m) (Signature Int
j OrderedMonomial (MOrder poly) (Arity poly)
n) = OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OrderedMonomial (MOrder poly) (Arity poly)
m OrderedMonomial (MOrder poly) (Arity poly)
n Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
  {-# INLINE cmpModule #-}

data WeightedPOT (gs :: k) = WeightedPOT
  deriving (ReadPrec [WeightedPOT gs]
ReadPrec (WeightedPOT gs)
Int -> ReadS (WeightedPOT gs)
ReadS [WeightedPOT gs]
(Int -> ReadS (WeightedPOT gs))
-> ReadS [WeightedPOT gs]
-> ReadPrec (WeightedPOT gs)
-> ReadPrec [WeightedPOT gs]
-> Read (WeightedPOT gs)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (gs :: k). ReadPrec [WeightedPOT gs]
forall k (gs :: k). ReadPrec (WeightedPOT gs)
forall k (gs :: k). Int -> ReadS (WeightedPOT gs)
forall k (gs :: k). ReadS [WeightedPOT gs]
readListPrec :: ReadPrec [WeightedPOT gs]
$creadListPrec :: forall k (gs :: k). ReadPrec [WeightedPOT gs]
readPrec :: ReadPrec (WeightedPOT gs)
$creadPrec :: forall k (gs :: k). ReadPrec (WeightedPOT gs)
readList :: ReadS [WeightedPOT gs]
$creadList :: forall k (gs :: k). ReadS [WeightedPOT gs]
readsPrec :: Int -> ReadS (WeightedPOT gs)
$creadsPrec :: forall k (gs :: k). Int -> ReadS (WeightedPOT gs)
Read, Int -> WeightedPOT gs -> ShowS
[WeightedPOT gs] -> ShowS
WeightedPOT gs -> String
(Int -> WeightedPOT gs -> ShowS)
-> (WeightedPOT gs -> String)
-> ([WeightedPOT gs] -> ShowS)
-> Show (WeightedPOT gs)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (gs :: k). Int -> WeightedPOT gs -> ShowS
forall k (gs :: k). [WeightedPOT gs] -> ShowS
forall k (gs :: k). WeightedPOT gs -> String
showList :: [WeightedPOT gs] -> ShowS
$cshowList :: forall k (gs :: k). [WeightedPOT gs] -> ShowS
show :: WeightedPOT gs -> String
$cshow :: forall k (gs :: k). WeightedPOT gs -> String
showsPrec :: Int -> WeightedPOT gs -> ShowS
$cshowsPrec :: forall k (gs :: k). Int -> WeightedPOT gs -> ShowS
Show, WeightedPOT gs -> WeightedPOT gs -> Bool
(WeightedPOT gs -> WeightedPOT gs -> Bool)
-> (WeightedPOT gs -> WeightedPOT gs -> Bool)
-> Eq (WeightedPOT gs)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Bool
/= :: WeightedPOT gs -> WeightedPOT gs -> Bool
$c/= :: forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Bool
== :: WeightedPOT gs -> WeightedPOT gs -> Bool
$c== :: forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Bool
Eq, Eq (WeightedPOT gs)
Eq (WeightedPOT gs)
-> (WeightedPOT gs -> WeightedPOT gs -> Ordering)
-> (WeightedPOT gs -> WeightedPOT gs -> Bool)
-> (WeightedPOT gs -> WeightedPOT gs -> Bool)
-> (WeightedPOT gs -> WeightedPOT gs -> Bool)
-> (WeightedPOT gs -> WeightedPOT gs -> Bool)
-> (WeightedPOT gs -> WeightedPOT gs -> WeightedPOT gs)
-> (WeightedPOT gs -> WeightedPOT gs -> WeightedPOT gs)
-> Ord (WeightedPOT gs)
WeightedPOT gs -> WeightedPOT gs -> Bool
WeightedPOT gs -> WeightedPOT gs -> Ordering
WeightedPOT gs -> WeightedPOT gs -> WeightedPOT gs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (gs :: k). Eq (WeightedPOT gs)
forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Bool
forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Ordering
forall k (gs :: k).
WeightedPOT gs -> WeightedPOT gs -> WeightedPOT gs
min :: WeightedPOT gs -> WeightedPOT gs -> WeightedPOT gs
$cmin :: forall k (gs :: k).
WeightedPOT gs -> WeightedPOT gs -> WeightedPOT gs
max :: WeightedPOT gs -> WeightedPOT gs -> WeightedPOT gs
$cmax :: forall k (gs :: k).
WeightedPOT gs -> WeightedPOT gs -> WeightedPOT gs
>= :: WeightedPOT gs -> WeightedPOT gs -> Bool
$c>= :: forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Bool
> :: WeightedPOT gs -> WeightedPOT gs -> Bool
$c> :: forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Bool
<= :: WeightedPOT gs -> WeightedPOT gs -> Bool
$c<= :: forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Bool
< :: WeightedPOT gs -> WeightedPOT gs -> Bool
$c< :: forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Bool
compare :: WeightedPOT gs -> WeightedPOT gs -> Ordering
$ccompare :: forall k (gs :: k). WeightedPOT gs -> WeightedPOT gs -> Ordering
$cp1Ord :: forall k (gs :: k). Eq (WeightedPOT gs)
Ord)

type DegreeWeightedPOT gs = DegreeWeighted gs POT
type DegreeWeightedTOP gs = DegreeWeighted gs TOP
type TermWeightedPOT gs   = TermWeighted gs POT
type TermWeightedTOP gs   = TermWeighted gs TOP

newtype DegreeWeighted (gs :: k) ord = DegreeWeighted ord
newtype TermWeighted (gs :: k) ord = TermWeighted ord

toDegreeWeights :: (IsOrderedPolynomial poly, Foldable t) => t poly -> UV.Vector Int
toDegreeWeights :: t poly -> Vector Int
toDegreeWeights = [Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
UV.fromList ([Int] -> Vector Int) -> (t poly -> [Int]) -> t poly -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (poly -> Int) -> [poly] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map poly -> Int
forall poly. IsPolynomial poly => poly -> Int
totalDegree' ([poly] -> [Int]) -> (t poly -> [poly]) -> t poly -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t poly -> [poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
{-# INLINE [1] toDegreeWeights #-}

toTermWeights :: (IsOrderedPolynomial poly, Foldable t) => t poly -> V.Vector (OMonom poly)
toTermWeights :: t poly -> Vector (OMonom poly)
toTermWeights = (poly -> OMonom poly) -> Vector poly -> Vector (OMonom poly)
forall a b. (a -> b) -> Vector a -> Vector b
V.map poly -> OMonom poly
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial (Vector poly -> Vector (OMonom poly))
-> (t poly -> Vector poly) -> t poly -> Vector (OMonom poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [poly] -> Vector poly
forall a. [a] -> Vector a
V.fromList ([poly] -> Vector poly)
-> (t poly -> [poly]) -> t poly -> Vector poly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t poly -> [poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
{-# INLINE [1] toTermWeights #-}

{-# RULES
"toDegreeWeghts/Vector"
  toDegreeWeights = GV.convert . V.map totalDegree'
"toTermWeghts/Vector"
  toTermWeights = V.map leadingMonomial
 #-}

reifyDegreeWeights :: forall ord poly proxy a t. (IsOrderedPolynomial poly, ModuleOrdering poly ord, Foldable t)
                   => proxy ord
                   -> t poly
                   -> (forall k (gs :: k). Reifies gs (UV.Vector Int) => Proxy (DegreeWeighted gs ord) -> t poly -> a)
                   -> a
reifyDegreeWeights :: proxy ord
-> t poly
-> (forall k (gs :: k).
    Reifies gs (Vector Int) =>
    Proxy (DegreeWeighted gs ord) -> t poly -> a)
-> a
reifyDegreeWeights proxy ord
_ t poly
pols forall k (gs :: k).
Reifies gs (Vector Int) =>
Proxy (DegreeWeighted gs ord) -> t poly -> a
act =
  let vec :: Vector Int
vec = t poly -> Vector Int
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Foldable t) =>
t poly -> Vector Int
toDegreeWeights t poly
pols
  in Vector Int
-> (forall s. Reifies s (Vector Int) => Proxy s -> a) -> a
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify Vector Int
vec ((forall s. Reifies s (Vector Int) => Proxy s -> a) -> a)
-> (forall s. Reifies s (Vector Int) => Proxy s -> a) -> a
forall a b. (a -> b) -> a -> b
$ \(Proxy s
Proxy :: Proxy gs) ->
     Proxy (DegreeWeighted s ord) -> t poly -> a
forall k (gs :: k).
Reifies gs (Vector Int) =>
Proxy (DegreeWeighted gs ord) -> t poly -> a
act (Proxy (DegreeWeighted s ord)
forall k (t :: k). Proxy t
Proxy :: Proxy (DegreeWeighted gs ord)) t poly
pols
{-# INLINE CONLIKE reifyDegreeWeights #-}

reifyTermWeights :: forall ord poly proxy a t. (IsOrderedPolynomial poly, ModuleOrdering poly ord, Foldable t)
                 => proxy ord
                 -> t poly
                 -> (forall k (gs :: k). Reifies gs (V.Vector (OMonom poly)) => Proxy (TermWeighted gs ord) -> t poly -> a)
                 -> a
reifyTermWeights :: proxy ord
-> t poly
-> (forall k (gs :: k).
    Reifies gs (Vector (OMonom poly)) =>
    Proxy (TermWeighted gs ord) -> t poly -> a)
-> a
reifyTermWeights proxy ord
_ t poly
pols forall k (gs :: k).
Reifies gs (Vector (OMonom poly)) =>
Proxy (TermWeighted gs ord) -> t poly -> a
act =
  let vec :: Vector (OMonom poly)
vec = t poly -> Vector (OMonom poly)
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Foldable t) =>
t poly -> Vector (OMonom poly)
toTermWeights t poly
pols
  in Vector (OMonom poly)
-> (forall s. Reifies s (Vector (OMonom poly)) => Proxy s -> a)
-> a
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify Vector (OMonom poly)
vec ((forall s. Reifies s (Vector (OMonom poly)) => Proxy s -> a) -> a)
-> (forall s. Reifies s (Vector (OMonom poly)) => Proxy s -> a)
-> a
forall a b. (a -> b) -> a -> b
$ \(Proxy s
Proxy :: Proxy gs) ->
     Proxy (TermWeighted s ord) -> t poly -> a
forall k (gs :: k).
Reifies gs (Vector (OMonom poly)) =>
Proxy (TermWeighted gs ord) -> t poly -> a
act (Proxy (TermWeighted s ord)
forall k (t :: k). Proxy t
Proxy :: Proxy (TermWeighted gs ord)) t poly
pols
{-# INLINE CONLIKE reifyTermWeights #-}

withDegreeWeights :: forall ord poly proxy a t. (IsOrderedPolynomial poly, ModuleOrdering poly ord, Foldable t)
                  => proxy ord
                  -> (forall k (gs :: k). Reifies gs (UV.Vector Int) => Proxy (DegreeWeighted gs ord) -> t poly -> a)
                  -> t poly -> a
withDegreeWeights :: proxy ord
-> (forall k (gs :: k).
    Reifies gs (Vector Int) =>
    Proxy (DegreeWeighted gs ord) -> t poly -> a)
-> t poly
-> a
withDegreeWeights proxy ord
_ forall k (gs :: k).
Reifies gs (Vector Int) =>
Proxy (DegreeWeighted gs ord) -> t poly -> a
bdy t poly
vs =
  Vector Int
-> (forall s. Reifies s (Vector Int) => Proxy s -> a) -> a
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify (t poly -> Vector Int
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Foldable t) =>
t poly -> Vector Int
toDegreeWeights t poly
vs) ((forall s. Reifies s (Vector Int) => Proxy s -> a) -> a)
-> (forall s. Reifies s (Vector Int) => Proxy s -> a) -> a
forall a b. (a -> b) -> a -> b
$ \(Proxy s
_ :: Proxy gs) ->
    Proxy (DegreeWeighted s ord) -> t poly -> a
forall k (gs :: k).
Reifies gs (Vector Int) =>
Proxy (DegreeWeighted gs ord) -> t poly -> a
bdy (Proxy (DegreeWeighted s ord)
forall k (t :: k). Proxy t
Proxy :: Proxy (DegreeWeighted gs ord)) t poly
vs
{-# INLINE CONLIKE withDegreeWeights #-}

withTermWeights :: forall ord poly proxy a t. (IsOrderedPolynomial poly, ModuleOrdering poly ord, Foldable t)
                  => proxy ord
                  -> (forall k (gs :: k). Reifies gs (V.Vector (OrderedMonomial (MOrder poly) (Arity poly)))
                      => Proxy (TermWeighted gs ord) -> t poly -> a)
                  -> t poly -> a
withTermWeights :: proxy ord
-> (forall k (gs :: k).
    Reifies gs (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
    Proxy (TermWeighted gs ord) -> t poly -> a)
-> t poly
-> a
withTermWeights proxy ord
_ forall k (gs :: k).
Reifies gs (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
Proxy (TermWeighted gs ord) -> t poly -> a
bdy t poly
vs =
  Vector (OrderedMonomial (MOrder poly) (Arity poly))
-> (forall s.
    Reifies s (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
    Proxy s -> a)
-> a
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify (t poly -> Vector (OrderedMonomial (MOrder poly) (Arity poly))
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Foldable t) =>
t poly -> Vector (OMonom poly)
toTermWeights t poly
vs) ((forall s.
  Reifies s (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
  Proxy s -> a)
 -> a)
-> (forall s.
    Reifies s (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
    Proxy s -> a)
-> a
forall a b. (a -> b) -> a -> b
$ \(Proxy s
_ :: Proxy gs) ->
    Proxy (TermWeighted s ord) -> t poly -> a
forall k (gs :: k).
Reifies gs (Vector (OrderedMonomial (MOrder poly) (Arity poly))) =>
Proxy (TermWeighted gs ord) -> t poly -> a
bdy (Proxy (TermWeighted s ord)
forall k (t :: k). Proxy t
Proxy :: Proxy (TermWeighted gs ord)) t poly
vs
{-# INLINE CONLIKE withTermWeights #-}

instance (ModuleOrdering poly ord, IsOrderedPolynomial poly, Reifies (gs :: k) (UV.Vector Int))
       => ModuleOrdering poly (DegreeWeighted gs ord) where
  cmpModule :: proxy (DegreeWeighted gs ord)
-> Signature poly -> Signature poly -> Ordering
cmpModule proxy (DegreeWeighted gs ord)
_ l :: Signature poly
l@(Signature Int
i OrderedMonomial (MOrder poly) (Arity poly)
t) r :: Signature poly
r@(Signature Int
j OrderedMonomial (MOrder poly) (Arity poly)
u) =
    let gs :: Vector Int
gs = Proxy gs -> Vector Int
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy gs
forall k (t :: k). Proxy t
Proxy :: Proxy gs)
    in Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
         (OrderedMonomial (MOrder poly) (Arity poly) -> Int
forall k (ord :: k) (n :: Nat). OrderedMonomial ord n -> Int
totalDegree OrderedMonomial (MOrder poly) (Arity poly)
t Int -> Int -> Int
forall r. Additive r => r -> r -> r
+ (Vector Int
gs Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
UV.! Int
i))
         (OrderedMonomial (MOrder poly) (Arity poly) -> Int
forall k (ord :: k) (n :: Nat). OrderedMonomial ord n -> Int
totalDegree OrderedMonomial (MOrder poly) (Arity poly)
u Int -> Int -> Int
forall r. Additive r => r -> r -> r
+ (Vector Int
gs Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
UV.! Int
j))
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Proxy ord -> Signature poly -> Signature poly -> Ordering
forall k poly (ord :: k) (proxy :: k -> *).
ModuleOrdering poly ord =>
proxy ord -> Signature poly -> Signature poly -> Ordering
cmpModule (Proxy ord
forall k (t :: k). Proxy t
Proxy @ord) Signature poly
l Signature poly
r
  {-# INLINE cmpModule #-}

instance (ModuleOrdering poly ord,
          IsOrderedPolynomial poly,
          Reifies (gs :: k) (V.Vector (OrderedMonomial (MOrder poly) (Arity poly))))
      => ModuleOrdering poly (TermWeighted gs ord) where
  cmpModule :: proxy (TermWeighted gs ord)
-> Signature poly -> Signature poly -> Ordering
cmpModule proxy (TermWeighted gs ord)
_ l :: Signature poly
l@(Signature Int
i OrderedMonomial (MOrder poly) (Arity poly)
t) r :: Signature poly
r@(Signature Int
j OrderedMonomial (MOrder poly) (Arity poly)
u) =
    let gs :: Vector (OrderedMonomial (MOrder poly) (Arity poly))
gs = Proxy gs -> Vector (OrderedMonomial (MOrder poly) (Arity poly))
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy gs
forall k (t :: k). Proxy t
Proxy :: Proxy gs)
    in OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
         (OrderedMonomial (MOrder poly) (Arity poly)
t OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
forall r. Multiplicative r => r -> r -> r
* (Vector (OrderedMonomial (MOrder poly) (Arity poly))
gs Vector (OrderedMonomial (MOrder poly) (Arity poly))
-> Int -> OrderedMonomial (MOrder poly) (Arity poly)
forall a. Vector a -> Int -> a
V.! Int
i))
         (OrderedMonomial (MOrder poly) (Arity poly)
u OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
forall r. Multiplicative r => r -> r -> r
* (Vector (OrderedMonomial (MOrder poly) (Arity poly))
gs Vector (OrderedMonomial (MOrder poly) (Arity poly))
-> Int -> OrderedMonomial (MOrder poly) (Arity poly)
forall a. Vector a -> Int -> a
V.! Int
j))
       Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Proxy ord -> Signature poly -> Signature poly -> Ordering
forall k poly (ord :: k) (proxy :: k -> *).
ModuleOrdering poly ord =>
proxy ord -> Signature poly -> Signature poly -> Ordering
cmpModule (Proxy ord
forall k (t :: k). Proxy t
Proxy @ord) Signature poly
l Signature poly
r
  {-# INLINE cmpModule #-}

data ModuleElement ord poly = ME { ModuleElement ord poly -> OrdSig ord poly
syzSign :: !(OrdSig ord poly)
                                 , ModuleElement ord poly -> poly
_polElem :: !poly
                                 }
                            deriving (ModuleElement ord poly -> ModuleElement ord poly -> Bool
(ModuleElement ord poly -> ModuleElement ord poly -> Bool)
-> (ModuleElement ord poly -> ModuleElement ord poly -> Bool)
-> Eq (ModuleElement ord poly)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (ord :: k) poly.
Eq poly =>
ModuleElement ord poly -> ModuleElement ord poly -> Bool
/= :: ModuleElement ord poly -> ModuleElement ord poly -> Bool
$c/= :: forall k (ord :: k) poly.
Eq poly =>
ModuleElement ord poly -> ModuleElement ord poly -> Bool
== :: ModuleElement ord poly -> ModuleElement ord poly -> Bool
$c== :: forall k (ord :: k) poly.
Eq poly =>
ModuleElement ord poly -> ModuleElement ord poly -> Bool
Eq)

data JPair poly = JPair { JPair poly -> OMonom poly
_jpTerm  :: !(OMonom poly)
                        , JPair poly -> Int
_jpIndex :: !Int
                        }
deriving instance KnownNat (Arity poly) => Show (JPair poly)
deriving instance KnownNat (Arity poly) => Eq (JPair poly)

class Multiplicative c => Action c a where
  (.*!) :: c -> a -> a

infixl 7 .*!

instance {-# OVERLAPPING #-} (Arity poly ~ k, MOrder poly ~ ord, IsOrderedPolynomial poly) =>
         Action (OrderedMonomial ord k) (ModuleElement mord poly) where
  OrderedMonomial ord k
m .*! :: OrderedMonomial ord k
-> ModuleElement mord poly -> ModuleElement mord poly
.*! ME OrdSig mord poly
u poly
v = OrdSig mord poly -> poly -> ModuleElement mord poly
forall k (ord :: k) poly.
OrdSig ord poly -> poly -> ModuleElement ord poly
ME (Signature poly -> OrdSig mord poly
forall k (ord :: k) poly. Signature poly -> OrdSig ord poly
OrdSig (Signature poly -> OrdSig mord poly)
-> Signature poly -> OrdSig mord poly
forall a b. (a -> b) -> a -> b
$ OrderedMonomial ord k
m OrderedMonomial ord k -> Signature poly -> Signature poly
forall c a. Action c a => c -> a -> a
.*! OrdSig mord poly -> Signature poly
forall k (ord :: k) poly. OrdSig ord poly -> Signature poly
runOrdSig OrdSig mord poly
u) (OrderedMonomial ord k
OrderedMonomial (MOrder poly) (Arity poly)
m OrderedMonomial (MOrder poly) (Arity poly) -> poly -> poly
forall poly.
IsOrderedPolynomial poly =>
OrderedMonomial (MOrder poly) (Arity poly) -> poly -> poly
>* poly
v)
  {-# INLINE (.*!) #-}

instance {-# OVERLAPPING #-} (Arity poly ~ k, MOrder poly ~ ord, IsOrderedPolynomial poly) =>
         Action (OrderedMonomial ord k) (Signature poly) where
  OrderedMonomial ord k
m .*! :: OrderedMonomial ord k -> Signature poly -> Signature poly
.*! Signature Int
i OrderedMonomial (MOrder poly) (Arity poly)
f = Int -> OrderedMonomial (MOrder poly) (Arity poly) -> Signature poly
forall poly.
Int -> OrderedMonomial (MOrder poly) (Arity poly) -> Signature poly
Signature Int
i (OrderedMonomial ord k
m OrderedMonomial ord k
-> OrderedMonomial ord k -> OrderedMonomial ord k
forall r. Multiplicative r => r -> r -> r
* OrderedMonomial ord k
OrderedMonomial (MOrder poly) (Arity poly)
f)
  {-# INLINE (.*!) #-}

instance {-# OVERLAPPING #-} (Arity poly ~ k, MOrder poly ~ ord, IsOrderedPolynomial poly) =>
         Action (OrderedMonomial ord k) (OrdSig mord poly) where
  .*! :: OrderedMonomial ord k -> OrdSig mord poly -> OrdSig mord poly
(.*!) = (OrderedMonomial ord k -> Signature poly -> Signature poly)
-> OrderedMonomial ord k -> OrdSig mord poly -> OrdSig mord poly
DC.coerce @(OrderedMonomial ord k -> Signature poly -> Signature poly) OrderedMonomial ord k -> Signature poly -> Signature poly
forall c a. Action c a => c -> a -> a
(.*!)
  {-# INLINE (.*!) #-}

-- | Calculates a Groebner basis for a given ideal, and a set of leading monomials of
--   Groebner basis of the associated syzygy module, as described in [Gao-Iv-Wang](#gao-iv-wang).
calcSignatureGBWith :: forall pxy ord poly.
                       (Field (Coefficient poly), ModuleOrdering poly ord, IsOrderedPolynomial poly)
                    => pxy ord -> V.Vector poly -> V.Vector (Signature poly, poly)
calcSignatureGBWith :: pxy ord -> Vector poly -> Vector (Signature poly, poly)
calcSignatureGBWith pxy ord
_ Vector poly
side | (poly -> Bool) -> Vector poly -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero Vector poly
side = Vector (Signature poly, poly)
forall a. Vector a
V.empty
calcSignatureGBWith pxy ord
_ ((poly -> poly) -> Vector poly -> Vector poly
forall a b. (a -> b) -> Vector a -> Vector b
V.map poly -> poly
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
poly -> poly
monoize (Vector poly -> Vector poly)
-> (Vector poly -> Vector poly) -> Vector poly -> Vector poly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (poly -> Bool) -> Vector poly -> Vector poly
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Bool -> Bool
not (Bool -> Bool) -> (poly -> Bool) -> poly -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero) -> Vector poly
sideal) = (forall s. ST s (Vector (Signature poly, poly)))
-> Vector (Signature poly, poly)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (Signature poly, poly)))
 -> Vector (Signature poly, poly))
-> (forall s. ST s (Vector (Signature poly, poly)))
-> Vector (Signature poly, poly)
forall a b. (a -> b) -> a -> b
$ do
  let n :: Int
n = Vector poly -> Int
forall a. Vector a -> Int
V.length Vector poly
sideal
      mods0 :: Vector (OrdSig ord poly)
mods0 = Int -> (Int -> OrdSig ord poly) -> Vector (OrdSig ord poly)
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
n Int -> OrdSig ord poly
forall k a (ord :: k). IsOrderedPolynomial a => Int -> OrdSig ord a
basis
      preGs :: Vector (ModuleElement ord poly)
preGs = (OrdSig ord poly -> poly -> ModuleElement ord poly)
-> Vector (OrdSig ord poly)
-> Vector poly
-> Vector (ModuleElement ord poly)
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith OrdSig ord poly -> poly -> ModuleElement ord poly
forall k (ord :: k) poly.
OrdSig ord poly -> poly -> ModuleElement ord poly
ME Vector (OrdSig ord poly)
mods0 Vector poly
sideal
      preHs :: Set (OrdSig ord poly)
preHs = [OrdSig ord poly] -> Set (OrdSig ord poly)
forall a. Ord a => [a] -> Set a
Set.fromList [ (Int, poly) -> (Int, poly) -> OrdSig ord poly
forall k poly (ord :: k).
(ModuleOrdering poly ord, Field (Coefficient poly)) =>
(Int, poly) -> (Int, poly) -> OrdSig ord poly
syzygyBase (Int
i, poly
gi) (Int
j, poly
gj)
                           | Int
j <- [Int
0..Int
n Int -> Int -> Int
forall r. Group r => r -> r -> r
- Int
1]
                           , Int
i <- [Int
0..Int
j Int -> Int -> Int
forall r. Group r => r -> r -> r
- Int
1]
                           , let (poly
gi, poly
gj) = (Vector poly
sideal Vector poly -> Int -> poly
forall a. Vector a -> Int -> a
V.! Int
i, Vector poly
sideal Vector poly -> Int -> poly
forall a. Vector a -> Int -> a
V.! Int
j)
                           ]
  STRef s (MVector s (ModuleElement ord poly))
gs <- MVector s (ModuleElement ord poly)
-> ST s (STRef s (MVector s (ModuleElement ord poly)))
forall a s. a -> ST s (STRef s a)
newSTRef (MVector s (ModuleElement ord poly)
 -> ST s (STRef s (MVector s (ModuleElement ord poly))))
-> ST s (MVector s (ModuleElement ord poly))
-> ST s (STRef s (MVector s (ModuleElement ord poly)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vector (ModuleElement ord poly)
-> ST s (MVector (PrimState (ST s)) (ModuleElement ord poly))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Vector (ModuleElement ord poly)
preGs
  STRef s (Set (OrdSig ord poly))
hs <- Set (OrdSig ord poly) -> ST s (STRef s (Set (OrdSig ord poly)))
forall a s. a -> ST s (STRef s a)
newSTRef Set (OrdSig ord poly)
preHs
  let preDecode :: JPair poly -> ModuleElement ord poly
      preDecode :: JPair poly -> ModuleElement ord poly
preDecode (JPair OMonom poly
m Int
i) = OMonom poly
m OMonom poly -> ModuleElement ord poly -> ModuleElement ord poly
forall c a. Action c a => c -> a -> a
.*! (Vector (ModuleElement ord poly)
preGs Vector (ModuleElement ord poly) -> Int -> ModuleElement ord poly
forall a. Vector a -> Int -> a
V.! Int
i)
      {-# INLINE preDecode #-}
  STRef s (Heap (Entry (OrdSig ord poly) (JPair poly)))
jprs <- Heap (Entry (OrdSig ord poly) (JPair poly))
-> ST s (STRef s (Heap (Entry (OrdSig ord poly) (JPair poly))))
forall a s. a -> ST s (STRef s a)
newSTRef (Heap (Entry (OrdSig ord poly) (JPair poly))
 -> ST s (STRef s (Heap (Entry (OrdSig ord poly) (JPair poly)))))
-> Heap (Entry (OrdSig ord poly) (JPair poly))
-> ST s (STRef s (Heap (Entry (OrdSig ord poly) (JPair poly))))
forall a b. (a -> b) -> a -> b
$ [Entry (OrdSig ord poly) (JPair poly)]
-> Heap (Entry (OrdSig ord poly) (JPair poly))
forall a. Ord a => [a] -> Heap a
H.fromList ([Entry (OrdSig ord poly) (JPair poly)]
 -> Heap (Entry (OrdSig ord poly) (JPair poly)))
-> [Entry (OrdSig ord poly) (JPair poly)]
-> Heap (Entry (OrdSig ord poly) (JPair poly))
forall a b. (a -> b) -> a -> b
$
          Fold
  (Entry (OrdSig ord poly) (JPair poly))
  [Entry (OrdSig ord poly) (JPair poly)]
-> [Entry (OrdSig ord poly) (JPair poly)]
-> [Entry (OrdSig ord poly) (JPair poly)]
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Fl.fold Fold
  (Entry (OrdSig ord poly) (JPair poly))
  [Entry (OrdSig ord poly) (JPair poly)]
forall a. Ord a => Fold a [a]
Fl.nub
          [ OrdSig ord poly
-> JPair poly -> Entry (OrdSig ord poly) (JPair poly)
forall a b. a -> b -> Entry a b
Entry OrdSig ord poly
sig JPair poly
jpr
          | Int
j <- [Int
0..Int
n Int -> Int -> Int
forall r. Group r => r -> r -> r
- Int
1]
          , Int
i <- [Int
0..Int
j Int -> Int -> Int
forall r. Group r => r -> r -> r
- Int
1]
          , let qi :: ModuleElement ord poly
qi = Vector (ModuleElement ord poly)
preGs Vector (ModuleElement ord poly) -> Int -> ModuleElement ord poly
forall a. Vector a -> Int -> a
V.! Int
i
          , let qj :: ModuleElement ord poly
qj = Vector (ModuleElement ord poly)
preGs Vector (ModuleElement ord poly) -> Int -> ModuleElement ord poly
forall a. Vector a -> Int -> a
V.! Int
j
          , (OrdSig ord poly
sig, JPair poly
jpr) <- Maybe (OrdSig ord poly, JPair poly)
-> [(OrdSig ord poly, JPair poly)]
forall a. Maybe a -> [a]
maybeToList (Maybe (OrdSig ord poly, JPair poly)
 -> [(OrdSig ord poly, JPair poly)])
-> Maybe (OrdSig ord poly, JPair poly)
-> [(OrdSig ord poly, JPair poly)]
forall a b. (a -> b) -> a -> b
$ (Int, ModuleElement ord poly)
-> (Int, ModuleElement ord poly)
-> Maybe (OrdSig ord poly, JPair poly)
forall k (ord :: k) poly.
(IsOrderedPolynomial poly, Field (Coefficient poly),
 ModuleOrdering poly ord) =>
(Int, ModuleElement ord poly)
-> (Int, ModuleElement ord poly)
-> Maybe (OrdSig ord poly, JPair poly)
jPair (Int
i, ModuleElement ord poly
qi) (Int
j, ModuleElement ord poly
qj)
          , let me :: ModuleElement ord poly
me = JPair poly -> ModuleElement ord poly
preDecode JPair poly
jpr
          , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleElement ord poly -> Bool)
-> Vector (ModuleElement ord poly) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ModuleElement ord poly -> ModuleElement ord poly -> Bool
forall k poly (ord :: k).
IsOrderedPolynomial poly =>
ModuleElement ord poly -> ModuleElement ord poly -> Bool
`covers` ModuleElement ord poly
me) Vector (ModuleElement ord poly)
preGs Bool -> Bool -> Bool
|| (OrdSig ord poly -> Bool) -> Set (OrdSig ord poly) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ModuleElement ord poly -> ModuleElement ord poly -> Bool
forall k poly (ord :: k).
IsOrderedPolynomial poly =>
ModuleElement ord poly -> ModuleElement ord poly -> Bool
`covers` ModuleElement ord poly
me) (ModuleElement ord poly -> Bool)
-> (OrdSig ord poly -> ModuleElement ord poly)
-> OrdSig ord poly
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature poly -> ModuleElement ord poly
forall k poly (ord :: k).
IsOrderedPolynomial poly =>
Signature poly -> ModuleElement ord poly
sigToElem (Signature poly -> ModuleElement ord poly)
-> (OrdSig ord poly -> Signature poly)
-> OrdSig ord poly
-> ModuleElement ord poly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSig ord poly -> Signature poly
forall k (ord :: k) poly. OrdSig ord poly -> Signature poly
runOrdSig) Set (OrdSig ord poly)
preHs
          ]
  ST
  s
  (Maybe
     (Entry (OrdSig ord poly) (JPair poly),
      Heap (Entry (OrdSig ord poly) (JPair poly))))
-> ((Entry (OrdSig ord poly) (JPair poly),
     Heap (Entry (OrdSig ord poly) (JPair poly)))
    -> ST s ())
-> ST s ()
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> (a -> m b) -> m ()
whileJust_ (Heap (Entry (OrdSig ord poly) (JPair poly))
-> Maybe
     (Entry (OrdSig ord poly) (JPair poly),
      Heap (Entry (OrdSig ord poly) (JPair poly)))
forall a. Heap a -> Maybe (a, Heap a)
H.viewMin (Heap (Entry (OrdSig ord poly) (JPair poly))
 -> Maybe
      (Entry (OrdSig ord poly) (JPair poly),
       Heap (Entry (OrdSig ord poly) (JPair poly))))
-> ST s (Heap (Entry (OrdSig ord poly) (JPair poly)))
-> ST
     s
     (Maybe
        (Entry (OrdSig ord poly) (JPair poly),
         Heap (Entry (OrdSig ord poly) (JPair poly))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (Heap (Entry (OrdSig ord poly) (JPair poly)))
-> ST s (Heap (Entry (OrdSig ord poly) (JPair poly)))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Heap (Entry (OrdSig ord poly) (JPair poly)))
jprs) (((Entry (OrdSig ord poly) (JPair poly),
   Heap (Entry (OrdSig ord poly) (JPair poly)))
  -> ST s ())
 -> ST s ())
-> ((Entry (OrdSig ord poly) (JPair poly),
     Heap (Entry (OrdSig ord poly) (JPair poly)))
    -> ST s ())
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Entry (OrdSig Signature poly
sig) (JPair OMonom poly
m0 Int
i0), Heap (Entry (OrdSig ord poly) (JPair poly))
jprs') -> do
    STRef s (Heap (Entry (OrdSig ord poly) (JPair poly)))
-> Heap (Entry (OrdSig ord poly) (JPair poly)) -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Heap (Entry (OrdSig ord poly) (JPair poly)))
jprs Heap (Entry (OrdSig ord poly) (JPair poly))
jprs'
    Vector (ModuleElement ord poly)
curGs <- MVector s (ModuleElement ord poly)
-> ST s (Vector (ModuleElement ord poly))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze (MVector s (ModuleElement ord poly)
 -> ST s (Vector (ModuleElement ord poly)))
-> ST s (MVector s (ModuleElement ord poly))
-> ST s (Vector (ModuleElement ord poly))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s (ModuleElement ord poly))
-> ST s (MVector s (ModuleElement ord poly))
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s (ModuleElement ord poly))
gs
    Set (OrdSig ord poly)
hs0   <- STRef s (Set (OrdSig ord poly)) -> ST s (Set (OrdSig ord poly))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Set (OrdSig ord poly))
hs
    let me :: ModuleElement ord poly
me = OMonom poly
m0 OMonom poly -> ModuleElement ord poly -> ModuleElement ord poly
forall c a. Action c a => c -> a -> a
.*! (Vector (ModuleElement ord poly)
curGs Vector (ModuleElement ord poly) -> Int -> ModuleElement ord poly
forall a. Vector a -> Int -> a
V.! Int
i0)
        next :: Bool
next = (ModuleElement ord poly -> Bool)
-> Vector (ModuleElement ord poly) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ModuleElement ord poly -> ModuleElement ord poly -> Bool
forall k poly (ord :: k).
IsOrderedPolynomial poly =>
ModuleElement ord poly -> ModuleElement ord poly -> Bool
`covers` ModuleElement ord poly
me) Vector (ModuleElement ord poly)
curGs Bool -> Bool -> Bool
|| (OrdSig ord poly -> Bool) -> Set (OrdSig ord poly) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Signature poly -> Signature poly -> Bool
forall poly.
IsOrderedPolynomial poly =>
Signature poly -> Signature poly -> Bool
`sigDivs` Signature poly
sig) (Signature poly -> Bool)
-> (OrdSig ord poly -> Signature poly) -> OrdSig ord poly -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSig ord poly -> Signature poly
forall k (ord :: k) poly. OrdSig ord poly -> Signature poly
runOrdSig) Set (OrdSig ord poly)
hs0
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
next (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
      let me' :: ModuleElement ord poly
me'@(ME OrdSig ord poly
t poly
v) = ModuleElement ord poly
-> Vector (ModuleElement ord poly) -> ModuleElement ord poly
forall k poly (ord :: k) (t :: * -> *).
(IsOrderedPolynomial poly, ModuleOrdering poly ord,
 Field (Coefficient poly), Functor t, Foldable t) =>
ModuleElement ord poly
-> t (ModuleElement ord poly) -> ModuleElement ord poly
reduceModuleElement ModuleElement ord poly
me Vector (ModuleElement ord poly)
curGs
      if poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
v
        then STRef s (Set (OrdSig ord poly))
-> (Set (OrdSig ord poly) -> Set (OrdSig ord poly)) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (Set (OrdSig ord poly))
hs ((Set (OrdSig ord poly) -> Set (OrdSig ord poly)) -> ST s ())
-> (Set (OrdSig ord poly) -> Set (OrdSig ord poly)) -> ST s ()
forall a b. (a -> b) -> a -> b
$ OrdSig ord poly -> Set (OrdSig ord poly) -> Set (OrdSig ord poly)
forall a. Ord a => a -> Set a -> Set a
Set.insert OrdSig ord poly
t
        else do
        let k :: Int
k = Vector (ModuleElement ord poly) -> Int
forall a. Vector a -> Int
V.length Vector (ModuleElement ord poly)
curGs
            decodeJpr :: JPair poly -> ModuleElement ord poly
            decodeJpr :: JPair poly -> ModuleElement ord poly
decodeJpr (JPair OMonom poly
m Int
i) | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k = OMonom poly
m OMonom poly -> ModuleElement ord poly -> ModuleElement ord poly
forall c a. Action c a => c -> a -> a
.*! ModuleElement ord poly
me'
                                  | Bool
otherwise = OMonom poly
m OMonom poly -> ModuleElement ord poly -> ModuleElement ord poly
forall c a. Action c a => c -> a -> a
.*! (Vector (ModuleElement ord poly)
curGs Vector (ModuleElement ord poly) -> Int -> ModuleElement ord poly
forall a. Vector a -> Int -> a
V.! Int
i)
            {-# INLINE decodeJpr #-}
            syzs :: Set (OrdSig ord poly)
syzs = (Set (OrdSig ord poly) -> OrdSig ord poly -> Set (OrdSig ord poly))
-> Set (OrdSig ord poly)
-> Vector (OrdSig ord poly)
-> Set (OrdSig ord poly)
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' ((OrdSig ord poly -> Set (OrdSig ord poly) -> Set (OrdSig ord poly))
-> Set (OrdSig ord poly)
-> OrdSig ord poly
-> Set (OrdSig ord poly)
forall a b c. (a -> b -> c) -> b -> a -> c
flip OrdSig ord poly -> Set (OrdSig ord poly) -> Set (OrdSig ord poly)
forall a. Ord a => a -> Set a -> Set a
Set.insert) Set (OrdSig ord poly)
forall a. Set a
Set.empty (Vector (OrdSig ord poly) -> Set (OrdSig ord poly))
-> Vector (OrdSig ord poly) -> Set (OrdSig ord poly)
forall a b. (a -> b) -> a -> b
$
                   (ModuleElement ord poly -> Maybe (OrdSig ord poly))
-> Vector (ModuleElement ord poly) -> Vector (OrdSig ord poly)
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe (Maybe (OrdSig ord poly) -> Maybe (OrdSig ord poly)
DC.coerce (Maybe (OrdSig ord poly) -> Maybe (OrdSig ord poly))
-> (ModuleElement ord poly -> Maybe (OrdSig ord poly))
-> ModuleElement ord poly
-> Maybe (OrdSig ord poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleElement ord poly
-> ModuleElement ord poly -> Maybe (OrdSig ord poly)
forall k poly (ord :: k).
(Field (Coefficient poly), IsOrderedPolynomial poly,
 ModuleOrdering poly ord) =>
ModuleElement ord poly
-> ModuleElement ord poly -> Maybe (OrdSig ord poly)
syzME ModuleElement ord poly
me') Vector (ModuleElement ord poly)
curGs
        STRef s (Set (OrdSig ord poly))
hs STRef s (Set (OrdSig ord poly))
-> (Set (OrdSig ord poly) -> Set (OrdSig ord poly)) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
.%= (Set (OrdSig ord poly)
-> Set (OrdSig ord poly) -> Set (OrdSig ord poly)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (OrdSig ord poly)
syzs)
        Set (OrdSig ord poly)
curHs <- STRef s (Set (OrdSig ord poly)) -> ST s (Set (OrdSig ord poly))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Set (OrdSig ord poly))
hs
        let newJprs :: [Entry (OrdSig ord poly) (JPair poly)]
newJprs = Fold
  (Entry (OrdSig ord poly) (JPair poly))
  [Entry (OrdSig ord poly) (JPair poly)]
-> Vector (Entry (OrdSig ord poly) (JPair poly))
-> [Entry (OrdSig ord poly) (JPair poly)]
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Fl.fold Fold
  (Entry (OrdSig ord poly) (JPair poly))
  [Entry (OrdSig ord poly) (JPair poly)]
forall a. Ord a => Fold a [a]
Fl.nub (Vector (Entry (OrdSig ord poly) (JPair poly))
 -> [Entry (OrdSig ord poly) (JPair poly)])
-> Vector (Entry (OrdSig ord poly) (JPair poly))
-> [Entry (OrdSig ord poly) (JPair poly)]
forall a b. (a -> b) -> a -> b
$
                      (Entry (OrdSig ord poly) (JPair poly) -> Bool)
-> Vector (Entry (OrdSig ord poly) (JPair poly))
-> Vector (Entry (OrdSig ord poly) (JPair poly))
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\(Entry OrdSig ord poly
sg JPair poly
jp) ->
                                   Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
                                   (ModuleElement ord poly -> Bool)
-> Vector (ModuleElement ord poly) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ModuleElement ord poly -> ModuleElement ord poly -> Bool
forall k poly (ord :: k).
IsOrderedPolynomial poly =>
ModuleElement ord poly -> ModuleElement ord poly -> Bool
`covers` JPair poly -> ModuleElement ord poly
decodeJpr JPair poly
jp) Vector (ModuleElement ord poly)
curGs Bool -> Bool -> Bool
||
                                   (OrdSig ord poly -> Bool) -> Set (OrdSig ord poly) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Signature poly -> Signature poly -> Bool
forall poly.
IsOrderedPolynomial poly =>
Signature poly -> Signature poly -> Bool
`sigDivs` OrdSig ord poly -> Signature poly
forall k (ord :: k) poly. OrdSig ord poly -> Signature poly
runOrdSig OrdSig ord poly
sg) (Signature poly -> Bool)
-> (OrdSig ord poly -> Signature poly) -> OrdSig ord poly -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSig ord poly -> Signature poly
forall k (ord :: k) poly. OrdSig ord poly -> Signature poly
runOrdSig) Set (OrdSig ord poly)
curHs) (Vector (Entry (OrdSig ord poly) (JPair poly))
 -> Vector (Entry (OrdSig ord poly) (JPair poly)))
-> Vector (Entry (OrdSig ord poly) (JPair poly))
-> Vector (Entry (OrdSig ord poly) (JPair poly))
forall a b. (a -> b) -> a -> b
$
                      (Int
 -> ModuleElement ord poly
 -> Maybe (Entry (OrdSig ord poly) (JPair poly)))
-> Vector (ModuleElement ord poly)
-> Vector (Entry (OrdSig ord poly) (JPair poly))
forall a b. (Int -> a -> Maybe b) -> Vector a -> Vector b
V.imapMaybe (((Int, ModuleElement ord poly)
 -> Maybe (Entry (OrdSig ord poly) (JPair poly)))
-> Int
-> ModuleElement ord poly
-> Maybe (Entry (OrdSig ord poly) (JPair poly))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((Int, ModuleElement ord poly)
  -> Maybe (Entry (OrdSig ord poly) (JPair poly)))
 -> Int
 -> ModuleElement ord poly
 -> Maybe (Entry (OrdSig ord poly) (JPair poly)))
-> ((Int, ModuleElement ord poly)
    -> Maybe (Entry (OrdSig ord poly) (JPair poly)))
-> Int
-> ModuleElement ord poly
-> Maybe (Entry (OrdSig ord poly) (JPair poly))
forall a b. (a -> b) -> a -> b
$ ((OrdSig ord poly, JPair poly)
 -> Entry (OrdSig ord poly) (JPair poly))
-> Maybe (OrdSig ord poly, JPair poly)
-> Maybe (Entry (OrdSig ord poly) (JPair poly))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((OrdSig ord poly
 -> JPair poly -> Entry (OrdSig ord poly) (JPair poly))
-> (OrdSig ord poly, JPair poly)
-> Entry (OrdSig ord poly) (JPair poly)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OrdSig ord poly
-> JPair poly -> Entry (OrdSig ord poly) (JPair poly)
forall a b. a -> b -> Entry a b
Entry) (Maybe (OrdSig ord poly, JPair poly)
 -> Maybe (Entry (OrdSig ord poly) (JPair poly)))
-> ((Int, ModuleElement ord poly)
    -> Maybe (OrdSig ord poly, JPair poly))
-> (Int, ModuleElement ord poly)
-> Maybe (Entry (OrdSig ord poly) (JPair poly))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ModuleElement ord poly)
-> (Int, ModuleElement ord poly)
-> Maybe (OrdSig ord poly, JPair poly)
forall k (ord :: k) poly.
(IsOrderedPolynomial poly, Field (Coefficient poly),
 ModuleOrdering poly ord) =>
(Int, ModuleElement ord poly)
-> (Int, ModuleElement ord poly)
-> Maybe (OrdSig ord poly, JPair poly)
jPair (Int
k, ModuleElement ord poly
me')) Vector (ModuleElement ord poly)
curGs
        STRef s (Heap (Entry (OrdSig ord poly) (JPair poly)))
jprs STRef s (Heap (Entry (OrdSig ord poly) (JPair poly)))
-> (Heap (Entry (OrdSig ord poly) (JPair poly))
    -> Heap (Entry (OrdSig ord poly) (JPair poly)))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
.%= (Heap (Entry (OrdSig ord poly) (JPair poly))
 -> Heap (Entry (OrdSig ord poly) (JPair poly))
 -> Heap (Entry (OrdSig ord poly) (JPair poly)))
-> Heap (Entry (OrdSig ord poly) (JPair poly))
-> Heap (Entry (OrdSig ord poly) (JPair poly))
-> Heap (Entry (OrdSig ord poly) (JPair poly))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Heap (Entry (OrdSig ord poly) (JPair poly))
-> Heap (Entry (OrdSig ord poly) (JPair poly))
-> Heap (Entry (OrdSig ord poly) (JPair poly))
forall a. Heap a -> Heap a -> Heap a
H.union ([Entry (OrdSig ord poly) (JPair poly)]
-> Heap (Entry (OrdSig ord poly) (JPair poly))
forall a. Ord a => [a] -> Heap a
H.fromList [Entry (OrdSig ord poly) (JPair poly)]
newJprs)
        STRef s (MVector s (ModuleElement ord poly))
-> ModuleElement ord poly -> ST s ()
forall s a. STRef s (MVector s a) -> a -> ST s ()
append STRef s (MVector s (ModuleElement ord poly))
gs ModuleElement ord poly
me'
  (ModuleElement ord poly -> (Signature poly, poly))
-> Vector (ModuleElement ord poly) -> Vector (Signature poly, poly)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(ME OrdSig ord poly
u poly
v) -> (OrdSig ord poly -> Signature poly
forall k (ord :: k) poly. OrdSig ord poly -> Signature poly
runOrdSig OrdSig ord poly
u, poly
v)) (Vector (ModuleElement ord poly) -> Vector (Signature poly, poly))
-> ST s (Vector (ModuleElement ord poly))
-> ST s (Vector (Signature poly, poly))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVector s (ModuleElement ord poly)
-> ST s (Vector (ModuleElement ord poly))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze (MVector s (ModuleElement ord poly)
 -> ST s (Vector (ModuleElement ord poly)))
-> ST s (MVector s (ModuleElement ord poly))
-> ST s (Vector (ModuleElement ord poly))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s (ModuleElement ord poly))
-> ST s (MVector s (ModuleElement ord poly))
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s (ModuleElement ord poly))
gs)

append :: STRef s (MV.MVector s a) -> a -> ST s ()
append :: STRef s (MVector s a) -> a -> ST s ()
append STRef s (MVector s a)
mv a
a = do
  MVector s a
g <- STRef s (MVector s a) -> ST s (MVector s a)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s a)
mv
  let n :: Int
n = MVector s a -> Int
forall s a. MVector s a -> Int
MV.length MVector s a
g
  MVector s a
g' <- MVector (PrimState (ST s)) a
-> Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MV.unsafeGrow MVector s a
MVector (PrimState (ST s)) a
g Int
1
  MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s a
MVector (PrimState (ST s)) a
g' Int
n a
a
  STRef s (MVector s a) -> MVector s a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (MVector s a)
mv MVector s a
g'
{-# INLINE append #-}

newtype OrdSig ord poly = OrdSig { OrdSig ord poly -> Signature poly
runOrdSig :: Signature poly }
  deriving (OrdSig ord poly -> OrdSig ord poly -> Bool
(OrdSig ord poly -> OrdSig ord poly -> Bool)
-> (OrdSig ord poly -> OrdSig ord poly -> Bool)
-> Eq (OrdSig ord poly)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (ord :: k) poly.
OrdSig ord poly -> OrdSig ord poly -> Bool
/= :: OrdSig ord poly -> OrdSig ord poly -> Bool
$c/= :: forall k (ord :: k) poly.
OrdSig ord poly -> OrdSig ord poly -> Bool
== :: OrdSig ord poly -> OrdSig ord poly -> Bool
$c== :: forall k (ord :: k) poly.
OrdSig ord poly -> OrdSig ord poly -> Bool
Eq)

pattern MkOrdSig :: Int -> OMonom poly -> OrdSig ord poly
pattern $bMkOrdSig :: Int -> OMonom poly -> OrdSig ord poly
$mMkOrdSig :: forall r k poly (ord :: k).
OrdSig ord poly -> (Int -> OMonom poly -> r) -> (Void# -> r) -> r
MkOrdSig f m = OrdSig (Signature f m)
{-# COMPLETE MkOrdSig #-}
{-# COMPLETE OrdSig #-}

instance ModuleOrdering poly ord => Ord (OrdSig ord poly) where
  compare :: OrdSig ord poly -> OrdSig ord poly -> Ordering
compare = (Signature poly -> Signature poly -> Ordering)
-> OrdSig ord poly -> OrdSig ord poly -> Ordering
DC.coerce ((Signature poly -> Signature poly -> Ordering)
 -> OrdSig ord poly -> OrdSig ord poly -> Ordering)
-> (Signature poly -> Signature poly -> Ordering)
-> OrdSig ord poly
-> OrdSig ord poly
-> Ordering
forall a b. (a -> b) -> a -> b
$ Proxy ord -> Signature poly -> Signature poly -> Ordering
forall k poly (ord :: k) (proxy :: k -> *).
ModuleOrdering poly ord =>
proxy ord -> Signature poly -> Signature poly -> Ordering
cmpModule @poly @ord Proxy ord
forall k (t :: k). Proxy t
Proxy
  {-# INLINE compare #-}

jPair :: forall ord poly.
         (IsOrderedPolynomial poly, Field (Coefficient poly), ModuleOrdering poly ord)
      => (Int, ModuleElement ord poly)
      -> (Int, ModuleElement ord poly)
      -> Maybe (OrdSig ord poly, JPair poly)
jPair :: (Int, ModuleElement ord poly)
-> (Int, ModuleElement ord poly)
-> Maybe (OrdSig ord poly, JPair poly)
jPair (Int
i, p1 :: ModuleElement ord poly
p1@(ME OrdSig ord poly
u1 poly
v1)) (Int
j, p2 :: ModuleElement ord poly
p2@(ME OrdSig ord poly
u2 poly
v2)) = do
  let (Coefficient poly
lc1, OrderedMonomial (MOrder poly) (Arity poly)
lm1) = poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
forall poly.
IsOrderedPolynomial poly =>
poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
leadingTerm poly
v1
      (Coefficient poly
lc2, OrderedMonomial (MOrder poly) (Arity poly)
lm2) = poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
forall poly.
IsOrderedPolynomial poly =>
poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
leadingTerm poly
v2
      t :: OrderedMonomial (MOrder poly) (Arity poly)
t = OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
forall k (n :: Nat) (ord :: k).
KnownNat n =>
OrderedMonomial ord n
-> OrderedMonomial ord n -> OrderedMonomial ord n
lcmMonomial OrderedMonomial (MOrder poly) (Arity poly)
lm1 OrderedMonomial (MOrder poly) (Arity poly)
lm2
      t1 :: OrderedMonomial (MOrder poly) (Arity poly)
t1 = OrderedMonomial (MOrder poly) (Arity poly)
t OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
forall r. Division r => r -> r -> r
/ OrderedMonomial (MOrder poly) (Arity poly)
lm1
      t2 :: OrderedMonomial (MOrder poly) (Arity poly)
t2 = OrderedMonomial (MOrder poly) (Arity poly)
t OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
forall r. Division r => r -> r -> r
/ OrderedMonomial (MOrder poly) (Arity poly)
lm2
  let jSig1 :: OrdSig ord poly
jSig1 = OrderedMonomial (MOrder poly) (Arity poly)
t1 OrderedMonomial (MOrder poly) (Arity poly)
-> OrdSig ord poly -> OrdSig ord poly
forall c a. Action c a => c -> a -> a
.*! OrdSig ord poly
u1
  let jSig2 :: OrdSig ord poly
jSig2 = OrderedMonomial (MOrder poly) (Arity poly)
t2 OrderedMonomial (MOrder poly) (Arity poly)
-> OrdSig ord poly -> OrdSig ord poly
forall c a. Action c a => c -> a -> a
.*! OrdSig ord poly
u2
  if OrdSig ord poly
jSig1 OrdSig ord poly -> OrdSig ord poly -> Bool
forall a. Ord a => a -> a -> Bool
>= OrdSig ord poly
jSig2
    then Int
-> OrdSig ord poly
-> Coefficient poly
-> OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly
-> OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly
-> Maybe (OrdSig ord poly, JPair poly)
forall k poly (ord :: k) c poly.
(ModuleOrdering poly ord, Euclidean (Coefficient poly),
 Division (Coefficient poly), Action c (ModuleElement ord poly),
 Arity poly ~ Arity poly, MOrder poly ~ MOrder poly) =>
Int
-> OrdSig ord poly
-> Coefficient poly
-> OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly
-> c
-> ModuleElement ord poly
-> Maybe (OrdSig ord poly, JPair poly)
loop Int
i OrdSig ord poly
jSig1 (Coefficient poly
lc1 Coefficient poly -> Coefficient poly -> Coefficient poly
forall r. Division r => r -> r -> r
/ Coefficient poly
lc2) OrderedMonomial (MOrder poly) (Arity poly)
t1 ModuleElement ord poly
p1 OrderedMonomial (MOrder poly) (Arity poly)
t2 ModuleElement ord poly
p2
    else Int
-> OrdSig ord poly
-> Coefficient poly
-> OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly
-> OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly
-> Maybe (OrdSig ord poly, JPair poly)
forall k poly (ord :: k) c poly.
(ModuleOrdering poly ord, Euclidean (Coefficient poly),
 Division (Coefficient poly), Action c (ModuleElement ord poly),
 Arity poly ~ Arity poly, MOrder poly ~ MOrder poly) =>
Int
-> OrdSig ord poly
-> Coefficient poly
-> OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly
-> c
-> ModuleElement ord poly
-> Maybe (OrdSig ord poly, JPair poly)
loop Int
j OrdSig ord poly
jSig2 (Coefficient poly
lc2 Coefficient poly -> Coefficient poly -> Coefficient poly
forall r. Division r => r -> r -> r
/ Coefficient poly
lc1) OrderedMonomial (MOrder poly) (Arity poly)
t2 ModuleElement ord poly
p2 OrderedMonomial (MOrder poly) (Arity poly)
t1 ModuleElement ord poly
p1
  where
    {-# INLINE loop #-}
    loop :: Int
-> OrdSig ord poly
-> Coefficient poly
-> OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly
-> c
-> ModuleElement ord poly
-> Maybe (OrdSig ord poly, JPair poly)
loop Int
k OrdSig ord poly
sig Coefficient poly
c OrderedMonomial (MOrder poly) (Arity poly)
t1 ModuleElement ord poly
w1 c
t2 ModuleElement ord poly
w2 = do
      ModuleElement ord poly
sgn <- ModuleElement ord poly
-> Maybe (Coefficient poly)
-> ModuleElement ord poly
-> Maybe (ModuleElement ord poly)
forall k (ord :: k) poly.
(ModuleOrdering poly ord, Field (Coefficient poly),
 IsOrderedPolynomial poly) =>
ModuleElement ord poly
-> Maybe (Coefficient poly)
-> ModuleElement ord poly
-> Maybe (ModuleElement ord poly)
cancelModuleElement (OrderedMonomial (MOrder poly) (Arity poly)
t1 OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly -> ModuleElement ord poly
forall c a. Action c a => c -> a -> a
.*! ModuleElement ord poly
w1) (Coefficient poly -> Maybe (Coefficient poly)
forall a. a -> Maybe a
Just Coefficient poly
c) (c
t2 c -> ModuleElement ord poly -> ModuleElement ord poly
forall c a. Action c a => c -> a -> a
.*! ModuleElement ord poly
w2)
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ OrdSig ord poly
sig OrdSig ord poly -> OrdSig ord poly -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleElement ord poly -> OrdSig ord poly
forall k (ord :: k) poly. ModuleElement ord poly -> OrdSig ord poly
syzSign ModuleElement ord poly
sgn
      (OrdSig ord poly, JPair poly)
-> Maybe (OrdSig ord poly, JPair poly)
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdSig ord poly
sig, OrderedMonomial (MOrder poly) (Arity poly) -> Int -> JPair poly
forall poly. OMonom poly -> Int -> JPair poly
JPair OrderedMonomial (MOrder poly) (Arity poly)
t1 Int
k)
{-# INLINE jPair #-}

data Signature poly =
  Signature { Signature poly -> Int
_sigPos :: {-# UNPACK #-} !Int
            , Signature poly -> OrderedMonomial (MOrder poly) (Arity poly)
sigMonom :: !(OrderedMonomial (MOrder poly) (Arity poly))
            }

instance (Show (Coefficient poly), KnownNat (Arity poly)) => Show (Signature poly) where
  showsPrec :: Int -> Signature poly -> ShowS
showsPrec Int
_ (Signature Int
pos OrderedMonomial (MOrder poly) (Arity poly)
m) =
    Char -> ShowS
showChar Char
'('  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrderedMonomial (MOrder poly) (Arity poly) -> ShowS
forall a. Show a => a -> ShowS
shows OrderedMonomial (MOrder poly) (Arity poly)
m ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'e' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
pos

instance Eq (Signature poly) where
  Signature Int
i OrderedMonomial (MOrder poly) (Arity poly)
m == :: Signature poly -> Signature poly -> Bool
== Signature Int
j OrderedMonomial (MOrder poly) (Arity poly)
n = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& OrderedMonomial (MOrder poly) (Arity poly)
n OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Bool
forall a. Eq a => a -> a -> Bool
== OrderedMonomial (MOrder poly) (Arity poly)
m

basis :: IsOrderedPolynomial a => Int -> OrdSig ord a
basis :: Int -> OrdSig ord a
basis Int
i = Int -> OMonom a -> OrdSig ord a
forall k poly (ord :: k). Int -> OMonom poly -> OrdSig ord poly
MkOrdSig Int
i OMonom a
forall r. Unital r => r
one
{-# INLINE basis #-}

reduceModuleElement :: (IsOrderedPolynomial poly, ModuleOrdering poly ord,
                        Field (Coefficient poly), Functor t, Foldable t)
                    => ModuleElement ord poly -> t (ModuleElement ord poly)
                    -> ModuleElement ord poly
reduceModuleElement :: ModuleElement ord poly
-> t (ModuleElement ord poly) -> ModuleElement ord poly
reduceModuleElement ModuleElement ord poly
p t (ModuleElement ord poly)
qs = ModuleElement ord poly -> ModuleElement ord poly
loop ModuleElement ord poly
p
  where
    loop :: ModuleElement ord poly -> ModuleElement ord poly
loop !ModuleElement ord poly
r =
      case First (ModuleElement ord poly) -> Maybe (ModuleElement ord poly)
forall a. First a -> Maybe a
getFirst (First (ModuleElement ord poly) -> Maybe (ModuleElement ord poly))
-> First (ModuleElement ord poly) -> Maybe (ModuleElement ord poly)
forall a b. (a -> b) -> a -> b
$ (ModuleElement ord poly -> First (ModuleElement ord poly))
-> t (ModuleElement ord poly) -> First (ModuleElement ord poly)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe (ModuleElement ord poly) -> First (ModuleElement ord poly)
forall a. Maybe a -> First a
First (Maybe (ModuleElement ord poly) -> First (ModuleElement ord poly))
-> (ModuleElement ord poly -> Maybe (ModuleElement ord poly))
-> ModuleElement ord poly
-> First (ModuleElement ord poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleElement ord poly
-> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall k poly (ord :: k).
(IsOrderedPolynomial poly, Field (Coefficient poly),
 ModuleOrdering poly ord) =>
ModuleElement ord poly
-> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
regularTopReduce ModuleElement ord poly
r) t (ModuleElement ord poly)
qs of
        Maybe (ModuleElement ord poly)
Nothing -> ModuleElement ord poly
r
        Just ModuleElement ord poly
r' -> ModuleElement ord poly -> ModuleElement ord poly
loop ModuleElement ord poly
r'
{-# INLINE reduceModuleElement #-}

regularTopReduce :: forall poly ord.
                    (IsOrderedPolynomial poly, Field (Coefficient poly), ModuleOrdering poly ord)
                 => ModuleElement ord poly -> ModuleElement ord poly
                 -> Maybe (ModuleElement ord poly)
regularTopReduce :: ModuleElement ord poly
-> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
regularTopReduce p1 :: ModuleElement ord poly
p1@(ME OrdSig ord poly
u1 poly
v1) p2 :: ModuleElement ord poly
p2@(ME OrdSig ord poly
u2 poly
v2) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
v2 Bool -> Bool -> Bool
|| poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
v1) Bool -> Bool -> Bool
&& poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
v2 OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Bool
forall k (n :: Nat) (ord :: k).
KnownNat n =>
OrderedMonomial ord n -> OrderedMonomial ord n -> Bool
`divs` poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
v1
  let (Coefficient poly
c, OrderedMonomial (MOrder poly) (Arity poly)
t) = (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
forall k (n :: Nat) r (ord :: k).
(KnownNat n, Field r) =>
(r, OrderedMonomial ord n)
-> (r, OrderedMonomial ord n) -> (r, OrderedMonomial ord n)
tryDiv (poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
forall poly.
IsOrderedPolynomial poly =>
poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
leadingTerm poly
v1) (poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
forall poly.
IsOrderedPolynomial poly =>
poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
leadingTerm poly
v2)
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (OrderedMonomial (MOrder poly) (Arity poly)
t OrderedMonomial (MOrder poly) (Arity poly)
-> OrdSig ord poly -> OrdSig ord poly
forall c a. Action c a => c -> a -> a
.*! OrdSig ord poly
u2) OrdSig ord poly -> OrdSig ord poly -> Bool
forall a. Ord a => a -> a -> Bool
<= OrdSig ord poly
u1
  ModuleElement ord poly
p <- ModuleElement ord poly
-> Maybe (Coefficient poly)
-> ModuleElement ord poly
-> Maybe (ModuleElement ord poly)
forall k (ord :: k) poly.
(ModuleOrdering poly ord, Field (Coefficient poly),
 IsOrderedPolynomial poly) =>
ModuleElement ord poly
-> Maybe (Coefficient poly)
-> ModuleElement ord poly
-> Maybe (ModuleElement ord poly)
cancelModuleElement ModuleElement ord poly
p1 (Coefficient poly -> Maybe (Coefficient poly)
forall a. a -> Maybe a
Just Coefficient poly
c) (OrderedMonomial (MOrder poly) (Arity poly)
t OrderedMonomial (MOrder poly) (Arity poly)
-> ModuleElement ord poly -> ModuleElement ord poly
forall c a. Action c a => c -> a -> a
.*! ModuleElement ord poly
p2)
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ModuleElement ord poly -> OrdSig ord poly
forall k (ord :: k) poly. ModuleElement ord poly -> OrdSig ord poly
syzSign ModuleElement ord poly
p OrdSig ord poly -> OrdSig ord poly -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleElement ord poly -> OrdSig ord poly
forall k (ord :: k) poly. ModuleElement ord poly -> OrdSig ord poly
syzSign ModuleElement ord poly
p1
  ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleElement ord poly
p

cancelModuleElement :: forall ord poly.
                       (ModuleOrdering poly ord,
                        Field (Coefficient poly), IsOrderedPolynomial poly)
                    => ModuleElement ord poly
                    -> Maybe (Coefficient poly)
                    -> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
cancelModuleElement :: ModuleElement ord poly
-> Maybe (Coefficient poly)
-> ModuleElement ord poly
-> Maybe (ModuleElement ord poly)
cancelModuleElement p1 :: ModuleElement ord poly
p1@(ME OrdSig ord poly
u1 poly
v1) Maybe (Coefficient poly)
mc (ME OrdSig ord poly
u2 poly
v2) =
  let c :: Coefficient poly
c = Coefficient poly -> Maybe (Coefficient poly) -> Coefficient poly
forall a. a -> Maybe a -> a
fromMaybe Coefficient poly
forall r. Unital r => r
one Maybe (Coefficient poly)
mc
      v' :: poly
v' = poly
v1 poly -> poly -> poly
forall r. Group r => r -> r -> r
- Coefficient poly
c Coefficient poly -> poly -> poly
forall r m. Module (Scalar r) m => r -> m -> m
.*. poly
v2
  in if Coefficient poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero Coefficient poly
c
  then ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleElement ord poly
p1
  else case OrdSig ord poly -> OrdSig ord poly -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OrdSig ord poly
u1 OrdSig ord poly
u2 of
    Ordering
LT -> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleElement ord poly -> Maybe (ModuleElement ord poly))
-> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall a b. (a -> b) -> a -> b
$ OrdSig ord poly -> poly -> ModuleElement ord poly
forall k (ord :: k) poly.
OrdSig ord poly -> poly -> ModuleElement ord poly
ME OrdSig ord poly
u2 (Coefficient poly -> Coefficient poly
forall r. Group r => r -> r
negate (Coefficient poly -> Coefficient poly
forall r. Division r => r -> r
recip Coefficient poly
c) Coefficient poly -> poly -> poly
forall r m. Module (Scalar r) m => r -> m -> m
.*. poly
v')
    Ordering
GT -> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleElement ord poly -> Maybe (ModuleElement ord poly))
-> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall a b. (a -> b) -> a -> b
$ OrdSig ord poly -> poly -> ModuleElement ord poly
forall k (ord :: k) poly.
OrdSig ord poly -> poly -> ModuleElement ord poly
ME OrdSig ord poly
u1 poly
v'
    Ordering
EQ -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Coefficient poly
c Coefficient poly -> Coefficient poly -> Bool
forall a. Eq a => a -> a -> Bool
/= Coefficient poly
forall r. Unital r => r
one
      ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleElement ord poly -> Maybe (ModuleElement ord poly))
-> ModuleElement ord poly -> Maybe (ModuleElement ord poly)
forall a b. (a -> b) -> a -> b
$ OrdSig ord poly -> poly -> ModuleElement ord poly
forall k (ord :: k) poly.
OrdSig ord poly -> poly -> ModuleElement ord poly
ME OrdSig ord poly
u1 (Coefficient poly -> Coefficient poly
forall r. Division r => r -> r
recip (Coefficient poly
c Coefficient poly -> Coefficient poly -> Coefficient poly
forall r. Group r => r -> r -> r
- Coefficient poly
forall r. Unital r => r
one) Coefficient poly -> poly -> poly
forall r m. Module (Scalar r) m => r -> m -> m
.*. poly
v')
{-# INLINE cancelModuleElement #-}

syzME :: (Field (Coefficient poly), IsOrderedPolynomial poly, ModuleOrdering poly ord)
      => ModuleElement ord poly -> ModuleElement ord poly -> Maybe (OrdSig ord poly)
syzME :: ModuleElement ord poly
-> ModuleElement ord poly -> Maybe (OrdSig ord poly)
syzME (ME OrdSig ord poly
u1 poly
v1) (ME OrdSig ord poly
u2 poly
v2) =
  let (OrdSig ord poly
u1', OrdSig ord poly
u2') = (poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
v2 OrderedMonomial (MOrder poly) (Arity poly)
-> OrdSig ord poly -> OrdSig ord poly
forall c a. Action c a => c -> a -> a
.*! OrdSig ord poly
u1, poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
v1 OrderedMonomial (MOrder poly) (Arity poly)
-> OrdSig ord poly -> OrdSig ord poly
forall c a. Action c a => c -> a -> a
.*! OrdSig ord poly
u2)
  in case OrdSig ord poly -> OrdSig ord poly -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OrdSig ord poly
u1' OrdSig ord poly
u2' of
    Ordering
LT -> OrdSig ord poly -> Maybe (OrdSig ord poly)
forall a. a -> Maybe a
Just OrdSig ord poly
u2'
    Ordering
GT -> OrdSig ord poly -> Maybe (OrdSig ord poly)
forall a. a -> Maybe a
Just OrdSig ord poly
u1'
    Ordering
EQ -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ poly -> Coefficient poly
forall poly. IsOrderedPolynomial poly => poly -> Coefficient poly
leadingCoeff poly
v1 Coefficient poly -> Coefficient poly -> Bool
forall a. Eq a => a -> a -> Bool
/= poly -> Coefficient poly
forall poly. IsOrderedPolynomial poly => poly -> Coefficient poly
leadingCoeff poly
v2
      OrdSig ord poly -> Maybe (OrdSig ord poly)
forall (m :: * -> *) a. Monad m => a -> m a
return OrdSig ord poly
u1'
{-# INLINE syzME #-}

sigDivs :: IsOrderedPolynomial poly => Signature poly -> Signature poly -> Bool
sigDivs :: Signature poly -> Signature poly -> Bool
sigDivs (Signature Int
i OrderedMonomial (MOrder poly) (Arity poly)
n) (Signature Int
j OrderedMonomial (MOrder poly) (Arity poly)
m) = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& OrderedMonomial (MOrder poly) (Arity poly)
n OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Bool
forall k (n :: Nat) (ord :: k).
KnownNat n =>
OrderedMonomial ord n -> OrderedMonomial ord n -> Bool
`divs` OrderedMonomial (MOrder poly) (Arity poly)
m
{-# INLINE sigDivs #-}

covers :: (IsOrderedPolynomial poly)
       => ModuleElement ord poly -> ModuleElement ord poly -> Bool
covers :: ModuleElement ord poly -> ModuleElement ord poly -> Bool
covers (ME (OrdSig Signature poly
sig2) poly
v2) (ME (OrdSig Signature poly
sig1) poly
v1) =
  let t :: OrderedMonomial (MOrder poly) (Arity poly)
t = Signature poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
Signature poly -> OrderedMonomial (MOrder poly) (Arity poly)
sigMonom Signature poly
sig1 OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
forall r. Division r => r -> r -> r
/ Signature poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
Signature poly -> OrderedMonomial (MOrder poly) (Arity poly)
sigMonom Signature poly
sig2
  in Signature poly
sig2 Signature poly -> Signature poly -> Bool
forall poly.
IsOrderedPolynomial poly =>
Signature poly -> Signature poly -> Bool
`sigDivs` Signature poly
sig1 Bool -> Bool -> Bool
&& ((poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
v2 Bool -> Bool -> Bool
&& Bool -> Bool
not (poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
v1)) Bool -> Bool -> Bool
|| OrderedMonomial (MOrder poly) (Arity poly)
t OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
forall r. Multiplicative r => r -> r -> r
* poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
v2 OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Bool
forall a. Ord a => a -> a -> Bool
< poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
v1)
{-# INLINE covers #-}

sigToElem :: IsOrderedPolynomial poly => Signature poly -> ModuleElement ord poly
sigToElem :: Signature poly -> ModuleElement ord poly
sigToElem Signature poly
sig = OrdSig ord poly -> poly -> ModuleElement ord poly
forall k (ord :: k) poly.
OrdSig ord poly -> poly -> ModuleElement ord poly
ME (Signature poly -> OrdSig ord poly
forall k (ord :: k) poly. Signature poly -> OrdSig ord poly
OrdSig Signature poly
sig) (OrderedMonomial (MOrder poly) (Arity poly) -> poly
forall poly.
IsOrderedPolynomial poly =>
OrderedMonomial (MOrder poly) (Arity poly) -> poly
fromOrderedMonomial (OrderedMonomial (MOrder poly) (Arity poly) -> poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> poly
forall a b. (a -> b) -> a -> b
$ Signature poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
Signature poly -> OrderedMonomial (MOrder poly) (Arity poly)
sigMonom Signature poly
sig)
{-# INLINE sigToElem #-}

{- $refs
  * J.-C. Faugère, __A new efficient algorithm for computing Gröbner bases without reduction to zero ( \(F_5\) )__, 2014. DOI: [10.1145/780506.780516](https://doi.org/10.1145/780506.780516).

  * C. Eder and J.-C. Faugère, __A survey on signature-based Gröbner basis computations__, 2015. arXiv: <https://arxiv.org/abs/1404.1774>.

  * D. Cox, J. Little, and D. O'Shea, __Additional Gröbner Basis Algorithms__, Chapter 10 in /Ideals, Variaeties and Algorithms/, 4th ed, Springer, 2015.

  * #gao-iv-wang#S. Gao, F. V. Iv, and M. Wang, __A new framework for computing Gröbner bases__, 2016. DOI: [10.1090/mcom/2969](https://dx.doi.org/10.1090/mcom/2969).
-}