Properties.hs

{-|
    Module      :  Data.Number.ER.Real.Base.Tests.Properties
    Description :  (testing) properties to check for real approximations
    Copyright   :  (c) 2009 Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable
    
    Properties of real approximations we want to check in tests. 
-}

module Data.Number.ER.Real.Approx.Tests.Properties 
where

import Data.Number.ER.Real.Approx.Tests.Generate
import Data.Number.ER.Real.Approx.Tests.Reporting
import Data.Number.ER.BasicTypes.Tests.Generate

import qualified Data.Number.ER.Real.Approx as RA
import Data.Number.ER.Real.Approx ((+:),(-:),(*:),(/:))
import qualified Data.Number.ER.Real.Approx.Elementary as RAEL

import Data.Number.ER.BasicTypes

import Data.Number.ER.Misc

import Test.QuickCheck

type RAPropTupleUnary ira =
    ira ->
    String ->
    ((Ix20, RAThin ira) -> Bool, 
     (Ix20, RAConsistent ira) -> Bool,
     (Ix20, RAThin ira) -> Bool, 
     (Ix20, RAConsistent ira) -> Bool, 
     (Ix20, RADirected ira) -> Bool)

props_ra_AMinusA_eq_oi ::
    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira
props_ra_AMinusA_eq_oi =
    props_ra_eq_oi_unary 0 (\ix a -> a - a) (\ix a -> a -: a)

props_ra_ADivA_eq_oi ::
    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira
props_ra_ADivA_eq_oi =
    props_ra_eq_oi_unary 1 (\ix a -> a / a) (\ix a -> a /: a)
    
props_ra_AddCommut_eq_oi ::
    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira
props_ra_AddCommut_eq_oi =
    props_ra_eq_oi_unary 0 commutDiff commutDiffInner
    where
    commutDiff ix a =
        (a + b) - (b + a)
        where
        b = 1 / (a + 1)
    commutDiffInner ix a =
        (a +: b) -: (b +: a)
        where
        b = 1 / (a + 1)

props_ra_MultCommut_eq_oi ::
    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira
props_ra_MultCommut_eq_oi =
    props_ra_eq_oi_unary 0 commutDiff commutDiffInner
    where
    commutDiff ix a =
        (a * b) - (b * a)
        where
        b = 1 / (a + 1)
    commutDiffInner ix a =
        (a *: b) -: (b *: a)
        where
        b = 1 / (a + 1)

props_ra_AddAssoc_eq_oi ::
    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira
props_ra_AddAssoc_eq_oi =
    props_ra_eq_oi_unary 0 assocDiff assocDiffInner
    where
    assocDiff ix a =
        ((a + b) + c) - (a + (b + c))
        where
        b = 1 / (a + 1)
        c = (a - 1)
    assocDiffInner ix a =
        ((a +: b) +: c) -: (a +: (b +: c))
        where
        b = 1 / (a + 1)
        c = (a - 1)

props_ra_MultAssoc_eq_oi ::
    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira
props_ra_MultAssoc_eq_oi =
    props_ra_eq_oi_unary 0 assocDiff assocDiffInner
    where
    assocDiff ix a =
        ((a * b) * c) - (a * (b * c))
        where
        b = 1 / (a + 1)
        c = (a - 1)
    assocDiffInner ix a =
        ((a *: b) *: c) -: (a *: (b *: c))
        where
        b = 1 / (a + 1)
        c = (a - 1)

props_ra_Distr_eq_oi ::
    (RA.ERIntApprox ira, RA.ERInnerOuterApprox ira) => RAPropTupleUnary ira
props_ra_Distr_eq_oi =
    props_ra_eq_oi_unary 0 distrDiff distrDiffInner
    where
    distrDiff ix a =
        (a * (b + c)) - (a * b + a * c)
        where
        b = 1 / (a + 1)
        c = (a - 1)
    distrDiffInner ix a =
        (a *: (b +: c)) -: ((a *: b) +: (a *: c))
        where
        b = 1 / (a + 1)
        c = (a - 1)

props_ra_SinCos_eq_oi ::
    (RAEL.ERInnerOuterApproxElementary ira, RAEL.ERApproxElementary ira) => RAPropTupleUnary ira
props_ra_SinCos_eq_oi =
    props_ra_eq_oi_unary 1 sincos sincosInner
    where
    sincos ix a =
        (RAEL.sin ix a)^2 + (RAEL.cos ix a)^2
    sincosInner ix a =
        (sina *: sina) +: (cosa *: cosa)
        where
        sina = RAEL.sinInner ix a 
        cosa = RAEL.cosInner ix a 

props_ra_TanATan_eq_oi ::
    (RAEL.ERInnerOuterApproxElementary ira, RAEL.ERApproxElementary ira) => RAPropTupleUnary ira
