hspray-0.2.3.0: tests/Main.hs
module Main where
import Approx ( assertApproxEqual )
import Data.Ratio ( (%) )
import Math.Algebra.Hspray ( Spray,
(^+^),
(^-^),
(^*^),
(^**^),
(*^),
lone,
unitSpray,
zeroSpray,
constantSpray,
getCoefficient,
evalSpray,
substituteSpray,
composeSpray,
permuteVariables,
swapVariables,
fromList,
toList,
bombieriSpray,
derivSpray,
groebner,
fromRationalSpray,
esPolynomial,
isSymmetricSpray,
isPolynomialOf,
resultant,
subresultants,
resultant1,
subresultants1,
gcdQX
)
import Test.Tasty ( defaultMain
, testGroup
)
import Test.Tasty.HUnit ( assertEqual
, assertBool
, testCase
)
main :: IO ()
main = defaultMain $ testGroup
"Testing hspray"
[ testCase "bombieriSpray" $ do
let
x = lone 1 :: Spray Rational
y = lone 2 :: Spray Rational
z = lone 3 :: Spray Rational
poly =
(2 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ (4 % 1) *^ z ^+^ (5 % 1) *^ unitSpray
bpoly =
(24 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ (4 % 1) *^ z ^+^ (5 % 1) *^ unitSpray
assertEqual "" bpoly (bombieriSpray poly),
testCase "composeSpray" $ do
let
x = lone 1 :: Spray Int
y = lone 2 :: Spray Int
z = lone 3 :: Spray Int
p = 2 *^ (2 *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ 4 *^ z ^+^ 5 *^ unitSpray
px = x ^+^ y ^+^ z
py = x ^*^ y ^*^ z
pz = y ^**^ 2
q = composeSpray p [px, py, pz]
xyz = [2, 3, 4]
pxyz = map (`evalSpray` xyz) [px, py, pz]
assertEqual "" (evalSpray p pxyz) (evalSpray q xyz),
testCase "getCoefficient" $ do
let
x = lone 1 :: Spray Int
y = lone 2 :: Spray Int
z = lone 3 :: Spray Int
p = 2 *^ (2 *^ (x^**^3 ^*^ y^**^2)) ^+^ 4 *^ z ^+^ 5 *^ unitSpray
assertEqual "" (getCoefficient [3, 2, 0] p, getCoefficient [0, 4] p) (4, 0),
testCase "fromList . toList = identity" $ do
let
x = lone 1 :: Spray Int
y = lone 2 :: Spray Int
z = lone 3 :: Spray Int
p = 2 *^ (2 *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ 4 *^ z ^+^ 5 *^ unitSpray
assertEqual "" p (fromList . toList $ p),
testCase "derivSpray" $ do
let
x = lone 1 :: Spray Int
y = lone 2 :: Spray Int
z = lone 3 :: Spray Int
p1 = x ^+^ y ^*^ z ^**^ 3
p2 = (x ^*^ y ^*^ z) ^+^ (2 *^ (x ^**^ 3 ^*^ y ^**^ 2))
q = p1 ^*^ p2
p1' = derivSpray 1 p1
p2' = derivSpray 1 p2
q' = derivSpray 1 q
assertEqual "" q' ((p1' ^*^ p2) ^+^ (p1 ^*^ p2')),
testCase "groebner" $ do
let
x = lone 1 :: Spray Rational
y = lone 2 :: Spray Rational
z = lone 3 :: Spray Rational
p1 = x^**^2 ^+^ y ^+^ z ^-^ unitSpray
p2 = x ^+^ y^**^2 ^+^ z ^-^ unitSpray
p3 = x ^+^ y ^+^ z^**^2 ^-^ unitSpray
g = groebner [p1, p2, p3] True
xyz = [sqrt 2 - 1, sqrt 2 - 1, sqrt 2 - 1]
gxyz = map ((`evalSpray` xyz) . fromRationalSpray) g
sumAbsValues = sum $ map abs gxyz
assertApproxEqual "" 8 sumAbsValues 0,
testCase "symmetric polynomials" $ do
let
e2 = esPolynomial 4 2 :: Spray Rational
e3 = esPolynomial 4 3 :: Spray Rational
p = e2^**^2 ^+^ (2*^ e3)
assertBool "" (isSymmetricSpray p),
testCase "Schur polynomial is symmetric" $ do
let
x = lone 1 :: Spray Rational
y = lone 2 :: Spray Rational
z = lone 3 :: Spray Rational
p = x^**^3 ^*^ y^**^2 ^*^ z ^+^ x^**^3 ^*^ y ^*^ z^**^2 ^+^ x^**^2 ^*^ y^**^3 ^*^ z ^+^ 2*^(x^**^2 ^*^ y^**^2 ^*^ z^**^2) ^+^ x^**^2 ^*^ y ^*^ z^**^3 ^+^ x ^*^ y^**^3 ^*^ z^**^2 ^+^ x ^*^ y^**^2 ^*^ z^**^3
assertBool "" (isSymmetricSpray p),
testCase "isPolynomialOf" $ do
let
x = lone 1 :: Spray Rational
y = lone 2 :: Spray Rational
p1 = x ^+^ y
p2 = x ^-^ y
p = p1 ^*^ p2
assertEqual "" (isPolynomialOf p [p1, p2]) (True, Just $ x ^*^ y),
testCase "substituteSpray" $ do
let
x1 = lone 1 :: Spray Rational
x2 = lone 2 :: Spray Rational
x3 = lone 3 :: Spray Rational
p = x1^**^2 ^+^ x2 ^+^ x3 ^-^ unitSpray
p' = substituteSpray [Just 2, Nothing, Just 3] p
assertEqual "" p' (x2 ^+^ (6*^ unitSpray)),
testCase "permuteVariables" $ do
let
f :: Spray Rational -> Spray Rational -> Spray Rational -> Spray Rational
f p1 p2 p3 = p1^**^4 ^+^ (2 *^ p2^**^3) ^+^ (3 *^ p3^**^2) ^-^ (4 *^ unitSpray)
x1 = lone 1 :: Spray Rational
x2 = lone 2 :: Spray Rational
x3 = lone 3 :: Spray Rational
p = f x1 x2 x3
p' = permuteVariables p [3, 1, 2]
assertEqual "" p' (f x3 x1 x2),
testCase "swapVariables" $ do
let
x1 = lone 1 :: Spray Rational
x2 = lone 2 :: Spray Rational
x3 = lone 3 :: Spray Rational
p = x1^**^4 ^+^ (2 *^ x2^**^3) ^+^ (3 *^ x3^**^2) ^-^ (4 *^ unitSpray)
p' = permuteVariables p [3, 2, 1]
assertEqual "" p' (swapVariables p (1, 3)),
testCase "resultant w.r.t x" $ do
let
x = lone 1 :: Spray Rational
y = lone 2 :: Spray Rational
p = x^**^4 ^-^ x^**^3 ^+^ x^**^2 ^-^ 2*^ (x ^*^ y^**^2) ^+^ y^**^4
q = x ^-^ (2*^ y^**^2)
r = resultant 1 p q
assertEqual "" r (y^**^4 ^-^ (8*^ y^**^6) ^+^ (16*^ y^**^8)),
testCase "resultant w.r.t y" $ do
let
x = lone 1 :: Spray Rational
y = lone 2 :: Spray Rational
p = x^**^4 ^-^ x^**^3 ^+^ x^**^2 ^-^ 2*^ (x ^*^ y^**^2) ^+^ y^**^4
q = x ^-^ (2*^ y^**^2)
r = resultant 2 p q
assertEqual "" r (16*^x^**^8 ^-^ 32*^x^**^7 ^+^ 24*^x^**^6 ^-^ 8*^x^**^5 ^+^ x^**^4),
testCase "resultant product rule" $ do
let
x = lone 1 :: Spray Rational
y = lone 2 :: Spray Rational
f = x^**^4 ^-^ x^**^3 ^+^ x^**^2 ^-^ 2*^ (x ^*^ y^**^2) ^+^ y^**^4
g = x ^-^ (2*^ y^**^2)
h = x^**^2 ^*^ y ^+^ y^**^3 ^+^ unitSpray
assertEqual "" (resultant 1 (f^*^g) h) (resultant 1 f h ^*^ resultant 1 g h),
testCase "subresultants" $ do
let
x = lone 1 :: Spray Rational
y = lone 2 :: Spray Rational
p = x^**^2 ^*^ y ^*^ (y^**^2 ^-^ 5*^ x ^+^ constantSpray 6)
q = x^**^2 ^*^ y ^*^ (3*^ y ^+^ constantSpray 2)
sx = subresultants 1 p q
assertBool "" (sx!!0 == zeroSpray && sx!!1 == zeroSpray && sx!!2 /= zeroSpray),
testCase "resultant1" $ do
let
x = lone 1 :: Spray Rational
p = x^**^2 ^-^ 5*^x ^+^ constantSpray 6
q = x^**^2 ^-^ 3*^x ^+^ constantSpray 2
assertEqual "" (resultant1 p q) (0%1),
testCase "resultant1 product rule" $ do
let
x = lone 1 :: Spray Rational
f = x^**^2 ^-^ 5*^x ^+^ constantSpray 6
g = x^**^2 ^-^ 3*^x ^+^ constantSpray 2
h = x^**^3 ^+^ x ^-^ constantSpray 3
assertEqual "" (resultant1 (f^*^g) h) (resultant1 f h * resultant1 g h),
testCase "subresultants1" $ do
let
x = lone 1 :: Spray Rational
p = x^**^2 ^-^ 5*^x ^+^ constantSpray 6
q = x^**^2 ^-^ 3*^x ^+^ constantSpray 2
assertEqual "" (subresultants1 p q) [0%1, 2%1, 1%1],
testCase "resultant agrees with resultant1 for univariate case" $ do
let
x = lone 1 :: Spray Rational
f = x^**^4 ^-^ x^**^3 ^+^ x^**^2 ^-^ 2*^x
g = x ^-^ (2*^ x^**^2) ^+^ constantSpray 4
r = resultant 1 f g
r1 = resultant1 f g
assertEqual "" r1 (getCoefficient [] r),
testCase "gcdQX" $ do
let
x = lone 1 :: Spray Rational
sprayD = x^**^2 ^+^ unitSpray
sprayA = sprayD ^*^ (x^**^4 ^-^ x)
sprayB = sprayD ^*^ (2*^x ^+^ unitSpray)
sprayGCD = gcdQX sprayA sprayB
assertEqual "" sprayGCD (2 *^ sprayD),
testCase "gcdQX with a constant spray" $ do
let
x = lone 1 :: Spray Rational
sprayA = 3 *^ x^**^4 ^-^ x
b1 = 2 :: Rational
b2 = 4 :: Rational
sprayB1 = constantSpray b1
sprayB2 = constantSpray b2
assertBool "" (gcdQX sprayA sprayB1 == constantSpray 3 && gcdQX sprayA sprayB2 == constantSpray 4)
]