Delta.hs

{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.Delta (deltaTestGroup) where

import Data.VectorSpace ((*^))
import Test.Tasty
import Test.Tasty.QuickCheck hiding ((.&&.), (.||.))
import Test.Tasty.TH
import ToySolver.Data.Delta (Delta (..))
import qualified ToySolver.Data.Delta as Delta

-- ---------------------------------------------------------------------
-- Delta

instance Arbitrary r => Arbitrary (Delta r) where
  arbitrary = do
    r <- arbitrary
    k <- arbitrary
    return (Delta r k)

prop_Delta_add_comm :: Property
prop_Delta_add_comm =
  forAll arbitrary $ \(a :: Delta Rational) ->
  forAll arbitrary $ \b ->
    a + b == b + a

prop_Delta_add_assoc :: Property
prop_Delta_add_assoc =
  forAll arbitrary $ \(a :: Delta Rational) ->
  forAll arbitrary $ \b ->
  forAll arbitrary $ \c ->
    a + (b + c) == (a + b) + c

prop_Delta_add_unitL :: Property
prop_Delta_add_unitL =
  forAll arbitrary $ \(a :: Delta Rational) ->
    0 + a == a

prop_Delta_add_unitR :: Property
prop_Delta_add_unitR =
  forAll arbitrary $ \(a :: Delta Rational) ->
    a + 0 == a

prop_Delta_mult_comm :: Property
prop_Delta_mult_comm =
  forAll arbitrary $ \(a :: Delta Rational) ->
  forAll arbitrary $ \b ->
    a * b == b * a

prop_Delta_mult_assoc :: Property
prop_Delta_mult_assoc =
  forAll arbitrary $ \(a :: Delta Rational) ->
  forAll arbitrary $ \b ->
  forAll arbitrary $ \c ->
    a * (b * c) == (a * b) * c

prop_Delta_mult_unitL :: Property
prop_Delta_mult_unitL =
  forAll arbitrary $ \(a :: Delta Rational) ->
    1 * a == a

prop_Delta_mult_unitR :: Property
prop_Delta_mult_unitR =
  forAll arbitrary $ \(a :: Delta Rational) ->
    a * 1 == a

prop_Delta_mult_dist :: Property
prop_Delta_mult_dist =
  forAll arbitrary $ \(a :: Delta Rational) ->
  forAll arbitrary $ \b ->
  forAll arbitrary $ \c ->
    a * (b + c) == a * b + a * c

prop_Delta_mult_zero :: Property
prop_Delta_mult_zero =
  forAll arbitrary $ \(a :: Delta Rational) ->
    0 * a ==  0

prop_Delta_scale_mult :: Property
prop_Delta_scale_mult =
  forAll arbitrary $ \(a :: Delta Rational) ->
  forAll arbitrary $ \b ->
    Delta.fromReal a * b ==  a *^ b

prop_Delta_signum_abs :: Property
prop_Delta_signum_abs =
  forAll arbitrary $ \(x :: Delta Rational) ->
    abs x * signum x == x

prop_Delta_floor :: Property
prop_Delta_floor =
  forAll arbitrary $ \(x :: Delta Rational) ->
    let y :: Integer
        y = Delta.floor' x
    in fromIntegral y <= x && x < fromIntegral (y+1)

prop_Delta_ceiling :: Property
prop_Delta_ceiling =
  forAll arbitrary $ \(x :: Delta Rational) ->
    let y :: Integer
        y = Delta.ceiling' x
    in fromIntegral (y-1) < x && x <= fromIntegral y

prop_Delta_properFraction :: Property
prop_Delta_properFraction =
  forAll arbitrary $ \(x :: Delta Rational) ->
    let n :: Integer
        (n,f) = properFraction x
    in and
       [ abs f < 1
       , not (x >= 0) || (n >= 0 && f >= 0)
       , not (x <= 0) || (n <= 0 && f <= 0)
       ]

------------------------------------------------------------------------
-- Test harness

deltaTestGroup :: TestTree
deltaTestGroup = $(testGroupGenerator)