{-# OPTIONS_GHC -Wno-orphans #-}
{-|
    Module      :  AERN2.Real.Tests
    Description :  Tests for operations on Cauchy real numbers
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    Tests for operations on Cauchy real numbers.

    To run the tests using stack, execute:

    @
    stack test aern2-real --test-arguments "-a 1000 -m Real"
    @
-}
module AERN2.Real.Tests
  (
    -- specCauchyReal, tCReal
  )
where

import MixedTypesNumPrelude
-- import qualified Prelude as P
-- import Data.Ratio
-- import Text.Printf

import qualified Numeric.CollectErrors as CN

import Test.Hspec
import Test.QuickCheck
-- import qualified Test.Hspec.SmallCheck as SC

-- import AERN2.Norm
import AERN2.MP.Accuracy
--
import AERN2.MP
import AERN2.MP.Dyadic

import AERN2.Real.Type
import AERN2.Real.Field ()

instance Arbitrary CReal where
  arbitrary :: Gen CReal
arbitrary =
    [(Int, Gen CReal)] -> Gen CReal
forall a. [(Int, Gen a)] -> Gen a
frequency
      [(Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
1, Integer -> CReal
forall t. CanBeCReal t => t -> CReal
creal (Integer -> CReal) -> Gen Integer -> Gen CReal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Gen Integer
forall a.
(Arbitrary a, HasOrderCertainly a Integer) =>
Integer -> Gen a
arbitrarySmall Integer
1000000 :: Gen Integer)),
       (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
1, Rational -> CReal
forall t. CanBeCReal t => t -> CReal
creal (Rational -> CReal) -> Gen Rational -> Gen CReal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Gen Rational
forall a.
(Arbitrary a, HasOrderCertainly a Integer) =>
Integer -> Gen a
arbitrarySmall Integer
1000000 :: Gen Rational)),
       (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
2, Integer -> CReal -> CReal
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
(*) (Integer -> CReal -> CReal) -> Gen Integer -> Gen (CReal -> CReal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Gen Integer
forall a.
(Arbitrary a, HasOrderCertainly a Integer) =>
Integer -> Gen a
arbitrarySmall Integer
1000000 :: Gen Integer) Gen (CReal -> CReal) -> Gen CReal -> Gen CReal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen CReal
arbitrarySignedBinary)
      ]
      where
      arbitrarySignedBinary :: Gen CReal
arbitrarySignedBinary =
        [Integer] -> CReal
forall a.
(HasEqAsymmetric a Integer, EqCompareType a Integer ~ Bool) =>
[a] -> CReal
signedBinary2Real ([Integer] -> CReal) -> Gen [Integer] -> Gen CReal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer -> Gen [Integer]
forall a. Gen a -> Gen [a]
infiniteListOf ([Integer] -> Gen Integer
forall a. [a] -> Gen a
elements [-Integer
1,Integer
0,Integer
1])
      signedBinary2Real :: [a] -> CReal
signedBinary2Real [a]
sbits =
        (Precision -> CN MPBall) -> CReal
crealFromPrecFunction ((Precision -> CN MPBall) -> CReal)
-> (Precision -> CN MPBall) -> CReal
forall a b. (a -> b) -> a -> b
$ \ Precision
p -> MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$ [MPBall]
[MulType MPBall Dyadic]
balls [MPBall] -> Precision -> MPBall
forall n a. CanBeInteger n => [a] -> n -> a
!! Precision
p
        where
        balls :: [MulType MPBall Dyadic]
balls = MulType MPBall Dyadic
-> [(a, Precision)] -> [MulType MPBall Dyadic]
forall a t1.
(HasEqAsymmetric a Integer,
 CanAddAsymmetric (MulType t1 Dyadic) (MulType t1 Dyadic),
 CanMulAsymmetric t1 Dyadic, CanSetPrecision (MulType t1 Dyadic),
 IsInterval (MulType t1 Dyadic),
 CanMinMaxAsymmetric
   (IntervalEndpoint (MulType t1 Dyadic))
   (IntervalEndpoint (MulType t1 Dyadic)),
 AddType (MulType t1 Dyadic) (MulType t1 Dyadic) ~ t1,
 EqCompareType a Integer ~ Bool,
 MinMaxType
   (IntervalEndpoint (MulType t1 Dyadic))
   (IntervalEndpoint (MulType t1 Dyadic))
 ~ IntervalEndpoint (MulType t1 Dyadic)) =>
