diff options
Diffstat (limited to 'dev-haskell/math-functions/files/math-functions-0.3.4.2-fix-test-suite.patch')
| -rw-r--r-- | dev-haskell/math-functions/files/math-functions-0.3.4.2-fix-test-suite.patch | 118 |
1 files changed, 118 insertions, 0 deletions
diff --git a/dev-haskell/math-functions/files/math-functions-0.3.4.2-fix-test-suite.patch b/dev-haskell/math-functions/files/math-functions-0.3.4.2-fix-test-suite.patch new file mode 100644 index 000000000000..5dd2d9c622f7 --- /dev/null +++ b/dev-haskell/math-functions/files/math-functions-0.3.4.2-fix-test-suite.patch @@ -0,0 +1,118 @@ +From 7e5deed1cb3fafdd6eb035b3713ae2f46b67014a Mon Sep 17 00:00:00 2001 +From: Alexey Khudyakov <alexey.skladnoy@gmail.com> +Date: Thu, 8 Jun 2023 13:26:11 +0300 +Bug: https://github.com/haskell/math-functions/pull/75 +Signed-off-by: hololeap <hololeap@protonmail.com> +Subject: [PATCH] Fix test suite + +QC as of 2.14.3. became much better at generating test cases and started +reliably failing Kahan summation + +This was fixed by tweaking badvec to be just very bad. Not outrageously +bad. +--- + tests/Tests/Sum.hs | 72 +++++++++++++++++++++++++++------------------- + 1 file changed, 43 insertions(+), 29 deletions(-) + +diff --git a/tests/Tests/Sum.hs b/tests/Tests/Sum.hs +index 08eaf1e..1fcb2e9 100644 +--- a/tests/Tests/Sum.hs ++++ b/tests/Tests/Sum.hs +@@ -4,54 +4,68 @@ module Tests.Sum (tests) where + + import Control.Applicative ((<$>)) + import Numeric.Sum as Sum ++import Numeric.MathFunctions.Comparison + import Prelude hiding (sum) + import Test.Tasty (TestTree, testGroup) +-import Test.Tasty.QuickCheck (testProperty) ++import Test.Tasty.QuickCheck + import Test.QuickCheck (Arbitrary(..)) + import qualified Prelude + +-t_sum :: ([Double] -> Double) -> [Double] -> Bool +-t_sum f xs = f xs == trueSum xs +- +-t_sum_error :: ([Double] -> Double) -> [Double] -> Bool +-t_sum_error f xs = abs (ts - f xs) <= abs (ts - Prelude.sum xs) +- where ts = trueSum xs +- +-t_sum_shifted :: ([Double] -> Double) -> [Double] -> Bool ++-- Test that summation result is same as exact sum. That should pass ++-- if we're effectively working with quad precision ++t_sum :: ([Double] -> Double) -> [Double] -> Property ++t_sum f xs ++ = counterexample ("APPROX = " ++ show approx) ++ $ counterexample ("EXACT = " ++ show exact) ++ $ counterexample ("DELTA = " ++ show (approx - exact)) ++ $ counterexample ("ULPS = " ++ show (ulpDistance approx exact)) ++ $ approx == exact ++ where ++ approx = f xs ++ exact = trueSum xs ++ ++-- Test that summation has smaller error than naive summation or no ++-- worse than given number of ulps. If we're close enough to exact ++-- answer naive may get ahead ++t_sum_error :: ([Double] -> Double) -> [Double] -> Property ++t_sum_error f xs ++ = counterexample ("APPROX = " ++ show approx) ++ $ counterexample ("NAIVE = " ++ show naive) ++ $ counterexample ("EXACT = " ++ show exact) ++ $ counterexample ("A-EXACT = " ++ show (approx - exact)) ++ $ counterexample ("N-EXACT = " ++ show (naive - exact)) ++ $ counterexample ("ULPS[A] = " ++ show (ulpDistance approx exact)) ++ $ counterexample ("ULPS[N] = " ++ show (ulpDistance naive exact)) ++ $ abs (exact - approx) <= abs (exact - naive) ++ where ++ naive = Prelude.sum xs ++ approx = f xs ++ exact = trueSum xs ++ ++t_sum_shifted :: ([Double] -> Double) -> [Double] -> Property + t_sum_shifted f = t_sum_error f . zipWith (+) badvec + + trueSum :: (Fractional b, Real a) => [a] -> b + trueSum xs = fromRational . Prelude.sum . map toRational $ xs + + badvec :: [Double] +-badvec = cycle [1,1e16,-1e16] ++badvec = cycle [1, 1e14, -1e14] + + tests :: TestTree +-tests = testGroup "Summation" [ +- testGroup "ID" [ +- -- plain summation loses precision quickly +- -- testProperty "t_sum" $ t_sum (sum id) +- +- -- tautological tests: +- -- testProperty "t_sum_error" $ t_sum_error (sum id) +- -- testProperty "t_sum_shifted" $ t_sum_shifted (sum id) +- ] +- , testGroup "Kahan" [ +- -- tests that cannot pass: +- -- testProprty "t_sum" $ t_sum (sum kahan) +- -- testProperty "t_sum_error" $ t_sum_error (sum kahan) +- +- -- kahan summation only beats normal summation with large values ++tests = testGroup "Summation" ++ [ testGroup "Kahan" [ ++ -- Kahan summation only beats naive summation when truly ++ -- catastrophic cancellation occurs + testProperty "t_sum_shifted" $ t_sum_shifted (sum kahan) + ] + , testGroup "KBN" [ +- testProperty "t_sum" $ t_sum (sum kbn) +- , testProperty "t_sum_error" $ t_sum_error (sum kbn) ++ testProperty "t_sum" $ t_sum (sum kbn) ++ , testProperty "t_sum_error" $ t_sum_error (sum kbn) + , testProperty "t_sum_shifted" $ t_sum_shifted (sum kbn) + ] + , testGroup "KB2" [ +- testProperty "t_sum" $ t_sum (sum kb2) +- , testProperty "t_sum_error" $ t_sum_error (sum kb2) ++ testProperty "t_sum" $ t_sum (sum kb2) ++ , testProperty "t_sum_error" $ t_sum_error (sum kb2) + , testProperty "t_sum_shifted" $ t_sum_shifted (sum kb2) + ] + ] |