numhask-range-0.1.0: test/test.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}
-- ghc-8.2 should sort out pattern matching bugs
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}

module Main where

import NumHask.Prelude
import NumHask.Range

import Test.Tasty (TestName, TestTree, testGroup, defaultMain, localOption)
import Test.Tasty.QuickCheck
import Test.DocTest

data LawArity a =
    Nonary Bool |
    Unary (a -> Bool) |
    Binary (a -> a -> Bool) |
    Ternary (a -> a -> a -> Bool) |
    Ornary (a -> a -> a -> a -> Bool) |
    Failiary (a -> Property)

type Law a = (TestName, LawArity a)

testLawOf  :: (Arbitrary a, Show a) => [a] -> Law a -> TestTree
testLawOf _ (name, Nonary f) = testProperty name f
testLawOf _ (name, Unary f) = testProperty name f
testLawOf _ (name, Binary f) = testProperty name f
testLawOf _ (name, Ternary f) = testProperty name f
testLawOf _ (name, Ornary f) = testProperty name f
testLawOf _ (name, Failiary f) = testProperty name f

testRange :: TestTree
testRange = testGroup "Data.Range" $ testLawOf ([]::[Range Double]) <$> rangeLaws

main :: IO ()
main = do
    defaultMain $ testGroup "range" [localOption (QuickCheckTests 100) testRange]
    doctest ["src/NumHask/Range.hs"]

rangeLaws :: [Law (Range Double)]
rangeLaws =
    [ ("associative: a * (b * c) = (a * b) * c", Ternary (\a b c -> fuzzyeq 1e-4 ((a * b) * c) (a * (b * c))))
    , ("left id: one * a = a", Unary (\a -> fuzzyeq 1e-8 (one `times` a) a))
    , ("right id: a * one = a", Unary (\a -> fuzzyeq 1e-8 (a `times` one) a))
    , ("commutative: a * b == b * a", Binary (\a b -> fuzzyeq 1e-4 (a * b) (b * a)))
    , ("recip iso: recip . recip == id", Unary (\a -> zeroRange a || fuzzyeq 1e-2 (recip . recip $ a) a))
    , ("divide: zero range || a / a = one", Unary (\a -> zeroRange a || fuzzyeq 1e-4 (a / a) one))
    , ("recip left: zero range || recip a * a == one",  Unary (\a -> zeroRange a ||fuzzyeq 1e-4 (recip a * a) one))
    , ("recip right: zero range || a * recip a == one", Unary (\a -> zeroRange a || fuzzyeq 1e-4 (a * recip a) one))
    ]

fuzzyeq :: (AdditiveGroup a, Ord a) => a -> Range a -> Range a -> Bool
fuzzyeq eps0 (Range l0 u0) (Range l1 u1) =
    (l0-l1) <= eps0 && (l1-l0) <= eps0 && (u0-u1) <= eps0 && (u1-u0) <= eps0 

zeroRange :: (Eq a) => Range a -> Bool
zeroRange (Range l u) = l==u