{-|
    Module      :  Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Enclosure
    Description :  (testing) properties of basic enclosure operations
    Copyright   :  (c) 2007-2008 Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable
    
    Quickcheck properties of basic enclosure operations, 
    mainly ring operations.
-}
module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Enclosure
where

import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Enclosure
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate

import Data.Number.ER.Real.Approx.Interval

prop_enclAdd_ThickEncls_consistent
        reportFileName
        (Deg20Size20 maxDegree maxSize,
         (PSize30 (n11,p11), PSize30 (n12, p12)),
         (PSize30 (n21,p21), PSize30 (n22, p22))) =
    enclAtKeyPointsPointwiseBinaryDownUpConsistent
        reportFileName
        ((maxDegree, maxSize), (n11, n12), (n21, n22))
        intervalPlusInner
        p1Encl p2Encl sumEncl
    where
    sumEncl = p1Encl +: p2Encl
    p1Encl = makeThickEncl maxDegree maxSize p11 p12 
    p2Encl = makeThickEncl maxDegree maxSize p21 p22 
    
prop_enclMultiply_ThickEncls_consistent
        reportFileName
        (Deg20Size20 maxDegree maxSize,
         (PSize30 (n11,p11), PSize30 (n12, p12)),
         (PSize30 (n21,p21), PSize30 (n22, p22))) =
    enclAtKeyPointsPointwiseBinaryDownUpConsistent
        reportFileName
        ((maxDegree, maxSize), (n11, n12), (n21, n22))
        intervalTimesInner
        p1Encl p2Encl prodEncl
    where
    prodEncl = enclMultiply maxDegree maxSize p1Encl p2Encl
    p1Encl = makeThickEncl maxDegree maxSize p11 p12 
    p2Encl = makeThickEncl maxDegree maxSize p21 p22 
    
prop_enclMultiply_ParalEncls_consistent
        reportFileName
        (Deg20Size20 maxDegree maxSize,
         (SmallRatio num1 denom1,
          PSize30 (n1,p1)),
         (SmallRatio num2 denom2,
          PSize30 (n2,p2))) =
    enclAtKeyPointsPointwiseBinaryDownUpConsistent 
        reportFileName
        ((maxDegree, maxSize), ((num1, denom1), n1), ((num2, denom2), n2))
        intervalTimesInner
        p1Encl p2Encl prodEncl
    where
    prodEncl = enclMultiply maxDegree maxSize p1Encl p2Encl
    p1Encl = makeParalEncl p1 num1 denom1
    p2Encl = makeParalEncl p2 num2 denom2
    
prop_enclScale_ThickEncl_consistent
        reportFileName
        (Deg20Size20 maxDegree maxSize,
         SmallRatio num denom,
         PSize30 (n1, p1), 
         PSize30 (n2, p2)) =
    enclAtKeyPointsPointwiseBinaryDownUpConsistent
        reportFileName 
        ((maxDegree, maxSize), (num, denom), (n1, n2))
        intervalTimesInner
        cEncl pEncl scaledEncl
    where
    scaledEncl = enclScale maxDegree maxSize cB pEncl
    pEncl = makeThickEncl maxDegree maxSize p1 p2 
    cEncl = enclConst cB 
    cB = numB / denomB
    numB = fromInteger $ toInteger num
    denomB = fromInteger $ toInteger denom
    
prop_enclScale_ParalEncl_consistent
        reportFileName
        (Deg20Size20 maxDegree maxSize,
         SmallRatio cNum cDenom,
         (SmallRatio wNum wDenom, PSize30 (n, p))) =
    enclAtKeyPointsPointwiseBinaryDownUpConsistent
        reportFileName 
        ((maxDegree, maxSize), (cNum, cDenom), ((wNum, wDenom), n))
        intervalTimesInner 
        cEncl pEncl scaledEncl
    where
    scaledEncl = enclScale maxDegree maxSize cB pEncl
    pEncl = makeParalEncl p wNum wDenom 
    cEncl = enclConst cB 
    cB = cNumB / cDenomB
    cNumB = fromInteger $ toInteger cNum
    cDenomB = fromInteger $ toInteger cDenom