From be580b424ffd1d8ffead78b38eae6262ef2930b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Justus=20Sagem=C3=BCller?= Date: Wed, 28 Mar 2018 12:52:30 +0200 Subject: Add test for invertability of `Floating` methods. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit These functions have inverses only on part of the real line, but there they should be reliably inverted – that's basically the whole point of the functions like `asin`, `atan` etc.. --- .../tests/numeric/should_run/FloatFnInverses.hs | 47 ++++++++++++++++++++++ .../numeric/should_run/FloatFnInverses.stdout | 10 +++++ testsuite/tests/numeric/should_run/all.T | 2 + 3 files changed, 59 insertions(+) create mode 100644 testsuite/tests/numeric/should_run/FloatFnInverses.hs create mode 100644 testsuite/tests/numeric/should_run/FloatFnInverses.stdout diff --git a/testsuite/tests/numeric/should_run/FloatFnInverses.hs b/testsuite/tests/numeric/should_run/FloatFnInverses.hs new file mode 100644 index 0000000000..773790e532 --- /dev/null +++ b/testsuite/tests/numeric/should_run/FloatFnInverses.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE TypeApplications #-} + +-- Check that the standard analytic functions are correctly +-- inverted by the corresponding inverse functions. + +main :: IO () +main = mapM_ print + [ -- @recip@ is self-inverse on @ℝ\\{0}@. + invDeviation @Double recip recip <$> [-1e20, -1e3, -1, -1e-40, 1e-40, 1e90] + , invDeviation @Float recip recip <$> [-1e10, -10, -1, -1e-20, 1e-20, 1e30] + , -- @exp@ is invertible on @ℝ <-> [0…∞[@, but grows very fast. + invDeviation @Double exp log <$> [-10, -5 .. 300] + , invDeviation @Float exp log <$> [-10 .. 60] + -- @sin@ is only invertible on @[-π/2…π/2] <-> [-1…1]@. + , invDeviation @Double sin asin <$> [-1.5, -1.4 .. 1.5] + , invDeviation @Float sin asin <$> [-1.5, -1.4 .. 1.5] + -- @cos@ is invertible on @[0…π] <-> [-1…1]@. + , invDeviation @Double cos acos <$> [0, 0.1 .. 3] + , invDeviation @Float cos acos <$> [0, 0.1 .. 3] + -- @tan@ is invertible on @]-π/4…π/4[ <-> ]-∞…∞[@. + , invDeviation @Double tan atan <$> [-0.7, -0.6 .. 0.7] + , invDeviation @Float tan atan <$> [-0.7, -0.6 .. 0.7] + ] + +invDeviation :: KnownNumDeviation a + => (a -> a) -- ^ Some numerical function @f@. + -> (a -> a) -- ^ Inverse @g = f⁻¹@ of that function. + -> a -- ^ Value @x@ which to compare with @g (f x)@. + -> Double -- ^ Relative discrepancy between original/expected + -- value and actual function result. +invDeviation f g 0 = rmNumericDeviation (g (f 0) + 1) - 1 +invDeviation f g x = rmNumericDeviation (g (f x) / x) - 1 + +-- | We need to round results to some sensible precision, +-- because floating-point arithmetic generally makes +-- it impossible to /exactly/ invert functions. +-- What precision this is depends on the type. The bounds +-- here are rather generous; the functions should usually +-- perform substantially better than that. +class (Floating a, Eq a) => KnownNumDeviation a where + rmNumericDeviation :: a -> Double + +instance KnownNumDeviation Double where + rmNumericDeviation x = fromIntegral (round $ x * 2^36) / 2^36 + +instance KnownNumDeviation Float where + rmNumericDeviation x = fromIntegral (round $ x * 2^16) / 2^16 diff --git a/testsuite/tests/numeric/should_run/FloatFnInverses.stdout b/testsuite/tests/numeric/should_run/FloatFnInverses.stdout new file mode 100644 index 0000000000..7fa36911bc --- /dev/null +++ b/testsuite/tests/numeric/should_run/FloatFnInverses.stdout @@ -0,0 +1,10 @@ +[0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index fd9c05fbbb..37fff44bde 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -41,6 +41,8 @@ test('arith018', normal, compile_and_run, ['']) test('arith019', normal, compile_and_run, ['']) test('expfloat', normal, compile_and_run, ['']) +test('FloatFnInverses', normal, compile_and_run, ['']) + test('T1603', skip, compile_and_run, ['']) test('T3676', expect_broken(3676), compile_and_run, ['']) test('T4381', normal, compile_and_run, ['']) -- cgit v1.2.1