{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Algebra.Algorithms.Groebner.Homogeneous
  ( calcGroebnerBasisAfterHomogenising,
    calcGroebnerBasisAfterHomogenisingHilb,
    calcGroebnerBasisAfterHomogenisingWith,
    calcHomogeneousGroebnerBasis,
    unsafeCalcHomogeneousGroebnerBasis,
    hilbertPoincareSeries,
    hilbertPoincareSeriesBy,
    hilbertPoincareSeriesForMonomials,
    HPS,
    taylorHPS,
    toRationalFunction,
    calcHomogeneousGroebnerBasisHilbert,
    calcHomogeneousGroebnerBasisHilbertBy,
    calcHomogeneousGroebnerBasisHilbertWithSeries,
  )
where

import Algebra.Field.RationalFunction
import Algebra.Prelude.Core hiding
  ( empty,
    filter,
    insert,
  )
import Algebra.Ring.Polynomial.Homogenised
import Algebra.Ring.Polynomial.Univariate
import Control.Lens (ix, (%~), (&))
import Control.Monad.Loops (whileJust_)
import Control.Monad.ST.Strict
import qualified Data.Coerce as C
import qualified Data.Foldable as F
import Data.Functor.Identity
import Data.Heap (Entry (..), Heap)
import qualified Data.Heap as H
import qualified Data.IntMap as IM
import qualified Data.List as L
import Data.Maybe (fromJust)
import Data.MonoTraversable (oall, osum)
import Data.STRef
  ( STRef,
    modifySTRef',
    newSTRef,
    readSTRef,
    writeSTRef,
  )
import qualified Data.Sized as SV
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import GHC.Conc (par)
import GHC.Exts (Constraint)
import qualified Numeric.Field.Fraction as NA

isHomogeneous ::
  IsOrderedPolynomial poly =>
  poly ->
  Bool
isHomogeneous :: poly -> Bool
isHomogeneous poly
poly =
  let degs :: [Int]
degs = (Monomial (Arity poly) -> Int) -> [Monomial (Arity poly)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Monomial (Arity poly) -> Int
forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
osum ([Monomial (Arity poly)] -> [Int])
-> [Monomial (Arity poly)] -> [Int]
forall a b. (a -> b) -> a -> b
$ HashSet (Monomial (Arity poly)) -> [Monomial (Arity poly)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (HashSet (Monomial (Arity poly)) -> [Monomial (Arity poly)])
-> HashSet (Monomial (Arity poly)) -> [Monomial (Arity poly)]
forall a b. (a -> b) -> a -> b
$ poly -> HashSet (Monomial (Arity poly))
forall poly.
IsPolynomial poly =>
poly -> HashSet (Monomial (Arity poly))
monomials poly
poly
   in [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
degs ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
degs)

{- | Calculates Groebner basis once homogenise, apply @'unsafeCalcHomogeneousGroebnerBasis'@,
   and then dehomogenise.
-}
calcGroebnerBasisAfterHomogenisingWith ::
  (Field (Coefficient poly), IsOrderedPolynomial poly) =>
  ( forall poly'.
    (Field (Coefficient poly'), IsOrderedPolynomial poly') =>
    Ideal poly' ->
    [poly']
  ) ->
  Ideal poly ->
  [poly]
calcGroebnerBasisAfterHomogenisingWith :: (forall poly'.
 (Field (Coefficient poly'), IsOrderedPolynomial poly') =>
 Ideal poly' -> [poly'])
-> Ideal poly -> [poly]
calcGroebnerBasisAfterHomogenisingWith forall poly'.
(Field (Coefficient poly'), IsOrderedPolynomial poly') =>
Ideal poly' -> [poly']
calc Ideal poly
i
  | (poly -> Bool) -> Ideal poly -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all poly -> Bool
forall poly. IsOrderedPolynomial poly => poly -> Bool
isHomogeneous Ideal poly
i = Ideal poly -> [poly]
forall poly'.
(Field (Coefficient poly'), IsOrderedPolynomial poly') =>
Ideal poly' -> [poly']
calc Ideal poly
i
  | Bool
otherwise = (Homogenised poly -> poly) -> [Homogenised poly] -> [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Homogenised poly -> poly
forall poly. IsOrderedPolynomial poly => Homogenised poly -> poly
unhomogenise ([Homogenised poly] -> [poly]) -> [Homogenised poly] -> [poly]
forall a b. (a -> b) -> a -> b
$ Ideal (Homogenised poly) -> [Homogenised poly]
forall poly'.
(Field (Coefficient poly'), IsOrderedPolynomial poly') =>
Ideal poly' -> [poly']
calc (Ideal (Homogenised poly) -> [Homogenised poly])
-> Ideal (Homogenised poly) -> [Homogenised poly]
forall a b. (a -> b) -> a -> b
$ (poly -> Homogenised poly)
-> Ideal poly -> Ideal (Homogenised poly)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap poly -> Homogenised poly
forall poly. IsOrderedPolynomial poly => poly -> Homogenised poly
homogenise Ideal poly
i

calcGroebnerBasisAfterHomogenising ::
  (Field (Coefficient poly), IsOrderedPolynomial poly) =>
  Ideal poly ->
  [poly]
calcGroebnerBasisAfterHomogenising :: Ideal poly -> [poly]
calcGroebnerBasisAfterHomogenising = (forall poly'.
 (Field (Coefficient poly'), IsOrderedPolynomial poly') =>
 Ideal poly' -> [poly'])
-> Ideal poly -> [poly]
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
(forall poly'.
 (Field (Coefficient poly'), IsOrderedPolynomial poly') =>
 Ideal poly' -> [poly'])
-> Ideal poly -> [poly]
calcGroebnerBasisAfterHomogenisingWith forall poly'.
(Field (Coefficient poly'), IsOrderedPolynomial poly') =>
Ideal poly' -> [poly']
unsafeCalcHomogeneousGroebnerBasis

calcGroebnerBasisAfterHomogenisingHilb ::
  (Field (Coefficient poly), IsOrderedPolynomial poly) =>
  Ideal poly ->
  [poly]
calcGroebnerBasisAfterHomogenisingHilb :: Ideal poly -> [poly]
calcGroebnerBasisAfterHomogenisingHilb = (forall poly'.
 (Field (Coefficient poly'), IsOrderedPolynomial poly') =>
 Ideal poly' -> [poly'])
-> Ideal poly -> [poly]
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
(forall poly'.
 (Field (Coefficient poly'), IsOrderedPolynomial poly') =>
 Ideal poly' -> [poly'])
-> Ideal poly -> [poly]
calcGroebnerBasisAfterHomogenisingWith forall poly'.
(Field (Coefficient poly'), IsOrderedPolynomial poly') =>
Ideal poly' -> [poly']
calcHomogeneousGroebnerBasisHilbert

{- | Calculates a Groebner basis of the given /homogeneous/ ideal,
   i.e. an ideal generated by homogeneous polynomials.
   Returns @'Nothing'@ if the given ideal is inhomogeneous.

   See also @'unsafeCalcHomogeneousGroebnerBasis'@.
-}
calcHomogeneousGroebnerBasis ::
  (Field (Coefficient poly), IsOrderedPolynomial poly) =>
  Ideal poly ->
  Maybe [poly]
calcHomogeneousGroebnerBasis :: Ideal poly -> Maybe [poly]
calcHomogeneousGroebnerBasis Ideal poly
i
  | (poly -> Bool) -> Ideal poly -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all poly -> Bool
forall poly. IsOrderedPolynomial poly => poly -> Bool
isHomogeneous Ideal poly
i = [poly] -> Maybe [poly]
forall a. a -> Maybe a
Just ([poly] -> Maybe [poly]) -> [poly] -> Maybe [poly]
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall poly'.
(Field (Coefficient poly'), IsOrderedPolynomial poly') =>
Ideal poly' -> [poly']
unsafeCalcHomogeneousGroebnerBasis Ideal poly
i
  | Bool
otherwise = Maybe [poly]
forall a. Maybe a
Nothing

{- | Calculates a Groebner basis of the given /homogeneous/ ideal,
   i.e. an ideal generated by homogeneous polynomials.

   __N.B.__ This function /DOES NOT/ check homogeniety of the given ideal.
   See also @'calcHomogeneousGroebnerBasis'@.
-}
unsafeCalcHomogeneousGroebnerBasis ::
  (Field (Coefficient poly), IsOrderedPolynomial poly) =>
  Ideal poly ->
  [poly]
unsafeCalcHomogeneousGroebnerBasis :: Ideal poly -> [poly]
unsafeCalcHomogeneousGroebnerBasis Ideal poly
ideal = (forall s. ST s [poly]) -> [poly]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [poly]) -> [poly])
-> (forall s. ST s [poly]) -> [poly]
forall a b. (a -> b) -> a -> b
$ do
  STRef s (MVector s poly)
gs <- MVector s poly -> ST s (STRef s (MVector s poly))
forall a s. a -> ST s (STRef s a)
newSTRef (MVector s poly -> ST s (STRef s (MVector s poly)))
-> ST s (MVector s poly) -> ST s (STRef s (MVector s poly))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vector poly -> ST s (MVector (PrimState (ST s)) poly)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw ([poly] -> Vector poly
forall a. [a] -> Vector a
V.fromList ([poly] -> Vector poly) -> [poly] -> Vector poly
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators Ideal poly
ideal)
  STRef s (Signatures Int)
sigs <-
    Signatures Int -> ST s (STRef s (Signatures Int))
forall a s. a -> ST s (STRef s a)
newSTRef
      (Signatures Int -> ST s (STRef s (Signatures Int)))
-> ST s (Signatures Int) -> ST s (STRef s (Signatures Int))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s poly) -> [Int] -> ST s (Signatures Int)
forall poly s.
IsOrderedPolynomial poly =>
RefVec s poly -> [Int] -> ST s (Signatures Int)
buildTable STRef s (MVector s poly)
gs [Int
0 .. [poly] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators Ideal poly
ideal) Int -> Int -> Int
forall r. Group r => r -> r -> r
- Int
1]
  let ins :: poly -> ST s ()
ins poly
g = do
        Int
j <- STRef s (MVector s poly) -> poly -> ST s Int
forall s a. RefVec s a -> a -> ST s Int
snoc STRef s (MVector s poly)
gs poly
g
        Signatures Int
news <- STRef s (MVector s poly) -> [Int] -> ST s (Signatures Int)
forall poly s.
IsOrderedPolynomial poly =>
RefVec s poly -> [Int] -> ST s (Signatures Int)
buildTable STRef s (MVector s poly)
gs [Int
j]
        STRef s (Signatures Int)
-> (Signatures Int -> Signatures Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (Signatures Int)
sigs ((Signatures Int -> Signatures Int) -> ST s ())
-> (Signatures Int -> Signatures Int) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Signatures Int -> Signatures Int -> Signatures Int
forall a. Heap a -> Heap a -> Heap a
H.union Signatures Int
news
  ST s (Maybe (Entry Int (Int, Int), Signatures Int))
-> ((Entry Int (Int, Int), Signatures Int) -> ST s ()) -> ST s ()
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> (a -> m b) -> m ()
whileJust_ (Signatures Int -> Maybe (Entry Int (Int, Int), Signatures Int)
forall a. Heap a -> Maybe (a, Heap a)
H.uncons (Signatures Int -> Maybe (Entry Int (Int, Int), Signatures Int))
-> ST s (Signatures Int)
-> ST s (Maybe (Entry Int (Int, Int), Signatures Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (Signatures Int) -> ST s (Signatures Int)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Signatures Int)
sigs) (((Entry Int (Int, Int), Signatures Int) -> ST s ()) -> ST s ())
-> ((Entry Int (Int, Int), Signatures Int) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Entry Int
_ (Int
i, Int
j), Signatures Int
h') -> do
    STRef s (Signatures Int) -> Signatures Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Signatures Int)
sigs Signatures Int
h'
    (poly
fi, poly
fj) <- (,) (poly -> poly -> (poly, poly))
-> ST s poly -> ST s (poly -> (poly, poly))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (MVector s poly) -> Int -> ST s poly
forall s a. RefVec s a -> Int -> ST s a
at STRef s (MVector s poly)
gs Int
i ST s (poly -> (poly, poly)) -> ST s poly -> ST s (poly, poly)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s (MVector s poly) -> Int -> ST s poly
forall s a. RefVec s a -> Int -> ST s a
at STRef s (MVector s poly)
gs Int
j
    [poly]
gs' <- Vector poly -> [poly]
forall a. Vector a -> [a]
V.toList (Vector poly -> [poly]) -> ST s (Vector poly) -> ST s [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVector s poly -> ST s (Vector poly)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze (MVector s poly -> ST s (Vector poly))
-> ST s (MVector s poly) -> ST s (Vector poly)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s poly) -> ST s (MVector s poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s poly)
gs)
    let s :: poly
s = poly -> poly -> poly
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
poly -> poly -> poly
sPolynomial poly
fi poly
fj poly -> [poly] -> poly
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
 Foldable t) =>
poly -> t poly -> poly
`modPolynomial` [poly]
gs'
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
s) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ poly -> ST s ()
ins poly
s
  Vector poly -> [poly]
forall a. Vector a -> [a]
V.toList (Vector poly -> [poly]) -> ST s (Vector poly) -> ST s [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVector s poly -> ST s (Vector poly)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze (MVector s poly -> ST s (Vector poly))
-> ST s (MVector s poly) -> ST s (Vector poly)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s poly) -> ST s (MVector s poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s poly)
gs)