props_ra_TanATan_eq_oi =
    props_ra_eq_oi_unary 0 tanAtan tanAtanInner
    where
    tanAtan ixP a =
--        unsafePrint 
--        (
--            "tanAtan: "
--            ++ "\n ix = " ++ show ix 
--            ++ "\n a = " ++ show a
--            ++ "\n atan ix a = " ++ show tana
--            ++ "\n tan ix (atan ix a) = " ++ show tanatana
--        ) $
        tanatana - a
        where
        tanatana = RAEL.tan ix tana
        tana = RAEL.atan ix a
        ix = min 10 ixP
    tanAtanInner ixP a =
        (RAEL.tanInner ix $ RAEL.atanInner ix a) -: a
        where
        ix = min 10 ixP

props_ra_LogExp_eq_oi ::
    (RAEL.ERInnerOuterApproxElementary ira, RAEL.ERApproxElementary ira) => RAPropTupleUnary ira
props_ra_LogExp_eq_oi =
    props_ra_eq_oi_unary 0 logExp logExpInner
    where
    logExp ixP a =
--        unsafePrint 
--        (
--            "logExp: "
--            ++ "\n ix = " ++ show ix 
--            ++ "\n a = " ++ show a
--            ++ "\n exp ix a = " ++ show expa
--            ++ "\n log ix (exp ix a) = " ++ show logexpa
--        ) $
        logexpa - a
        where
        logexpa = RAEL.log ix expa 
        expa = RAEL.exp ix a
        ix = min 10 ixP
    logExpInner ixP a =
        logexpa -: a
        where
        logexpa = RAEL.logInner ix expa
        expa = RAEL.expInner ix a
        ix = min 10 ixP


{------------------  auxiliary functions ------------------------}

props_ra_eq_oi_unary constRes opOuter opInner sampleRA reportFileName =
    (prop_Eq_Thin, prop_Eq_Consistent, 
     prop_OI_Thin, prop_OI_Consistent, prop_OI_Directed)
    where
    prop_Eq_Thin (Ix20 ix, RAThin a) =
        raConsistentWithPrecise sampleRA (reportFileName  ++ "_Eq_Thin") (ix,aId) 0 constRes resOuter
        where
        resOuter = opOuter ix a
        aId = RA.showApprox 10 True True a
    prop_Eq_Consistent (Ix20 ix, RAConsistent a) =
        raConsistentWithPrecise sampleRA (reportFileName ++ "_Eq_Consistent") (ix,aId) 0 constRes resOuter
        where
        resOuter = opOuter ix a
        aId = RA.showApprox 10 True True a
    prop_OI_Thin (Ix20 ix, RAThin a) =
        raIncludedIn sampleRA (reportFileName ++ "_OI_Thin") (ix, aId) 0 resInner resOuter
        where
        resOuter = opOuter ix a
        resInner = opInner ix a
        aId = RA.showApprox 10 True True a
    prop_OI_Consistent (Ix20 ix, RAConsistent a) =
        raIncludedIn sampleRA (reportFileName ++ "_OI_Consistent") (ix,aId) 0 resInner resOuter
        where
        resOuter = opOuter ix a
        resInner = opInner ix a
        aId = RA.showApprox 10 True True a
    prop_OI_Directed (Ix20 ix, RADirected a) =
        raIncludedIn sampleRA (reportFileName ++ "_OI_Directed") (ix, aId) 0 resInner resOuter
        where
        resOuter = opOuter ix a
        resInner = opInner ix a
        aId = RA.showApprox 10 True True a
    
raConsistentWithPrecise sampleRA reportFileName caseId subId preciseVal approxVal 
    | result =
        unsafeERTestReport reportFileName
            (caseId, subId, preciseVal, approxVal) $
        result
    | otherwise = 
        unsafePrint
        (
            "raAntiIncludes failed"
            ++ "\n caseId = " ++ show caseId
            ++ "\n subId = " ++ show subId
            ++ "\n preciseVal = " ++ show preciseVal
            ++ "\n approxVal = " ++ show approxVal
        ) $
        result
    where
    result = 
        (approxVal `RA.refines` preciseVal)
        || 
        (preciseVal `RA.refines` approxVal)
    _ = [sampleRA, approxVal]

raIncludedIn sampleRA reportFileName caseId subId innerVal outerVal 
    | result =
        unsafeERTestReport reportFileName
            (caseId, subId, innerVal, outerVal) $
        result
    | otherwise = 
        unsafePrint
        (
            "raIncludes failed"
            ++ "\n caseId = " ++ show caseId
            ++ "\n subId = " ++ show subId
            ++ "\n innerVal = " ++ show innerVal
            ++ "\n outerVal = " ++ show outerVal
        ) $
        result
    where
    result = innerVal `RA.refines` outerVal 
    _ = [sampleRA, innerVal]