fp-ieee-0.1.0: test/TwoSumSpec.hs

module TwoSumSpec where
import           Data.Coerce
import           Data.Functor.Identity
import           Data.Proxy
import           Numeric.Floating.IEEE
import           Numeric.Floating.IEEE.Internal
import           Test.Hspec
import           Test.Hspec.QuickCheck
import           Test.QuickCheck
import           Util (forAllFloats2, sameFloatP)

twoProduct_generic :: RealFloat a => a -> a -> (a, a)
twoProduct_generic x y = coerce (twoProduct (Identity x) (Identity y))

prop_twoSum :: (RealFloat a, Show a) => Proxy a -> a -> a -> Property
prop_twoSum _ x y = exponent x < expMax && exponent y < expMax ==> case twoSum x y of
  (s, t) -> x + y `sameFloatP` s .&&. (isFinite x && isFinite y && isFinite s ==> isFinite t .&&. toRational x + toRational y === toRational s + toRational t)
  where (_,expMax) = floatRange x

prop_twoProduct :: (RealFloat a, Show a) => Proxy a -> (a -> a -> (a, a)) -> a -> a -> Property
prop_twoProduct _ tp x y = case tp x y of
  (s, t) -> x * y `sameFloatP` s .&&. (isFinite x && isFinite y && isFinite s ==> isFinite t .&&. fromRational (toRational x * toRational y - toRational s) === t) -- The result of twoProduct is not exact if the product underflows

{-# NOINLINE spec #-}
spec :: Spec
spec = modifyMaxSuccess (* 100) $ do
  describe "Double" $ do
    let proxy :: Proxy Double
        proxy = Proxy
    prop "twoSum" $ forAllFloats2 $ prop_twoSum proxy
    prop "twoProduct" $ forAllFloats2 $ prop_twoProduct proxy twoProduct
    prop "twoProduct_generic" $ forAllFloats2 $ prop_twoProduct proxy twoProduct_generic
  describe "Float" $ do
    let proxy :: Proxy Float
        proxy = Proxy
    prop "twoSum" $ forAllFloats2 $ prop_twoSum proxy
    prop "twoProduct" $ forAllFloats2 $ prop_twoProduct proxy twoProduct
    prop "twoProduct_generic" $ forAllFloats2 $ prop_twoProduct proxy twoProduct_generic
    prop "twoProductFloat_viaDouble" $ forAllFloats2 $ prop_twoProduct proxy twoProductFloat_viaDouble