{-|
    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Elementary
    Description :  (testing) properties of enclosure elementary operations
    Copyright   :  (c) 2007-2008 Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable
    
    Quickcheck properties of some elementary operations on primitive polynomial
    enclosures.
-}
module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Elementary
where

import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Common

import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate

import qualified Data.Number.ER.Real.Approx as RA
import qualified Data.Number.ER.Real.Base as B
import Data.Number.ER.Real.Arithmetic.Elementary

import Data.Number.ER.BasicTypes
import Data.Number.ER.BasicTypes.Tests.Generate 

import Test.QuickCheck

prop_enclSqrt_ThickEncl_consistent sampleE =
    encl_op_ThickEncl_consistent sampleE UFB.sqrtEncl erSqrt_IR_Inner positiveDomain

prop_enclSqrt_ParalEncl_consistent sampleE =
    encl_op_ParalEncl_consistent sampleE UFB.sqrtEncl erSqrt_IR_Inner positiveDomain

prop_enclSqrt_ThinEncl_consistent sampleE =
    encl_op_ThinEncl_consistent sampleE UFB.sqrtEncl erSqrt_IR_Inner positiveDomain


prop_enclExp_ThickEncl_consistent sampleE =
    encl_op_ThickEncl_consistent sampleE UFB.expEncl erExp_IR_Inner noDomainRestriction

prop_enclExp_ParalEncl_consistent sampleE =
    encl_op_ParalEncl_consistent sampleE UFB.expEncl erExp_IR_Inner noDomainRestriction
    
prop_enclExp_ThinEncl_consistent sampleE =
    encl_op_ThinEncl_consistent sampleE UFB.expEncl erExp_IR_Inner noDomainRestriction
    
prop_enclSine_ThickEncl_consistent sampleE =
    encl_op_ThickEncl_consistent sampleE UFB.sinEncl erSine_IR_Inner sincosDomain

prop_enclSine_ParalEncl_consistent sampleE =
    encl_op_ParalEncl_consistent sampleE UFB.sinEncl erSine_IR_Inner sincosDomain
    
prop_enclSine_ThinEncl_consistent sampleE =
    encl_op_ThinEncl_consistent sampleE UFB.sinEncl erSine_IR_Inner sincosDomain
    
prop_enclCosine_ThickEncl_consistent sampleE =
    encl_op_ThickEncl_consistent sampleE UFB.cosEncl erCosine_IR_Inner sincosDomain

prop_enclCosine_ParalEncl_consistent sampleE =
    encl_op_ParalEncl_consistent sampleE UFB.cosEncl erCosine_IR_Inner sincosDomain
    
prop_enclCosine_ThinEncl_consistent sampleE =
    encl_op_ThinEncl_consistent sampleE UFB.cosEncl erCosine_IR_Inner sincosDomain
    
prop_enclAtan_ThickEncl_consistent sampleE =
    encl_op_ThickEncl_consistent sampleE UFB.atanEncl erATan_IR_Inner noDomainRestriction

prop_enclAtan_ParalEncl_consistent sampleE =
    encl_op_ParalEncl_consistent sampleE UFB.atanEncl erATan_IR_Inner noDomainRestriction
    
prop_enclAtan_ThinEncl_consistent sampleE =
    encl_op_ThinEncl_consistent sampleE UFB.atanEncl erATan_IR_Inner noDomainRestriction

sincosDomain :: (B.ERRealBase b) => (Maybe b, Maybe b)
sincosDomain = (Just (-1.57), Just 1.57) -- almost (-pi/2, pi/2)

noDomainRestriction :: (B.ERRealBase b) => (Maybe b, Maybe b)
noDomainRestriction = (Nothing, Nothing)

positiveDomain :: (B.ERRealBase b) => (Maybe b, Maybe b)
positiveDomain = (Just 0, Nothing) 
    
encl_op_ThickEncl_consistent
        sampleE
        opEncl opInner rangeRestriction
        reportFileName
        (Deg5Size10 maxDegree maxSize,
         (Ix10 ix),
         (FBEnclThickSize10Degree3 (n,preE))) = 
    enclAtKeyPointsPointwiseUnaryInnerInOuter
        reportFileName
        ((maxDegree, maxSize), ix, n) 
        (opInner ix)
        e resEncl
    where
    _ = [sampleE, preE]
    (succeeded, e) = 
        enclRestrictRange ix maxDegree maxSize rangeRestriction preE 
    resEncl = opEncl maxDegree maxSize ix e
    
encl_op_ParalEncl_consistent
        sampleE
        opEncl opInner rangeRestriction
        reportFileName
        (Deg5Size10 maxDegree maxSize,
         (Ix10 ix),
         (FBEnclParalSize10Degree3 (n,preE))) = 
    enclAtKeyPointsPointwiseUnaryInnerInOuter
        reportFileName
        ((maxDegree, maxSize), ix, n) 
        (opInner ix)
        e resEncl
    where
    _ = [sampleE, preE]
    (succeeded, e) = 
        enclRestrictRange ix maxDegree maxSize rangeRestriction preE 
    resEncl = opEncl maxDegree maxSize ix e
    
encl_op_ThinEncl_consistent
        sampleE
        opEncl opInner rangeRestriction
        reportFileName
        (Deg5Size10 maxDegree maxSize,
         (Ix10 ix),
         (FBEnclThinSize10Degree3 (n,preE))) = 
    enclAtKeyPointsPointwiseUnaryInnerInOuter
        reportFileName
        ((maxDegree, maxSize), ix, n) 
        (opInner ix)
        e resEncl
    where
    _ = [sampleE, preE]
    (succeeded, e) = 
        enclRestrictRange ix maxDegree maxSize rangeRestriction preE 
    resEncl = opEncl maxDegree maxSize ix e