type Signatures weight = H.Heap (Entry weight (Int, Int))

buildTable ::
  IsOrderedPolynomial poly =>
  RefVec s poly ->
  [Int] ->
  ST s (Signatures Int)
buildTable :: RefVec s poly -> [Int] -> ST s (Signatures Int)
buildTable RefVec s poly
gs [Int]
inds =
  [Entry Int (Int, Int)] -> Signatures Int
forall a. Ord a => [a] -> Heap a
H.fromList
    ([Entry Int (Int, Int)] -> Signatures Int)
-> ST s [Entry Int (Int, Int)] -> ST s (Signatures Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ST s (Entry Int (Int, Int))] -> ST s [Entry Int (Int, Int)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
      [ (Int -> (Int, Int) -> Entry Int (Int, Int))
-> (Int, Int) -> Int -> Entry Int (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> (Int, Int) -> Entry Int (Int, Int)
forall p a. p -> a -> Entry p a
Entry (Int
i, Int
j) (Int -> Entry Int (Int, Int))
-> ST s Int -> ST s (Entry Int (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefVec s poly -> Int -> Int -> ST s Int
forall poly s.
IsOrderedPolynomial poly =>
RefVec s poly -> Int -> Int -> ST s Int
deg RefVec s poly
gs Int
i Int
j
      | Int
j <- [Int]
inds
      , Int
i <- [Int
0 .. Int
j Int -> Int -> Int
forall r. Group r => r -> r -> r
- Int
1]
      ]

type RefVec s a = STRef s (MV.MVector s a)

at :: RefVec s a -> Int -> ST s a
at :: RefVec s a -> Int -> ST s a
at RefVec s a
mv Int
i = (MVector s a -> Int -> ST s a) -> Int -> MVector s a -> ST s a
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVector s a -> Int -> ST s a
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.read Int
i (MVector s a -> ST s a) -> ST s (MVector s a) -> ST s a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RefVec s a -> ST s (MVector s a)
forall s a. STRef s a -> ST s a
readSTRef RefVec s a
mv

snoc :: RefVec s a -> a -> ST s Int
snoc :: RefVec s a -> a -> ST s Int
snoc RefVec s a
ref a
v = do
  MVector s a
vec <- (MVector s a -> Int -> ST s (MVector s a))
-> Int -> MVector s a -> ST s (MVector s a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVector s a -> Int -> ST s (MVector s a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MV.grow Int
1 (MVector s a -> ST s (MVector s a))
-> ST s (MVector s a) -> ST s (MVector s a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RefVec s a -> ST s (MVector s a)
forall s a. STRef s a -> ST s a
readSTRef RefVec s a
ref
  let ind :: Int
ind = MVector s a -> Int
forall s a. MVector s a -> Int
MV.length MVector s a
vec Int -> Int -> Int
forall r. Group r => r -> r -> r
- 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
vec Int
ind a
v
  RefVec s a -> MVector s a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef RefVec s a
ref MVector s a
vec
  Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ind
{-# INLINE snoc #-}

deg :: IsOrderedPolynomial poly => RefVec s poly -> Int -> Int -> ST s Int
deg :: RefVec s poly -> Int -> Int -> ST s Int
deg RefVec s poly
gs Int
i Int
j = do
  MVector s poly
vec <- RefVec s poly -> ST s (MVector s poly)
forall s a. STRef s a -> ST s a
readSTRef RefVec s poly
gs
  (OrderedMonomial (MOrder poly) (Arity poly) -> Int
forall k (ord :: k) (n :: Nat). OrderedMonomial ord n -> Int
totalDegree (OrderedMonomial (MOrder poly) (Arity poly) -> Int)
-> (poly -> OrderedMonomial (MOrder poly) (Arity poly))
-> poly
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((poly -> OrderedMonomial (MOrder poly) (Arity poly))
 -> poly -> Int)
-> (poly -> poly -> OrderedMonomial (MOrder poly) (Arity poly))
-> poly
-> poly
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
 -> OrderedMonomial (MOrder poly) (Arity poly)
 -> OrderedMonomial (MOrder poly) (Arity poly))
-> (poly -> OrderedMonomial (MOrder poly) (Arity poly))
-> poly
-> poly
-> OrderedMonomial (MOrder poly) (Arity poly)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial)
    (poly -> poly -> Int) -> ST s poly -> ST s (poly -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (ST s)) poly -> Int -> ST s poly
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.read MVector s poly
MVector (PrimState (ST s)) poly
vec Int
i
    ST s (poly -> Int) -> ST s poly -> ST s Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector (PrimState (ST s)) poly -> Int -> ST s poly
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.read MVector s poly
MVector (PrimState (ST s)) poly
vec Int
j
{-# INLINE deg #-}

data ReversedEntry p a = ReversedEntry
  { ReversedEntry p a -> p
rePriority :: p
  , ReversedEntry p a -> a
rePayload :: a
  }
  deriving (ReadPrec [ReversedEntry p a]
ReadPrec (ReversedEntry p a)
Int -> ReadS (ReversedEntry p a)
ReadS [ReversedEntry p a]
(Int -> ReadS (ReversedEntry p a))
-> ReadS [ReversedEntry p a]
-> ReadPrec (ReversedEntry p a)
-> ReadPrec [ReversedEntry p a]
-> Read (ReversedEntry p a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall p a. (Read p, Read a) => ReadPrec [ReversedEntry p a]
forall p a. (Read p, Read a) => ReadPrec (ReversedEntry p a)
forall p a. (Read p, Read a) => Int -> ReadS (ReversedEntry p a)
forall p a. (Read p, Read a) => ReadS [ReversedEntry p a]
readListPrec :: ReadPrec [ReversedEntry p a]
$creadListPrec :: forall p a. (Read p, Read a) => ReadPrec [ReversedEntry p a]
readPrec :: ReadPrec (ReversedEntry p a)
$creadPrec :: forall p a. (Read p, Read a) => ReadPrec (ReversedEntry p a)
readList :: ReadS [ReversedEntry p a]
$creadList :: forall p a. (Read p, Read a) => ReadS [ReversedEntry p a]
readsPrec :: Int -> ReadS (ReversedEntry p a)
$creadsPrec :: forall p a. (Read p, Read a) => Int -> ReadS (ReversedEntry p a)
Read, Int -> ReversedEntry p a -> ShowS
[ReversedEntry p a] -> ShowS
ReversedEntry p a -> String
(Int -> ReversedEntry p a -> ShowS)
-> (ReversedEntry p a -> String)
-> ([ReversedEntry p a] -> ShowS)
-> Show (ReversedEntry p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> ReversedEntry p a -> ShowS
forall p a. (Show p, Show a) => [ReversedEntry p a] -> ShowS
forall p a. (Show p, Show a) => ReversedEntry p a -> String
showList :: [ReversedEntry p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [ReversedEntry p a] -> ShowS
show :: ReversedEntry p a -> String
$cshow :: forall p a. (Show p, Show a) => ReversedEntry p a -> String
showsPrec :: Int -> ReversedEntry p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> ReversedEntry p a -> ShowS
Show, a -> ReversedEntry p b -> ReversedEntry p a
(a -> b) -> ReversedEntry p a -> ReversedEntry p b
(forall a b. (a -> b) -> ReversedEntry p a -> ReversedEntry p b)
-> (forall a b. a -> ReversedEntry p b -> ReversedEntry p a)
-> Functor (ReversedEntry p)
forall a b. a -> ReversedEntry p b -> ReversedEntry p a
forall a b. (a -> b) -> ReversedEntry p a -> ReversedEntry p b
forall p a b. a -> ReversedEntry p b -> ReversedEntry p a
forall p a b. (a -> b) -> ReversedEntry p a -> ReversedEntry p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ReversedEntry p b -> ReversedEntry p a
$c<$ :: forall p a b. a -> ReversedEntry p b -> ReversedEntry p a
fmap :: (a -> b) -> ReversedEntry p a -> ReversedEntry p b
$cfmap :: forall p a b. (a -> b) -> ReversedEntry p a -> ReversedEntry p b
Functor, ReversedEntry p a -> Bool
(a -> m) -> ReversedEntry p a -> m
(a -> b -> b) -> b -> ReversedEntry p a -> b
(forall m. Monoid m => ReversedEntry p m -> m)
-> (forall m a. Monoid m => (a -> m) -> ReversedEntry p a -> m)
-> (forall m a. Monoid m => (a -> m) -> ReversedEntry p a -> m)
-> (forall a b. (a -> b -> b) -> b -> ReversedEntry p a -> b)
-> (forall a b. (a -> b -> b) -> b -> ReversedEntry p a -> b)
-> (forall b a. (b -> a -> b) -> b -> ReversedEntry p a -> b)
-> (forall b a. (b -> a -> b) -> b -> ReversedEntry p a -> b)
-> (forall a. (a -> a -> a) -> ReversedEntry p a -> a)
-> (forall a. (a -> a -> a) -> ReversedEntry p a -> a)
-> (forall a. ReversedEntry p a -> [a])
-> (forall a. ReversedEntry p a -> Bool)
-> (forall a. ReversedEntry p a -> Int)
-> (forall a. Eq a => a -> ReversedEntry p a -> Bool)
-> (forall a. Ord a => ReversedEntry p a -> a)
-> (forall a. Ord a => ReversedEntry p a -> a)
-> (forall a. Num a => ReversedEntry p a -> a)
-> (forall a. Num a => ReversedEntry p a -> a)
-> Foldable (ReversedEntry p)
forall a. Eq a => a -> ReversedEntry p a -> Bool
forall a. Num a => ReversedEntry p a -> a
forall a. Ord a => ReversedEntry p a -> a
forall m. Monoid m => ReversedEntry p m -> m
forall a. ReversedEntry p a -> Bool
forall a. ReversedEntry p a -> Int
forall a. ReversedEntry p a -> [a]
forall a. (a -> a -> a) -> ReversedEntry p a -> a
forall p a. Eq a => a -> ReversedEntry p a -> Bool
forall p a. Num a => ReversedEntry p a -> a
forall p a. Ord a => ReversedEntry p a -> a
forall m a. Monoid m => (a -> m) -> ReversedEntry p a -> m
forall p m. Monoid m => ReversedEntry p m -> m
forall p a. ReversedEntry p a -> Bool
forall p a. ReversedEntry p a -> Int
forall p a. ReversedEntry p a -> [a]
forall b a. (b -> a -> b) -> b -> ReversedEntry p a -> b
forall a b. (a -> b -> b) -> b -> ReversedEntry p a -> b
forall p a. (a -> a -> a) -> ReversedEntry p a -> a
forall p m a. Monoid m => (a -> m) -> ReversedEntry p a -> m
forall p b a. (b -> a -> b) -> b -> ReversedEntry p a -> b
forall p a b. (a -> b -> b) -> b -> ReversedEntry p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: ReversedEntry p a -> a
$cproduct :: forall p a. Num a => ReversedEntry p a -> a
sum :: ReversedEntry p a -> a
$csum :: forall p a. Num a => ReversedEntry p a -> a
minimum :: ReversedEntry p a -> a
$cminimum :: forall p a. Ord a => ReversedEntry p a -> a
maximum :: ReversedEntry p a -> a
$cmaximum :: forall p a. Ord a => ReversedEntry p a -> a
elem :: a -> ReversedEntry p a -> Bool
$celem :: forall p a. Eq a => a -> ReversedEntry p a -> Bool
length :: ReversedEntry p a -> Int
$clength :: forall p a. ReversedEntry p a -> Int
null :: ReversedEntry p a -> Bool
$cnull :: forall p a. ReversedEntry p a -> Bool
toList :: ReversedEntry p a -> [a]
$ctoList :: forall p a. ReversedEntry p a -> [a]
foldl1 :: (a -> a -> a) -> ReversedEntry p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> ReversedEntry p a -> a
foldr1 :: (a -> a -> a) -> ReversedEntry p a -> a
$cfoldr1 :: forall p a. (a -> a -> a) -> ReversedEntry p a -> a
foldl' :: (b -> a -> b) -> b -> ReversedEntry p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> ReversedEntry p a -> b
foldl :: (b -> a -> b) -> b -> ReversedEntry p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> ReversedEntry p a -> b
foldr' :: (a -> b -> b) -> b -> ReversedEntry p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> ReversedEntry p a -> b
foldr :: (a -> b -> b) -> b -> ReversedEntry p a -> b
$cfoldr :: forall p a b. (a -> b -> b) -> b -> ReversedEntry p a -> b
foldMap' :: (a -> m) -> ReversedEntry p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> ReversedEntry p a -> m
foldMap :: (a -> m) -> ReversedEntry p a -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> ReversedEntry p a -> m
fold :: ReversedEntry p m -> m
$cfold :: forall p m. Monoid m => ReversedEntry p m -> m
Foldable)

instance Eq p => Eq (ReversedEntry p a) where
  == :: ReversedEntry p a -> ReversedEntry p a -> Bool
(==) = p -> p -> Bool
forall a. Eq a => a -> a -> Bool
(==) (p -> p -> Bool)
-> (ReversedEntry p a -> p)
-> ReversedEntry p a
-> ReversedEntry p a
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ReversedEntry p a -> p
forall p a. ReversedEntry p a -> p
rePriority

instance (Ord p) => Ord (ReversedEntry p a) where
  compare :: ReversedEntry p a -> ReversedEntry p a -> Ordering
compare = (ReversedEntry p a -> ReversedEntry p a -> Ordering)
-> ReversedEntry p a -> ReversedEntry p a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ReversedEntry p a -> p)
-> ReversedEntry p a -> ReversedEntry p a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ReversedEntry p a -> p
forall p a. ReversedEntry p a -> p
rePriority)

viewMax :: Ord p => Heap (ReversedEntry p a) -> Maybe (ReversedEntry p a, Heap (ReversedEntry p a))
viewMax :: Heap (ReversedEntry p a)
-> Maybe (ReversedEntry p a, Heap (ReversedEntry p a))
viewMax = Heap (ReversedEntry p a)
-> Maybe (ReversedEntry p a, Heap (ReversedEntry p a))
forall a. Heap a -> Maybe (a, Heap a)
H.viewMin

class (Foldable f) => Container f where
  type Element f a :: Constraint
  filter :: (a -> Bool) -> f a -> f a
  insert :: Element f a => a -> f a -> f a
  empty :: f a

instance Container Heap where
  {-# SPECIALIZE instance Container Heap #-}
  type Element Heap a = (Ord a)
  filter :: (a -> Bool) -> Heap a -> Heap a
filter = (a -> Bool) -> Heap a -> Heap a
forall a. (a -> Bool) -> Heap a -> Heap a
H.filter
  insert :: a -> Heap a -> Heap a
insert = a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
H.insert
  empty :: Heap a
empty = Heap a
forall a. Heap a
H.empty

instance Container [] where
  {-# SPECIALIZE instance Container [] #-}
  type Element [] a = ()
  filter :: (a -> Bool) -> [a] -> [a]
filter = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter
  insert :: a -> [a] -> [a]
insert = (:)
  empty :: [a]
empty = []

head' :: Foldable t => t a -> a
head' :: t a -> a
head' = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (t a -> Maybe a) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> t a -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)

divs' :: (KnownNat n, Foldable t) => t (Monomial n) -> t (Monomial n) -> Bool
divs' :: t (Monomial n) -> t (Monomial n) -> Bool
divs' = OrderedMonomial Lex n -> OrderedMonomial Lex n -> Bool
forall k (n :: Nat) (ord :: k).
KnownNat n =>
OrderedMonomial ord n -> OrderedMonomial ord n -> Bool
divs (OrderedMonomial Lex n -> OrderedMonomial Lex n -> Bool)
-> (t (Monomial n) -> OrderedMonomial Lex n)
-> t (Monomial n)
-> t (Monomial n)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Maybe Lex -> Monomial n -> OrderedMonomial Lex n
forall k (proxy :: k -> *) (ord :: k) (n :: Nat).
proxy ord -> Monomial n -> OrderedMonomial ord n
orderMonomial (Lex -> Maybe Lex
forall a. a -> Maybe a
Just Lex
Lex) (Monomial n -> OrderedMonomial Lex n)
-> (t (Monomial n) -> Monomial n)
-> t (Monomial n)
-> OrderedMonomial Lex n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Monomial n) -> Monomial n
forall (t :: * -> *) a. Foldable t => t a -> a
head'

minimalGenerators' ::
  forall t f n.
  (Container t, KnownNat n, Element t (f (Monomial n)), Foldable f) =>
  t (f (Monomial n)) ->
  t (f (Monomial n))
minimalGenerators' :: t (f (Monomial n)) -> t (f (Monomial n))
minimalGenerators' t (f (Monomial n))
bs
  | (f (Monomial n) -> Bool) -> t (f (Monomial n)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Element (Monomial n) -> Bool) -> Monomial n -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
oall (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Monomial n -> Bool)
-> (f (Monomial n) -> Monomial n) -> f (Monomial n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Monomial n) -> Monomial n
forall (t :: * -> *) a. Foldable t => t a -> a
head') t (f (Monomial n))
bs = t (f (Monomial n))
forall (f :: * -> *) a. Container f => f a
empty
  | Bool
otherwise = (f (Monomial n) -> t (f (Monomial n)) -> t (f (Monomial n)))
-> t (f (Monomial n)) -> t (f (Monomial n)) -> t (f (Monomial n))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr f (Monomial n) -> t (f (Monomial n)) -> t (f (Monomial n))
forall (f :: * -> *) (t :: * -> *) (n :: Nat).
(Element f (t (Monomial n)), KnownNat n, Foldable t,
 Container f) =>
t (Monomial n) -> f (t (Monomial n)) -> f (t (Monomial n))
check t (f (Monomial n))
forall (f :: * -> *) a. Container f => f a
empty t (f (Monomial n))
bs
  where
    check :: t (Monomial n) -> f (t (Monomial n)) -> f (t (Monomial n))
check t (Monomial n)
a f (t (Monomial n))
acc =
      if (t (Monomial n) -> Bool) -> f (t (Monomial n)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (t (Monomial n) -> t (Monomial n) -> Bool
forall (n :: Nat) (t :: * -> *).
(KnownNat n, Foldable t) =>
t (Monomial n) -> t (Monomial n) -> Bool
`divs'` t (Monomial n)
a) f (t (Monomial n))
acc
        then f (t (Monomial n))
acc
        else t (Monomial n) -> f (t (Monomial n)) -> f (t (Monomial n))
forall (f :: * -> *) a.
(Container f, Element f a) =>
a -> f a -> f a
insert t (Monomial n)
a (f (t (Monomial n)) -> f (t (Monomial n)))
-> f (t (Monomial n)) -> f (t (Monomial n))
forall a b. (a -> b) -> a -> b
$ (t (Monomial n) -> Bool)
-> f (t (Monomial n)) -> f (t (Monomial n))
forall (f :: * -> *) a. Container f => (a -> Bool) -> f a -> f a
filter (Bool -> Bool
not (Bool -> Bool)
-> (t (Monomial n) -> Bool) -> t (Monomial n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t (Monomial n)
a t (Monomial n) -> t (Monomial n) -> Bool
forall (n :: Nat) (t :: * -> *).
(KnownNat n, Foldable t) =>
t (Monomial n) -> t (Monomial n) -> Bool
`divs'`)) f (t (Monomial n))
acc
{-# SPECIALIZE minimalGenerators' :: KnownNat n => [Identity (Monomial n)] -> [Identity (Monomial n)] #-}
{-# SPECIALIZE minimalGenerators' :: (KnownNat n, Ord p) => Heap (ReversedEntry p (Monomial n)) -> Heap (ReversedEntry p (Monomial n)) #-}

-- | Computes a minimal generator of monomial ideal
minimalGenerators :: KnownNat n => [Monomial n] -> [Monomial n]
minimalGenerators :: [Monomial n] -> [Monomial n]
minimalGenerators =
  [Identity (Monomial n)] -> [Monomial n]
C.coerce ([Identity (Monomial n)] -> [Monomial n])
-> ([Monomial n] -> [Identity (Monomial n)])
-> [Monomial n]
-> [Monomial n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identity (Monomial n)] -> [Identity (Monomial n)]
forall (t :: * -> *) (f :: * -> *) (n :: Nat).
(Container t, KnownNat n, Element t (f (Monomial n)),
 Foldable f) =>
t (f (Monomial n)) -> t (f (Monomial n))
minimalGenerators'
    ([Identity (Monomial n)] -> [Identity (Monomial n)])
-> ([Monomial n] -> [Identity (Monomial n)])
-> [Monomial n]
-> [Identity (Monomial n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (n :: Nat). [Monomial n] -> [Identity (Monomial n)]
C.coerce :: [Monomial n] -> [Identity (Monomial n)])
{-# INLINE minimalGenerators #-}

{- | Calculates the Hilbert-Poincare serires of a given homogeneous ideal,
   using the specified monomial ordering.
-}
hilbertPoincareSeriesBy ::
  forall ord poly.
  ( IsMonomialOrder (Arity poly) ord
  , Field (Coefficient poly)
  , IsOrderedPolynomial poly
  ) =>
  ord ->
  Ideal poly ->
  HPS (Arity poly)
hilbertPoincareSeriesBy :: ord -> Ideal poly -> HPS (Arity poly)
hilbertPoincareSeriesBy ord
_ =
  [Monomial (Arity poly)] -> HPS (Arity poly)
forall (t :: * -> *) (n :: Nat).
(KnownNat n, Foldable t) =>
t (Monomial n) -> HPS n
hilbertPoincareSeriesForMonomials
    ([Monomial (Arity poly)] -> HPS (Arity poly))
-> (Ideal poly -> [Monomial (Arity poly)])
-> Ideal poly
-> HPS (Arity poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OrderedPolynomial (Coefficient poly) ord (Arity poly)
 -> Monomial (Arity poly))
-> [OrderedPolynomial (Coefficient poly) ord (Arity poly)]
-> [Monomial (Arity poly)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (OrderedMonomial ord (Arity poly) -> Monomial (Arity poly)
forall k (ordering :: k) (n :: Nat).
OrderedMonomial ordering n -> Monomial n
getMonomial (OrderedMonomial ord (Arity poly) -> Monomial (Arity poly))
-> (OrderedPolynomial (Coefficient poly) ord (Arity poly)
    -> OrderedMonomial ord (Arity poly))
-> OrderedPolynomial (Coefficient poly) ord (Arity poly)
-> Monomial (Arity poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrderedPolynomial (Coefficient poly) ord (Arity poly)
-> OrderedMonomial ord (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial)
    ([OrderedPolynomial (Coefficient poly) ord (Arity poly)]
 -> [Monomial (Arity poly)])
-> (Ideal poly
    -> [OrderedPolynomial (Coefficient poly) ord (Arity poly)])
-> Ideal poly
-> [Monomial (Arity poly)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ideal (OrderedPolynomial (Coefficient poly) ord (Arity poly))
-> [OrderedPolynomial (Coefficient poly) ord (Arity poly)]
forall poly'.
(Field (Coefficient poly'), IsOrderedPolynomial poly') =>
Ideal poly' -> [poly']
unsafeCalcHomogeneousGroebnerBasis
    (Ideal (OrderedPolynomial (Coefficient poly) ord (Arity poly))
 -> [OrderedPolynomial (Coefficient poly) ord (Arity poly)])
-> (Ideal poly
    -> Ideal (OrderedPolynomial (Coefficient poly) ord (Arity poly)))
-> Ideal poly
-> [OrderedPolynomial (Coefficient poly) ord (Arity poly)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (poly -> OrderedPolynomial (Coefficient poly) ord (Arity poly))
-> Ideal poly
-> Ideal (OrderedPolynomial (Coefficient poly) ord (Arity poly))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Coefficient poly
 -> Coefficient
      (OrderedPolynomial (Coefficient poly) ord (Arity poly)))
-> (Ordinal (Arity poly)
    -> Ordinal
         (Arity (OrderedPolynomial (Coefficient poly) ord (Arity poly))))
-> poly
-> OrderedPolynomial (Coefficient poly) ord (Arity poly)
forall poly poly'.
(IsOrderedPolynomial poly, IsOrderedPolynomial poly') =>
(Coefficient poly -> Coefficient poly')
-> (Ordinal (Arity poly) -> Ordinal (Arity poly')) -> poly -> poly'
mapPolynomial Coefficient poly
-> Coefficient
     (OrderedPolynomial (Coefficient poly) ord (Arity poly))
forall a. a -> a
id Ordinal (Arity poly)
-> Ordinal
     (Arity (OrderedPolynomial (Coefficient poly) ord (Arity poly)))
forall a. a -> a
id :: poly -> OrderedPolynomial (Coefficient poly) ord (Arity poly))

-- | A variant of @'hilbertPoincareSeriesBy'@ using @'Grevlex'@ ordering.
hilbertPoincareSeries ::
  (Field (Coefficient poly), IsOrderedPolynomial poly) =>
  Ideal poly ->
  HPS (Arity poly)
hilbertPoincareSeries :: Ideal poly -> HPS (Arity poly)
hilbertPoincareSeries = Grevlex -> Ideal poly -> HPS (Arity poly)
forall ord poly.
(IsMonomialOrder (Arity poly) ord, Field (Coefficient poly),
 IsOrderedPolynomial poly) =>
ord -> Ideal poly -> HPS (Arity poly)
hilbertPoincareSeriesBy Grevlex
Grevlex

-- | One-point compactification of ordered space.
data Compactified a
  = Infinity
  | Finite a
  deriving (ReadPrec [Compactified a]
ReadPrec (Compactified a)
Int -> ReadS (Compactified a)
ReadS [Compactified a]
(Int -> ReadS (Compactified a))
-> ReadS [Compactified a]
-> ReadPrec (Compactified a)
-> ReadPrec [Compactified a]
-> Read (Compactified a)
forall a. Read a => ReadPrec [Compactified a]
forall a. Read a => ReadPrec (Compactified a)
forall a. Read a => Int -> ReadS (Compactified a)
forall a. Read a => ReadS [Compactified a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Compactified a]
$creadListPrec :: forall a. Read a => ReadPrec [Compactified a]
readPrec :: ReadPrec (Compactified a)
$creadPrec :: forall a. Read a => ReadPrec (Compactified a)
readList :: ReadS [Compactified a]
$creadList :: forall a. Read a => ReadS [Compactified a]
readsPrec :: Int -> ReadS (Compactified a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Compactified a)
Read, Int -> Compactified a -> ShowS
[Compactified a] -> ShowS
Compactified a -> String
(Int -> Compactified a -> ShowS)
-> (Compactified a -> String)
-> ([Compactified a] -> ShowS)
-> Show (Compactified a)
forall a. Show a => Int -> Compactified a -> ShowS
forall a. Show a => [Compactified a] -> ShowS
forall a. Show a => Compactified a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compactified a] -> ShowS
$cshowList :: forall a. Show a => [Compactified a] -> ShowS
show :: Compactified a -> String
$cshow :: forall a. Show a => Compactified a -> String
showsPrec :: Int -> Compactified a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Compactified a -> ShowS
Show, Compactified a -> Compactified a -> Bool
(Compactified a -> Compactified a -> Bool)
-> (Compactified a -> Compactified a -> Bool)
-> Eq (Compactified a)
forall a. Eq a => Compactified a -> Compactified a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compactified a -> Compactified a -> Bool
$c/= :: forall a. Eq a => Compactified a -> Compactified a -> Bool
== :: Compactified a -> Compactified a -> Bool
$c== :: forall a. Eq a => Compactified a -> Compactified a -> Bool
Eq, a -> Compactified b -> Compactified a
(a -> b) -> Compactified a -> Compactified b
(forall a b. (a -> b) -> Compactified a -> Compactified b)
-> (forall a b. a -> Compactified b -> Compactified a)
-> Functor Compactified
forall a b. a -> Compactified b -> Compactified a
forall a b. (a -> b) -> Compactified a -> Compactified b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Compactified b -> Compactified a
$c<$ :: forall a b. a -> Compactified b -> Compactified a
fmap :: (a -> b) -> Compactified a -> Compactified b
$cfmap :: forall a b. (a -> b) -> Compactified a -> Compactified b
Functor, Compactified a -> Bool
(a -> m) -> Compactified a -> m
(a -> b -> b) -> b -> Compactified a -> b
(forall m. Monoid m => Compactified m -> m)
-> (forall m a. Monoid m => (a -> m) -> Compactified a -> m)
-> (forall m a. Monoid m => (a -> m) -> Compactified a -> m)
-> (forall a b. (a -> b -> b) -> b -> Compactified a -> b)
-> (forall a b. (a -> b -> b) -> b -> Compactified a -> b)
-> (forall b a. (b -> a -> b) -> b -> Compactified a -> b)
-> (forall b a. (b -> a -> b) -> b -> Compactified a -> b)
-> (forall a. (a -> a -> a) -> Compactified a -> a)
-> (forall a. (a -> a -> a) -> Compactified a -> a)
-> (forall a. Compactified a -> [a])
-> (forall a. Compactified a -> Bool)
-> (forall a. Compactified a -> Int)
-> (forall a. Eq a => a -> Compactified a -> Bool)
-> (forall a. Ord a => Compactified a -> a)
-> (forall a. Ord a => Compactified a -> a)
-> (forall a. Num a => Compactified a -> a)
-> (forall a. Num a => Compactified a -> a)
-> Foldable Compactified
forall a. Eq a => a -> Compactified a -> Bool
forall a. Num a => Compactified a -> a
forall a. Ord a => Compactified a -> a
forall m. Monoid m => Compactified m -> m
forall a. Compactified a -> Bool
forall a. Compactified a -> Int
forall a. Compactified a -> [a]
forall a. (a -> a -> a) -> Compactified a -> a
forall m a. Monoid m => (a -> m) -> Compactified a -> m
forall b a. (b -> a -> b) -> b -> Compactified a -> b
forall a b. (a -> b -> b) -> b -> Compactified a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Compactified a -> a
$cproduct :: forall a. Num a => Compactified a -> a
sum :: Compactified a -> a
$csum :: forall a. Num a => Compactified a -> a
minimum :: Compactified a -> a
$cminimum :: forall a. Ord a => Compactified a -> a
maximum :: Compactified a -> a
$cmaximum :: forall a. Ord a => Compactified a -> a
elem :: a -> Compactified a -> Bool
$celem :: forall a. Eq a => a -> Compactified a -> Bool
length :: Compactified a -> Int
$clength :: forall a. Compactified a -> Int
null :: Compactified a -> Bool
$cnull :: forall a. Compactified a -> Bool
toList :: Compactified a -> [a]
$ctoList :: forall a. Compactified a -> [a]
foldl1 :: (a -> a -> a) -> Compactified a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Compactified a -> a
foldr1 :: (a -> a -> a) -> Compactified a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Compactified a -> a
foldl' :: (b -> a -> b) -> b -> Compactified a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Compactified a -> b
foldl :: (b -> a -> b) -> b -> Compactified a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Compactified a -> b
foldr' :: (a -> b -> b) -> b -> Compactified a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Compactified a -> b
foldr :: (a -> b -> b) -> b -> Compactified a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Compactified a -> b
foldMap' :: (a -> m) -> Compactified a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Compactified a -> m
foldMap :: (a -> m) -> Compactified a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Compactified a -> m
fold :: Compactified m -> m
$cfold :: forall m. Monoid m => Compactified m -> m
Foldable, Functor Compactified
Foldable Compactified
Functor Compactified
-> Foldable Compactified
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Compactified a -> f (Compactified b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Compactified (f a) -> f (Compactified a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Compactified a -> m (Compactified b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Compactified (m a) -> m (Compactified a))
-> Traversable Compactified
(a -> f b) -> Compactified a -> f (Compactified b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Compactified (m a) -> m (Compactified a)
forall (f :: * -> *) a.
Applicative f =>
Compactified (f a) -> f (Compactified a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Compactified a -> m (Compactified b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Compactified a -> f (Compactified b)
sequence :: Compactified (m a) -> m (Compactified a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Compactified (m a) -> m (Compactified a)
mapM :: (a -> m b) -> Compactified a -> m (Compactified b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Compactified a -> m (Compactified b)
sequenceA :: Compactified (f a) -> f (Compactified a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Compactified (f a) -> f (Compactified a)
traverse :: (a -> f b) -> Compactified a -> f (Compactified b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Compactified a -> f (Compactified b)
$cp2Traversable :: Foldable Compactified
$cp1Traversable :: Functor Compactified
Traversable)

instance Ord a => Ord (Compactified a) where
  compare :: Compactified a -> Compactified a -> Ordering
compare Compactified a
Infinity Compactified a
Infinity = Ordering
EQ
  compare Compactified a
Infinity Compactified a
_ = Ordering
GT
  compare Compactified a
_ Compactified a
Infinity = Ordering
LT
  compare (Finite a
a) (Finite a
b) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b

  Compactified a
Infinity < :: Compactified a -> Compactified a -> Bool
< Compactified a
_ = Bool
False
  Finite a
_ < Compactified a
Infinity = Bool
True
  Finite a
a < Finite a
b = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b

  Compactified a
_ <= :: Compactified a -> Compactified a -> Bool
<= Compactified a
Infinity = Bool
True
  Finite a
a <= Finite a
b = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b
  Compactified a
Infinity <= Finite a
_ = Bool
False

data HPS n = HPS
  { HPS n -> [Integer]
taylorHPS :: [Integer]
  , HPS n -> Unipol Integer
hpsNumerator :: Unipol Integer
  }

instance Eq (HPS a) where
  == :: HPS a -> HPS a -> Bool
(==) = Unipol Integer -> Unipol Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Unipol Integer -> Unipol Integer -> Bool)
-> (HPS a -> Unipol Integer) -> HPS a -> HPS a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` HPS a -> Unipol Integer
forall k (n :: k). HPS n -> Unipol Integer
hpsNumerator

instance KnownNat n => Show (HPS n) where
  showsPrec :: Int -> HPS n -> ShowS
showsPrec Int
d = Int -> RationalFunction Rational -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (RationalFunction Rational -> ShowS)
-> (HPS n -> RationalFunction Rational) -> HPS n -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HPS n -> RationalFunction Rational
forall (n :: Nat). KnownNat n => HPS n -> RationalFunction Rational
toRationalFunction

instance Additive (HPS n) where
  HPS [Integer]
cs Unipol Integer
f + :: HPS n -> HPS n -> HPS n
+ HPS [Integer]
ds Unipol Integer
g = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS ((Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Integer -> Integer
forall r. Additive r => r -> r -> r
(+) [Integer]
cs [Integer]
ds) (Unipol Integer
f Unipol Integer -> Unipol Integer -> Unipol Integer
forall r. Additive r => r -> r -> r
+ Unipol Integer
g)

instance LeftModule Natural (HPS n) where
  Natural
n .* :: Natural -> HPS n -> HPS n
.* HPS [Integer]
cs Unipol Integer
f = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS ((Integer -> Integer) -> [Integer] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
*) [Integer]
cs) (Natural
n Natural -> Unipol Integer -> Unipol Integer
forall r m. LeftModule r m => r -> m -> m
.* Unipol Integer
f)

instance RightModule Natural (HPS n) where
  HPS [Integer]
cs Unipol Integer
f *. :: HPS n -> Natural -> HPS n
*. Natural
n = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS ((Integer -> Integer) -> [Integer] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
* Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n) [Integer]
cs) (Unipol Integer
f Unipol Integer -> Natural -> Unipol Integer
forall r m. RightModule r m => m -> r -> m
*. Natural
n)

instance LeftModule Integer (HPS n) where
  Integer
n .* :: Integer -> HPS n -> HPS n
.* HPS [Integer]
cs Unipol Integer
f = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS ((Integer -> Integer) -> [Integer] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Integer
n Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
*) [Integer]
cs) (Integer
n Integer -> Unipol Integer -> Unipol Integer
forall r m. LeftModule r m => r -> m -> m
.* Unipol Integer
f)

instance RightModule Integer (HPS n) where
  HPS [Integer]
cs Unipol Integer
f *. :: HPS n -> Integer -> HPS n
*. Integer
n = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS ((Integer -> Integer) -> [Integer] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
* Integer
n) [Integer]
cs) (Unipol Integer
f Unipol Integer -> Integer -> Unipol Integer
forall r m. RightModule r m => m -> r -> m
*. Integer
n)

instance Monoidal (HPS n) where
  zero :: HPS n
zero = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS (Integer -> [Integer]
forall a. a -> [a]
repeat Integer
0) Unipol Integer
forall m. Monoidal m => m
zero

instance Group (HPS n) where
  negate :: HPS n -> HPS n
negate (HPS [Integer]
cs Unipol Integer
f) = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS ((Integer -> Integer) -> [Integer] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Integer -> Integer
forall r. Group r => r -> r
negate [Integer]
cs) (Unipol Integer -> Unipol Integer
forall r. Group r => r -> r
negate Unipol Integer
f)
  HPS [Integer]
cs Unipol Integer
f - :: HPS n -> HPS n -> HPS n
- HPS [Integer]
ds Unipol Integer
g = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS ((Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Integer]
cs [Integer]
ds) (Unipol Integer
f Unipol Integer -> Unipol Integer -> Unipol Integer
forall r. Group r => r -> r -> r
- Unipol Integer
g)

instance Abelian (HPS n)

convolute :: [Integer] -> [Integer] -> [Integer]
convolute :: [Integer] -> [Integer] -> [Integer]
convolute ~(Integer
x : [Integer]
xs) ~(Integer
y : [Integer]
ys) =
  Integer
x Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
* Integer
y Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer] -> [Integer]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Integer
a Integer
b Integer
c -> Integer
a Integer -> Integer -> Integer
forall a b. a -> b -> b
`par` Integer
b Integer -> Integer -> Integer
forall a b. a -> b -> b
`par` Integer
c Integer -> Integer -> Integer
`seq` (Integer
a Integer -> Integer -> Integer
forall r. Additive r => r -> r -> r
+ Integer
b Integer -> Integer -> Integer
forall r. Additive r => r -> r -> r
+ Integer
c)) ((Integer -> Integer) -> [Integer] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Integer
x Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
*) [Integer]
ys) ((Integer -> Integer) -> [Integer] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Integer
y Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
*) [Integer]
xs) (Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [Integer] -> [Integer]
convolute [Integer]
xs [Integer]
ys)
{-# INLINE convolute #-}

instance LeftModule (Unipol Integer) (HPS n) where
  Unipol Integer
poly .* :: Unipol Integer -> HPS n -> HPS n
.* HPS [Integer]
cs Unipol Integer
g = [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS ([Integer] -> [Integer] -> [Integer]
convolute (Unipol Integer -> [Integer]
forall k. Monoidal k => Unipol k -> [k]
coeffList Unipol Integer
poly [Integer] -> [Integer] -> [Integer]
forall w. Monoid w => w -> w -> w
++ Integer -> [Integer]
forall a. a -> [a]
repeat Integer
0) [Integer]
cs) (Unipol Integer
poly Unipol Integer -> Unipol Integer -> Unipol Integer
forall r. Multiplicative r => r -> r -> r
* Unipol Integer
g)

binoms :: forall n. KnownNat n => Natural -> HPS n
binoms :: Natural -> HPS n
binoms Natural
p =
  let n :: Integer
n = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ SNat n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (SNat n
forall (n :: Nat). KnownNat n => SNat n
sNat :: SNat n)
   in ((Unipol Integer
1 Unipol Integer -> Unipol Integer -> Unipol Integer
forall r. Group r => r -> r -> r
- IsLabel "x" (Unipol Integer)
Unipol Integer
#x) Unipol Integer -> Natural -> Unipol Integer
forall r. Unital r => r -> Natural -> r
^ Natural
p :: Unipol Integer)
        Unipol Integer -> HPS n -> HPS n
forall r m. LeftModule r m => r -> m -> m
.* [Integer] -> Unipol Integer -> HPS n
forall k (n :: k). [Integer] -> Unipol Integer -> HPS n
HPS [Integer -> Integer -> Integer
binom (Integer
n Integer -> Integer -> Integer
forall r. Additive r => r -> r -> r
+ Integer
m Integer -> Integer -> Integer
forall r. Group r => r -> r -> r
- Integer
1) Integer
m | Integer
m <- [Integer
0 ..]] Unipol Integer
1
{-# INLINE binoms #-}

binom :: Integer -> Integer -> Integer
binom :: Integer -> Integer -> Integer
binom Integer
m Integer
k = [Integer] -> Integer
forall (f :: * -> *) r. (Foldable f, Unital r) => f r -> r
product [Integer
m Integer -> Integer -> Integer
forall r. Group r => r -> r -> r
- Integer
k Integer -> Integer -> Integer
forall r. Additive r => r -> r -> r
+ Integer
1 .. Integer
m] Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` [Integer] -> Integer
forall (f :: * -> *) r. (Foldable f, Unital r) => f r -> r
product [Integer
1 .. Integer
k]
{-# INLINE binom #-}

toRationalFunction :: KnownNat n => HPS n -> RationalFunction Rational
toRationalFunction :: HPS n -> RationalFunction Rational
toRationalFunction s :: HPS n
s@(HPS [Integer]
_ Unipol Integer
f) =
  Unipol Rational -> RationalFunction (Coefficient (Unipol Rational))
forall poly.
(IsOrderedPolynomial poly, Arity poly ~ 1,
 Field (Coefficient poly)) =>
poly -> RationalFunction (Coefficient poly)
fromPolynomial ((Integer -> Rational) -> Unipol Integer -> Unipol Rational
forall b a. DecidableZero b => (a -> b) -> Unipol a -> Unipol b
mapCoeffUnipol (Integer -> Integer -> Rational
forall d. GCDDomain d => d -> d -> Fraction d
NA.% Integer
1) Unipol Integer
f) RationalFunction Rational
-> RationalFunction Rational -> RationalFunction Rational
forall r. Division r => r -> r -> r
/ Unipol Rational -> RationalFunction (Coefficient (Unipol Rational))
forall poly.
(IsOrderedPolynomial poly, Arity poly ~ 1,
 Field (Coefficient poly)) =>
poly -> RationalFunction (Coefficient poly)
fromPolynomial ((Unipol Rational
1 Unipol Rational -> Unipol Rational -> Unipol Rational
forall r. Group r => r -> r -> r
- IsLabel "x" (Unipol Rational)
Unipol Rational
#x) Unipol Rational -> Natural -> Unipol Rational
forall r. Unital r => r -> Natural -> r
^ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HPS n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal HPS n
s) :: Unipol Rational)

hilbertPoincareSeriesForMonomials ::
  forall t n.
  (KnownNat n, Foldable t) =>
  t (Monomial n) ->
  HPS n
hilbertPoincareSeriesForMonomials :: t (Monomial n) -> HPS n
hilbertPoincareSeriesForMonomials t (Monomial n)
ms0 =
  Heap (ReversedEntry Int (Monomial n)) -> HPS n
go (Heap (ReversedEntry Int (Monomial n)) -> HPS n)
-> Heap (ReversedEntry Int (Monomial n)) -> HPS n
forall a b. (a -> b) -> a -> b
$
    [ReversedEntry Int (Monomial n)]
-> Heap (ReversedEntry Int (Monomial n))
forall a. Ord a => [a] -> Heap a
H.fromList
      [ Int -> Monomial n -> ReversedEntry Int (Monomial n)
forall p a. p -> a -> ReversedEntry p a
ReversedEntry (Monomial n -> Element (Monomial n)
forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
osum Monomial n
m) Monomial n
m
      | Monomial n
m <- [Monomial n] -> [Monomial n]
forall (n :: Nat). KnownNat n => [Monomial n] -> [Monomial n]
minimalGenerators ([Monomial n] -> [Monomial n]) -> [Monomial n] -> [Monomial n]
forall a b. (a -> b) -> a -> b
$ t (Monomial n) -> [Monomial n]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t (Monomial n)
ms0
      ]
  where
    go :: Heap (ReversedEntry Int (Monomial n)) -> HPS n
go Heap (ReversedEntry Int (Monomial n))
ms =
      let n :: Natural
n = Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
       in case Heap (ReversedEntry Int (Monomial n))
-> Maybe
     (ReversedEntry Int (Monomial n),
      Heap (ReversedEntry Int (Monomial n)))
forall p a.
Ord p =>
Heap (ReversedEntry p a)
-> Maybe (ReversedEntry p a, Heap (ReversedEntry p a))
viewMax Heap (ReversedEntry Int (Monomial n))
ms of
            Maybe
  (ReversedEntry Int (Monomial n),
   Heap (ReversedEntry Int (Monomial n)))
Nothing -> Natural -> HPS n
forall (n :: Nat). KnownNat n => Natural -> HPS n
binoms Natural
n
            Just (ReversedEntry Int
0 Monomial n
_, Heap (ReversedEntry Int (Monomial n))
_) -> HPS n
forall m. Monoidal m => m
zero
            Just (ReversedEntry Int
1 Monomial n
_, Heap (ReversedEntry Int (Monomial n))
_) -> Natural -> HPS n
forall (n :: Nat). KnownNat n => Natural -> HPS n
binoms (Natural -> HPS n) -> Natural -> HPS n
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Heap (ReversedEntry Int (Monomial n)) -> Int
forall a. Heap a -> Int
H.size Heap (ReversedEntry Int (Monomial n))
ms
            Just (ReversedEntry Int
_ Monomial n
m, Heap (ReversedEntry Int (Monomial n))
_) ->
              let Just Ordinal n
i = (Int -> Bool) -> Monomial n -> Maybe (Ordinal n)
forall (f :: * -> *) (n :: Nat) a.
(KnownNat n, CFoldable f, Dom f a) =>
(a -> Bool) -> Sized f n a -> Maybe (Ordinal n)
SV.sFindIndex (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Monomial n
m
                  xi :: Monomial n
xi = SNat n -> Ordinal n -> Monomial n
forall (n :: Nat). SNat n -> Ordinal n -> Monomial n
varMonom SNat n
forall (n :: Nat). KnownNat n => SNat n
sNat Ordinal n
i
                  upd :: ReversedEntry Int (Monomial n) -> ReversedEntry Int (Monomial n)
upd (ReversedEntry Int
_ Monomial n
xs) =
                    let xs' :: Monomial n
xs' = (Monomial n
xs Monomial n -> (Monomial n -> Monomial n) -> Monomial n
forall a b. a -> (a -> b) -> b
& Index (Monomial n)
-> Traversal' (Monomial n) (IxValue (Monomial n))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Ordinal n
Index (Monomial n)
i ((Int -> Identity Int) -> Monomial n -> Identity (Monomial n))
-> (Int -> Int) -> Monomial n -> Monomial n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred)
                     in Int -> Monomial n -> ReversedEntry Int (Monomial n)
forall p a. p -> a -> ReversedEntry p a
ReversedEntry (Monomial n -> Element (Monomial n)
forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
osum Monomial n
xs') Monomial n
xs'
                  added :: Heap (ReversedEntry Int (Monomial n))
added = Heap (ReversedEntry Int (Monomial n))
-> Heap (ReversedEntry Int (Monomial n))
forall (t :: * -> *) (f :: * -> *) (n :: Nat).
(Container t, KnownNat n, Element t (f (Monomial n)),
 Foldable f) =>
t (f (Monomial n)) -> t (f (Monomial n))
minimalGenerators' (Heap (ReversedEntry Int (Monomial n))
 -> Heap (ReversedEntry Int (Monomial n)))
-> Heap (ReversedEntry Int (Monomial n))
-> Heap (ReversedEntry Int (Monomial n))
forall a b. (a -> b) -> a -> b
$ ReversedEntry Int (Monomial n)
-> Heap (ReversedEntry Int (Monomial n))
-> Heap (ReversedEntry Int (Monomial n))
forall (f :: * -> *) a.
(Container f, Element f a) =>
a -> f a -> f a
insert (Int -> Monomial n -> ReversedEntry Int (Monomial n)
forall p a. p -> a -> ReversedEntry p a
ReversedEntry Int
1 Monomial n
xi) Heap (ReversedEntry Int (Monomial n))
ms
                  quo :: Heap (ReversedEntry Int (Monomial n))
quo = Heap (ReversedEntry Int (Monomial n))
-> Heap (ReversedEntry Int (Monomial n))
forall (t :: * -> *) (f :: * -> *) (n :: Nat).
(Container t, KnownNat n, Element t (f (Monomial n)),
 Foldable f) =>
t (f (Monomial n)) -> t (f (Monomial n))
minimalGenerators' (Heap (ReversedEntry Int (Monomial n))
 -> Heap (ReversedEntry Int (Monomial n)))
-> Heap (ReversedEntry Int (Monomial n))
-> Heap (ReversedEntry Int (Monomial n))
forall a b. (a -> b) -> a -> b
$ (ReversedEntry Int (Monomial n) -> ReversedEntry Int (Monomial n))
-> Heap (ReversedEntry Int (Monomial n))
-> Heap (ReversedEntry Int (Monomial n))
forall b a. Ord b => (a -> b) -> Heap a -> Heap b
H.map ReversedEntry Int (Monomial n) -> ReversedEntry Int (Monomial n)
upd Heap (ReversedEntry Int (Monomial n))
ms
               in Heap (ReversedEntry Int (Monomial n)) -> HPS n
go Heap (ReversedEntry Int (Monomial n))
added HPS n -> HPS n -> HPS n
forall r. Additive r => r -> r -> r
+ (IsLabel "x" (Unipol Integer)
Unipol Integer
#x :: Unipol Integer) Unipol Integer -> HPS n -> HPS n
forall r m. LeftModule r m => r -> m -> m
.* Heap (ReversedEntry Int (Monomial n)) -> HPS n
go Heap (ReversedEntry Int (Monomial n))
quo

buildHilbTable ::
  IsOrderedPolynomial poly =>
  RefVec s poly ->
  [Int] ->
  ST s (IntMap [(Int, Int)])
buildHilbTable :: RefVec s poly -> [Int] -> ST s (IntMap [(Int, Int)])
buildHilbTable RefVec s poly
gs [Int]
js =
  ([(Int, Int)] -> [(Int, Int)] -> [(Int, Int)])
-> [IntMap [(Int, Int)]] -> IntMap [(Int, Int)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IM.unionsWith [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall w. Monoid w => w -> w -> w
(++)
    ([IntMap [(Int, Int)]] -> IntMap [(Int, Int)])
-> ST s [IntMap [(Int, Int)]] -> ST s (IntMap [(Int, Int)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ST s (IntMap [(Int, Int)])] -> ST s [IntMap [(Int, Int)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
      [ (Int -> [(Int, Int)] -> IntMap [(Int, Int)])
-> [(Int, Int)] -> Int -> IntMap [(Int, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [(Int, Int)] -> IntMap [(Int, Int)]
forall a. Int -> a -> IntMap a
IM.singleton [(Int
i, Int
j)] (Int -> IntMap [(Int, Int)])
-> ST s Int -> ST s (IntMap [(Int, Int)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefVec s poly -> Int -> Int -> ST s Int
forall poly s.
IsOrderedPolynomial poly =>
RefVec s poly -> Int -> Int -> ST s Int
deg RefVec s poly
gs Int
i Int
j
      | Int
j <- [Int]
js
      , Int
i <- [Int
0 .. Int
j Int -> Int -> Int
forall r. Group r => r -> r -> r
-Int
1]
      ]

whileForM_ :: (Foldable t, Monad m) => m Bool -> t a -> (a -> m b) -> m ()
whileForM_ :: m Bool -> t a -> (a -> m b) -> m ()
whileForM_ m Bool
test t a
xs a -> m b
f =
  (a -> m () -> m ()) -> m () -> t a -> m ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\a
x m ()
act -> m Bool
test m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()) -> m () -> Bool -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> m b
f a
x m b -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
act)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) t a
xs
{-# INLINE whileForM_ #-}

calcHomogeneousGroebnerBasisHilbertWithSeries ::
  (Field (Coefficient poly), IsOrderedPolynomial poly) =>
  Ideal poly ->
  HPS (Arity poly) ->
  [poly]
calcHomogeneousGroebnerBasisHilbertWithSeries :: Ideal poly -> HPS (Arity poly) -> [poly]
calcHomogeneousGroebnerBasisHilbertWithSeries Ideal poly
ip HPS (Arity poly)
hps = (forall s. ST s [poly]) -> [poly]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [poly]) -> [poly])
-> (forall s. ST s [poly]) -> [poly]
forall a b. (a -> b) -> a -> b
$ do
  STRef s (Compactified Integer)
delta <- Compactified Integer -> ST s (STRef s (Compactified Integer))
forall a s. a -> ST s (STRef s a)
newSTRef Compactified Integer
forall a. Compactified a
Infinity
  let v0 :: Vector poly
v0 = [poly] -> Vector poly
forall a. [a] -> Vector a
V.fromList ([poly] -> Vector poly) -> [poly] -> Vector poly
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators Ideal poly
ip
  STRef s (MVector s poly)
gs <- MVector s poly -> ST s (STRef s (MVector s poly))
forall a s. a -> ST s (STRef s a)
newSTRef (MVector s poly -> ST s (STRef s (MVector s poly)))
-> ST s (MVector s poly) -> ST s (STRef s (MVector s poly))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vector poly -> ST s (MVector (PrimState (ST s)) poly)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Vector poly
v0
  STRef s (IntMap [(Int, Int)])
bs <-
    IntMap [(Int, Int)] -> ST s (STRef s (IntMap [(Int, Int)]))
forall a s. a -> ST s (STRef s a)
newSTRef (IntMap [(Int, Int)] -> ST s (STRef s (IntMap [(Int, Int)])))
-> (IntMap [(Int, Int)] -> IntMap [(Int, Int)])
-> IntMap [(Int, Int)]
-> ST s (STRef s (IntMap [(Int, Int)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Int)] -> [(Int, Int)] -> [(Int, Int)])
-> Int
-> [(Int, Int)]
-> IntMap [(Int, Int)]
-> IntMap [(Int, Int)]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall w. Monoid w => w -> w -> w
(++) Int
0 []
      (IntMap [(Int, Int)] -> ST s (STRef s (IntMap [(Int, Int)])))
-> ST s (IntMap [(Int, Int)])
-> ST s (STRef s (IntMap [(Int, Int)]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s poly) -> [Int] -> ST s (IntMap [(Int, Int)])
forall poly s.
IsOrderedPolynomial poly =>
RefVec s poly -> [Int] -> ST s (IntMap [(Int, Int)])
buildHilbTable STRef s (MVector s poly)
gs [Int
0 .. Vector poly -> Int
forall a. Vector a -> Int
V.length Vector poly
v0 Int -> Int -> Int
forall r. Group r => r -> r -> r
- Int
1]
  let ins :: poly -> ST s ()
ins poly
g = do
        Int
j <- STRef s (MVector s poly) -> poly -> ST s Int
forall s a. RefVec s a -> a -> ST s Int
snoc STRef s (MVector s poly)
gs poly
g
        IntMap [(Int, Int)]
news <- STRef s (MVector s poly) -> [Int] -> ST s (IntMap [(Int, Int)])
forall poly s.
IsOrderedPolynomial poly =>
RefVec s poly -> [Int] -> ST s (IntMap [(Int, Int)])
buildHilbTable STRef s (MVector s poly)
gs [Int
j]
        STRef s (IntMap [(Int, Int)])
-> (IntMap [(Int, Int)] -> IntMap [(Int, Int)]) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (IntMap [(Int, Int)])
bs ((IntMap [(Int, Int)] -> IntMap [(Int, Int)]) -> ST s ())
-> (IntMap [(Int, Int)] -> IntMap [(Int, Int)]) -> ST s ()
forall a b. (a -> b) -> a -> b
$ ([(Int, Int)] -> [(Int, Int)] -> [(Int, Int)])
-> IntMap [(Int, Int)]
-> IntMap [(Int, Int)]
-> IntMap [(Int, Int)]
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall w. Monoid w => w -> w -> w
(++) IntMap [(Int, Int)]
news
  ST s (Maybe ([(Int, Int)], IntMap [(Int, Int)]))
-> (([(Int, Int)], IntMap [(Int, Int)]) -> ST s ()) -> ST s ()
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> (a -> m b) -> m ()
whileJust_ (IntMap [(Int, Int)] -> Maybe ([(Int, Int)], IntMap [(Int, Int)])
forall a. IntMap a -> Maybe (a, IntMap a)
IM.minView (IntMap [(Int, Int)] -> Maybe ([(Int, Int)], IntMap [(Int, Int)]))
-> ST s (IntMap [(Int, Int)])
-> ST s (Maybe ([(Int, Int)], IntMap [(Int, Int)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (IntMap [(Int, Int)]) -> ST s (IntMap [(Int, Int)])
forall s a. STRef s a -> ST s a
readSTRef STRef s (IntMap [(Int, Int)])
bs) ((([(Int, Int)], IntMap [(Int, Int)]) -> ST s ()) -> ST s ())
-> (([(Int, Int)], IntMap [(Int, Int)]) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \([(Int, Int)]
sigs, IntMap [(Int, Int)]
bs') -> do
    STRef s (IntMap [(Int, Int)]) -> IntMap [(Int, Int)] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (IntMap [(Int, Int)])
bs IntMap [(Int, Int)]
bs'
    ST s Bool -> [(Int, Int)] -> ((Int, Int) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
m Bool -> t a -> (a -> m b) -> m ()
whileForM_ ((Compactified Integer -> Compactified Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Compactified Integer
forall a. a -> Compactified a
Finite Integer
0) (Compactified Integer -> Bool)
-> ST s (Compactified Integer) -> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (Compactified Integer) -> ST s (Compactified Integer)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Compactified Integer)
delta) [(Int, Int)]
sigs (((Int, Int) -> ST s ()) -> ST s ())
-> ((Int, Int) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, Int
j) -> do
      poly
spol <-
        poly -> [poly] -> poly
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
 Foldable t) =>
poly -> t poly -> poly
modPolynomial (poly -> [poly] -> poly) -> ST s poly -> ST s ([poly] -> poly)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (poly -> poly -> poly
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
poly -> poly -> poly
sPolynomial (poly -> poly -> poly) -> ST s poly -> ST s (poly -> poly)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (MVector s poly) -> Int -> ST s poly
forall s a. RefVec s a -> Int -> ST s a
at STRef s (MVector s poly)
gs Int
i ST s (poly -> poly) -> ST s poly -> ST s poly
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s (MVector s poly) -> Int -> ST s poly
forall s a. RefVec s a -> Int -> ST s a
at STRef s (MVector s poly)
gs Int
j)
          ST s ([poly] -> poly) -> ST s [poly] -> ST s poly
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Vector poly -> [poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Vector poly -> [poly]) -> ST s (Vector poly) -> ST s [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVector s poly -> ST s (Vector poly)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze (MVector s poly -> ST s (Vector poly))
-> ST s (MVector s poly) -> ST s (Vector poly)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s poly) -> ST s (MVector s poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s poly)
gs))
      Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
spol) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
        poly -> ST s ()
ins poly
spol
        STRef s (Compactified Integer)
-> (Compactified Integer -> Compactified Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (Compactified Integer)
delta ((Integer -> Integer)
-> Compactified Integer -> Compactified Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Integer
forall a. Enum a => a -> a
pred)
    HPS (Arity poly)
hps' <-
      Vector (Monomial (Arity poly)) -> HPS (Arity poly)
forall (t :: * -> *) (n :: Nat).
(KnownNat n, Foldable t) =>
t (Monomial n) -> HPS n
hilbertPoincareSeriesForMonomials (Vector (Monomial (Arity poly)) -> HPS (Arity poly))
-> (Vector poly -> Vector (Monomial (Arity poly)))
-> Vector poly
-> HPS (Arity poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (poly -> Monomial (Arity poly))
-> Vector poly -> Vector (Monomial (Arity poly))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OrderedMonomial (MOrder poly) (Arity poly) -> Monomial (Arity poly)
forall k (ordering :: k) (n :: Nat).
OrderedMonomial ordering n -> Monomial n
getMonomial (OrderedMonomial (MOrder poly) (Arity poly)
 -> Monomial (Arity poly))
-> (poly -> OrderedMonomial (MOrder poly) (Arity poly))
-> poly
-> Monomial (Arity poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial)
        (Vector poly -> HPS (Arity poly))
-> ST s (Vector poly) -> ST s (HPS (Arity poly))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVector s poly -> ST s (Vector poly)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze (MVector s poly -> ST s (Vector poly))
-> ST s (MVector s poly) -> ST s (Vector poly)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s poly) -> ST s (MVector s poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s poly)
gs)
    if HPS (Arity poly)
hps' HPS (Arity poly) -> HPS (Arity poly) -> Bool
forall a. Eq a => a -> a -> Bool
== HPS (Arity poly)
hps
      then STRef s (IntMap [(Int, Int)]) -> IntMap [(Int, Int)] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (IntMap [(Int, Int)])
bs IntMap [(Int, Int)]
forall a. IntMap a
IM.empty
      else do
        let Just (Int
m', Integer
orig, Integer
new) =
              ((Int, Integer, Integer) -> Bool)
-> [(Int, Integer, Integer)] -> Maybe (Int, Integer, Integer)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Int
_, Integer
b, Integer
c) -> Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
c) ([(Int, Integer, Integer)] -> Maybe (Int, Integer, Integer))
-> [(Int, Integer, Integer)] -> Maybe (Int, Integer, Integer)
forall a b. (a -> b) -> a -> b
$
                [Int] -> [Integer] -> [Integer] -> [(Int, Integer, Integer)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 ..] (HPS (Arity poly) -> [Integer]
forall k (n :: k). HPS n -> [Integer]
taylorHPS HPS (Arity poly)
hps) (HPS (Arity poly) -> [Integer]
forall k (n :: k). HPS n -> [Integer]
taylorHPS HPS (Arity poly)
hps')
        STRef s (Compactified Integer) -> Compactified Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Compactified Integer)
delta (Compactified Integer -> ST s ())
-> Compactified Integer -> ST s ()
forall a b. (a -> b) -> a -> b
$ Integer -> Compactified Integer
forall a. a -> Compactified a
Finite (Integer -> Compactified Integer)
-> Integer -> Compactified Integer
forall a b. (a -> b) -> a -> b
$ Integer
new Integer -> Integer -> Integer
forall r. Group r => r -> r -> r
- Integer
orig
        STRef s (IntMap [(Int, Int)]) -> IntMap [(Int, Int)] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (IntMap [(Int, Int)])
bs (IntMap [(Int, Int)] -> ST s ())
-> (IntMap [(Int, Int)] -> IntMap [(Int, Int)])
-> IntMap [(Int, Int)]
-> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [(Int, Int)], IntMap [(Int, Int)]) -> IntMap [(Int, Int)]
forall a b. (a, b) -> b
snd ((IntMap [(Int, Int)], IntMap [(Int, Int)]) -> IntMap [(Int, Int)])
-> (IntMap [(Int, Int)]
    -> (IntMap [(Int, Int)], IntMap [(Int, Int)]))
-> IntMap [(Int, Int)]
-> IntMap [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> IntMap [(Int, Int)]
-> (IntMap [(Int, Int)], IntMap [(Int, Int)])
forall a. Int -> IntMap a -> (IntMap a, IntMap a)
IM.split (Int
m' Int -> Int -> Int
forall r. Group r => r -> r -> r
- Int
1) (IntMap [(Int, Int)] -> ST s ())
-> ST s (IntMap [(Int, Int)]) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (IntMap [(Int, Int)]) -> ST s (IntMap [(Int, Int)])
forall s a. STRef s a -> ST s a
readSTRef STRef s (IntMap [(Int, Int)])
bs
  Vector poly -> [poly]
forall a. Vector a -> [a]
V.toList (Vector poly -> [poly]) -> ST s (Vector poly) -> ST s [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVector s poly -> ST s (Vector poly)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze (MVector s poly -> ST s (Vector poly))
-> ST s (MVector s poly) -> ST s (Vector poly)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s (MVector s poly) -> ST s (MVector s poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s poly)
gs)

{- | First compute Hilbert-Poicare series w.r.t. @ord@ by
   @'hilbertPoincareSeriesBy'@, and then apply @'calcHomogeneousGroebnerBasisHilbertWithSeries'@.
-}
calcHomogeneousGroebnerBasisHilbertBy ::
  ( Field (Coefficient poly)
  , IsOrderedPolynomial poly
  , IsMonomialOrder (Arity poly) ord
  ) =>
  ord ->
  Ideal poly ->
  [poly]
calcHomogeneousGroebnerBasisHilbertBy :: ord -> Ideal poly -> [poly]
calcHomogeneousGroebnerBasisHilbertBy ord
ord Ideal poly
is =
  Ideal poly -> HPS (Arity poly) -> [poly]
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly -> HPS (Arity poly) -> [poly]
calcHomogeneousGroebnerBasisHilbertWithSeries Ideal poly
is (ord -> Ideal poly -> HPS (Arity poly)
forall ord poly.
(IsMonomialOrder (Arity poly) ord, Field (Coefficient poly),
 IsOrderedPolynomial poly) =>
ord -> Ideal poly -> HPS (Arity poly)
hilbertPoincareSeriesBy ord
ord Ideal poly
is)

{- | Calculates homogeneous Groebner basis by Hilbert-driven method,
   computing Hilbert-Poincare series w.r.t. Grevlex.
-}
calcHomogeneousGroebnerBasisHilbert ::
  ( Field (Coefficient poly)
  , IsOrderedPolynomial poly
  ) =>
  Ideal poly ->
  [poly]
calcHomogeneousGroebnerBasisHilbert :: Ideal poly -> [poly]
calcHomogeneousGroebnerBasisHilbert = Grevlex -> Ideal poly -> [poly]
forall poly ord.
(Field (Coefficient poly), IsOrderedPolynomial poly,
 IsMonomialOrder (Arity poly) ord) =>
ord -> Ideal poly -> [poly]
calcHomogeneousGroebnerBasisHilbertBy Grevlex
Grevlex