Commit be580b42 authored by Justus Sagemüller's avatar Justus Sagemüller Committed by Ben Gamari

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..
parent 6243bba7
{-# 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
[0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
......@@ -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, [''])
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment