diff --git a/Algebra/Algorithms/Groebner.hs b/Algebra/Algorithms/Groebner.hs --- a/Algebra/Algorithms/Groebner.hs +++ b/Algebra/Algorithms/Groebner.hs @@ -233,14 +233,18 @@ => [OrderedPolynomial k order n] -> [OrderedPolynomial k order n] minimizeGroebnerBasis = foldr step [] where - step x xs = injectCoeff (recip $ leadingCoeff x) * x : filter (not . (leadingMonomial x `divs`) . leadingMonomial) xs + step x xs = monoize x : filter (not . (leadingMonomial x `divs`) . leadingMonomial) xs -- | Reduce minimum Groebner basis into reduced Groebner basis. reduceMinimalGroebnerBasis :: (Field k, IsPolynomial k n, IsMonomialOrder order) => [OrderedPolynomial k order n] -> [OrderedPolynomial k order n] -reduceMinimalGroebnerBasis bs = filter (/= zero) $ map red bs +reduceMinimalGroebnerBasis bs = filter (/= zero) $ map (monoize . red) bs where red x = x `modPolynomial` delete x bs + +monoize :: (Field k, IsPolynomial k n, IsMonomialOrder order) + => OrderedPolynomial k order n -> OrderedPolynomial k order n +monoize f = injectCoeff (recip $ leadingCoeff f) * f -- | Caliculating reduced Groebner basis of the given ideal w.r.t. the specified monomial order. calcGroebnerBasisWith :: (Field k, IsPolynomial k n, IsMonomialOrder order, IsMonomialOrder order') diff --git a/Algebra/Internal.hs b/Algebra/Internal.hs --- a/Algebra/Internal.hs +++ b/Algebra/Internal.hs @@ -102,6 +102,15 @@ instance Sing n => Sing (S n) where sing = SS sing +{-# SPECIALISE INLINE sing :: SNat Z #-} +{-# SPECIALISE INLINE sing :: SNat (S Z) #-} +{-# SPECIALISE INLINE sing :: SNat (S (S Z)) #-} +{-# SPECIALISE INLINE sing :: SNat (S (S (S Z))) #-} +{-# SPECIALISE INLINE sing :: SNat (S (S (S (S Z)))) #-} +{-# SPECIALISE INLINE sing :: SNat (S (S (S (S (S Z))))) #-} +{-# SPECIALISE INLINE sing :: SNat (S (S (S (S (S (S Z)))))) #-} +{-# SPECIALISE INLINE sing :: SNat (S (S (S (S (S (S (S Z))))))) #-} + class (n :: Nat) :<= (m :: Nat) instance Zero :<= n instance (n :<= m) => S n :<= S m @@ -223,8 +232,8 @@ takeVAtMost = (fst .) . splitAtLess splitAtLess :: SNat n -> Vector a m -> (Vector a (Min n m), Vector a (m :-: n)) -splitAtLess SZ v = case zAbsorbsMinL (sLengthV v) of - Eql -> (Nil, v) +splitAtLess SZ Nil = (Nil, Nil) +splitAtLess SZ (x :- xs) = (Nil, x :- xs) splitAtLess (SS _) Nil = (Nil, Nil) splitAtLess (SS n) (x :- xs) = case splitAtLess n xs of @@ -245,6 +254,15 @@ sLengthV :: Vector a n -> SNat n sLengthV Nil = SZ sLengthV (_ :- xs) = sOne %+ sLengthV xs +{-# RULES +"sLengthV/zero" forall (v :: Vector a Z). sLengthV v = sZ +"sLengthV/one" forall (v :: Vector a (S Z)). sLengthV v = sS sZ +"sLengthV/two" forall (v :: Vector a (S (S Z))). sLengthV v = sS (sS sZ) +"sLengthV/three" forall (v :: Vector a (S (S (S Z)))). sLengthV v = sS (sS (sS sZ)) +"sLengthV/four" forall (v :: Vector a (S (S (S (S Z))))). sLengthV v = sS (sS (sS (sS sZ))) +"sLengthV/five" forall (v :: Vector a (S (S (S (S (S Z)))))). sLengthV v = sS (sS (sS (sS (sS sZ)))) +"sLengthV/sing" forall (v :: Sing n => Vector a n). sLengthV (v :: Vector a n) = sing :: SNat n + #-} mapV :: (a -> b) -> Vector a n -> Vector b n mapV _ Nil = Nil @@ -422,9 +440,7 @@ zAbsorbsMinL :: SNat n -> Eql (Min Z n) Z zAbsorbsMinL SZ = Eql -zAbsorbsMinL (SS n) = - case zAbsorbsMinL n of - Eql -> Eql +zAbsorbsMinL (SS n) = case zAbsorbsMinL n of Eql -> Eql minLeqL :: SNat n -> SNat m -> Leq (Min n m) n minLeqL SZ m = case zAbsorbsMinL m of Eql -> ZeroLeq sZ diff --git a/Algebra/Ring/Polynomial.hs b/Algebra/Ring/Polynomial.hs --- a/Algebra/Ring/Polynomial.hs +++ b/Algebra/Ring/Polynomial.hs @@ -82,6 +82,7 @@ totalDegree :: Monomial n -> Int totalDegree = foldlV (+) 0 +{-# INLINE totalDegree #-} -- | Lexicographical order. This *is* a monomial order. lex :: MonomialOrder @@ -98,14 +99,21 @@ -- | Convert ordering into graded one. graded :: (Monomial n -> Monomial n -> Ordering) -> (Monomial n -> Monomial n -> Ordering) graded cmp xs ys = comparing totalDegree xs ys <> cmp xs ys +{-# INLINE graded #-} +{-# RULES +"graded/grevlex" graded grevlex = grevlex +"graded/grlex" graded grlex = grlex + #-} -- | Graded lexicographical order. This *is* a monomial order. grlex :: MonomialOrder grlex = graded lex +{-# INLINE grlex #-} -- | Graded reversed lexicographical order. This *is* a monomial order. grevlex :: MonomialOrder grevlex = graded revlex +{-# INLINE grevlex #-} -- | A wrapper for monomials with a certain (monomial) order. newtype OrderedMonomial (ordering :: *) n = OrderedMonomial { getMonomial :: Monomial n } @@ -172,19 +180,19 @@ data Proxy' (vs :: [Nat]) = Proxy' class ToWeightVector (vs :: [Nat]) where - toWeightV :: Proxy' vs -> [Int] + calcOrderWeight :: Proxy' vs -> Vector Int n -> Int instance ToWeightVector '[] where - toWeightV Proxy' = [] + calcOrderWeight Proxy' _ = 0 instance (Sing n, ToWeightVector ns) => ToWeightVector (n ': ns) where - toWeightV Proxy' = toInt (sing :: SNat n) : toWeightV (Proxy' :: Proxy' ns) + calcOrderWeight Proxy' Nil = 0 + calcOrderWeight Proxy' (x :- xs) = x * toInt (sing :: SNat n) + calcOrderWeight (Proxy' :: Proxy' ns) xs weightOrder :: forall ns ord m. (ToWeightVector ns, IsOrder ord) => Proxy (WeightOrder ns ord) -> Monomial m -> Monomial m -> Ordering -weightOrder Proxy m m' = comparing toW m m' <> cmpMonomial (Proxy :: Proxy ord) m m' - where - toW = zipWith (*) (toWeightV (Proxy' :: Proxy' ns)) . toList +weightOrder Proxy m m' = comparing (calcOrderWeight (Proxy' :: Proxy' ns)) m m' + <> cmpMonomial (Proxy :: Proxy ord) m m' instance (ToWeightVector ws, IsOrder ord) => IsOrder (WeightOrder ws ord) where cmpMonomial p = weightOrder p @@ -234,6 +242,7 @@ weightedEliminationOrder :: SNat n -> WeightedEliminationOrder n Grevlex weightedEliminationOrder n = WEOrder n (Proxy :: Proxy Grevlex) + type family EWeight n :: [Nat] type instance EWeight Z = '[] type instance EWeight (S n) = One ': EWeight n @@ -242,9 +251,12 @@ WEOrder :: SNat n -> Proxy ord -> WeightedEliminationOrder n ord instance (Sing n, IsMonomialOrder ord) => IsOrder (WeightedEliminationOrder n ord) where - cmpMonomial Proxy m m' = comparing calc m m' <> cmpMonomial (Proxy :: Proxy ord) m m' + cmpMonomial Proxy m m' = comparing (calc (sing :: SNat n)) m m' <> cmpMonomial (Proxy :: Proxy ord) m m' where - calc = foldlV (+) 0 . takeVAtMost (sing :: SNat n) + calc :: SNat l -> Vector Int m -> Int + calc (SS _) Nil = 0 + calc SZ _ = 0 + calc (SS l) (x :- xs)= x + calc l xs instance (Sing n, IsMonomialOrder ord) => IsMonomialOrder (WeightedEliminationOrder n ord) @@ -487,3 +499,12 @@ sDegree :: OrderedPolynomial k ord n -> SNat n sDegree (Polynomial dic) = sLengthV $ getMonomial $ fst $ M.findMin dic +{-# RULES +"sDegree/zero" forall (v :: OrderedPolynomial k ord Z). sDegree v = SZ +"sDegree/one" forall (v :: OrderedPolynomial k ord (S Z)). sDegree v = SS SZ +"sDegree/two" forall (v :: OrderedPolynomial k ord (S (S Z))). sDegree v = SS (SS SZ) +"sDegree/three" forall (v :: OrderedPolynomial k ord (S (S (S Z)))). sDegree v = SS (SS (sS SZ)) +"sDegree/four" forall (v :: OrderedPolynomial k ord (S (S (S (S Z))))). sDegree v = SS (SS (SS (SS SZ))) +"sDegree/five" forall (v :: OrderedPolynomial k ord (S (S (S (S (S Z)))))). sDegree v = SS (SS (SS (SS (SS SZ)))) +"sDegree/sing" forall (v :: Sing n => OrderedPolynomial k ord n). sDegree (v :: OrderedPolynomial k ord n) = sing :: SNat n + #-} diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -29,7 +29,7 @@ * Arity-paramaterized polynomials. It uses vector representations for monomials. `Algebra.Ring.Polynomial` and `Algebra.Algorithms.Groebner`. -*Monomorphic wrapper I/F +* Monomorphic wrapper I/F * Not-so-dependently-typed interface to wrap dependently-typed ones. `Algebra.Ring.Polynomial.Monomorphic` and `Algebra.Algorithms.Groebner.Monomorphic`. diff --git a/computational-algebra.cabal b/computational-algebra.cabal --- a/computational-algebra.cabal +++ b/computational-algebra.cabal @@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: computational-algebra -version: 0.1.3.0 +version: 0.1.3.1 synopsis: Well-kinded computational algebra library, currently supporting Groebner basis. description: Dependently-typed computational algebra libray for Groebner basis. homepage: https://github.com/konn/computational-algebra diff --git a/examples/bench.hs b/examples/bench.hs --- a/examples/bench.hs +++ b/examples/bench.hs @@ -64,9 +64,9 @@ ] ,bgroup "lex03" [ bench "simple" $ nf (simpleBuchbergerWith Lex) ideal3 - , bench "relprime" $ nf (primeTestBuchbergerWith Lex) ideal4 - , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Lex) ideal4 - , bench "syz+sugar" $ nf (syzygyBuchbergerWith Lex) ideal4 + , bench "relprime" $ nf (primeTestBuchbergerWith Lex) ideal3 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Lex) ideal3 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Lex) ideal3 -- , bench "singular" $ nfIO (singularWith Lex ideal3) ] ,bgroup "grlex03" @@ -85,7 +85,7 @@ ,bgroup "grlex04" [ bench "simple" $ nf (simpleBuchbergerWith Grlex) ideal4 , bench "relprime" $ nf (primeTestBuchbergerWith Grlex) ideal4 - , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grlex) ideal + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grlex) ideal4 , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grlex) ideal4 -- , bench "singular" $ nfIO (singularWith Grlex ideal4) ] diff --git a/examples/elimination-bench.hs b/examples/elimination-bench.hs --- a/examples/elimination-bench.hs +++ b/examples/elimination-bench.hs @@ -3,8 +3,7 @@ {-# LANGUAGE TemplateHaskell, UndecidableInstances #-} import Algebra.Algorithms.Groebner.Monomorphic import Algebra.Internal -import Algebra.Ring.Polynomial (eliminationOrder, - weightedEliminationOrder) +import Algebra.Ring.Polynomial (eliminationOrder, weightedEliminationOrder) import Algebra.Ring.Polynomial.Monomorphic import Control.DeepSeq import Control.Parallel.Strategies @@ -14,7 +13,7 @@ import qualified Numeric.Algebra as NA x, y, z, w, s, a, b, c, t, u, v :: Polynomial Rational -[x, y, z, w, s, a, b, c, t, u, v] = map (injectVar . flip Variable Nothing) "xyzwSabctuv" +[x, y, z, w, s, a, b, c, t, u, v, x', y'] = map (injectVar . flip Variable Nothing) "xyzwsabctuvXY" instance NFData Variable where rnf (Variable x y) = rnf x `seq` rnf y `seq` () @@ -22,14 +21,19 @@ instance NFData (Polynomial Rational) where rnf (Polynomial dic) = rnf dic -i1, i2, i3, i4, i5 :: [Polynomial Rational] +i1, i2, i3, i4 :: [Polynomial Rational] i1 = [x - (t + u), y - (t^2 + 2*t*u), z - (t^3 + 3*t^2*u)] i2 = [t^2 + x^2+y^2+z^2, t^2 + 2*x^2 - x*y -z^2, t+ y^3-z^3] -i3 = [ 2 * s - a * y, b^2 - (x^2 + y^2), c^2 - ( (a-x) ^ 2 + y^2) - ] +i3 = [ 2 * s - a * y', b^2 - (x'^2 + y'^2), c^2 - ( (a-x') ^ 2 + y'^2) + ] i4 = [ x - (3*u + 3*u*v^2 - u^3), y - (3*v + 3*u^2*v - v^3), z - (3*u^2 - 3*v^2)] -i5 = [t^2+x^2+y^2+z^2, t^2+2*x^2-x*y-z^2, t+y^3-z^3] +mkTestCase :: Sing n => String -> [Polynomial Rational] -> SNat n -> Benchmark +mkTestCase name ideal nth = + bgroup name [ bench "lex" $ nf (calcGroebnerBasisWith Lex) ideal + , bench "product" $ nf (calcGroebnerBasisWith (eliminationOrder nth)) ideal + , bench "weight" $ nf (calcGroebnerBasisWith (weightedEliminationOrder nth)) ideal + ] main :: IO () main = do @@ -37,32 +41,10 @@ ideal2 <- return $! (i2 `using` rdeepseq) ideal3 <- return $! (i3 `using` rdeepseq) ideal4 <- return $! (i4 `using` rdeepseq) - ideal5 <- return $! (i5 `using` rdeepseq) [var_x, var_y, var_t] <- return $! (map (flip Variable Nothing) "xyt" `using` rdeepseq) - defaultMain $ [ bgroup "heron" - [ bench "lex" $ nf (eliminateWith Lex [var_x, var_y]) ideal3 - , bench "product" $ nf (eliminateWith (eliminationOrder sTwo) [var_x, var_y]) ideal3 - , bench "weight" $ nf (eliminateWith (weightedEliminationOrder sTwo) [var_x, var_y]) ideal3 - ] - , bgroup "implicit01" - [ bench "lex" $ nf (eliminateWith Lex [var_t]) ideal5 - , bench "product" $ nf (eliminateWith (eliminationOrder sOne) [var_t]) ideal5 - , bench "weight" $ nf (eliminateWith (weightedEliminationOrder sOne) [var_t]) ideal5 - ] - , bgroup "implicit02" - [ bench "lex" $ nf (eliminateWith Lex [var_t]) ideal2 - , bench "product" $ nf (eliminateWith (eliminationOrder sOne) [var_t]) ideal2 - , bench "weight" $ nf (eliminateWith (weightedEliminationOrder sOne) [var_t]) ideal2 - ] - , bgroup "implicit03" - [ bench "lex" $ nf (eliminateWith Lex [var_t]) ideal1 - , bench "product" $ nf (eliminateWith (eliminationOrder sOne) [var_t]) ideal1 - , bench "weight" $ nf (eliminateWith (weightedEliminationOrder sOne) [var_t]) ideal1 - ] - , bgroup "implicit04" - [ bench "lex" $ nf (eliminateWith Lex [var_t]) ideal4 - , bench "product" $ nf (eliminateWith (eliminationOrder sOne) [var_t]) ideal4 - , bench "weight" $ nf (eliminateWith (weightedEliminationOrder sOne) [var_t]) ideal4 - ] - ] + defaultMain $ [ mkTestCase "heron" ideal3 sTwo + , mkTestCase "implicit01" ideal2 sOne + , mkTestCase "implicit03" ideal1 sTwo + , mkTestCase "implicit04" ideal4 sTwo + ] diff --git a/examples/sandpit-poly.hs b/examples/sandpit-poly.hs --- a/examples/sandpit-poly.hs +++ b/examples/sandpit-poly.hs @@ -10,8 +10,8 @@ import Data.Ratio import qualified Numeric.Algebra as NA -c, s, x, y :: Polynomial Rational (S Three) -[c, s, x, y] = genVars (sS sThree) +u, v, x, y, z :: Polynomial Rational (S (S Three)) +[u, v, x, y, z] = genVars (sS (sS sThree)) (.+), (.*), (.-) :: Polynomial Rational (S Three) -> Polynomial Rational (S Three) -> Polynomial Rational (S Three) (.+) = (NA.+) @@ -26,11 +26,12 @@ fromRight :: Either t t1 -> t1 fromRight (Right a) = a - +fromRight _ = error "fromRight" {- parse :: String -> Polynomial Rational parse = fromRight . parsePolyn -} main :: IO () -main = print $ thEliminationIdealWith (weightedEliminationOrder sTwo) sTwo (toIdeal [x-c^3, y-s^3, c^2+s^2-1]) +main = print $ thEliminationIdealWith (eliminationOrder sTwo) sTwo $ + toIdeal [x - (3*u + 3*u*v^2 - u^3), y - (3*v + 3*u^2*v - v^3), z - (3*u^2 - 3*v^2)] diff --git a/examples/sugar-paper.hs b/examples/sugar-paper.hs new file mode 100644 --- /dev/null +++ b/examples/sugar-paper.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs #-} +{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings, PolyKinds #-} +{-# LANGUAGE QuasiQuotes, TemplateHaskell, UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-} +import Algebra.Algorithms.Groebner.Monomorphic +import Algebra.Ring.Polynomial.Monomorphic +import Algebra.Ring.Polynomial.Parser +import Control.DeepSeq +import Control.Parallel.Strategies +import Criterion.Main + +x, y, z, w, s, a, b, c :: Polynomial Rational +[x, y, z, w, s, a, b, c, t] = map (injectVar . flip Variable Nothing) "xyzwSabct" + +instance NFData Variable where + rnf (Variable x y) = rnf x `seq` rnf y `seq` () + +instance NFData (Polynomial Rational) where + rnf (Polynomial dic) = rnf dic + +parse x = case parsePolyn x of + Right y -> y + Left er -> error $ show er + +i1, i2, i3, i4 :: [Polynomial Rational] +i1 = map parse ["yw - 1/2 zw + tw" + ,"-2/7 uw^2 + 10/7 vw^2 - 20/7 w^3 + tu - 5tv + 10tw" + ,"2/7 yw^2 - 2/7 zw^2 + 6/7 tw^2 - yt + zt - 3t^2" + ,"-2v^3 + 4uvw + 5v^2w - 6uw^2 - 7vw^2 + 15w^3 + 42yv" + ,"-14zv - 63yw + 21zw - 42tw + 147x" + ,"-9/7uw^3 + 45/7vw^3 - 135/7w^4 + 2zv^2 - 2tv^2 - 4zuw+10tuw - 2zvw - 28tvw + 4zw^2 + 86tw^2 - 42yz+14z^2 + 42yt - 14zt - 21xu + 105xv - 315xw" + ,"6/7yw^3 - 9/7zw^3 + 36/7tw^3 - 2zv^2 - 4ytw + 6ztw - 24t^2w\ + \+ 4xuw + 2xvw - 4xw^2 + 56xy - 35xz + 84xt" + ,"2uvw - 6v^2w - uw^2 + 13vw^2 - 5w^3 + 14yw - 28tw" + ,"u^2w - 3uvw + 5uw^2 + 14yw - 28tw" + ,"-2zuw - 2tuw + 4yvw + 6zvw - 2tvw - 16yw^2 - 10 zw^2 + 22tw^2 + 42xw" + ,"28/3yuw + 8/3zuw - 20/3tuw - 88/3yvw - 8zvw\ + \+68/3tvw + 52yw^2 + 40/3zw^2 - 44tw^2 - 84xw" + ,"-4yzw + 10ytw + 8ztw - 20t^2w + 12xuw - 30xvw + 15xw^2" + ,"-1 y^2w + 1/2 yzw + ytw - ztw + 2 t^2 w - 3xuw + 6xvw - 3xw^2" + , "8xyw - 4xzw + 8xtw" + ] +i2 = map parse ["35y^4 - 30xy^2 - 210y^2z + 3x^2 + 30xz - 105z^2 +140yt - 21u" + ,"5xy^3 - 140y^3z - 3x^2y + 45xyz - 420yz^2 + 210y^2t -25xt + 70zt + 126yu" + ] +i3 = [ x^31 - x^6 - x- y, x^8 - z, x^10 -t] +i4 = [ w+x+y+z, w*x+x*y+y*z+z*w, w*x*y + x*y*z + y*z*w + z*w*x, w*x*y*z] + +mkTestCases :: (Eq r, Show a, r ~ Rational) => a -> [Polynomial r] -> [Benchmark] +mkTestCases num ideal = [ mkTC ("lex0" ++ show num) ideal Lex + , mkTC ("grevlex0" ++ show num) ideal Grevlex + ] + +mkTC :: (r ~ Rational, IsMonomialOrder ord) => String -> [Polynomial r] -> ord -> Benchmark +mkTC name ideal ord = + bgroup name [ bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy ord) ideal + , bench "syz+sugar" $ nf (syzygyBuchbergerWithStrategy (SugarStrategy NormalStrategy) ord) ideal + ] + +main :: IO () +main = do + ideal1 <- return $! (i1 `using` rdeepseq) + ideal2 <- return $! (i2 `using` rdeepseq) + ideal3 <- return $! (i3 `using` rdeepseq) + ideal4 <- return $! (i4 `using` rdeepseq) + defaultMain $ concat (zipWith mkTestCases [1..] [ideal2, ideal4]) + ++ [mkTC "grevlex03" ideal3 Grevlex] + diff --git a/examples/sugar.hs b/examples/sugar.hs new file mode 100644 --- /dev/null +++ b/examples/sugar.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs #-} +{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings, PolyKinds #-} +{-# LANGUAGE QuasiQuotes, TemplateHaskell, UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-} +import Algebra.Algorithms.Groebner.Monomorphic +import Algebra.Ring.Polynomial.Monomorphic +import Control.DeepSeq +import Control.Parallel.Strategies +import Criterion.Main +import SingularBench + +x, y, z, w, s, a, b, c :: Polynomial Rational +[x, y, z, w, s, a, b, c] = map (injectVar . flip Variable Nothing) "xyzwSabc" + +instance NFData Variable where + rnf (Variable x y) = rnf x `seq` rnf y `seq` () + +instance NFData (Polynomial Rational) where + rnf (Polynomial dic) = rnf dic + +i1, i2, i3, i4 :: [Polynomial Rational] +i1 = [x^2 + y^2 + z^2 - 1, x^2 + y^2 + z^2 - 2*x, 2*x -3*y - z] +i2 = [x^2 * y - 2*x*y - 4*z - 1, z-y^2, x^3 - 4*z*y] +i3 = [ 2 * s - a * y, b^2 - (x^2 + y^2), c^2 - ( (a-x) ^ 2 + y^2) + ] +i4 = [ z^5 + y^4 + x^3 - 1, z^3 + y^3 + x^2 - 1] + +main :: IO () +main = do + ideal1 <- return $! (i1 `using` rdeepseq) + ideal2 <- return $! (i2 `using` rdeepseq) + ideal3 <- return $! (i3 `using` rdeepseq) + ideal4 <- return $! (i4 `using` rdeepseq) + defaultMain $ [bgroup "lex01" + [ bench "simple" $ nf (simpleBuchbergerWith Lex) ideal1 + , bench "relprime" $ nf (primeTestBuchbergerWith Lex) ideal1 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Lex) ideal1 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Lex) ideal1 + ] + ,bgroup "grlex01" + [ bench "simple" $ nf (simpleBuchbergerWith Grlex) ideal1 + , bench "relprime" $ nf (primeTestBuchbergerWith Grlex) ideal1 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grlex) ideal1 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grlex) ideal1 + ] + ,bgroup "grevlex01" + [ bench "simple" $ nf (simpleBuchbergerWith Grevlex) ideal1 + , bench "relprime" $ nf (primeTestBuchbergerWith Grevlex) ideal1 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grevlex) ideal1 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grevlex) ideal1 + ] + ,bgroup "grlex02" + [ bench "simple" $ nf (simpleBuchbergerWith Grlex) ideal2 + , bench "relprime" $ nf (primeTestBuchbergerWith Grlex) ideal2 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grlex) ideal2 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grlex) ideal2 + ] + ,bgroup "grevlex02" + [ bench "simple" $ nf (simpleBuchbergerWith Grevlex) ideal2 + , bench "relprime" $ nf (primeTestBuchbergerWith Grevlex) ideal2 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grevlex) ideal2 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grevlex) ideal2 + -- , bench "singular" $ nfIO (singularWith Grevlex ideal2) + ] + ,bgroup "lex03" + [ bench "simple" $ nf (simpleBuchbergerWith Lex) ideal3 + , bench "relprime" $ nf (primeTestBuchbergerWith Lex) ideal3 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Lex) ideal3 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Lex) ideal3 + -- , bench "singular" $ nfIO (singularWith Lex ideal3) + ] + ,bgroup "grlex03" + [ bench "simple" $ nf (simpleBuchbergerWith Grlex) ideal3 + , bench "relprime" $ nf (primeTestBuchbergerWith Grlex) ideal3 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grlex) ideal3 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grlex) ideal3 + -- , bench "singular" $ nfIO (singularWith Grlex ideal3) + ] + ,bgroup "grevlex03" + [ bench "simple" $ nf (simpleBuchbergerWith Grevlex) ideal3 + , bench "relprime" $ nf (primeTestBuchbergerWith Grevlex) ideal3 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grevlex) ideal3 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grevlex) ideal3 + ] + ,bgroup "grlex04" + [ bench "simple" $ nf (simpleBuchbergerWith Grlex) ideal4 + , bench "relprime" $ nf (primeTestBuchbergerWith Grlex) ideal4 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grlex) ideal4 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grlex) ideal4 + -- , bench "singular" $ nfIO (singularWith Grlex ideal4) + ] + ,bgroup "grevlex04" + [ bench "simple" $ nf (simpleBuchbergerWith Grevlex) ideal4 + , bench "relprime" $ nf (primeTestBuchbergerWith Grevlex) ideal4 + , bench "syzygy" $ nf (syzygyBuchbergerWithStrategy NormalStrategy Grevlex) ideal4 + , bench "syz+sugar" $ nf (syzygyBuchbergerWith Grevlex) ideal4 + -- , bench "singular" $ nfIO (singularWith Grevlex ideal4) + ] + ]