{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
module Algebra.Algorithms.Groebner
(
isGroebnerBasis,
calcGroebnerBasis,
calcGroebnerBasisWith,
calcGroebnerBasisWithStrategy,
buchberger,
syzygyBuchberger,
simpleBuchberger,
primeTestBuchberger,
reduceMinimalGroebnerBasis,
minimizeGroebnerBasis,
syzygyBuchbergerWithStrategy,
module Algebra.Algorithms.Groebner.SelectionStrategy,
isIdealMember,
intersection,
thEliminationIdeal,
thEliminationIdealWith,
unsafeThEliminationIdealWith,
eliminatePadding,
quotIdeal,
quotByPrincipalIdeal,
saturationIdeal,
saturationByPrincipalIdeal,
resultant,
hasCommonFactor,
lcmPolynomial,
gcdPolynomial,
)
where
import Algebra.Algorithms.Groebner.SelectionStrategy
import Algebra.Internal
import Algebra.Prelude.Core
import Algebra.Ring.Polynomial.Univariate (Unipol)
import Control.Monad.Loops (whileM_)
import Control.Monad.ST (ST, runST)
import qualified Data.Foldable as F
import qualified Data.Heap as H
import Data.MonoTraversable (oall)
import Data.STRef (STRef, modifySTRef, modifySTRef', newSTRef, readSTRef, writeSTRef)
import Data.Sequence (Seq ((:<|)))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
#if MIN_VERSION_singletons(3,0,0)
import Data.List.Singletons
#else
import Data.Singletons.Prelude.List
#endif
import qualified Data.Sized as V
import Data.Type.Natural.Lemma.Arithmetic (plusCongR, plusMinus')
import Unsafe.Coerce (unsafeCoerce)
import qualified Prelude as P
isGroebnerBasis ::
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
Ideal poly ->
Bool
isGroebnerBasis :: Ideal poly -> Bool
isGroebnerBasis ([poly] -> [poly]
forall a. Eq a => [a] -> [a]
nub ([poly] -> [poly])
-> (Ideal poly -> [poly]) -> Ideal poly -> [poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators -> [poly]
ideal) = ((poly, poly) -> Bool) -> [(poly, poly)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (poly, poly) -> Bool
check ([(poly, poly)] -> Bool) -> [(poly, poly)] -> Bool
forall a b. (a -> b) -> a -> b
$ [poly] -> [(poly, poly)]
forall a. [a] -> [(a, a)]
combinations [poly]
ideal
where
check :: (poly, poly) -> Bool
check (poly
f, poly
g) =
let (OrderedMonomial (MOrder poly) (Arity poly)
t, OrderedMonomial (MOrder poly) (Arity poly)
u) = (poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
f, poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
g)
in 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
* OrderedMonomial (MOrder poly) (Arity poly)
u OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Bool
forall a. Eq a => a -> a -> Bool
== 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)
t OrderedMonomial (MOrder poly) (Arity poly)
u Bool -> Bool -> Bool
|| poly -> poly -> poly
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
poly -> poly -> poly
sPolynomial poly
f poly
g poly -> [poly] -> poly
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
Foldable t) =>
poly -> t poly -> poly
`modPolynomial` [poly]
ideal poly -> poly -> Bool
forall a. Eq a => a -> a -> Bool
== poly
forall m. Monoidal m => m
zero
simpleBuchberger ::
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly ->
[poly]
simpleBuchberger :: Ideal poly -> [poly]
simpleBuchberger Ideal poly
ideal =
let gs :: [poly]
gs = [poly] -> [poly]
forall a. Eq a => [a] -> [a]
nub ([poly] -> [poly]) -> [poly] -> [poly]
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators Ideal poly
ideal
in ([poly], [poly]) -> [poly]
forall a b. (a, b) -> a
fst (([poly], [poly]) -> [poly]) -> ([poly], [poly]) -> [poly]
forall a b. (a -> b) -> a -> b
$
(([poly], [poly]) -> Bool)
-> (([poly], [poly]) -> ([poly], [poly]))
-> ([poly], [poly])
-> ([poly], [poly])
forall a. (a -> Bool) -> (a -> a) -> a -> a
until
([poly] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([poly] -> Bool)
-> (([poly], [poly]) -> [poly]) -> ([poly], [poly]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([poly], [poly]) -> [poly]
forall a b. (a, b) -> b
snd)
( \([poly]
ggs, [poly]
acc) ->
let cur :: [poly]
cur = [poly] -> [poly]
forall a. Eq a => [a] -> [a]
nub ([poly] -> [poly]) -> [poly] -> [poly]
forall a b. (a -> b) -> a -> b
$ [poly]
ggs [poly] -> [poly] -> [poly]
forall w. Monoid w => w -> w -> w
++ [poly]
acc
in ([poly]
cur, [poly] -> [poly]
forall a.
(IsOrderedPolynomial a, Euclidean (Coefficient a),
Division (Coefficient a)) =>
[a] -> [a]
calc [poly]
cur)
)
([poly]
gs, [poly] -> [poly]
forall a.
(IsOrderedPolynomial a, Euclidean (Coefficient a),
Division (Coefficient a)) =>
[a] -> [a]
calc [poly]
gs)
where
calc :: [a] -> [a]
calc [a]
acc =
[ a
q | a
f <- [a]
acc, a
g <- [a]
acc, let q :: a
q = a -> a -> a
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
poly -> poly -> poly
sPolynomial a
f a
g a -> [a] -> a
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
Foldable t) =>
poly -> t poly -> poly
`modPolynomial` [a]
acc, a
q a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall m. Monoidal m => m
zero
]
primeTestBuchberger ::
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly ->
[poly]
primeTestBuchberger :: Ideal poly -> [poly]
primeTestBuchberger Ideal poly
ideal =
let gs :: [poly]
gs = [poly] -> [poly]
forall a. Eq a => [a] -> [a]
nub ([poly] -> [poly]) -> [poly] -> [poly]
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators Ideal poly
ideal
in ([poly], [poly]) -> [poly]
forall a b. (a, b) -> a
fst (([poly], [poly]) -> [poly]) -> ([poly], [poly]) -> [poly]
forall a b. (a -> b) -> a -> b
$
(([poly], [poly]) -> Bool)
-> (([poly], [poly]) -> ([poly], [poly]))
-> ([poly], [poly])
-> ([poly], [poly])
forall a. (a -> Bool) -> (a -> a) -> a -> a
until
([poly] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([poly] -> Bool)
-> (([poly], [poly]) -> [poly]) -> ([poly], [poly]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([poly], [poly]) -> [poly]
forall a b. (a, b) -> b
snd)
( \([poly]
ggs, [poly]
acc) ->
let cur :: [poly]
cur = [poly] -> [poly]
forall a. Eq a => [a] -> [a]
nub ([poly] -> [poly]) -> [poly] -> [poly]
forall a b. (a -> b) -> a -> b
$ [poly]
ggs [poly] -> [poly] -> [poly]
forall w. Monoid w => w -> w -> w
++ [poly]
acc
in ([poly]
cur, [poly] -> [poly]
forall a.
(IsOrderedPolynomial a, Euclidean (Coefficient a),
Division (Coefficient a)) =>
[a] -> [a]
calc [poly]
cur)
)
([poly]
gs, [poly] -> [poly]
forall a.
(IsOrderedPolynomial a, Euclidean (Coefficient a),
Division (Coefficient a)) =>
[a] -> [a]
calc [poly]
gs)
where
calc :: [a] -> [a]
calc [a]
acc =
[ a
q | a
f <- [a]
acc, a
g <- [a]
acc, a
f a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
g, let f0 :: OrderedMonomial (MOrder a) (Arity a)
f0 = a -> OrderedMonomial (MOrder a) (Arity a)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial a
f, let g0 :: OrderedMonomial (MOrder a) (Arity a)
g0 = a -> OrderedMonomial (MOrder a) (Arity a)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial a
g, OrderedMonomial (MOrder a) (Arity a)
-> OrderedMonomial (MOrder a) (Arity a)
-> OrderedMonomial (MOrder a) (Arity a)
forall k (n :: Nat) (ord :: k).
KnownNat n =>
OrderedMonomial ord n
-> OrderedMonomial ord n -> OrderedMonomial ord n
lcmMonomial OrderedMonomial (MOrder a) (Arity a)
f0 OrderedMonomial (MOrder a) (Arity a)
g0 OrderedMonomial (MOrder a) (Arity a)
-> OrderedMonomial (MOrder a) (Arity a) -> Bool
forall a. Eq a => a -> a -> Bool
/= OrderedMonomial (MOrder a) (Arity a)
f0 OrderedMonomial (MOrder a) (Arity a)
-> OrderedMonomial (MOrder a) (Arity a)
-> OrderedMonomial (MOrder a) (Arity a)
forall r. Multiplicative r => r -> r -> r
* OrderedMonomial (MOrder a) (Arity a)
g0, let q :: a
q = a -> a -> a
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
poly -> poly -> poly
sPolynomial a
f a
g a -> [a] -> a
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
Foldable t) =>
poly -> t poly -> poly
`modPolynomial` [a]
acc, a
q a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall m. Monoidal m => m
zero
]
(.=) :: STRef s a -> a -> ST s ()
STRef s a
x .= :: STRef s a -> a -> ST s ()
.= a
v = STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s a
x a
v
(%=) :: STRef s a -> (a -> a) -> ST s ()
STRef s a
x %= :: STRef s a -> (a -> a) -> ST s ()
%= a -> a
f = STRef s a -> (a -> a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s a
x a -> a
f
combinations :: [a] -> [(a, a)]
combinations :: [a] -> [(a, a)]
combinations [a]
xs = [[(a, a)]] -> [(a, a)]
forall w. Monoid w => [w] -> w
concat ([[(a, a)]] -> [(a, a)]) -> [[(a, a)]] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ (a -> [a] -> [(a, a)]) -> [a] -> [[a]] -> [[(a, a)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((a -> (a, a)) -> [a] -> [(a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((a -> (a, a)) -> [a] -> [(a, a)])
-> (a -> a -> (a, a)) -> a -> [a] -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,)) [a]
xs ([[a]] -> [[(a, a)]]) -> [[a]] -> [[(a, a)]]
forall a b. (a -> b) -> a -> b
$ Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
drop Int
1 ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
xs
{-# INLINE combinations #-}
buchberger ::
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly ->
[poly]
buchberger :: Ideal poly -> [poly]
buchberger = Ideal poly -> [poly]
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly -> [poly]
syzygyBuchberger
syzygyBuchberger ::
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly ->
[poly]
syzygyBuchberger :: Ideal poly -> [poly]
syzygyBuchberger = SugarStrategy NormalStrategy -> Ideal poly -> [poly]
forall poly strategy.
(Field (Coefficient poly), IsOrderedPolynomial poly,
SelectionStrategy (Arity poly) strategy,
Ord (Weight (Arity poly) strategy (MOrder poly))) =>
strategy -> Ideal poly -> [poly]
syzygyBuchbergerWithStrategy (NormalStrategy -> SugarStrategy NormalStrategy
forall s. s -> SugarStrategy s
SugarStrategy NormalStrategy
NormalStrategy)
{-# SPECIALIZE INLINE [0] syzygyBuchberger ::
(CoeffRing r, Field r, IsMonomialOrder n ord, KnownNat n) =>
Ideal (OrderedPolynomial r ord n) ->
[OrderedPolynomial r ord n]
#-}
{-# SPECIALIZE INLINE [0] syzygyBuchberger ::
(CoeffRing r, Field r) =>
Ideal (Unipol r) ->
[Unipol r]
#-}
{-# INLINE [1] syzygyBuchberger #-}
syzygyBuchbergerWithStrategy ::
( Field (Coefficient poly)
, IsOrderedPolynomial poly
, SelectionStrategy (Arity poly) strategy
, Ord (Weight (Arity poly) strategy (MOrder poly))
) =>
strategy ->
Ideal poly ->
[poly]
syzygyBuchbergerWithStrategy :: strategy -> Ideal poly -> [poly]
syzygyBuchbergerWithStrategy strategy
strategy 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
let gens :: [(Integer, poly)]
gens = [Integer] -> [poly] -> [(Integer, poly)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1 ..] ([poly] -> [(Integer, poly)]) -> [poly] -> [(Integer, poly)]
forall a b. (a -> b) -> a -> b
$ (poly -> Bool) -> [poly] -> [poly]
forall a. (a -> Bool) -> [a] -> [a]
filter (poly -> poly -> Bool
forall a. Eq a => a -> a -> Bool
/= poly
forall m. Monoidal m => m
zero) ([poly] -> [poly]) -> [poly] -> [poly]
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators Ideal poly
ideal
STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
gs <- Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> ST
s
(STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)))
forall a s. a -> ST s (STRef s a)
newSTRef (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> ST
s
(STRef
s
(Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))))
-> Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> ST
s
(STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)))
forall a b. (a -> b) -> a -> b
$ [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
-> Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
forall a. Ord a => [a] -> Heap a
H.fromList [OrderedMonomial (MOrder poly) (Arity poly)
-> poly -> Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly
forall p a. p -> a -> Entry p a
H.Entry (poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
g) poly
g | (Integer
_, poly
g) <- [(Integer, poly)]
gens]
STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
b <- Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> ST
s
(STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly))))
forall a s. a -> ST s (STRef s a)
newSTRef (Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> ST
s
(STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))))
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> ST
s
(STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly))))
forall a b. (a -> b) -> a -> b
$ [Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly)]
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
forall a. Ord a => [a] -> Heap a
H.fromList [(Weight (Arity poly) strategy (MOrder poly), Integer)
-> (poly, poly)
-> Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly)
forall p a. p -> a -> Entry p a
H.Entry (strategy
-> poly -> poly -> Weight (Arity poly) strategy (MOrder poly)
forall poly s.
(SelectionStrategy (Arity poly) s, IsOrderedPolynomial poly) =>
s -> poly -> poly -> Weight (Arity poly) s (MOrder poly)
calcWeight' strategy
strategy poly
f poly
g, Integer
j) (poly
f, poly
g) | ((Integer
_, poly
f), (Integer
j, poly
g)) <- [(Integer, poly)] -> [((Integer, poly), (Integer, poly))]
forall a. [a] -> [(a, a)]
combinations [(Integer, poly)]
gens]
STRef s Integer
len <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef ([(Integer, poly)] -> Integer
forall i a. Num i => [a] -> i
genericLength [(Integer, poly)]
gens :: Integer)
ST s Bool -> ST s () -> ST s ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ (Bool -> Bool
not (Bool -> Bool)
-> (Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Bool)
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Bool
forall a. Heap a -> Bool
H.null (Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Bool)
-> ST
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
-> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
-> ST
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
forall s a. STRef s a -> ST s a
readSTRef STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
b) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Just (H.Entry (Weight (Arity poly) strategy (MOrder poly), Integer)
_ (poly
f, poly
g), Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
rest) <- Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Maybe
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly),
Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
forall a. Heap a -> Maybe (a, Heap a)
H.viewMin (Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Maybe
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly),
Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly))))
-> ST
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
-> ST
s
(Maybe
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly),
Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
-> ST
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
forall s a. STRef s a -> ST s a
readSTRef STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
b
Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
gs0 <- STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
-> ST
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
forall s a. STRef s a -> ST s a
readSTRef STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
gs
STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
b STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> ST s ()
forall s a. STRef s a -> a -> ST s ()
.= Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
rest
let f0 :: OrderedMonomial (MOrder poly) (Arity poly)
f0 = poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
f
g0 :: OrderedMonomial (MOrder poly) (Arity poly)
g0 = poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
g
l :: OrderedMonomial (MOrder poly) (Arity poly)
l = 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)
f0 OrderedMonomial (MOrder poly) (Arity poly)
g0
redundant :: Bool
redundant =
(Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly -> Bool)
-> Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any
( \(H.Entry OrderedMonomial (MOrder poly) (Arity poly)
_ poly
h) ->
(poly
h poly -> [poly] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [poly
f, poly
g])
Bool -> Bool -> Bool
&& ((poly, poly) -> Bool) -> [(poly, poly)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
(\(poly, poly)
k -> (Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly)
-> Bool)
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (((poly, poly) -> (poly, poly) -> Bool
forall a. Eq a => a -> a -> Bool
/= (poly, poly)
k) ((poly, poly) -> Bool)
-> (Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly)
-> (poly, poly))
-> Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly)
-> (poly, poly)
forall p a. Entry p a -> a
H.payload) Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
rest)
[(poly
f, poly
h), (poly
g, poly
h), (poly
h, poly
f), (poly
h, poly
g)]
Bool -> Bool -> Bool
&& poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
h 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)
l
)
Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
gs0
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OrderedMonomial (MOrder poly) (Arity poly)
l OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly) -> Bool
forall a. Eq a => a -> a -> Bool
/= OrderedMonomial (MOrder poly) (Arity poly)
f0 OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
-> OrderedMonomial (MOrder poly) (Arity poly)
forall r. Multiplicative r => r -> r -> r
* OrderedMonomial (MOrder poly) (Arity poly)
g0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
redundant) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Integer
len0 <- STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
len
let qs :: [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
qs = Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
gs0
s :: poly
s = poly -> poly -> poly
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
poly -> poly -> poly
sPolynomial poly
f poly
g poly -> [poly] -> poly
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
Foldable t) =>
poly -> t poly -> poly
`modPolynomial` (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly -> poly)
-> [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
-> [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly -> poly
forall p a. Entry p a -> a
H.payload [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
qs
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (poly
s poly -> poly -> Bool
forall a. Eq a => a -> a -> Bool
/= poly
forall m. Monoidal m => m
zero) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
b STRef
s
(Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
-> (Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer)
(poly, poly)))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
%= Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
forall a. Heap a -> Heap a -> Heap a
H.union ([Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly)]
-> Heap
(Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly))
forall a. Ord a => [a] -> Heap a
H.fromList [(Weight (Arity poly) strategy (MOrder poly), Integer)
-> (poly, poly)
-> Entry
(Weight (Arity poly) strategy (MOrder poly), Integer) (poly, poly)
forall p a. p -> a -> Entry p a
H.Entry (strategy
-> poly -> poly -> Weight (Arity poly) strategy (MOrder poly)
forall poly s.
(SelectionStrategy (Arity poly) s, IsOrderedPolynomial poly) =>
s -> poly -> poly -> Weight (Arity poly) s (MOrder poly)
calcWeight' strategy
strategy poly
q poly
s, Integer
j) (poly
q, poly
s) | H.Entry OrderedMonomial (MOrder poly) (Arity poly)
_ poly
q <- [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
qs | Integer
j <- [Integer
len0 Integer -> Integer -> Integer
forall r. Additive r => r -> r -> r
+ Integer
1 ..]])
STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
gs STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
-> (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
%= Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly
-> Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
forall a. Ord a => a -> Heap a -> Heap a
H.insert (OrderedMonomial (MOrder poly) (Arity poly)
-> poly -> Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly
forall p a. p -> a -> Entry p a
H.Entry (poly -> OrderedMonomial (MOrder poly) (Arity poly)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial poly
s) poly
s)
STRef s Integer
len STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
%= (Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
* Integer
2)
(Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly -> poly)
-> [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
-> [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly -> poly
forall p a. Entry p a -> a
H.payload ([Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
-> [poly])
-> (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly])
-> Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> [poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> [Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly)
-> [poly])
-> ST
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
-> ST s [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
-> ST
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
forall s a. STRef s a -> ST s a
readSTRef STRef
s (Heap (Entry (OrderedMonomial (MOrder poly) (Arity poly)) poly))
gs
{-# SPECIALIZE INLINE [0] syzygyBuchbergerWithStrategy ::
(Field k, CoeffRing k, KnownNat n) =>
SugarStrategy NormalStrategy ->
Ideal (OrderedPolynomial k Grevlex n) ->
[OrderedPolynomial k Grevlex n]
#-}
{-# SPECIALIZE INLINE [0] syzygyBuchbergerWithStrategy ::
(Field k, CoeffRing k) =>
SugarStrategy NormalStrategy ->
Ideal (Unipol k) ->
[Unipol k]
#-}
{-# SPECIALIZE INLINE [1] syzygyBuchbergerWithStrategy ::
(Field k, CoeffRing k, KnownNat n, IsMonomialOrder n ord) =>
SugarStrategy NormalStrategy ->
Ideal (OrderedPolynomial k ord n) ->
[OrderedPolynomial k ord n]
#-}
{-# SPECIALIZE INLINE [1] syzygyBuchbergerWithStrategy ::
( Field k
, CoeffRing k
, IsMonomialOrder n ord
, SelectionStrategy n strategy
, KnownNat n
, Ord (Weight n strategy ord)
) =>
strategy ->
Ideal (OrderedPolynomial k ord n) ->
[OrderedPolynomial k ord n]
#-}
{-# INLINEABLE [2] syzygyBuchbergerWithStrategy #-}
data PolyEntry p = PE
{ PolyEntry p -> OrderedMonomial (MOrder p) (Arity p)
leadMon :: !(OrderedMonomial (MOrder p) (Arity p))
, PolyEntry p -> p
poly :: p
}
instance IsOrderedPolynomial p => Eq (PolyEntry p) where
== :: PolyEntry p -> PolyEntry p -> Bool
(==) = OrderedMonomial (MOrder p) (Arity p)
-> OrderedMonomial (MOrder p) (Arity p) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (OrderedMonomial (MOrder p) (Arity p)
-> OrderedMonomial (MOrder p) (Arity p) -> Bool)
-> (PolyEntry p -> OrderedMonomial (MOrder p) (Arity p))
-> PolyEntry p
-> PolyEntry p
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PolyEntry p -> OrderedMonomial (MOrder p) (Arity p)
forall p. PolyEntry p -> OrderedMonomial (MOrder p) (Arity p)
leadMon
{-# INLINE (==) #-}
instance IsOrderedPolynomial p => Ord (PolyEntry p) where
compare :: PolyEntry p -> PolyEntry p -> Ordering
compare = (PolyEntry p -> OrderedMonomial (MOrder p) (Arity p))
-> PolyEntry p -> PolyEntry p -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing PolyEntry p -> OrderedMonomial (MOrder p) (Arity p)
forall p. PolyEntry p -> OrderedMonomial (MOrder p) (Arity p)
leadMon
{-# INLINE compare #-}
toPE :: (Field (Coefficient p), IsOrderedPolynomial p) => p -> PolyEntry p
toPE :: p -> PolyEntry p
toPE p
p = OrderedMonomial (MOrder p) (Arity p) -> p -> PolyEntry p
forall p. OrderedMonomial (MOrder p) (Arity p) -> p -> PolyEntry p
PE (p -> OrderedMonomial (MOrder p) (Arity p)
forall poly.
IsOrderedPolynomial poly =>
poly -> OrderedMonomial (MOrder poly) (Arity poly)
leadingMonomial p
p) (p -> PolyEntry p) -> p -> PolyEntry p
forall a b. (a -> b) -> a -> b
$ p -> p
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
poly -> poly
monoize p
p
{-# INLINE toPE #-}
divsPE :: IsOrderedPolynomial p => PolyEntry p -> PolyEntry p -> Bool
divsPE :: PolyEntry p -> PolyEntry p -> Bool
divsPE = OrderedMonomial (MOrder p) (Arity p)
-> OrderedMonomial (MOrder p) (Arity p) -> Bool
forall k (n :: Nat) (ord :: k).
KnownNat n =>
OrderedMonomial ord n -> OrderedMonomial ord n -> Bool
divs (OrderedMonomial (MOrder p) (Arity p)
-> OrderedMonomial (MOrder p) (Arity p) -> Bool)
-> (PolyEntry p -> OrderedMonomial (MOrder p) (Arity p))
-> PolyEntry p
-> PolyEntry p
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PolyEntry p -> OrderedMonomial (MOrder p) (Arity p)
forall p. PolyEntry p -> OrderedMonomial (MOrder p) (Arity p)
leadMon
{-# INLINE divsPE #-}
insPE :: (Field (Coefficient p), IsOrderedPolynomial p) => p -> Set (PolyEntry p) -> Set (PolyEntry p)
insPE :: p -> Set (PolyEntry p) -> Set (PolyEntry p)
insPE p
p Set (PolyEntry p)
s
| Set (PolyEntry p) -> Bool
forall a. Set a -> Bool
Set.null Set (PolyEntry p)
s = PolyEntry p -> Set (PolyEntry p)
forall a. a -> Set a
Set.singleton (PolyEntry p -> Set (PolyEntry p))
-> PolyEntry p -> Set (PolyEntry p)
forall a b. (a -> b) -> a -> b
$ p -> PolyEntry p
forall p.
(Field (Coefficient p), IsOrderedPolynomial p) =>
p -> PolyEntry p
toPE p
p
| Bool
otherwise =
let pe :: PolyEntry p
pe = p -> PolyEntry p
forall p.
(Field (Coefficient p), IsOrderedPolynomial p) =>
p -> PolyEntry p
toPE p
p
(Set (PolyEntry p)
l, Bool
there, Set (PolyEntry p)
r) = PolyEntry p
-> Set (PolyEntry p)
-> (Set (PolyEntry p), Bool, Set (PolyEntry p))
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
Set.splitMember PolyEntry p
pe Set (PolyEntry p)
s
in if Bool
there Bool -> Bool -> Bool
|| (PolyEntry p -> Bool) -> Set (PolyEntry p) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any (PolyEntry p -> PolyEntry p -> Bool
forall p.
IsOrderedPolynomial p =>
PolyEntry p -> PolyEntry p -> Bool
`divsPE` PolyEntry p
pe) Set (PolyEntry p)
l
then Set (PolyEntry p)
s
else Set (PolyEntry p) -> Set (PolyEntry p) -> Set (PolyEntry p)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (PolyEntry p)
l (PolyEntry p -> Set (PolyEntry p) -> Set (PolyEntry p)
forall a. Ord a => a -> Set a -> Set a
Set.insert PolyEntry p
pe (Set (PolyEntry p) -> Set (PolyEntry p))
-> Set (PolyEntry p) -> Set (PolyEntry p)
forall a b. (a -> b) -> a -> b
$ (PolyEntry p -> Bool) -> Set (PolyEntry p) -> Set (PolyEntry p)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (PolyEntry p -> Bool) -> PolyEntry p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PolyEntry p
pe PolyEntry p -> PolyEntry p -> Bool
forall p.
IsOrderedPolynomial p =>
PolyEntry p -> PolyEntry p -> Bool
`divsPE`)) Set (PolyEntry p)
r)
{-# INLINE insPE #-}
minimizeGroebnerBasis ::
(Foldable t, Field (Coefficient poly), IsOrderedPolynomial poly) =>
t poly ->
[poly]
minimizeGroebnerBasis :: t poly -> [poly]
minimizeGroebnerBasis = (PolyEntry poly -> poly) -> [PolyEntry poly] -> [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PolyEntry poly -> poly
forall p. PolyEntry p -> p
poly ([PolyEntry poly] -> [poly])
-> (t poly -> [PolyEntry poly]) -> t poly -> [poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (PolyEntry poly) -> [PolyEntry poly]
forall a. Set a -> [a]
Set.toList (Set (PolyEntry poly) -> [PolyEntry poly])
-> (t poly -> Set (PolyEntry poly)) -> t poly -> [PolyEntry poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (poly -> Set (PolyEntry poly) -> Set (PolyEntry poly))
-> Set (PolyEntry poly) -> t poly -> Set (PolyEntry poly)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr poly -> Set (PolyEntry poly) -> Set (PolyEntry poly)
forall p.
(Field (Coefficient p), IsOrderedPolynomial p) =>
p -> Set (PolyEntry p) -> Set (PolyEntry p)
insPE Set (PolyEntry poly)
forall a. Set a
Set.empty
{-# INLINE minimizeGroebnerBasis #-}
reduceMinimalGroebnerBasis ::
(Foldable t, Field (Coefficient poly), IsOrderedPolynomial poly) =>
t poly ->
[poly]
reduceMinimalGroebnerBasis :: t poly -> [poly]
reduceMinimalGroebnerBasis t poly
bs = (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 (Seq poly)
left <- Seq poly -> ST s (STRef s (Seq poly))
forall a s. a -> ST s (STRef s a)
newSTRef (Seq poly -> ST s (STRef s (Seq poly)))
-> Seq poly -> ST s (STRef s (Seq poly))
forall a b. (a -> b) -> a -> b
$ [poly] -> Seq poly
forall a. [a] -> Seq a
Seq.fromList ([poly] -> Seq poly) -> [poly] -> Seq poly
forall a b. (a -> b) -> a -> b
$ t poly -> [poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t poly
bs
STRef s (Seq poly)
right <- Seq poly -> ST s (STRef s (Seq poly))
forall a s. a -> ST s (STRef s a)
newSTRef Seq poly
forall a. Seq a
Seq.empty
ST s Bool -> ST s () -> ST s ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ (Bool -> Bool
not (Bool -> Bool) -> (Seq poly -> Bool) -> Seq poly -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq poly -> Bool
forall a. Seq a -> Bool
Seq.null (Seq poly -> Bool) -> ST s (Seq poly) -> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (Seq poly) -> ST s (Seq poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq poly)
left) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
poly
f :<| Seq poly
xs <- STRef s (Seq poly) -> ST s (Seq poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq poly)
left
STRef s (Seq poly) -> Seq poly -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Seq poly)
left Seq poly
xs
Seq poly
ys <- STRef s (Seq poly) -> ST s (Seq poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq poly)
right
let q :: poly
q = poly
f poly -> Seq poly -> poly
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
Foldable t) =>
poly -> t poly -> poly
`modPolynomial` (Seq poly
xs Seq poly -> Seq poly -> Seq poly
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq poly
ys)
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
q) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ STRef s (Seq poly) -> (Seq poly -> Seq poly) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (Seq poly)
right (poly
q poly -> Seq poly -> Seq poly
forall a. a -> Seq a -> Seq a
:<|)
Seq poly -> [poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq poly -> [poly]) -> ST s (Seq poly) -> ST s [poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (Seq poly) -> ST s (Seq poly)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq poly)
right
calcGroebnerBasisWith ::
( IsOrderedPolynomial poly
, Field (Coefficient poly)
, IsMonomialOrder (Arity poly) order
) =>
order ->
Ideal poly ->
[OrderedPolynomial (Coefficient poly) order (Arity poly)]
calcGroebnerBasisWith :: order
-> Ideal poly
-> [OrderedPolynomial (Coefficient poly) order (Arity poly)]
calcGroebnerBasisWith order
_ord = Ideal (OrderedPolynomial (Coefficient poly) order (Arity poly))
-> [OrderedPolynomial (Coefficient poly) order (Arity poly)]
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly -> [poly]
calcGroebnerBasis (Ideal (OrderedPolynomial (Coefficient poly) order (Arity poly))
-> [OrderedPolynomial (Coefficient poly) order (Arity poly)])
-> (Ideal poly
-> Ideal (OrderedPolynomial (Coefficient poly) order (Arity poly)))
-> Ideal poly
-> [OrderedPolynomial (Coefficient poly) order (Arity poly)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (poly -> OrderedPolynomial (Coefficient poly) order (Arity poly))
-> Ideal poly
-> Ideal (OrderedPolynomial (Coefficient poly) order (Arity poly))
forall r r'. (r -> r') -> Ideal r -> Ideal r'
mapIdeal poly -> OrderedPolynomial (Coefficient poly) order (Arity poly)
forall r r'.
(Arity r <= Arity r', IsPolynomial r, IsPolynomial r',
Coefficient r ~ Coefficient r') =>
r -> r'
injectVars
{-# INLINE [2] calcGroebnerBasisWith #-}
{-# RULES
"calcGroebnerBasisWith/sameOrderPolyn" [~2] forall x.
calcGroebnerBasisWith x =
calcGroebnerBasis
#-}
calcGroebnerBasisWithStrategy ::
( Field (Coefficient poly)
, IsOrderedPolynomial poly
, SelectionStrategy (Arity poly) strategy
, Ord (Weight (Arity poly) strategy (MOrder poly))
) =>
strategy ->
Ideal poly ->
[poly]
calcGroebnerBasisWithStrategy :: strategy -> Ideal poly -> [poly]
calcGroebnerBasisWithStrategy strategy
strategy =
[poly] -> [poly]
forall (t :: * -> *) poly.
(Foldable t, Field (Coefficient poly), IsOrderedPolynomial poly) =>
t poly -> [poly]
reduceMinimalGroebnerBasis ([poly] -> [poly])
-> (Ideal poly -> [poly]) -> Ideal poly -> [poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [poly] -> [poly]
forall (t :: * -> *) poly.
(Foldable t, Field (Coefficient poly), IsOrderedPolynomial poly) =>
t poly -> [poly]
minimizeGroebnerBasis ([poly] -> [poly])
-> (Ideal poly -> [poly]) -> Ideal poly -> [poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. strategy -> Ideal poly -> [poly]
forall poly strategy.
(Field (Coefficient poly), IsOrderedPolynomial poly,
SelectionStrategy (Arity poly) strategy,
Ord (Weight (Arity poly) strategy (MOrder poly))) =>
strategy -> Ideal poly -> [poly]
syzygyBuchbergerWithStrategy strategy
strategy
calcGroebnerBasis ::
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly ->
[poly]
calcGroebnerBasis :: Ideal poly -> [poly]
calcGroebnerBasis = [poly] -> [poly]
forall (t :: * -> *) poly.
(Foldable t, Field (Coefficient poly), IsOrderedPolynomial poly) =>
t poly -> [poly]
reduceMinimalGroebnerBasis ([poly] -> [poly])
-> (Ideal poly -> [poly]) -> Ideal poly -> [poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [poly] -> [poly]
forall (t :: * -> *) poly.
(Foldable t, Field (Coefficient poly), IsOrderedPolynomial poly) =>
t poly -> [poly]
minimizeGroebnerBasis ([poly] -> [poly])
-> (Ideal poly -> [poly]) -> Ideal poly -> [poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ideal poly -> [poly]
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly -> [poly]
syzygyBuchberger
{-# SPECIALIZE INLINE [2] calcGroebnerBasis ::
(CoeffRing r, Field r, IsMonomialOrder n ord, KnownNat n) =>
Ideal (OrderedPolynomial r ord n) ->
[OrderedPolynomial r ord n]
#-}
{-# SPECIALIZE INLINE [2] calcGroebnerBasis ::
(CoeffRing r, Field r) =>
Ideal (Unipol r) ->
[Unipol r]
#-}
{-# INLINE [2] calcGroebnerBasis #-}
isIdealMember ::
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
poly ->
Ideal poly ->
Bool
isIdealMember :: poly -> Ideal poly -> Bool
isIdealMember poly
f Ideal poly
ideal = poly -> [poly] -> Bool
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
poly -> [poly] -> Bool
groebnerTest poly
f (Ideal poly -> [poly]
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly -> [poly]
calcGroebnerBasis Ideal poly
ideal)
{-# INLINE isIdealMember #-}
groebnerTest ::
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
poly ->
[poly] ->
Bool
groebnerTest :: poly -> [poly] -> Bool
groebnerTest poly
f [poly]
fs = poly
f poly -> [poly] -> poly
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
Foldable t) =>
poly -> t poly -> poly
`modPolynomial` [poly]
fs poly -> poly -> Bool
forall a. Eq a => a -> a -> Bool
== poly
forall m. Monoidal m => m
zero
lengthReplicate :: forall m x p. SNat m -> p x -> Length (Replicate m x) :~: m
lengthReplicate :: SNat m -> p x -> Length (Replicate m x) :~: m
lengthReplicate SNat m
_ p x
_ = (() :~: ())
-> Length (Case_6989586621680379320 m x (DefaultEq m 0)) :~: m
forall a b. a -> b
unsafeCoerce ((() :~: ())
-> Length (Case_6989586621680379320 m x (DefaultEq m 0)) :~: m)
-> (() :~: ())
-> Length (Case_6989586621680379320 m x (DefaultEq m 0)) :~: m
forall a b. (a -> b) -> a -> b
$ () :~: ()
forall k (a :: k). a :~: a
Refl @()
thEliminationIdeal ::
forall poly n.
( IsMonomialOrder (Arity poly - n) (MOrder poly)
, Field (Coefficient poly)
, IsOrderedPolynomial poly
, (n <= Arity poly)
) =>
SNat n ->
Ideal poly ->
Ideal (OrderedPolynomial (Coefficient poly) (MOrder poly) (Arity poly - n))
thEliminationIdeal :: SNat n
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
thEliminationIdeal SNat n
n =
Sing (Case_6989586621680379320 n 1 (DefaultEq n 0))
-> (SingI (Case_6989586621680379320 n 1 (DefaultEq n 0)) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI (SNat n -> SList (Replicate n 1)
forall (n :: Nat). SNat n -> SList (Replicate n 1)
sOnes SNat n
n) ((SingI (Case_6989586621680379320 n 1 (DefaultEq n 0)) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> (SingI (Case_6989586621680379320 n 1 (DefaultEq n 0)) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall a b. (a -> b) -> a -> b
$
(Length (Case_6989586621680379320 n 1 (DefaultEq n 0)) :~: n)
-> ((Length (Case_6989586621680379320 n 1 (DefaultEq n 0)) ~ n) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall k (a :: k) (b :: k) r. (a :~: b) -> ((a ~ b) => r) -> r
withRefl (SNat n -> SNat 1 -> Length (Replicate n 1) :~: n
forall a (m :: Nat) (x :: a) (p :: a -> *).
SNat m -> p x -> Length (Replicate m x) :~: m
lengthReplicate SNat n
n (KnownNat 1 => SNat 1
forall (n :: Nat). KnownNat n => SNat n
sNat @1)) (((Length (Case_6989586621680379320 n 1 (DefaultEq n 0)) ~ n) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> ((Length (Case_6989586621680379320 n 1 (DefaultEq n 0)) ~ n) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall a b. (a -> b) -> a -> b
$
SNat n
-> (KnownNat n =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall (n :: Nat) r. SNat n -> (KnownNat n => r) -> r
withKnownNat SNat n
n ((KnownNat n =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> (KnownNat n =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall a b. (a -> b) -> a -> b
$
SNat (Arity poly - n)
-> (KnownNat (Arity poly - n) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall (n :: Nat) r. SNat n -> (KnownNat n => r) -> r
withKnownNat ((SNat (Arity poly)
forall (n :: Nat). KnownNat n => SNat n
sNat :: SNat (Arity poly)) SNat (Arity poly) -> SNat n -> SNat (Arity poly - n)
forall (n :: Nat) (m :: Nat). SNat n -> SNat m -> SNat (n - m)
%- SNat n
n) ((KnownNat (Arity poly - n) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> (KnownNat (Arity poly - n) =>
Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall a b. (a -> b) -> a -> b
$
(OrderedPolynomial (Coefficient poly) Grevlex (Arity poly - n)
-> OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
-> Ideal
(OrderedPolynomial (Coefficient poly) Grevlex (Arity poly - n))
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall r r'. (r -> r') -> Ideal r -> Ideal r'
mapIdeal (Proxy (MOrder poly)
-> OrderedPolynomial (Coefficient poly) Grevlex (Arity poly - n)
-> OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)
forall k (n :: Nat) o o'.
(CoeffRing k, Eq (Monomial n), IsMonomialOrder n o,
IsMonomialOrder n o', KnownNat n) =>
Proxy o' -> OrderedPolynomial k o n -> OrderedPolynomial k o' n
changeOrderProxy Proxy (MOrder poly)
forall k (t :: k). Proxy t
Proxy) (Ideal
(OrderedPolynomial (Coefficient poly) Grevlex (Arity poly - n))
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n)))
-> (Ideal poly
-> Ideal
(OrderedPolynomial (Coefficient poly) Grevlex (Arity poly - n)))
-> Ideal poly
-> Ideal
(OrderedPolynomial
(Coefficient poly) (MOrder poly) (Arity poly - n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WeightOrder (Case_6989586621680379320 n 1 (DefaultEq n 0)) Grevlex
-> SNat n
-> Ideal poly
-> Ideal
(OrderedPolynomial (Coefficient poly) Grevlex (Arity poly - n))
forall poly (m :: Nat) k (n :: Nat) ord.
(IsOrderedPolynomial poly, m ~ Arity poly, k ~ Coefficient poly,
Field k, KnownNat (m - n), n <= m, EliminationType m n ord) =>
ord
-> SNat n
-> Ideal poly
-> Ideal (OrderedPolynomial k Grevlex (m - n))
thEliminationIdealWith (SNat n -> WeightedEliminationOrder n Grevlex
forall (n :: Nat). SNat n -> WeightedEliminationOrder n Grevlex
weightedEliminationOrder SNat n
n) SNat n
n
{-# INLINE CONLIKE thEliminationIdeal #-}
thEliminationIdealWith ::
( IsOrderedPolynomial poly
, m ~ Arity poly
, k ~ Coefficient poly
, Field k
, KnownNat (m - n)
, (n <= m)
, EliminationType m n ord
) =>
ord ->
SNat n ->
Ideal poly ->
Ideal (OrderedPolynomial k Grevlex (m - n))
thEliminationIdealWith :: ord
-> SNat n
-> Ideal poly
-> Ideal (OrderedPolynomial k Grevlex (m - n))
thEliminationIdealWith = ord
-> SNat n
-> Ideal poly
-> Ideal (OrderedPolynomial k Grevlex (m - n))
forall poly (m :: Nat) k ord (n :: Nat).
(IsOrderedPolynomial poly, m ~ Arity poly, k ~ Coefficient poly,
Field k, IsMonomialOrder m ord, n <= m) =>
ord
-> SNat n
-> Ideal poly
-> Ideal (OrderedPolynomial k Grevlex (m - n))
unsafeThEliminationIdealWith
unsafeThEliminationIdealWith ::
( IsOrderedPolynomial poly
, m ~ Arity poly
, k ~ Coefficient poly
, Field k
, IsMonomialOrder m ord
, (n <= m)
) =>
ord ->
SNat n ->
Ideal poly ->
Ideal (OrderedPolynomial k Grevlex (m - n))
unsafeThEliminationIdealWith :: ord
-> SNat n
-> Ideal poly
-> Ideal (OrderedPolynomial k Grevlex (m - n))
unsafeThEliminationIdealWith ord
ord SNat n
n Ideal poly
ideal =
SNat n
-> (KnownNat n => Ideal (OrderedPolynomial k Grevlex (m - n)))
-> Ideal (OrderedPolynomial k Grevlex (m - n))
forall (n :: Nat) r. SNat n -> (KnownNat n => r) -> r
withKnownNat SNat n
n ((KnownNat n => Ideal (OrderedPolynomial k Grevlex (m - n)))
-> Ideal (OrderedPolynomial k Grevlex (m - n)))
-> (KnownNat n => Ideal (OrderedPolynomial k Grevlex (m - n)))
-> Ideal (OrderedPolynomial k Grevlex (m - n))
forall a b. (a -> b) -> a -> b
$
[OrderedPolynomial k Grevlex (m - n)]
-> Ideal (OrderedPolynomial k Grevlex (m - n))
forall r. (DecidableZero r, Monoidal r) => [r] -> Ideal r
toIdeal
[ (USized m Int -> USized (m - n) Int)
-> OrderedPolynomial k ord m -> OrderedPolynomial k Grevlex (m - n)
forall k1 (m :: Nat) o' k2 (n :: Nat) (o :: k1).
(IsMonomialOrder m o', CoeffRing k2, KnownNat m) =>
(USized n Int -> USized m Int)
-> OrderedPolynomial k2 o n -> OrderedPolynomial k2 o' m
transformMonomial (SNat n -> USized m Int -> USized (m - n) Int
forall (n :: Nat) (f :: * -> *) (m :: Nat) a.
(CFreeMonoid f, Dom f a, n <= m) =>
SNat n -> Sized f m a -> Sized f (m - n) a
V.drop SNat n
n) OrderedPolynomial k ord m
f
| OrderedPolynomial k ord m
f <- ord
-> Ideal poly
-> [OrderedPolynomial (Coefficient poly) ord (Arity poly)]
forall poly order.
(IsOrderedPolynomial poly, Field (Coefficient poly),
IsMonomialOrder (Arity poly) order) =>
order
-> Ideal poly
-> [OrderedPolynomial (Coefficient poly) order (Arity poly)]
calcGroebnerBasisWith ord
ord Ideal poly
ideal
, ((k, OrderedMonomial ord m) -> Bool)
-> [(k, OrderedMonomial ord m)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Element (Sized Vector n Int) -> Bool)
-> Sized Vector n Int -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
oall (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Sized Vector n Int -> Bool)
-> ((k, OrderedMonomial ord m) -> Sized Vector n Int)
-> (k, OrderedMonomial ord m)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SNat n -> USized m Int -> Sized Vector (Min n m) Int
forall (n :: Nat) (f :: * -> *) (m :: Nat) a.
(CFreeMonoid f, Dom f a) =>
SNat n -> Sized f m a -> Sized f (Min n m) a
V.takeAtMost SNat n
n (USized m Int -> Sized Vector n Int)
-> ((k, OrderedMonomial ord m) -> USized m Int)
-> (k, OrderedMonomial ord m)
-> Sized Vector n Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrderedMonomial ord m -> USized m Int
forall k (ordering :: k) (n :: Nat).
OrderedMonomial ordering n -> Monomial n
getMonomial (OrderedMonomial ord m -> USized m Int)
-> ((k, OrderedMonomial ord m) -> OrderedMonomial ord m)
-> (k, OrderedMonomial ord m)
-> USized m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, OrderedMonomial ord m) -> OrderedMonomial ord m
forall a b. (a, b) -> b
snd) ([(k, OrderedMonomial ord m)] -> Bool)
-> [(k, OrderedMonomial ord m)] -> Bool
forall a b. (a -> b) -> a -> b
$ OrderedPolynomial k ord m -> [(k, OrderedMonomial ord m)]
forall k1 k2 (order :: k1) (n :: Nat).
OrderedPolynomial k2 order n -> [(k2, OrderedMonomial order n)]
getTerms OrderedPolynomial k ord m
f
]
{-# INLINE CONLIKE unsafeThEliminationIdealWith #-}
eliminatePadding ::
( IsOrderedPolynomial poly
, IsMonomialOrder n ord
, Field (Coefficient poly)
, SingI (Replicate n 1)
, KnownNat n
) =>
Ideal (PadPolyL n ord poly) ->
Ideal poly
eliminatePadding :: Ideal (PadPolyL n ord poly) -> Ideal poly
eliminatePadding Ideal (PadPolyL n ord poly)
ideal =
[poly] -> Ideal poly
forall r. (DecidableZero r, Monoidal r) => [r] -> Ideal r
toIdeal
[ poly
c
| PadPolyL n ord poly
f0 <- Ideal (PadPolyL n ord poly) -> [PadPolyL n ord poly]
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly -> [poly]
calcGroebnerBasis Ideal (PadPolyL n ord poly)
ideal
, let (poly
c, OrderedMonomial (Graded ord) n
m) = OrderedPolynomial poly (Graded ord) n
-> (Coefficient (OrderedPolynomial poly (Graded ord) n),
OrderedMonomial
(MOrder (OrderedPolynomial poly (Graded ord) n))
(Arity (OrderedPolynomial poly (Graded ord) n)))
forall poly.
IsOrderedPolynomial poly =>
poly
-> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly))
leadingTerm (OrderedPolynomial poly (Graded ord) n
-> (Coefficient (OrderedPolynomial poly (Graded ord) n),
OrderedMonomial
(MOrder (OrderedPolynomial poly (Graded ord) n))
(Arity (OrderedPolynomial poly (Graded ord) n))))
-> OrderedPolynomial poly (Graded ord) n
-> (Coefficient (OrderedPolynomial poly (Graded ord) n),
OrderedMonomial
(MOrder (OrderedPolynomial poly (Graded ord) n))
(Arity (OrderedPolynomial poly (Graded ord) n)))
forall a b. (a -> b) -> a -> b
$ PadPolyL n ord poly -> OrderedPolynomial poly (Graded ord) n
forall (n :: Nat) ord poly.
PadPolyL n ord poly -> OrderedPolynomial poly (Graded ord) n
runPadPolyL PadPolyL n ord poly
f0
, OrderedMonomial (Graded ord) n
m OrderedMonomial (Graded ord) n
-> OrderedMonomial (Graded ord) n -> Bool
forall a. Eq a => a -> a -> Bool
== OrderedMonomial (Graded ord) n
forall r. Unital r => r
one
]
{-# INLINE CONLIKE eliminatePadding #-}
intersection ::
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
[Ideal poly] ->
Ideal poly
intersection :: [Ideal poly] -> Ideal poly
intersection [Ideal poly]
ideals
| [Ideal poly] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ideal poly]
ideals = poly -> Ideal poly
forall r. r -> Ideal r
principalIdeal poly
forall r. Unital r => r
one
| Bool
otherwise =
case Natural -> SomeSNat
toSomeSNat (Natural -> SomeSNat) -> Natural -> SomeSNat
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
$ [Ideal poly] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length [Ideal poly]
ideals of
SomeSNat SNat n
sk ->
Sing (Case_6989586621680379320 n 1 (DefaultEq n 0))
-> (SingI (Case_6989586621680379320 n 1 (DefaultEq n 0)) =>
Ideal poly)
-> Ideal poly
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI (SNat n -> SList (Replicate n 1)
forall (n :: Nat). SNat n -> SList (Replicate n 1)
sOnes SNat n
sk) ((SingI (Case_6989586621680379320 n 1 (DefaultEq n 0)) =>
Ideal poly)
-> Ideal poly)
-> (SingI (Case_6989586621680379320 n 1 (DefaultEq n 0)) =>
Ideal poly)
-> Ideal poly
forall a b. (a -> b) -> a -> b
$
SNat n -> (KnownNat n => Ideal poly) -> Ideal poly
forall (n :: Nat) r. SNat n -> (KnownNat n => r) -> r
withKnownNat SNat n
sk ((KnownNat n => Ideal poly) -> Ideal poly)
-> (KnownNat n => Ideal poly) -> Ideal poly
forall a b. (a -> b) -> a -> b
$
let ts :: [PadPolyL n Grevlex poly]
ts = Natural -> [PadPolyL n Grevlex poly] -> [PadPolyL n Grevlex poly]
forall i a. Integral i => i -> [a] -> [a]
genericTake (SNat n -> Natural
forall (n :: Nat). SNat n -> Natural
toNatural SNat n
sk) [PadPolyL n Grevlex poly]
forall poly. IsPolynomial poly => [poly]
vars
inj :: poly -> PadPolyL n Grevlex poly
inj = SNat n -> Grevlex -> poly -> PadPolyL n Grevlex poly
forall (n :: Nat) ord poly.
(IsMonomialOrder n ord, IsPolynomial poly) =>
SNat n -> ord -> poly -> PadPolyL n ord poly
padLeftPoly SNat n
sk Grevlex
Grevlex
tis :: [Ideal (PadPolyL n Grevlex poly)]
tis = (Ideal poly
-> PadPolyL n Grevlex poly -> Ideal (PadPolyL n Grevlex poly))
-> [Ideal poly]
-> [PadPolyL n Grevlex poly]
-> [Ideal (PadPolyL n Grevlex poly)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Ideal poly
ideal PadPolyL n Grevlex poly
t -> (poly -> PadPolyL n Grevlex poly)
-> Ideal poly -> Ideal (PadPolyL n Grevlex poly)
forall r r'. (r -> r') -> Ideal r -> Ideal r'
mapIdeal ((PadPolyL n Grevlex poly
t PadPolyL n Grevlex poly
-> PadPolyL n Grevlex poly -> PadPolyL n Grevlex poly
forall r. Multiplicative r => r -> r -> r
*) (PadPolyL n Grevlex poly -> PadPolyL n Grevlex poly)
-> (poly -> PadPolyL n Grevlex poly)
-> poly
-> PadPolyL n Grevlex poly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. poly -> PadPolyL n Grevlex poly
inj) Ideal poly
ideal) ([Ideal poly] -> [Ideal poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList [Ideal poly]
ideals) [PadPolyL n Grevlex poly]
ts
j :: Ideal (PadPolyL n Grevlex poly)
j = (Ideal (PadPolyL n Grevlex poly)
-> Ideal (PadPolyL n Grevlex poly)
-> Ideal (PadPolyL n Grevlex poly))
-> Ideal (PadPolyL n Grevlex poly)
-> [Ideal (PadPolyL n Grevlex poly)]
-> Ideal (PadPolyL n Grevlex poly)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ideal (PadPolyL n Grevlex poly)
-> Ideal (PadPolyL n Grevlex poly)
-> Ideal (PadPolyL n Grevlex poly)
forall r. Ideal r -> Ideal r -> Ideal r
appendIdeal (PadPolyL n Grevlex poly -> Ideal (PadPolyL n Grevlex poly)
forall r. r -> Ideal r
principalIdeal (PadPolyL n Grevlex poly
forall r. Unital r => r
one PadPolyL n Grevlex poly
-> PadPolyL n Grevlex poly -> PadPolyL n Grevlex poly
forall r. Group r => r -> r -> r
- (PadPolyL n Grevlex poly
-> PadPolyL n Grevlex poly -> PadPolyL n Grevlex poly)
-> PadPolyL n Grevlex poly
-> [PadPolyL n Grevlex poly]
-> PadPolyL n Grevlex poly
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PadPolyL n Grevlex poly
-> PadPolyL n Grevlex poly -> PadPolyL n Grevlex poly
forall r. Additive r => r -> r -> r
(+) PadPolyL n Grevlex poly
forall m. Monoidal m => m
zero [PadPolyL n Grevlex poly]
ts)) [Ideal (PadPolyL n Grevlex poly)]
tis
in Ideal (PadPolyL n Grevlex poly) -> Ideal poly
forall poly (n :: Nat) ord.
(IsOrderedPolynomial poly, IsMonomialOrder n ord,
Field (Coefficient poly), SingI (Replicate n 1), KnownNat n) =>
Ideal (PadPolyL n ord poly) -> Ideal poly
eliminatePadding Ideal (PadPolyL n Grevlex poly)
j
{-# INLINE CONLIKE intersection #-}
quotByPrincipalIdeal ::
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly ->
poly ->
Ideal poly
quotByPrincipalIdeal :: Ideal poly -> poly -> Ideal poly
quotByPrincipalIdeal Ideal poly
i poly
g =
(poly -> poly) -> Ideal poly -> Ideal poly
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((poly, poly) -> poly
forall a b. (a, b) -> b
snd ((poly, poly) -> poly) -> (poly -> (poly, poly)) -> poly -> poly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(poly, poly)] -> (poly, poly)
forall a. [a] -> a
head ([(poly, poly)] -> (poly, poly))
-> (poly -> [(poly, poly)]) -> poly -> (poly, poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (poly -> [poly] -> [(poly, poly)]
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
poly -> [poly] -> [(poly, poly)]
`divPolynomial` [poly
g])) (Ideal poly -> Ideal poly) -> Ideal poly -> Ideal poly
forall a b. (a -> b) -> a -> b
$ [Ideal poly] -> Ideal poly
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
[Ideal poly] -> Ideal poly
intersection [Ideal poly
i, poly -> Ideal poly
forall r. r -> Ideal r
principalIdeal poly
g]
{-# INLINE CONLIKE quotByPrincipalIdeal #-}
quotIdeal ::
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
Ideal poly ->
Ideal poly ->
Ideal poly
quotIdeal :: Ideal poly -> Ideal poly -> Ideal poly
quotIdeal Ideal poly
i Ideal poly
g =
[Ideal poly] -> Ideal poly
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
[Ideal poly] -> Ideal poly
intersection ([Ideal poly] -> Ideal poly) -> [Ideal poly] -> Ideal poly
forall a b. (a -> b) -> a -> b
$ (poly -> Ideal poly) -> [poly] -> [Ideal poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Ideal poly
i Ideal poly -> poly -> Ideal poly
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
Ideal poly -> poly -> Ideal poly
`quotByPrincipalIdeal`) ([poly] -> [Ideal poly]) -> [poly] -> [Ideal poly]
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Ideal poly
g
{-# INLINE CONLIKE quotIdeal #-}
saturationByPrincipalIdeal ::
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
Ideal poly ->
poly ->
Ideal poly
saturationByPrincipalIdeal :: Ideal poly -> poly -> Ideal poly
saturationByPrincipalIdeal Ideal poly
is poly
g =
let n :: SNat (Arity poly)
n = poly -> SNat (Arity poly)
forall poly. IsPolynomial poly => poly -> SNat (Arity poly)
sArity' poly
g
in SNat (Arity poly)
-> (KnownNat (Arity poly) => Ideal poly) -> Ideal poly
forall (n :: Nat) r. SNat n -> (KnownNat n => r) -> r
withKnownNat SNat (Arity poly)
n ((KnownNat (Arity poly) => Ideal poly) -> Ideal poly)
-> (KnownNat (Arity poly) => Ideal poly) -> Ideal poly
forall a b. (a -> b) -> a -> b
$
Ideal (PadPolyL 1 Grevlex poly) -> Ideal poly
forall poly (n :: Nat) ord.
(IsOrderedPolynomial poly, IsMonomialOrder n ord,
Field (Coefficient poly), SingI (Replicate n 1), KnownNat n) =>
Ideal (PadPolyL n ord poly) -> Ideal poly
eliminatePadding (Ideal (PadPolyL 1 Grevlex poly) -> Ideal poly)
-> Ideal (PadPolyL 1 Grevlex poly) -> Ideal poly
forall a b. (a -> b) -> a -> b
$
PadPolyL 1 Grevlex poly
-> Ideal (PadPolyL 1 Grevlex poly)
-> Ideal (PadPolyL 1 Grevlex poly)
forall r. (Monoidal r, DecidableZero r) => r -> Ideal r -> Ideal r
addToIdeal (PadPolyL 1 Grevlex poly
forall r. Unital r => r
one PadPolyL 1 Grevlex poly
-> PadPolyL 1 Grevlex poly -> PadPolyL 1 Grevlex poly
forall r. Group r => r -> r -> r
- (SNat 1 -> Grevlex -> poly -> PadPolyL 1 Grevlex poly
forall (n :: Nat) ord poly.
(IsMonomialOrder n ord, IsPolynomial poly) =>
SNat n -> ord -> poly -> PadPolyL n ord poly
padLeftPoly (KnownNat 1 => SNat 1
forall (n :: Nat). KnownNat n => SNat n
sNat @1) Grevlex
Grevlex poly
g PadPolyL 1 Grevlex poly
-> PadPolyL 1 Grevlex poly -> PadPolyL 1 Grevlex poly
forall r. Multiplicative r => r -> r -> r
* Ordinal (Arity (PadPolyL 1 Grevlex poly))
-> PadPolyL 1 Grevlex poly
forall poly. IsPolynomial poly => Ordinal (Arity poly) -> poly
var Ordinal (Arity (PadPolyL 1 Grevlex poly))
0)) (Ideal (PadPolyL 1 Grevlex poly)
-> Ideal (PadPolyL 1 Grevlex poly))
-> Ideal (PadPolyL 1 Grevlex poly)
-> Ideal (PadPolyL 1 Grevlex poly)
forall a b. (a -> b) -> a -> b
$
(poly -> PadPolyL 1 Grevlex poly)
-> Ideal poly -> Ideal (PadPolyL 1 Grevlex poly)
forall r r'. (r -> r') -> Ideal r -> Ideal r'
mapIdeal (SNat 1 -> Grevlex -> poly -> PadPolyL 1 Grevlex poly
forall (n :: Nat) ord poly.
(IsMonomialOrder n ord, IsPolynomial poly) =>
SNat n -> ord -> poly -> PadPolyL n ord poly
padLeftPoly (KnownNat 1 => SNat 1
forall (n :: Nat). KnownNat n => SNat n
sNat @1) Grevlex
Grevlex) Ideal poly
is
{-# INLINE CONLIKE saturationByPrincipalIdeal #-}
saturationIdeal ::
forall poly.
( Field (Coefficient poly)
, IsOrderedPolynomial poly
) =>
Ideal poly ->
Ideal poly ->
Ideal poly
saturationIdeal :: Ideal poly -> Ideal poly -> Ideal poly
saturationIdeal Ideal poly
i Ideal poly
g =
[Ideal poly] -> Ideal poly
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
[Ideal poly] -> Ideal poly
intersection ([Ideal poly] -> Ideal poly) -> [Ideal poly] -> Ideal poly
forall a b. (a -> b) -> a -> b
$ (poly -> Ideal poly) -> [poly] -> [Ideal poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Ideal poly
i Ideal poly -> poly -> Ideal poly
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
Ideal poly -> poly -> Ideal poly
`saturationByPrincipalIdeal`) ([poly] -> [Ideal poly]) -> [poly] -> [Ideal poly]
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Ideal poly
g
{-# INLINE CONLIKE saturationIdeal #-}
resultant ::
forall poly.
( Field (Coefficient poly)
, IsOrderedPolynomial poly
, Arity poly ~ 1
) =>
poly ->
poly ->
Coefficient poly
resultant :: poly -> poly -> Coefficient poly
resultant = Coefficient poly -> poly -> poly -> Coefficient poly
forall poly.
(IsOrderedPolynomial poly, Euclidean (Coefficient poly),
Division (Coefficient poly)) =>
Coefficient poly -> poly -> poly -> Coefficient poly
go Coefficient poly
forall r. Unital r => r
one
where
go :: Coefficient poly -> poly -> poly -> Coefficient poly
go Coefficient poly
res poly
h poly
s
| poly -> Int
forall poly. IsPolynomial poly => poly -> Int
totalDegree' poly
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
let r :: poly
r = poly
h poly -> [poly] -> poly
forall poly (t :: * -> *).
(IsOrderedPolynomial poly, Field (Coefficient poly), Functor t,
Foldable t) =>
poly -> t poly -> poly
`modPolynomial` [poly
s]
res' :: Coefficient poly
res' =
Coefficient poly
res Coefficient poly -> Coefficient poly -> Coefficient poly
forall r. Multiplicative r => r -> r -> r
* Coefficient poly -> Coefficient poly
forall r. Group r => r -> r
negate Coefficient poly
forall r. Unital r => r
one Coefficient poly -> Natural -> Coefficient poly
forall r. Unital r => r -> Natural -> r
^ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (poly -> Int
forall poly. IsPolynomial poly => poly -> Int
totalDegree' poly
h Int -> Int -> Int
forall r. Multiplicative r => r -> r -> r
* poly -> Int
forall poly. IsPolynomial poly => poly -> Int
totalDegree' poly
s)
Coefficient poly -> Coefficient poly -> Coefficient poly
forall r. Multiplicative r => r -> r -> r
* poly -> Coefficient poly
forall poly. IsOrderedPolynomial poly => poly -> Coefficient poly
leadingCoeff poly
s Coefficient poly -> Natural -> Coefficient poly
forall r. Unital r => r -> Natural -> r
^ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (poly -> Int
forall poly. IsPolynomial poly => poly -> Int
totalDegree' poly
h Int -> Int -> Int
forall a. Num a => a -> a -> a
P.- poly -> Int
forall poly. IsPolynomial poly => poly -> Int
totalDegree' poly
r)
in Coefficient poly -> poly -> poly -> Coefficient poly
go Coefficient poly
res' poly
s poly
r
| poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
h Bool -> Bool -> Bool
|| poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero poly
s = Coefficient poly
forall m. Monoidal m => m
zero
| poly -> Int
forall poly. IsPolynomial poly => poly -> Int
totalDegree' poly
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (poly -> Coefficient poly
forall poly. IsOrderedPolynomial poly => poly -> Coefficient poly
leadingCoeff poly
s Coefficient poly -> Natural -> Coefficient poly
forall r. Unital r => r -> Natural -> r
^ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (poly -> Int
forall poly. IsPolynomial poly => poly -> Int
totalDegree' poly
h)) Coefficient poly -> Coefficient poly -> Coefficient poly
forall r. Multiplicative r => r -> r -> r
* Coefficient poly
res
| Bool
otherwise = Coefficient poly
res
Arity poly :~: 1
_ = Arity poly :~: 1
forall k (a :: k). a :~: a
Refl :: Arity poly :~: 1
hasCommonFactor ::
( Field (Coefficient poly)
, IsOrderedPolynomial poly
, Arity poly ~ 1
) =>
poly ->
poly ->
Bool
hasCommonFactor :: poly -> poly -> Bool
hasCommonFactor poly
f poly
g = Coefficient poly -> Bool
forall r. DecidableZero r => r -> Bool
isZero (Coefficient poly -> Bool) -> Coefficient poly -> Bool
forall a b. (a -> b) -> a -> b
$ poly -> poly -> Coefficient poly
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly,
Arity poly ~ 1) =>
poly -> poly -> Coefficient poly
resultant poly
f poly
g
lcmPolynomial ::
forall poly.
( Field (Coefficient poly)
, IsOrderedPolynomial poly
) =>
poly ->
poly ->
poly
lcmPolynomial :: poly -> poly -> poly
lcmPolynomial poly
f poly
g = [poly] -> poly
forall a. [a] -> a
head ([poly] -> poly) -> [poly] -> poly
forall a b. (a -> b) -> a -> b
$ Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators (Ideal poly -> [poly]) -> Ideal poly -> [poly]
forall a b. (a -> b) -> a -> b
$ [Ideal poly] -> Ideal poly
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
[Ideal poly] -> Ideal poly
intersection [poly -> Ideal poly
forall r. r -> Ideal r
principalIdeal poly
f, poly -> Ideal poly
forall r. r -> Ideal r
principalIdeal poly
g]
{-# INLINE lcmPolynomial #-}
gcdPolynomial ::
( Field (Coefficient poly)
, IsOrderedPolynomial poly
) =>
poly ->
poly ->
poly
gcdPolynomial :: poly -> poly -> poly
gcdPolynomial poly
f poly
g = (poly, poly) -> poly
forall a b. (a, b) -> b
snd ((poly, poly) -> poly) -> (poly, poly) -> poly
forall a b. (a -> b) -> a -> b
$ [(poly, poly)] -> (poly, poly)
forall a. [a] -> a
head ([(poly, poly)] -> (poly, poly)) -> [(poly, poly)] -> (poly, poly)
forall a b. (a -> b) -> a -> b
$ poly
f poly -> poly -> poly
forall r. Multiplicative r => r -> r -> r
* poly
g poly -> [poly] -> [(poly, poly)]
forall poly.
(IsOrderedPolynomial poly, Field (Coefficient poly)) =>
poly -> [poly] -> [(poly, poly)]
`divPolynomial` [poly -> poly -> poly
forall poly.
(Field (Coefficient poly), IsOrderedPolynomial poly) =>
poly -> poly -> poly
lcmPolynomial poly
f poly
g]
{-# INLINE CONLIKE gcdPolynomial #-}