{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses, NoImplicitPrelude, PolyKinds #-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans -freduction-depth=1000 #-}
module Main where
import Algebra.Algorithms.Groebner
import Algebra.Ring.Ideal
import Algebra.Ring.Polynomial
import Algebra.Scalar
import Control.DeepSeq
import Control.Monad
import Control.Parallel.Strategies
import Criterion
import Data.Type.Natural hiding (one)
import Data.Vector.Sized (Vector (..))
import qualified Data.Vector.Sized as V
import Numeric.Algebra hiding ((.*), (<), (^))
import qualified Numeric.Algebra as NA
import Numeric.Field.Fraction (Fraction)
import Prelude hiding (Fractional (..),
Integral (..), Num (..),
Real (..), sum, (^^))
import qualified Prelude as P
import Progression.Main
x, y, z :: Polynomial (Fraction Integer) Three
[x, y, z] = vars
(.*) :: SingI n => (Fraction Integer) -> Polynomial (Fraction Integer) n -> Polynomial (Fraction Integer) n
(.*) = (.*.)
infixl 7 .*
(^^) :: Unital r => r -> NA.Natural -> r
(^^) = NA.pow
eqn01 :: Ideal (Polynomial (Fraction Integer) Three)
eqn01 = toIdeal [x^^2 - 2*x*z + 5, x*y^^2+y*z+1, 3*y^^2 - 8*x*z]
eqn02 :: Ideal (Polynomial (Fraction Integer) Three)
eqn02 =
toIdeal [x^^2 + 2*y^^2 - y - 2*z
,x^^2 - 8*y^^2 + 10*z - 1
,x^^2 - 7*y*z
]
eqn03 :: Ideal (Polynomial (Fraction Integer) Three)
eqn03 = toIdeal [x^^2 + y^^2 + z^^2 - 2*x
,x^^3 - y*z - x
,x - y + 2*z
]
eqn04 :: Ideal (Polynomial (Fraction Integer) Three)
eqn04 = toIdeal [x*y + z - x*z, x^^2 - z, 2*x^^3 - x^^2 * y * z - 1]
f01 :: Polynomial (Fraction Integer) Three
f01 = -4*x^^4*y^^4 - (1/3).*(x^^3*y^^4*z) + (4/5).*(x^^2*y^^2*z^^4) - (1/5).*(x*y^^2*z^^5)
f02 :: Polynomial (Fraction Integer) Three
f02 = (3/4).*x^^6 - (6/5).*(x^^5*y) + 4*y^^5*z
f03 :: Polynomial (Fraction Integer) Four
f03 = (6/7).* (a^^7*b^^3*c^^4) - (4/3) .* (a^^5*b^^6*c*d^^2) - a^^4*b^^2*c^^4*d^^4
where
a, b, c, d :: Polynomial (Fraction Integer) Four
[a, b, c, d] = vars
main :: IO ()
main = do
v10 <- return $!! ((V.replicate [snat|10|] ()) `using` rdeepseq)
v100 <- return $!! ((V.replicate [snat|100|] ()) `using` rdeepseq)
v200 <- return $!! ((V.replicate [snat|200|] ()) `using` rdeepseq)
v300 <- return $!! ((V.replicate [snat|300|] ()) `using` rdeepseq)
v400 <- return $!! ((V.replicate [snat|400|] ()) `using` rdeepseq)
case01 <- return $!! (eqn01 `using` rdeepseq)
case02 <- return $!! (eqn02 `using` rdeepseq)
case03 <- return $!! (eqn03 `using` rdeepseq)
case04 <- return $!! (eqn04 `using` rdeepseq)
poly01 <- return $!! (f01 `using` rdeepseq)
poly02 <- return $!! (f02 `using` rdeepseq)
poly03 <- return $!! (f03 `using` rdeepseq)
defaultMain $ bgroup "coercion" $
[ bgroup "unhomogenize"
[ bench "01" $ nf unhomogenize poly01
, bench "02" $ nf unhomogenize poly02
, bench "03" $ nf unhomogenize poly03
]
-- These are too expensive...
, bgroup "intersection"
[ bench "two" $ nf intersection (case01 :- case02 :- Nil)
, bench "three" $ nf intersection (case03 :- case01 :- case02 :- Nil)
, bench "four" $ nf intersection (case04 :- case03 :- case01 :- case02 :- Nil)
]
, bgroup "satByPrinc"
[ bench "01" $ nf (saturationByPrincipalIdeal case01) f01
, bench "02" $ nf (saturationByPrincipalIdeal case02) f01
, bench "03" $ nf (saturationByPrincipalIdeal case03) f01
, bench "04" $ nf (saturationByPrincipalIdeal case01) f02
, bench "05" $ nf (saturationByPrincipalIdeal case02) f02
, bench "06" $ nf (saturationByPrincipalIdeal case03) f02
]
]