Tests.hs

-----------------------------------------------------------------------------
-- Copyright 2014, Open Universiteit Nederland. This file is distributed
-- under the terms of the GNU General Public License. For more information,
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------
--  $Id: Tests.hs 6548 2014-05-16 10:34:18Z bastiaan $

module Domain.Math.Numeric.Tests (main) where

import Data.Maybe
import Data.Monoid
import Domain.Math.Expr
import Domain.Math.Numeric.Generators
import Domain.Math.Numeric.Strategies
import Domain.Math.Numeric.Views
import Ideas.Common.Classes
import Ideas.Common.Context
import Ideas.Common.Utils.TestSuite
import Ideas.Common.View
import Test.QuickCheck

main :: TestSuite
main = suite "Numeric tests"

   [ let f s v = mconcat
            [ useProperty ("idempotence " ++ s)
                 (propIdempotence g v) <>
              useProperty ("soundness " ++ s)
                 (propSoundness semEqDouble g v)
            | g <- numGenerators
            ]
     in suite "Correctness numeric views"
           [ f "integer view"          integerView
           , f "rational view"         rationalView
           , f "integer normal form"   integerNF
           , f "rational normal form"  rationalNF
           , f "rational relaxed form" rationalRelaxedForm
           ]

   , let f s v = [ useProperty s $ propNormalForm g v
                 | g <- numGenerators
                 ]
     in suite "Normal forms" $
           f "integer normal form" integerNF
           -- f rationalNF -- no longer a normal form

   , let f s g v = useProperty s $ forAll (sized g) (`belongsTo` v)
     in suite "Correctness generators"
           [ f "integer" integerGenerator integerView
           , f "rational" rationalGenerator rationalView
           , f "ratio expr" ratioExprGen rationalNF
           , f "ratio expr nonzero" ratioExprGenNonZero rationalNF
           ]

   , let va .>. vb = mconcat
            [ useProperty "" $ forAll g $ \a ->
                 not (a `belongsTo` va) || a `belongsTo` vb
            | g <- numGenerators
            ]
     in suite "View relations"
           [ integerNF .>. integerView
           , rationalNF .>. rationalRelaxedForm
           , rationalRelaxedForm .>. rationalView
           , integerNF .>. rationalNF
           , integerView .>. rationalView
           ]

   , let f l s pre post = mconcat
            [ useProperty l $ forAll g $ \a ->
                 let run = fromMaybe a . fromContext . applyD s
                         . newContext . termNavigator
                 in not (a `belongsTo` pre) || run a `belongsTo` post
            | g <- numGenerators
            ]
     in suite "Pre/post conditions strategies"
           [ f "natural"  naturalStrategy  integerView  integerNF
           , f "integer"  integerStrategy  integerView  integerNF
           , f "rational" rationalStrategy rationalView rationalNF
           , f "fraction" fractionStrategy rationalView rationalNF
           ]
   ]

numGenerators :: [Gen Expr]
numGenerators = map sized
   [ integerGenerator, rationalGenerator
   , ratioExprGen, ratioExprGenNonZero, numGenerator
   ]

semEqDouble :: Expr -> Expr -> Bool
semEqDouble a b =
   case (match doubleView a, match doubleView b) of
      (Just x, Just y)   -> x ~= y
      (Nothing, Nothing) -> True
      _                  -> False
 where
   delta = 0.0001

   (~=) :: Double -> Double -> Bool
   x ~= y = abs x < delta || abs y < delta || abs (1 - (x/y)) < delta