module AERN2.Real.Tests
(
specCauchyReal, tCauchyReal, tCauchyRealAtAccuracy
)
where
import MixedTypesNumPrelude
import Test.Hspec
import Test.QuickCheck
import AERN2.MP.Accuracy
import AERN2.MP
import AERN2.MP.Dyadic
import AERN2.QA.Protocol
import AERN2.AccuracySG
import AERN2.Real.Type
instance Arbitrary CauchyRealAtAccuracy where
arbitrary =
cauchyRealAtAccuracy <$>
arbitrary <*>
((accuracySG . bits) <$> (arbitrarySmall 1000 :: Gen Integer))
instance Arbitrary CauchyReal where
arbitrary =
frequency
[(int 1, real <$> (arbitrarySmall 1000000 :: Gen Integer)),
(int 1, real <$> (arbitrarySmall 1000000 :: Gen Rational)),
(int 2, (*) <$> (arbitrarySmall 1000000 :: Gen Integer) <*> arbitrarySignedBinary)
]
where
arbitrarySignedBinary =
signedBinary2Real <$> infiniteListOf (elements [1,0,1])
signedBinary2Real sbits =
newCR "random" [] $ \ _ (AccuracySG _ acG) ->
case acG of
NoInformation -> balls !! 0
Exact -> error "signedBinary2Real: cannot request the number Exactly"
_ -> balls !! (fromAccuracy acG + 1)
where
balls = nextBit (mpBall (0,1)) $ zip sbits (map prec [10..])
nextBit ball ((sbit, p):rest) =
ball : nextBit newBall rest
where
newBall =
case sbit of
(1) -> fromEndpoints l m
0 -> fromEndpoints l2 r2
1 -> fromEndpoints m r
_ -> error "in Arbitrary CauchyReal"
(l_,r_) = endpoints ball :: (MPBall, MPBall)
l = setPrecision p l_
r = setPrecision p r_
m = (l + r) * (dyadic 0.5)
l2 = (l + m) * (dyadic 0.5)
r2 = (r + m) * (dyadic 0.5)
nextBit _ _ = error "in Arbitrary CauchyReal"
arbitrarySmall :: (Arbitrary a, HasOrderCertainly a Integer) => Integer -> Gen a
arbitrarySmall limit = aux
where
aux =
do
x <- arbitrary
if limit !<=! x && x !<=! limit
then return x
else aux
tCauchyReal :: T CauchyReal
tCauchyReal = T "CauchyReal"
tCauchyRealAtAccuracy :: T CauchyRealAtAccuracy
tCauchyRealAtAccuracy = T "CauchyReal(ac)"
specCRrespectsAccuracy1 ::
String ->
(CauchyReal -> CauchyReal) ->
(CauchyReal -> AccuracySG -> Bool) ->
Spec
specCRrespectsAccuracy1 opName op =
specCRrespectsAccuracy1CN opName (\ a -> cn (op a))
specCRrespectsAccuracy1CN ::
String ->
(CauchyReal -> CauchyRealCN) ->
(CauchyReal -> AccuracySG -> Bool) ->
Spec
specCRrespectsAccuracy1CN opName op precond =
it (opName ++ " respects accuracy requests") $ do
property $
\ (x :: CauchyReal) (ac :: Accuracy) ->
let acSG = accuracySG ac in
ac < (bits 1000) && precond x acSG ==>
case getMaybeValueCN ((op x) ? acSG) of
Just v -> getAccuracy v >=$ ac
_ -> property True
(>=$) :: Accuracy -> Accuracy -> Property
(>=$) = printArgsIfFails2 ">=" (>=)
precondAnyReal :: CauchyReal -> AccuracySG -> Bool
precondAnyReal _x _ac = True
precondPositiveReal :: CauchyReal -> AccuracySG -> Bool
precondPositiveReal x ac = (x ? ac) !>! 0
precondNonZeroReal :: CauchyReal -> AccuracySG -> Bool
precondNonZeroReal x ac = (x ? ac) !/=! 0
precondSmallReal :: CauchyReal -> AccuracySG -> Bool
precondSmallReal x ac = abs (x ? ac) !<! 1000
precondPositiveSmallReal :: CauchyReal -> AccuracySG -> Bool
precondPositiveSmallReal x ac = 0 !<! b && b !<! 1000
where b = x ? ac
specCRrespectsAccuracy2 ::
String ->
(CauchyReal -> CauchyReal -> CauchyReal) ->
(CauchyReal -> AccuracySG -> Bool) ->
(CauchyReal -> AccuracySG -> Bool) ->
Spec
specCRrespectsAccuracy2 opName op =
specCRrespectsAccuracy2CN opName (\ a b -> cn (op a b))
specCRrespectsAccuracy2CN ::
String ->
(CauchyReal -> CauchyReal -> CauchyRealCN) ->
(CauchyReal -> AccuracySG -> Bool) ->
(CauchyReal -> AccuracySG -> Bool) ->
Spec
specCRrespectsAccuracy2CN opName op precond1 precond2 =
it (opName ++ " respects accuracy requests") $ do
property $
\ (x :: CauchyReal) (y :: CauchyReal) (ac :: Accuracy) ->
let acSG = accuracySG ac in
ac < (bits 1000) && precond1 x acSG && precond2 y acSG ==>
case getMaybeValueCN ((op x y) ? acSG) of
Just v -> getAccuracy v >=$ ac
_ -> property True
specCRrespectsAccuracy2T ::
(Arbitrary t, Show t) =>
T t ->
String ->
(CauchyReal -> t -> CauchyReal) ->
(CauchyReal -> AccuracySG -> Bool) ->
(t -> Bool) ->
Spec
specCRrespectsAccuracy2T tt opName op =
specCRrespectsAccuracy2TCN tt opName (\ a b -> cn (op a b))
specCRrespectsAccuracy2TCN ::
(Arbitrary t, Show t) =>
T t ->
String ->
(CauchyReal -> t -> CauchyRealCN) ->
(CauchyReal -> AccuracySG -> Bool) ->
(t -> Bool) ->
Spec
specCRrespectsAccuracy2TCN (T tName :: T t) opName op precond1 precond2 =
it (opName ++ " with " ++ tName ++ " respects accuracy requests") $ do
property $
\ (x :: CauchyReal) (t :: t) (ac :: Accuracy) ->
let acSG = accuracySG ac in
ac < (bits 1000) && precond1 x acSG && precond2 t ==>
case getMaybeValueCN ((op x t) ? acSG) of
Just v -> getAccuracy v >=$ ac
_ -> property True
precondAnyT :: t -> Bool
precondAnyT _t = True
precondNonZeroT :: (HasEqCertainly t Integer) => t -> Bool
precondNonZeroT t = t !/=! 0
precondSmallT :: (HasOrderCertainly t Integer) => t -> Bool
precondSmallT t = 1000 !<=! t && t !<=! 1000
specCauchyReal :: Spec
specCauchyReal =
describe ("CauchyReal") $ do
describe "order" $ do
specHasEqNotMixed tCauchyRealAtAccuracy
specHasOrderNotMixed tCauchyRealAtAccuracy
describe "min/max/abs" $ do
specCRrespectsAccuracy1 "abs" abs precondAnyReal
specCRrespectsAccuracy2 "max" max precondAnyReal precondAnyReal
specCRrespectsAccuracy2 "min" min precondAnyReal precondAnyReal
describe "ring" $ do
specCRrespectsAccuracy1 "negate" negate precondAnyReal
specCRrespectsAccuracy2 "+" add precondAnyReal precondAnyReal
specCRrespectsAccuracy2T tInteger "+" add precondAnyReal precondAnyT
specCRrespectsAccuracy2T tRational "+" add precondAnyReal precondAnyT
specCRrespectsAccuracy2T tDyadic "+" add precondAnyReal precondAnyT
specCRrespectsAccuracy2 "a-b" sub precondAnyReal precondAnyReal
specCRrespectsAccuracy2T tInteger "a-b" sub precondAnyReal precondAnyT
specCRrespectsAccuracy2T tRational "a-b" sub precondAnyReal precondAnyT
specCRrespectsAccuracy2T tDyadic "a-b" sub precondAnyReal precondAnyT
specCRrespectsAccuracy2 "*" mul precondAnyReal precondAnyReal
specCRrespectsAccuracy2T tInteger "*" mul precondAnyReal precondAnyT
specCRrespectsAccuracy2T tRational "*" mul precondAnyReal precondAnyT
specCRrespectsAccuracy2T tDyadic "*" mul precondAnyReal precondAnyT
describe "field" $ do
specCRrespectsAccuracy2CN "/" divide precondAnyReal precondNonZeroReal
specCRrespectsAccuracy2TCN tInteger "/" divide precondAnyReal precondNonZeroT
specCRrespectsAccuracy2TCN tRational "/" divide precondAnyReal precondNonZeroT
specCRrespectsAccuracy2TCN tDyadic "/" divide precondAnyReal precondNonZeroT
describe "elementary" $ do
specCRrespectsAccuracy1CN "sqrt" sqrt precondPositiveReal
specCRrespectsAccuracy1 "exp" exp precondSmallReal
specCRrespectsAccuracy1CN "log" log precondPositiveSmallReal
specCRrespectsAccuracy2CN "pow" pow precondPositiveSmallReal precondSmallReal
specCRrespectsAccuracy2TCN tInteger "pow" pow precondNonZeroReal precondSmallT
specCRrespectsAccuracy2TCN tRational "pow" pow precondPositiveSmallReal precondSmallT
specCRrespectsAccuracy2TCN tDyadic "pow" pow precondPositiveSmallReal precondSmallT
specCRrespectsAccuracy1 "cos" cos precondAnyReal
specCRrespectsAccuracy1 "sine" sin precondAnyReal