MulType t1 Dyadic -> [(a, Precision)] -> [MulType t1 Dyadic]
nextBit ((Integer, Integer) -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall (Integer
0,Integer
1)) ([(a, Precision)] -> [MulType MPBall Dyadic])
-> [(a, Precision)] -> [MulType MPBall Dyadic]
forall a b. (a -> b) -> a -> b
$ [a] -> [Precision] -> [(a, Precision)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
sbits ((Integer -> Precision) -> [Integer] -> [Precision]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Precision
prec [Integer
10..])
        nextBit :: MulType t1 Dyadic -> [(a, Precision)] -> [MulType t1 Dyadic]
nextBit MulType t1 Dyadic
ball ((a
sbit, Precision
p):[(a, Precision)]
rest) =
          MulType t1 Dyadic
ball MulType t1 Dyadic -> [MulType t1 Dyadic] -> [MulType t1 Dyadic]
forall a. a -> [a] -> [a]
: MulType t1 Dyadic -> [(a, Precision)] -> [MulType t1 Dyadic]
nextBit MulType t1 Dyadic
newBall [(a, Precision)]
rest
          where
          newBall :: MulType t1 Dyadic
newBall =
            case a
sbit of
              (-1) -> MulType t1 Dyadic -> MulType t1 Dyadic -> MulType t1 Dyadic
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals MulType t1 Dyadic
l MulType t1 Dyadic
m
              a
0 -> MulType t1 Dyadic -> MulType t1 Dyadic -> MulType t1 Dyadic
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals MulType t1 Dyadic
l2 MulType t1 Dyadic
r2
              a
1 -> MulType t1 Dyadic -> MulType t1 Dyadic -> MulType t1 Dyadic
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals MulType t1 Dyadic
m MulType t1 Dyadic
r
              a
_ -> [Char] -> MulType t1 Dyadic
forall a. HasCallStack => [Char] -> a
error [Char]
"in Arbitrary CReal"
          (MulType t1 Dyadic
l_,MulType t1 Dyadic
r_) = MulType t1 Dyadic -> (MulType t1 Dyadic, MulType t1 Dyadic)
forall i. IsInterval i => i -> (i, i)
endpointsAsIntervals MulType t1 Dyadic
ball
          l :: MulType t1 Dyadic
l = Precision -> MulType t1 Dyadic -> MulType t1 Dyadic
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p MulType t1 Dyadic
l_
          r :: MulType t1 Dyadic
r = Precision -> MulType t1 Dyadic -> MulType t1 Dyadic
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p MulType t1 Dyadic
r_
          m :: MulType t1 Dyadic
m = (MulType t1 Dyadic
l MulType t1 Dyadic
-> MulType t1 Dyadic
-> AddType (MulType t1 Dyadic) (MulType t1 Dyadic)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ MulType t1 Dyadic
r) t1 -> Dyadic -> MulType t1 Dyadic
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Rational -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic Rational
0.5)
          l2 :: MulType t1 Dyadic
l2 = (MulType t1 Dyadic
l MulType t1 Dyadic
-> MulType t1 Dyadic
-> AddType (MulType t1 Dyadic) (MulType t1 Dyadic)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ MulType t1 Dyadic
m) t1 -> Dyadic -> MulType t1 Dyadic
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Rational -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic Rational
0.5)
          r2 :: MulType t1 Dyadic
r2 = (MulType t1 Dyadic
r MulType t1 Dyadic
-> MulType t1 Dyadic
-> AddType (MulType t1 Dyadic) (MulType t1 Dyadic)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ MulType t1 Dyadic
m) t1 -> Dyadic -> MulType t1 Dyadic
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Rational -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic Rational
0.5)
        nextBit MulType t1 Dyadic
_ [(a, Precision)]
_ = [Char] -> [MulType t1 Dyadic]
forall a. HasCallStack => [Char] -> a
error [Char]
"in Arbitrary CReal"

arbitrarySmall :: (Arbitrary a, HasOrderCertainly a Integer) => Integer -> Gen a
arbitrarySmall :: Integer -> Gen a
arbitrarySmall Integer
limit = Gen a
aux
  where
  aux :: Gen a
aux =
    do
    a
x <- Gen a
forall a. Arbitrary a => Gen a
arbitrary
    if -Integer
limit Integer -> a -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! a
x Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& a
x a -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! Integer
limit
      then a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      else Gen a
aux


{-|
  A runtime representative of type @CReal@.
  Used for specialising polymorphic tests to concrete types.
-}
tCReal :: T CReal
tCReal :: T CReal
tCReal = [Char] -> T CReal
forall t. [Char] -> T t
T [Char]
"CReal"

-- tCauchyRealAtAccuracy :: T CauchyRealAtAccuracy
-- tCauchyRealAtAccuracy = T "CReal(ac)"

specCRrespectsAccuracy1 ::
  String ->
  (CReal -> CReal) ->
  (CReal -> Accuracy -> Bool) ->
  Spec
