[Git][haskell-team/DHG_packages][master] polynomial: add in missing tests
Clint Adams
gitlab at salsa.debian.org
Mon Apr 16 19:26:20 BST 2018
Clint Adams pushed to branch master at Debian Haskell Group / DHG_packages
Commits:
db12a946 by Clint Adams at 2018-04-16T14:25:40-04:00
polynomial: add in missing tests
- - - - -
3 changed files:
- p/haskell-polynomial/debian/changelog
- + p/haskell-polynomial/debian/patches/missing-tests
- p/haskell-polynomial/debian/patches/series
Changes:
=====================================
p/haskell-polynomial/debian/changelog
=====================================
--- a/p/haskell-polynomial/debian/changelog
+++ b/p/haskell-polynomial/debian/changelog
@@ -1,3 +1,9 @@
+haskell-polynomial (0.7.3-3) unstable; urgency=medium
+
+ * Add in missing tests.
+
+ -- Clint Adams <clint at debian.org> Mon, 16 Apr 2018 14:25:28 -0400
+
haskell-polynomial (0.7.3-2) unstable; urgency=medium
* Enable testsuite.
=====================================
p/haskell-polynomial/debian/patches/missing-tests
=====================================
--- /dev/null
+++ b/p/haskell-polynomial/debian/patches/missing-tests
@@ -0,0 +1,727 @@
+--- /dev/null
++++ b/test/TestUtils.hs
+@@ -0,0 +1,67 @@
++{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, TypeFamilies #-}
++module TestUtils where
++
++import Control.Applicative
++import Control.Monad
++import Data.List
++import Data.VectorSpace
++import Math.Polynomial
++import Math.Polynomial.Type
++import Test.QuickCheck
++import qualified Data.Vector as V
++
++instance Arbitrary Endianness where
++ arbitrary = elements [BE, LE]
++
++instance (Num a, Eq a, Arbitrary a) => Arbitrary (Poly a) where
++ arbitrary = polyCon <*> arbitrary <*> arbitrary
++ where
++ polyCon = elements
++ [ poly
++ , rawListPoly
++ , \e -> rawVectorPoly e . V.fromList
++ ]
++
++newtype SmallPoly a = SmallPoly (Poly a)
++ deriving (Eq, Show)
++instance (Num a, Eq a, Arbitrary a) => Arbitrary (SmallPoly a) where
++ arbitrary = SmallPoly <$> (polyCon <*> arbitrary <*> smallList)
++ where
++ polyCon = elements
++ [ poly
++ , rawListPoly
++ , \e -> rawVectorPoly e . V.fromList
++ ]
++
++ smallList = do
++ let binom n k = product [k+1 .. n] `div` product [1 .. n-k]
++ n <- frequency [ (fromInteger (binom 10 k), return k) | k <- [0..10]]
++ replicateM (fromInteger n) arbitrary
++
++-- instance AdditiveGroup Rational where
++-- zeroV = 0
++-- (^+^) = (+)
++-- negateV = negate
++-- instance VectorSpace Rational where
++-- type Scalar Rational = Rational
++-- (*^) = (*)
++
++rev BE = LE
++rev LE = BE
++
++sep [] = []
++sep rts = uniq : sep (rts \\ uniq)
++ where uniq = nub rts
++
++-- arbitrary function mapping the real line to the unit interval
++onUnitInterval x = x - fromIntegral (floor x)
++
++onInterval a b x = a + w * onUnitInterval x
++ where
++ w = b - a
++
++distinct [] = True
++distinct (x:xs) = all (/= x) xs && distinct xs
++
++relErr 0 0 = 0
++relErr x y = abs (x - y) / max (abs x) (abs y)
+--- /dev/null
++++ b/test/Tests/Bernstein.hs
+@@ -0,0 +1,94 @@
++{-# LANGUAGE ExtendedDefaultRules #-}
++module Tests.Bernstein (bernsteinTests) where
++
++import Math.Polynomial
++import Math.Polynomial.Bernstein
++import Test.Framework (testGroup)
++import Test.Framework.Providers.QuickCheck2 (testProperty)
++import Test.QuickCheck
++import TestUtils
++
++default (Integer, Rational)
++
++bernsteinTests =
++ [ testGroup "bernstein" bernstein_tests
++ , testGroup "evalBernstein" evalBernstein_tests
++ ]
++
++bernstein_tests =
++ [ testProperty "sum" prop_bernstein_sum
++ , testProperty "recurrence" prop_bernstein_recurrence
++ , testProperty "symmetry" prop_bernstein_symmetry
++ ]
++
++-- prop_bernstein_sum can be very time and space intensive if we let it
++-- look too far into the table. We also don't really gain much if any
++-- additional confidence in the correctness of the implementation by doing
++-- so, so here's a limit for 'n' in the "bernstein :: [[Poly Integer]]" tests.
++bernsteinLimit = 500
++
++prop_bernstein_sum (NonNegative n) =
++ polyIsOne (sumPolys (bernstein !! (n `mod` bernsteinLimit)))
++
++prop_bernstein_recurrence (Positive a) (Positive b) =
++ let a' = a `mod` bernsteinLimit
++ b' = b `mod` bernsteinLimit
++ n = 1 + max a' b'; n' = fromIntegral n
++ v = min a' b'; v' = fromIntegral v
++ in addPoly (scalePoly ((n'-v')/n') (fmap toRational (bernstein !! n !! v )))
++ (scalePoly ((v'+ 1)/n') (fmap toRational (bernstein !! n !! (v+1))))
++ == fmap toRational (bernstein !! (n-1) !! v)
++
++
++prop_bernstein_symmetry (Positive a) (Positive b) =
++ let a' = a `mod` bernsteinLimit
++ b' = b `mod` bernsteinLimit
++ n = max a' b'
++ v = min a' b'
++ in bernstein !! n !! (n-v)
++ == composePoly (bernstein !! n !! v) (poly LE [1, -1])
++
++
++evalBernstein_tests =
++ [ testProperty "sane" prop_evalBernstein_sane
++ , testProperty "sign" prop_evalBernstein_sign
++ , testProperty "local max" prop_evalBernstein_local_max
++ , testProperty "symmetry" prop_evalBernstein_symmetry
++ ]
++
++prop_evalBernstein_sane (NonNegative a) (NonNegative b) x =
++ let n = max a b
++ v = min a b
++ in n <= bernsteinLimit ==>
++ evalPoly (fmap toRational (bernstein !! n !! v)) x
++ == evalBernstein n v x
++
++prop_evalBernstein_sign (NonNegative a) (NonNegative b) x =
++ let n = max a b
++ v = min a b
++ in signum (evalBernstein n v x) == evalBernstein_sign n v x
++
++prop_evalBernstein_local_max (NonNegative a) (NonNegative b) x =
++ let n = max a b
++ v = min a b
++ xMax = fromIntegral v / fromIntegral n
++ in n >= 0 ==>
++ evalBernstein n v (onUnitInterval x) <= evalBernstein n v xMax
++
++prop_evalBernstein_symmetry (NonNegative a) (NonNegative b) x =
++ let n = max a b
++ v = min a b
++ in evalBernstein n (n-v) x
++ == evalBernstein n v (1-x)
++
++evalBernstein_sign 0 0 _ = 1
++evalBernstein_sign n v 0 = delta v 0
++evalBernstein_sign n v 1 = delta v n
++evalBernstein_sign n v x
++ | x > 0 && x < 1 = 1
++ | even n || x < 0 = if even v then 1 else -1
++ | otherwise = if odd v then 1 else -1
++
++delta x y
++ | x == y = 1
++ | otherwise = 0
+--- /dev/null
++++ b/test/Tests/Chebyshev.hs
+@@ -0,0 +1,142 @@
++{-# LANGUAGE ExtendedDefaultRules #-}
++module Tests.Chebyshev (chebyshevTests) where
++
++import Math.Polynomial
++import Math.Polynomial.Chebyshev
++import Test.Framework (testGroup)
++import Test.Framework.Providers.QuickCheck2 (testProperty)
++import Test.QuickCheck
++import TestUtils
++import Text.Show.Functions ()
++
++default (Integer, Rational)
++
++chebyshevTests =
++ [ testGroup "ts" ts_tests
++ , testGroup "us" us_tests
++ , testProperty "Pell's equation" prop_pell's_eqn
++ , testProperty "t n == ts !! n" $ \(NonNegative a) -> let n = a `mod` 1000 in t n == ts !! n
++ , testProperty "u n == us !! n" $ \(NonNegative a) -> let n = a `mod` 1000 in u n == us !! n
++ , testGroup "evalT" evalT_tests
++ , testGroup "evalU" evalU_tests
++ , testGroup "tRoots" tRoots_tests
++ , testGroup "tExtrema" tExtrema_tests
++ , testGroup "chebyshevFit" chebyshevFit_tests
++ , testGroup "evalChebyshevSeries" evalChebyshevSeries_tests
++ ]
++
++ts_tests =
++ [ testProperty "recurrence" prop_ts_recurrence
++ , testProperty "parity" prop_ts_parity
++ ]
++
++prop_ts_recurrence (NonNegative 0) = ts !! 0 == one
++prop_ts_recurrence (NonNegative 1) = ts !! 1 == x
++prop_ts_recurrence (NonNegative a) =
++ let n = 1 + a `mod` 1200
++ in (multPoly (scalePoly 2 x) (ts !! n))
++ == addPoly (ts !! (n-1)) (ts !! (n+1))
++
++prop_ts_parity (NonNegative n)
++ | even n = composePoly t (negatePoly x) == t
++ | otherwise = composePoly t (negatePoly x) == negatePoly t
++ where t = ts !! (n `mod` 1200)
++
++us_tests =
++ [ testProperty "recurrence" prop_us_recurrence
++ , testProperty "parity" prop_us_parity
++ ]
++
++prop_us_recurrence (NonNegative 0) = us !! 0 == one
++prop_us_recurrence (NonNegative 1) = us !! 1 == scalePoly 2 x
++prop_us_recurrence (NonNegative a) =
++ let n = 1 + a `mod` 1200
++ in (multPoly (scalePoly 2 x) (us !! n))
++ == addPoly (us !! (n-1)) (us !! (n+1))
++
++prop_us_parity (NonNegative n)
++ | even n = composePoly u (negatePoly x) == u
++ | otherwise = composePoly u (negatePoly x) == negatePoly u
++ where u = us !! (n `mod` 1200)
++
++prop_pell's_eqn (Positive a) =
++ let n = 1 + a `mod` 400
++ in powPoly (ts !! n) 2
++ == addPoly one (multPoly (poly BE [1,0,-1]) (powPoly (us !! (n-1)) 2))
++
++evalT_tests =
++ [ testProperty "sane" prop_evalT_sane
++ , testProperty "limits (Float)" (prop_evalT_limits (1e-7 :: Float))
++ , testProperty "limits (Double)" (prop_evalT_limits (1e-15 :: Double))
++ , testProperty "endpoints" prop_evalT_endpoints
++ ]
++
++prop_evalT_sane (NonNegative a) x =
++ let n = a `mod` 1000
++ in evalT n x == evalPoly (t n) x
++
++prop_evalT_limits eps (NonNegative n) x = abs (evalT (n `mod` 1000) (onInterval (-1) 1 x)) <= 1 + eps
++
++prop_evalT_endpoints (NonNegative a) True =
++ let n = a `mod` 5000
++ in evalT n 1 == 1
++prop_evalT_endpoints (NonNegative a) False =
++ let n = a `mod` 5000
++ in evalT n (-1) == if even n then 1 else -1
++
++evalU_tests =
++ [ testProperty "sane" prop_evalU_sane
++ ]
++
++prop_evalU_sane (NonNegative a) x =
++ let n = a `mod` 1000
++ in evalT n x == evalPoly (t n) x
++
++
++tRoots_tests =
++ [ testProperty "distinct (Float)" (prop_tRoots_distinct (undefined :: Float))
++ , testProperty "distinct (Double)" (prop_tRoots_distinct (undefined :: Double))
++ -- I could test that the roots are roots, but numerically they aren't,
++ -- and with the insanely large derivatives at some of the roots, I don't
++ -- expect 'evalT n' to even be particularly close to zero at many of the
++ -- "roots".
++ ]
++
++prop_tRoots_distinct w (NonNegative n') = distinct (tRoots n `asTypeOf` [w])
++ where n = n' `mod` 1200
++
++tExtrema_tests =
++ [ testProperty "distinct (Float)" (prop_tExtrema_distinct (undefined :: Float))
++ , testProperty "distinct (Double)" (prop_tExtrema_distinct (undefined :: Double))
++ , testProperty "near 1 (Float)" (prop_tExtrema_near_1 (\n -> n * 1e-7 :: Float))
++ , testProperty "near 1 (Double)" (prop_tExtrema_near_1 (\n -> n * 1e-16 :: Double))
++ ]
++
++prop_tExtrema_distinct w (NonNegative n') = distinct (tExtrema n `asTypeOf` [w])
++ where n = n' `mod` 1200
++
++prop_tExtrema_near_1 eps (NonNegative n') = all (near1.abs.evalT n) (tExtrema n)
++ where
++ n = n' `mod` 1200
++ near1 y = abs (y-1) <= eps (fromIntegral n)
++
++chebyshevFit_tests =
++ [ testProperty "sane (Double)" (prop_chebyshevFit_sane (\n -> 1e-11 * n^2 :: Double))
++ , testProperty "sane (Float)" (prop_chebyshevFit_sane (\n -> 1e-4 * n^2 :: Float))
++ ]
++
++prop_chebyshevFit_sane epsF (NonNegative n') f =
++ n' < 100 ==> all (<= eps) [relErr (f x) (f' x) | x <- tRoots n]
++ where
++ eps = epsF (fromIntegral n)
++ n = n' `mod` 500
++ cs = chebyshevFit n f
++ f' = evalChebyshevSeries cs
++
++evalChebyshevSeries_tests =
++ [ testProperty "sane" prop_evalChebyshevSeries_sane
++ ]
++
++prop_evalChebyshevSeries_sane cs x
++ = evalChebyshevSeries cs x
++ == sum (zipWith (*) cs (evalTs x))
+--- /dev/null
++++ b/test/Tests/Core.hs
+@@ -0,0 +1,290 @@
++{-# LANGUAGE ExtendedDefaultRules #-}
++module Tests.Core (coreTests) where
++
++import Data.List
++import Data.VectorSpace
++import Math.Polynomial
++import Math.Polynomial.Lagrange
++import Test.Framework (testGroup)
++import Test.Framework.Providers.HUnit (testCase)
++import Test.Framework.Providers.QuickCheck2 (testProperty)
++import Test.HUnit
++import Test.QuickCheck
++import TestUtils
++
++-- Use exact math everywhere; we're not testing stability or speed,
++-- just mathematical soundness.
++default (Integer, Rational)
++
++coreTests =
++ [ testGroup "constants"
++ [ testGroup "zero"
++ [ testCase "polyIsZero zero" (assert (polyIsZero zero))
++ , testCase "polyDegree zero == (-1)" (assert (polyDegree zero == (-1)))
++ , testProperty "(p == zero) == polyIsZero p" $ \p ->
++ (p == zero) == polyIsZero p
++ , testProperty "evalPoly zero x == 0" $ \x ->
++ evalPoly zero x == 0
++ ]
++ , testGroup "one"
++ [ testCase "polyIsOne one" (assert (polyIsOne one))
++ , testCase "polyDegree one == 0" (assert (polyDegree one == 0))
++ , testProperty "(p == one) == polyIsOne p" $ \p ->
++ (p == one) == polyIsOne p
++ , testProperty "evalPoly one x == 1" $ \x ->
++ evalPoly one x == 1
++ ]
++ , testGroup "x"
++ [ testProperty "evalPoly x t == t" $ \t ->
++ evalPoly x t == t
++ , testCase "polyDegree x == 1" (assert (polyDegree x == 1))
++ ]
++ , testGroup "constPoly"
++ [ testProperty "evalPoly (constPoly x) == const x" $ \a b ->
++ evalPoly (constPoly a) b == const a b
++ , testProperty "polyDegree (constPoly x) == if x == 0 then -1 else 0" $ \x ->
++ polyDegree (constPoly x) == if x == 0 then -1 else 0
++ ]
++ ]
++ , testGroup "constructors"
++ [ testProperty "polyCoeffs LE . poly LE" $ \cs ->
++ case stripPrefix (polyCoeffs LE (poly LE cs)) cs of
++ Just zs -> all (== 0) zs
++ Nothing -> False
++ , testProperty "polyCoeffs LE . poly BE" $ \cs ->
++ case stripPrefix (polyCoeffs LE (poly BE cs)) (reverse cs) of
++ Just zs -> all (== 0) zs
++ Nothing -> False
++ , testProperty "polyCoeffs BE . poly LE" $ \cs ->
++ case stripPrefix (reverse (polyCoeffs BE (poly LE cs))) cs of
++ Just zs -> all (== 0) zs
++ Nothing -> False
++ , testProperty "polyCoeffs BE . poly BE" $ \cs ->
++ case stripPrefix (reverse (polyCoeffs BE (poly BE cs))) (reverse cs) of
++ Just zs -> all (== 0) zs
++ Nothing -> False
++ ]
++ , testGroup "instances"
++ [ testGroup "Eq"
++ [ testProperty "reflexive" $ \p -> p == p
++ , testProperty "symmetric" $ \p q -> (p==q) == (q==p)
++ , testProperty "transitive" $ \p q r -> (p == q && q == r) ==> p == r
++ , testProperty "sane" $ \cs ds end1 end2 ->
++ let p = poly end1 cs; q = poly end1 ds
++ in (p==q) == (polyCoeffs end2 p == polyCoeffs end2 q)
++ , testProperty "endianness-independent" $ \cs end ->
++ poly end cs == poly (rev end) (reverse cs)
++ ]
++ , testGroup "AdditiveGroup"
++ [ testGroup "zeroV"
++ [ testCase "polyIsZero zeroV" (assert (polyIsZero zeroV))
++ , testProperty "(p == zeroV) == polyIsZero p" $ \p ->
++ (p == zeroV) == polyIsZero p
++ , testProperty "evalPoly zeroV x == zeroV" $ \x ->
++ evalPoly zeroV x == zeroV
++ ]
++ , testGroup "^+^"
++ [ testProperty "left unit" $ \p -> zeroV ^+^ p == p
++ , testProperty "right unit" $ \p -> p ^+^ zeroV == p
++ , testProperty "commutative" $ \p q -> p ^+^ q == q ^+^ p
++ , testProperty "associative" $ \p q r ->
++ p ^+^ (q ^+^ r) == (p ^+^ q) ^+^ r
++ , testProperty "sane" $ \p q x ->
++ evalPoly (p ^+^ q) x ==
++ evalPoly p x ^+^ evalPoly q x
++ ]
++ , testGroup "negateV"
++ [ testProperty "sane" $ \p -> p ^+^ negateV p == zeroV
++ ]
++ ]
++ , testGroup "VectorSpace"
++ [ testProperty "sane" $ \s p x ->
++ evalPoly (s *^ (p :: Poly Rational)) x == s *^ evalPoly p x
++ ]
++ ]
++ , testGroup "addPoly"
++ [ testProperty "left unit" $ \p -> addPoly zero p == p
++ , testProperty "right unit" $ \p -> addPoly p zero == p
++ , testProperty "commutative" $ \p q -> addPoly p q == addPoly q p
++ , testProperty "associative" $ \p q r ->
++ addPoly p (addPoly q r) == addPoly (addPoly p q) r
++ , testProperty "sane" $ \p q x ->
++ evalPoly (addPoly p q) x ==
++ evalPoly p x + evalPoly q x
++ , testProperty "degree" $ \p q ->
++ let n = polyDegree p
++ m = polyDegree q
++ r = addPoly p q
++ in if n /= m
++ || polyIsZero p || polyIsZero q
++ || head (polyCoeffs BE p) + head (polyCoeffs BE q) /= 0
++ then polyDegree r == max m n
++ else polyDegree r < max m n
++ ]
++ , testGroup "sumPoly"
++ [ testProperty "sane" $ \ps -> sumPolys ps == foldl' addPoly zero ps
++ ]
++ , testGroup "negatePoly"
++ [ testProperty "sane" $ \p -> polyIsZero (addPoly p (negatePoly p))
++ , testProperty "degree" $ \p -> polyDegree p == polyDegree (negatePoly p)
++ ]
++ , testGroup "composePoly"
++ [ testProperty "sane" $ \f g x ->
++ polyDegree f * polyDegree g <= 250 ==>
++ evalPoly (composePoly f g) x
++ == evalPoly f (evalPoly g x)
++ , testProperty "associative" $ \(SmallPoly f) (SmallPoly g) (SmallPoly h) ->
++ polyDegree f * polyDegree g * polyDegree h <= 500 ==>
++ composePoly f (composePoly g h)
++ == composePoly (composePoly f g) h
++ , testProperty "left cancel" $ \p k ->
++ composePoly p (constPoly k) == constPoly (evalPoly p k)
++ , testProperty "right cancel" $ \k p ->
++ composePoly (constPoly k) p == constPoly k
++ , testProperty "left identity" $ \p ->
++ composePoly p x == p
++ , testProperty "right identity" $ \p ->
++ composePoly x p == p
++ , testProperty "degree" $ \(SmallPoly p) (SmallPoly q) ->
++ polyDegree (composePoly p q)
++ <= (1 + polyDegree p) * (1 + polyDegree q)
++ ]
++ , testGroup "scalePoly"
++ [ testProperty "sane" $ \s p x ->
++ evalPoly (scalePoly s p) x == s * evalPoly p x
++ , testProperty "degree" $ \s p ->
++ polyDegree (scalePoly s p) == if s == 0 then -1 else polyDegree p
++ ]
++ , testGroup "multPoly"
++ [ testProperty "left cancel" $ \p -> polyIsZero (multPoly zero p)
++ , testProperty "right cancel" $ \p -> polyIsZero (multPoly p zero)
++ , testProperty "left unit" $ \p -> multPoly one p == p
++ , testProperty "right unit" $ \p -> multPoly p one == p
++ , testProperty "commutative" $ \p q -> multPoly p q == multPoly q p
++ , testProperty "associative" $ \p q r ->
++ multPoly p (multPoly q r) == multPoly (multPoly p q) r
++ , testProperty "distributive" $ \p q r ->
++ multPoly p (addPoly q r) == addPoly (multPoly p q) (multPoly p r)
++ , testProperty "sane" $ \p q x ->
++ evalPoly (multPoly p q) x ==
++ evalPoly p x * evalPoly q x
++ , testProperty "degree" $ \p q ->
++ if polyIsZero p || polyIsZero q
++ then polyDegree (multPoly p q) == (-1)
++ else polyDegree (multPoly p q) == polyDegree p + polyDegree q
++ ]
++ , testGroup "powPoly"
++ [ testProperty "cancel" $ \p -> polyIsOne (powPoly p 0)
++ , testProperty "unit" $ \p -> powPoly p 1 == p
++ , testProperty "multiply" $ \(SmallPoly p) (NonNegative a) (NonNegative b) ->
++ let a' = a `mod` 8; b' = b `mod` 8
++ in multPoly (powPoly p a') (powPoly p b') == powPoly p (a' + b')
++ , testProperty "compose" $ \(SmallPoly p) (NonNegative a) (NonNegative b) ->
++ let a' = a `mod` 6; b' = b `mod` 6
++ in powPoly (powPoly p b') a' == powPoly p (a' * b')
++ , testProperty "sane" $ \(SmallPoly p) (NonNegative n) ->
++ let n' = n `mod` 16
++ in powPoly p n' == foldl' multPoly one (replicate n' p)
++ , testProperty "degree" $ \p (NonNegative n) ->
++ let n' = n `mod` 16
++ in polyDegree (powPoly p n') == max (-1) (n' * polyDegree p)
++ ]
++ , testGroup "quotRemPoly"
++ [ testProperty "sane" $ \a (SmallPoly b) ->
++ not (polyIsZero b) ==> case quotRemPoly a b of
++ (q, r) -> polyDegree r < polyDegree b
++ && addPoly (multPoly q b) r == a
++ ]
++ , testGroup "quotPoly"
++ [ testProperty "sane" $ \a b ->
++ not (polyIsZero b) ==>
++ quotPoly a b == fst (quotRemPoly a b)
++ ]
++ , testGroup "remPoly"
++ [ testProperty "sane" $ \a b ->
++ not (polyIsZero b) ==>
++ remPoly a b == snd (quotRemPoly a b)
++ ]
++ , testGroup "evalPolyDeriv"
++ [ testProperty "zero" $ \t -> evalPolyDeriv zero t == (0,0)
++ , testProperty "one" $ \t -> evalPolyDeriv one t == (1,0)
++ , testProperty "constPoly" $ \t k -> evalPolyDeriv (constPoly k) t == (k,0)
++ , testProperty "x" $ \t -> evalPolyDeriv x t == (t,1)
++ , testProperty "chain rule" $ \p q x ->
++ snd (evalPolyDeriv (multPoly p q) x)
++ == snd (evalPolyDeriv p x) * evalPoly q x + snd (evalPolyDeriv q x) * evalPoly p x
++ , testProperty "sane" $ \p x ->
++ evalPolyDeriv p x == (evalPoly p x, evalPoly (polyDeriv p) x)
++ ]
++ , testGroup "evalPolyDerivs"
++ [ testProperty "sane" $ \p x ->
++ and $ zipWith (==)
++ (evalPolyDerivs p x)
++ [evalPoly p x | p <- iterate polyDeriv p]
++ ]
++ , testGroup "contractPoly"
++ [ testProperty "sane" $ \p a ->
++ case contractPoly p a of
++ (q, r) -> addPoly (multPoly q (poly BE [1,-a])) (constPoly r) == p
++ , testProperty "root" $ \p a ->
++ case contractPoly p a of
++ (q, r) -> evalPoly (addPoly p (poly BE [-r])) a == 0
++ ]
++ , testGroup "monicPoly"
++ [ testProperty "sane" $ \p ->
++ if polyIsZero p
++ then polyIsZero (monicPoly p)
++ else head (polyCoeffs BE (monicPoly p)) == 1
++ ]
++ , testGroup "gcdPoly"
++ [ testProperty "sane" $ \p q ->
++ (polyDegree p + polyDegree q <= 20) &&
++ not (all polyIsZero [p,q]) ==>
++ let g = gcdPoly p q
++ in all polyIsZero [p `remPoly` g, q `remPoly` g]
++ , testProperty "monic" $ \p q ->
++ (polyDegree p + polyDegree q <= 20) &&
++ not (all polyIsZero [p,q]) ==>
++ head (polyCoeffs BE (gcdPoly p q)) == 1
++ , testProperty "right cancel" $ \p -> gcdPoly p one == one
++ , testProperty "left cancel" $ \p -> gcdPoly one p == one
++ , testProperty "commutative" $ \p q ->
++ (polyDegree p + polyDegree q <= 20) &&
++ not (all polyIsZero [p,q]) ==>
++ gcdPoly p q == gcdPoly q p
++ , testProperty "associative" $ \p q r ->
++ (polyDegree p + polyDegree q + polyDegree r <= 20) &&
++ not (any (all polyIsZero) [[p,q], [p,r], [q,r]]) ==>
++ gcdPoly (gcdPoly p q) r == gcdPoly p (gcdPoly q r)
++ , testProperty "roots" $ \pScale (Ordered pRoots) qScale (Ordered qRoots) ->
++ (length pRoots + length qRoots <= 20) ==>
++ let p = scalePoly pScale (lagrange pRoots)
++ q = scalePoly qScale (lagrange qRoots)
++ r = lagrange (intersect pRoots qRoots)
++ in not (null pRoots && null qRoots)
++ ==> r == gcdPoly p q
++
++ ]
++ , testGroup "polyDeriv"
++ [ testCase "zero" $ do
++ assert (polyDeriv zero == zero)
++ , testCase "one" $ do
++ assert (polyDeriv one == zero)
++ , testProperty "constPoly" $ \k ->
++ polyDeriv (constPoly k) == zero
++ , testCase "x" $ do
++ assert (polyDeriv x == one)
++ , testProperty "chain rule" $ \p q ->
++ (polyDegree p + polyDegree q <= 20) ==>
++ polyDeriv (multPoly p q) == addPoly (multPoly p (polyDeriv q)) (multPoly q (polyDeriv p))
++ ]
++ , testGroup "polyIntegral"
++ [ testProperty "sane" $ \p -> polyDeriv (polyIntegral p) == p
++ , testProperty "constant factor" $ \p -> evalPoly (polyIntegral p) 0 == 0
++ ]
++ , testGroup "separateRoots"
++ [ testProperty "sane" $ \(NonEmpty rts) ->
++ length rts < 10 ==>
++ separateRoots (lagrange rts) == map lagrange (sep rts)
++ ]
++ ]
+--- /dev/null
++++ b/test/Tests/Hermite.hs
+@@ -0,0 +1,119 @@
++{-# LANGUAGE ExtendedDefaultRules #-}
++module Tests.Hermite (hermiteTests) where
++
++import Data.VectorSpace
++import Math.Polynomial
++import Math.Polynomial.Hermite
++import Test.Framework (testGroup)
++import Test.Framework.Providers.HUnit (testCase)
++import Test.Framework.Providers.QuickCheck2 (testProperty)
++import Test.HUnit
++import Test.QuickCheck
++import TestUtils
++
++default (Integer, Rational)
++
++hermiteLimit = 500
++
++hermiteTests =
++ [ testGroup "probHermite" probHermite_tests
++ , testGroup "physHermite" physHermite_tests
++ , testGroup "evalProbHermite" evalProbHermite_tests
++ , testGroup "evalPhysHermite" evalPhysHermite_tests
++ , testGroup "evalProbHermiteDeriv" evalProbHermiteDeriv_tests
++ , testGroup "evalPhysHermiteDeriv" evalPhysHermiteDeriv_tests
++ ]
++
++probHermite_tests =
++ [ testCase "known values" case_probHermite_knownValues
++ , testProperty "recurrence" prop_probHermite_recurrence
++ ]
++
++probHermite_knownValues :: [(Int, Poly Integer)]
++probHermite_knownValues =
++ [ ( 0, one)
++ , ( 1, x)
++ , ( 2, poly BE [1, 0, -1])
++ , ( 3, poly BE [1, 0, -3, 0])
++ , ( 4, poly BE [1, 0, -6, 0, 3])
++ , ( 5, poly BE [1, 0, -10, 0, 15, 0])
++ , ( 6, poly BE [1, 0, -15, 0, 45, 0, -15])
++ , ( 7, poly BE [1, 0, -21, 0, 105, 0, -105, 0])
++ , ( 8, poly BE [1, 0, -28, 0, 210, 0, -420, 0, 105])
++ , ( 9, poly BE [1, 0, -36, 0, 378, 0, -1260, 0, 945, 0])
++ , (10, poly BE [1, 0, -45, 0, 630, 0, -3150, 0, 4725, 0, -945])
++ ]
++case_probHermite_knownValues = sequence_
++ [ assertEqual ("probHermite !! " ++ show n) (probHermite !! n) value
++ | (n, value) <- probHermite_knownValues
++ ]
++
++prop_probHermite_recurrence (Positive n)
++ = probHermite !! (n'+1)
++ == multPoly x (probHermite !! n') ^-^ polyDeriv (probHermite !! n')
++ where n' = n `mod` hermiteLimit
++
++physHermite_tests =
++ [ testCase "known values" case_physHermite_knownValues
++ , testProperty "recurrence" prop_physHermite_recurrence
++ ]
++
++physHermite_knownValues :: [(Int, Poly Integer)]
++physHermite_knownValues =
++ [ ( 0, one)
++ , ( 1, poly BE [ 2, 0])
++ , ( 2, poly BE [ 4, 0, -2])
++ , ( 3, poly BE [ 8, 0, -12, 0])
++ , ( 4, poly BE [ 16, 0, -48, 0, 12])
++ , ( 5, poly BE [ 32, 0, -160, 0, 120, 0])
++ , ( 6, poly BE [ 64, 0, -480, 0, 720, 0, -120])
++ , ( 7, poly BE [ 128, 0, -1344, 0, 3360, 0, -1680, 0])
++ , ( 8, poly BE [ 256, 0, -3584, 0, 13440, 0, -13440, 0, 1680])
++ , ( 9, poly BE [ 512, 0, -9216, 0, 48384, 0, -80640, 0, 30240, 0])
++ , (10, poly BE [1024, 0, -23040, 0, 161280, 0, -403200, 0, 302400, 0, -30240])
++ ]
++case_physHermite_knownValues = sequence_
++ [ assertEqual ("physHermite !! " ++ show n) (physHermite !! n) value
++ | (n, value) <- physHermite_knownValues
++ ]
++
++prop_physHermite_recurrence (Positive n)
++ = physHermite !! (n'+1)
++ == scalePoly 2 (multPoly x (physHermite !! n')) ^-^ polyDeriv (physHermite !! n')
++ where n' = n `mod` hermiteLimit
++
++evalProbHermite_tests =
++ [ testProperty "sane" prop_evalProbHermite_sane
++ ]
++
++prop_evalProbHermite_sane n x
++ = evalProbHermite n' x
++ == evalPoly (fmap fromIntegral (probHermite !! n')) x
++ where n' = n `mod` hermiteLimit
++
++evalPhysHermite_tests =
++ [ testProperty "sane" prop_evalPhysHermite_sane
++ ]
++
++prop_evalPhysHermite_sane n x
++ = evalPhysHermite n' x
++ == evalPoly (fmap fromIntegral (physHermite !! n')) x
++ where n' = n `mod` hermiteLimit
++
++evalProbHermiteDeriv_tests =
++ [ testProperty "sane" prop_evalProbHermiteDeriv_sane
++ ]
++
++prop_evalProbHermiteDeriv_sane n x
++ = evalProbHermiteDeriv n' x
++ == evalPolyDeriv (fmap fromIntegral (probHermite !! n')) x
++ where n' = n `mod` hermiteLimit
++
++evalPhysHermiteDeriv_tests =
++ [ testProperty "sane" prop_evalPhysHermiteDeriv_sane
++ ]
++
++prop_evalPhysHermiteDeriv_sane n x
++ = evalPhysHermiteDeriv n' x
++ == evalPolyDeriv (fmap fromIntegral (physHermite !! n')) x
++ where n' = n `mod` hermiteLimit
=====================================
p/haskell-polynomial/debian/patches/series
=====================================
--- a/p/haskell-polynomial/debian/patches/series
+++ b/p/haskell-polynomial/debian/patches/series
@@ -1 +1,2 @@
newer-hunit
+missing-tests
View it on GitLab: https://salsa.debian.org/haskell-team/DHG_packages/commit/db12a9461ed86772e71ef282a5d7ad694c973320
---
View it on GitLab: https://salsa.debian.org/haskell-team/DHG_packages/commit/db12a9461ed86772e71ef282a5d7ad694c973320
You're receiving this email because of your account on salsa.debian.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://alioth-lists.debian.net/pipermail/pkg-haskell-commits/attachments/20180416/8f0bf882/attachment-0001.html>
More information about the Pkg-haskell-commits
mailing list