[commit: ghc] master: Add test for invertability of `Floating` methods. (be580b4)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/be580b424ffd1d8ffead78b38eae6262ef2930b4/ghc

>---------------------------------------------------------------

commit be580b424ffd1d8ffead78b38eae6262ef2930b4
Author: Justus Sagemüller <sagemueller at geo.uni-koeln.de>
Date:   Wed Mar 28 12:52:30 2018 +0200

    Add test for invertability of `Floating` methods.
    
    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..


>---------------------------------------------------------------

be580b424ffd1d8ffead78b38eae6262ef2930b4
 .../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(+)

diff --git a/testsuite/tests/numeric/should_run/FloatFnInverses.hs b/testsuite/tests/numeric/should_run/FloatFnInverses.hs
new file mode 100644
index 0000000..773790e
--- /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 at .
+          -> (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 0000000..7fa3691
--- /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 fd9c05f..37fff44 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, [''])