specCRrespectsAccuracy1 :: [Char] -> (CReal -> CReal) -> (CReal -> Accuracy -> Bool) -> Spec
specCRrespectsAccuracy1 [Char]
opName CReal -> CReal
op CReal -> Accuracy -> Bool
precond =
  [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it ([Char]
opName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" respects accuracy requests") (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
    (CReal -> Accuracy -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((CReal -> Accuracy -> Property) -> Property)
-> (CReal -> Accuracy -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
      \ (CReal
x :: CReal) (Accuracy
ac :: Accuracy) ->
        Accuracy
ac Accuracy -> Accuracy -> OrderCompareType Accuracy Accuracy
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< (Integer -> Accuracy
forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits Integer
1000) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CReal -> Accuracy -> Bool
precond CReal
x Accuracy
ac Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
        case CN MPBall -> Either NumErrors MPBall
forall es v. CanBeErrors es => CollectErrors es v -> Either es v
CN.toEither ((CReal -> CReal
op CReal
x) CReal -> Accuracy -> ExtractedApproximation CReal Accuracy
forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
? Accuracy
ac) of
          Right MPBall
v -> MPBall -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy MPBall
v Accuracy -> Accuracy -> Property
>=$ Accuracy
ac
          Either NumErrors MPBall
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True

(>=$) :: Accuracy -> Accuracy -> Property
>=$ :: Accuracy -> Accuracy -> Property
(>=$) = [Char]
-> (Accuracy -> Accuracy -> Bool)
-> Accuracy
-> Accuracy
-> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
">=" Accuracy -> Accuracy -> Bool
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
(>=)

precondAnyReal :: CReal -> Accuracy -> Bool
precondAnyReal :: CReal -> Accuracy -> Bool
precondAnyReal CReal
_x Accuracy
_ac = Bool
True

precondPositiveReal :: CReal -> Accuracy -> Bool
precondPositiveReal :: CReal -> Accuracy -> Bool
precondPositiveReal CReal
x Accuracy
ac = (CReal
x CReal -> Accuracy -> ExtractedApproximation CReal Accuracy
forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
? Accuracy
ac) CN MPBall -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0

precondNonZeroReal :: CReal -> Accuracy -> Bool
precondNonZeroReal :: CReal -> Accuracy -> Bool
precondNonZeroReal CReal
x Accuracy
ac = (CReal
x CReal -> Accuracy -> ExtractedApproximation CReal Accuracy
forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
? Accuracy
ac) CN MPBall -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!/=! Integer
0

precondSmallReal :: CReal -> Accuracy -> Bool
precondSmallReal :: CReal -> Accuracy -> Bool
precondSmallReal CReal
x Accuracy
ac = CN MPBall -> AbsType (CN MPBall)
forall t. CanAbs t => t -> AbsType t
abs (CReal
x CReal -> Accuracy -> ExtractedApproximation CReal Accuracy
forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
? Accuracy
ac) CN MPBall -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
1000

precondPositiveSmallReal :: CReal -> Accuracy -> Bool
precondPositiveSmallReal :: CReal -> Accuracy -> Bool
precondPositiveSmallReal CReal
x Accuracy
ac = Integer
0 Integer -> CN MPBall -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! CN MPBall
ExtractedApproximation CReal Accuracy
b Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN MPBall
ExtractedApproximation CReal Accuracy
b CN MPBall -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
1000
  where b :: ExtractedApproximation CReal Accuracy
b = CReal
x CReal -> Accuracy -> ExtractedApproximation CReal Accuracy
forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
? Accuracy
ac

-- specCRrespectsAccuracy2 ::
--   String ->
--   (CReal -> CReal -> CReal) ->
--   (CReal -> Accuracy -> Bool) ->
--   (CReal -> Accuracy -> Bool) ->
--   Spec
-- specCRrespectsAccuracy2 opName op =
--   specCRrespectsAccuracy2CN opName (\ a b -> cn (op a b))

-- specCRrespectsAccuracy2CN ::
--   String ->
--   (CReal -> CReal -> CauchyRealCN) ->
--   (CReal -> Accuracy -> Bool) ->
--   (CReal -> Accuracy -> Bool) ->
--   Spec
-- specCRrespectsAccuracy2CN opName op precond1 precond2 =
--   it (opName ++ " respects accuracy requests") $ do
--     property $
--       \ (x :: CReal) (y :: CReal) (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 ->
--   (CReal -> t -> CReal) ->
--   (CReal -> Accuracy -> 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 ->
--   (CReal -> t -> CauchyRealCN) ->
--   (CReal -> Accuracy -> Bool) ->
--   (t -> Bool) ->
--   Spec
-- specCRrespectsAccuracy2TCN (T tName :: T t) opName op precond1 precond2 =
--   it (opName ++ " with " ++ tName ++ " respects accuracy requests") $ do
--     property $
--       \ (x :: CReal) (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 -> Bool
precondAnyT t
_t = Bool
True

precondNonZeroT :: (HasEqCertainly t Integer) => t -> Bool
precondNonZeroT :: t -> Bool
precondNonZeroT t
t = t
t t -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!/=! Integer
0

precondSmallT :: (HasOrderCertainly t Integer) => t -> Bool
precondSmallT :: t -> Bool
precondSmallT t
t = -Integer
1000 Integer -> t -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! t
t Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
t t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! Integer
1000

-- specCauchyReal :: Spec
-- specCauchyReal =
--   describe ("CReal") $ do
--     -- specConversion tInteger tCauchyReal real (fst . integerBounds)
--     describe "order" $ do
--       specHasEqNotMixed tCReal
--       -- specHasEq tInt tCReal tRational
--       -- specCanPickNonZero tCReal
--       specHasOrderNotMixed tCReal
--       -- specHasOrder tInt tCReal tRational
    -- 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