RealRing.hs

{-# LANGUAGE RebindableSyntax #-}
module Test.Algebra.RealRing where

import qualified Algebra.RealRing as RealRing

import Test.NumericPrelude.Utility (testUnit, )
import Test.QuickCheck (quickCheck, )
import qualified Test.HUnit as HUnit

import Data.Tuple.HT (mapFst, )

import NumericPrelude.Base as P
import NumericPrelude.Numeric as NP


test :: (Eq a) => (Double -> a) -> (Double -> a) -> IO ()
test f g =
   quickCheck (\x -> f x == g x)


tests :: HUnit.Test
tests =
   HUnit.TestLabel "rounding functions" $
   HUnit.TestList $
   map testUnit $
      ("round",         test RealRing.genericRound    (NP.round :: Double -> Integer)) :
      ("truncate",      test RealRing.genericTruncate (NP.truncate :: Double -> Integer)) :
      ("ceiling",       test RealRing.genericCeiling  (NP.ceiling :: Double -> Integer)) :
      ("floor",         test RealRing.genericFloor    (NP.floor :: Double -> Integer)) :
      ("fraction",      test RealRing.genericFraction (NP.fraction :: Double -> Double)) :
      ("splitFraction", test RealRing.genericSplitFraction (NP.splitFraction :: Double -> (Integer, Double))) :

{-
      ("splitFractionId", quickCheck (\x -> (x::Double) == (uncurry (+) $ mapFst fromInteger $ splitFraction x))) :
-}
      ("splitFractionId", quickCheck (\x ->  uncurry (==) $ mapFst (((x::Double)-) . fromInteger) $ splitFraction x)) :
      ("splitFractionFloorFraction", quickCheck (\x -> (floor (x::Double) :: Integer, fraction x) == splitFraction x)) :
      ("fractionBound", quickCheck (\x -> let y = fraction (x::Double) in 0<=y && y<1)) :
      ("floorCeiling", quickCheck (\x -> negate (floor (x::Double) :: Integer) == ceiling (-x))) :
      []