{-# LANGUAGE DeriveDataTypeable #-}
{-|
    Module      :  AERN2.MP.ErrorBound
    Description :  Fixed precision non-negative up-rounded floating-point numbers
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Fixed precision non-negative up-rounded floating-point numbers.

    Currently using a fixed-precision MPFloat.
-}
module AERN2.MP.ErrorBound
    (ErrorBound, CanBeErrorBound, errorBound,
     absMP, subMP)
where

import MixedTypesNumPrelude
import qualified Prelude as P

import Data.Typeable
import GHC.Generics (Generic)
import Control.DeepSeq

import Test.QuickCheck

-- import Data.Convertible

import Math.NumberTheory.Logarithms (integerLog2)

import AERN2.MP.Precision
import AERN2.MP.Accuracy
import qualified AERN2.MP.Float as MPFloat
import AERN2.MP.Float (MPFloat, mpFloat, frequencyElements, one, ceduUp)
import AERN2.MP.Float.Operators
import AERN2.MP.Dyadic

{- example -}

_example1 :: ErrorBound
_example1 :: ErrorBound
_example1 = Integer
2forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*((forall t. CanBeErrorBound t => t -> ErrorBound
errorBound Rational
0.01) forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Rational
0.1forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(forall t. CanBeErrorBound t => t -> ErrorBound
errorBound Rational
0.01)forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
3)

{- type -}

{-| A non-negative Double value to serve as an error bound. Arithmetic is rounded towards +infinity. -}
newtype ErrorBound = ErrorBound { ErrorBound -> MPFloat
er2mp :: MPFloat }
  deriving (ErrorBound -> ErrorBound -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorBound -> ErrorBound -> Bool
$c/= :: ErrorBound -> ErrorBound -> Bool
== :: ErrorBound -> ErrorBound -> Bool
$c== :: ErrorBound -> ErrorBound -> Bool
P.Eq, Eq ErrorBound
ErrorBound -> ErrorBound -> Bool
ErrorBound -> ErrorBound -> Ordering
ErrorBound -> ErrorBound -> ErrorBound
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorBound -> ErrorBound -> ErrorBound
$cmin :: ErrorBound -> ErrorBound -> ErrorBound
max :: ErrorBound -> ErrorBound -> ErrorBound
$cmax :: ErrorBound -> ErrorBound -> ErrorBound
>= :: ErrorBound -> ErrorBound -> Bool
$c>= :: ErrorBound -> ErrorBound -> Bool
> :: ErrorBound -> ErrorBound -> Bool
$c> :: ErrorBound -> ErrorBound -> Bool
<= :: ErrorBound -> ErrorBound -> Bool
$c<= :: ErrorBound -> ErrorBound -> Bool
< :: ErrorBound -> ErrorBound -> Bool
$c< :: ErrorBound -> ErrorBound -> Bool
compare :: ErrorBound -> ErrorBound -> Ordering
$ccompare :: ErrorBound -> ErrorBound -> Ordering
P.Ord, Typeable, forall x. Rep ErrorBound x -> ErrorBound
forall x. ErrorBound -> Rep ErrorBound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorBound x -> ErrorBound
$cfrom :: forall x. ErrorBound -> Rep ErrorBound x
Generic)

instance NFData ErrorBound

instance Show ErrorBound where
    show :: ErrorBound -> String
show (ErrorBound MPFloat
d) = forall a. Show a => a -> String
show MPFloat
d

errorBoundPrecision :: Precision
errorBoundPrecision :: Precision
errorBoundPrecision = Integer -> Precision
prec Integer
53

instance HasAccuracy ErrorBound where
  getAccuracy :: ErrorBound -> Accuracy
getAccuracy (ErrorBound MPFloat
e)
      | RoundType Rational
eN forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 =
          forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits forall a b. (a -> b) -> a -> b
$ forall t. CanNeg t => t -> NegType t
negate forall a b. (a -> b) -> a -> b
$ Integer -> Int
integerLog2 RoundType Rational
eN
      | MPFloat
e forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& RoundType Rational
eRecipN forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 =
          forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits forall a b. (a -> b) -> a -> b
$ Integer -> Int
integerLog2 RoundType Rational
eRecipN
      | MPFloat
e forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = Accuracy
Exact
      | Bool
otherwise = Accuracy
NoInformation
      where
      eN :: RoundType Rational
eN = forall t. CanRound t => t -> RoundType t
floor forall a b. (a -> b) -> a -> b
$ forall t. CanBeRational t => t -> Rational
rational MPFloat
e
      eRecipN :: RoundType Rational
eRecipN = forall t. CanRound t => t -> RoundType t
ceiling forall a b. (a -> b) -> a -> b
$ forall t. CanBeRational t => t -> Rational
rational forall a b. (a -> b) -> a -> b
$ MPFloat
one MPFloat -> MPFloat -> MPFloat
/. MPFloat
e
  getFiniteAccuracy :: ErrorBound -> Accuracy
getFiniteAccuracy eb :: ErrorBound
eb@(ErrorBound MPFloat
e) 
    | MPFloat
e forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits Precision
errorBoundPrecision
    | Bool
otherwise = forall a. HasAccuracy a => a -> Accuracy
getAccuracy ErrorBound
eb


{- conversions -}

instance ConvertibleExactly ErrorBound ErrorBound where
  safeConvertExactly :: ErrorBound -> ConvertResult ErrorBound
safeConvertExactly = forall a b. b -> Either a b
Right

instance ConvertibleExactly ErrorBound MPFloat where
  safeConvertExactly :: ErrorBound -> ConvertResult MPFloat
safeConvertExactly = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorBound -> MPFloat
er2mp

instance ConvertibleExactly ErrorBound Dyadic where
  safeConvertExactly :: ErrorBound -> ConvertResult Dyadic
safeConvertExactly = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeDyadic t => t -> Dyadic
dyadic forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorBound -> MPFloat
er2mp

instance ConvertibleExactly ErrorBound Rational where
  safeConvertExactly :: ErrorBound -> ConvertResult Rational
safeConvertExactly = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeMPFloat t => t -> MPFloat
mpFloat

type CanBeErrorBound t = Convertible t ErrorBound
errorBound :: (CanBeErrorBound t) => t -> ErrorBound
errorBound :: forall t. CanBeErrorBound t => t -> ErrorBound
errorBound = forall a b. Convertible a b => a -> b
convert

instance Convertible Rational ErrorBound where
  safeConvert :: Rational -> ConvertResult ErrorBound
safeConvert Rational
x
    | Rational
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Integer
0 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ Precision -> Rational -> MPFloat
MPFloat.fromRationalUp Precision
errorBoundPrecision Rational
x
    | Bool
otherwise = forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
"Trying to construct a negative ErrorBound" Rational
x

instance Convertible MPFloat ErrorBound where
  safeConvert :: MPFloat -> ConvertResult ErrorBound
safeConvert MPFloat
x
    | MPFloat
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Integer
0 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ forall a. BoundsCEDU a -> a
ceduUp forall a b. (a -> b) -> a -> b
$ Precision -> MPFloat -> BoundsCEDU MPFloat
MPFloat.setPrecisionCEDU Precision
errorBoundPrecision MPFloat
x
    | Bool
otherwise = forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
"Trying to construct a negative ErrorBound" MPFloat
x

instance Convertible Integer ErrorBound where
  safeConvert :: Integer -> ConvertResult ErrorBound
safeConvert Integer
x
    | Integer
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Integer
0 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ Precision -> Integer -> MPFloat
MPFloat.fromIntegerUp Precision
errorBoundPrecision Integer
x
    | Bool
otherwise = forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
"Trying to construct a negative ErrorBound" Integer
x

instance Convertible Int ErrorBound where
  safeConvert :: Int -> ConvertResult ErrorBound
safeConvert = forall a b. Convertible a b => a -> ConvertResult b
safeConvert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInteger t => t -> Integer
integer

{- comparisons -}

instance HasOrderAsymmetric ErrorBound ErrorBound

instance HasOrderAsymmetric ErrorBound MPFloat where
  lessThan :: ErrorBound -> MPFloat -> OrderCompareType ErrorBound MPFloat
lessThan = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: ErrorBound -> MPFloat -> OrderCompareType ErrorBound MPFloat
leq = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric MPFloat ErrorBound where
  lessThan :: MPFloat -> ErrorBound -> OrderCompareType MPFloat ErrorBound
lessThan = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: MPFloat -> ErrorBound -> OrderCompareType MPFloat ErrorBound
leq = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq

instance HasEqAsymmetric ErrorBound Rational where
  equalTo :: ErrorBound -> Rational -> EqCompareType ErrorBound Rational
equalTo = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Rational ErrorBound where
  equalTo :: Rational -> ErrorBound -> EqCompareType Rational ErrorBound
equalTo = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasOrderAsymmetric ErrorBound Rational where
  lessThan :: ErrorBound -> Rational -> OrderCompareType ErrorBound Rational
lessThan = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: ErrorBound -> Rational -> OrderCompareType ErrorBound Rational
leq = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Rational ErrorBound where
  lessThan :: Rational -> ErrorBound -> OrderCompareType Rational ErrorBound
lessThan = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Rational -> ErrorBound -> OrderCompareType Rational ErrorBound
leq = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq

instance HasEqAsymmetric ErrorBound Integer where
  equalTo :: ErrorBound -> Integer -> EqCompareType ErrorBound Integer
equalTo ErrorBound
a Integer
b = forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
b)
instance HasEqAsymmetric Integer ErrorBound where
  equalTo :: Integer -> ErrorBound -> EqCompareType Integer ErrorBound
equalTo Integer
a ErrorBound
b = forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo (forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
b)
instance HasOrderAsymmetric ErrorBound Integer where
  lessThan :: ErrorBound -> Integer -> OrderCompareType ErrorBound Integer
lessThan ErrorBound
a Integer
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
b)
  leq :: ErrorBound -> Integer -> OrderCompareType ErrorBound Integer
leq ErrorBound
a Integer
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
b)
instance HasOrderAsymmetric Integer ErrorBound where
  lessThan :: Integer -> ErrorBound -> OrderCompareType Integer ErrorBound
lessThan Integer
a ErrorBound
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan (forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
b)
  leq :: Integer -> ErrorBound -> OrderCompareType Integer ErrorBound
leq Integer
a ErrorBound
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq (forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
b)

instance HasEqAsymmetric ErrorBound Int where
  equalTo :: ErrorBound -> Int -> EqCompareType ErrorBound Int
equalTo ErrorBound
a Int
b = forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic Int
b)
instance HasEqAsymmetric Int ErrorBound where
  equalTo :: Int -> ErrorBound -> EqCompareType Int ErrorBound
equalTo Int
a ErrorBound
b = forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo (forall t. CanBeDyadic t => t -> Dyadic
dyadic Int
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
b)
instance HasOrderAsymmetric ErrorBound Int where
  lessThan :: ErrorBound -> Int -> OrderCompareType ErrorBound Int
lessThan ErrorBound
a Int
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic Int
b)
  leq :: ErrorBound -> Int -> OrderCompareType ErrorBound Int
leq ErrorBound
a Int
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic Int
b)
instance HasOrderAsymmetric Int ErrorBound where
  lessThan :: Int -> ErrorBound -> OrderCompareType Int ErrorBound
lessThan Int
a ErrorBound
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan (forall t. CanBeDyadic t => t -> Dyadic
dyadic Int
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
b)
  leq :: Int -> ErrorBound -> OrderCompareType Int ErrorBound
leq Int
a ErrorBound
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq (forall t. CanBeDyadic t => t -> Dyadic
dyadic Int
a) (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
b)

instance CanMinMaxAsymmetric ErrorBound ErrorBound

{- converting operations -}

subMP :: MPFloat -> MPFloat -> ErrorBound
MPFloat
a subMP :: MPFloat -> MPFloat -> ErrorBound
`subMP` MPFloat
b = forall t. CanBeErrorBound t => t -> ErrorBound
errorBound forall a b. (a -> b) -> a -> b
$ MPFloat
a MPFloat -> MPFloat -> MPFloat
-^ MPFloat
b

absMP :: MPFloat -> ErrorBound
absMP :: MPFloat -> ErrorBound
absMP = forall t. CanBeErrorBound t => t -> ErrorBound
errorBound forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanAbs t => t -> AbsType t
abs

{- up-rounded operations -}

instance CanAddAsymmetric ErrorBound ErrorBound where
    add :: ErrorBound -> ErrorBound -> AddType ErrorBound ErrorBound
add (ErrorBound MPFloat
a) (ErrorBound MPFloat
b) = MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ MPFloat
a MPFloat -> MPFloat -> MPFloat
+^ MPFloat
b

instance CanAddAsymmetric ErrorBound MPFloat where
  type AddType ErrorBound MPFloat = ErrorBound
  add :: ErrorBound -> MPFloat -> AddType ErrorBound MPFloat
add = forall a b c. (a -> b -> a) -> (a -> a -> c) -> a -> b -> c
convertSecondUsing (\ ErrorBound
_ MPFloat
f -> forall a b. Convertible a b => a -> b
convert MPFloat
f) forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric MPFloat ErrorBound where
  type AddType MPFloat ErrorBound = ErrorBound
  add :: MPFloat -> ErrorBound -> AddType MPFloat ErrorBound
add = forall a b c. (a -> b -> b) -> (b -> b -> c) -> a -> b -> c
convertFirstUsing (\ MPFloat
f ErrorBound
_ -> forall a b. Convertible a b => a -> b
convert MPFloat
f) forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance CanMulAsymmetric ErrorBound ErrorBound where
    mul :: ErrorBound -> ErrorBound -> MulType ErrorBound ErrorBound
mul (ErrorBound MPFloat
a) (ErrorBound MPFloat
b) = MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ MPFloat
a MPFloat -> MPFloat -> MPFloat
*^ MPFloat
b

instance CanMulAsymmetric ErrorBound MPFloat where
  type MulType ErrorBound MPFloat = ErrorBound
  mul :: ErrorBound -> MPFloat -> MulType ErrorBound MPFloat
mul = forall a b c. (a -> b -> a) -> (a -> a -> c) -> a -> b -> c
convertSecondUsing (\ ErrorBound
_ MPFloat
f -> forall a b. Convertible a b => a -> b
convert MPFloat
f) forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric MPFloat ErrorBound where
  type MulType MPFloat ErrorBound = ErrorBound
  mul :: MPFloat -> ErrorBound -> MulType MPFloat ErrorBound
mul = forall a b c. (a -> b -> b) -> (b -> b -> c) -> a -> b -> c
convertFirstUsing (\ MPFloat
f ErrorBound
_ -> forall a b. Convertible a b => a -> b
convert MPFloat
f) forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric ErrorBound Integer where
    type MulType ErrorBound Integer = ErrorBound
    mul :: ErrorBound -> Integer -> MulType ErrorBound Integer
mul (ErrorBound MPFloat
a) Integer
i
        | Integer
i forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Integer
0 = MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ MPFloat
a MPFloat -> MPFloat -> MPFloat
*^ (Precision -> Integer -> MPFloat
MPFloat.fromIntegerUp Precision
errorBoundPrecision Integer
i)
        | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"trying to multiply ErrorBound by a negative integer"
instance CanMulAsymmetric Integer ErrorBound where
    type MulType Integer ErrorBound = ErrorBound
    mul :: Integer -> ErrorBound -> MulType Integer ErrorBound
mul Integer
i (ErrorBound MPFloat
b)
        | Integer
i forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Integer
0 = MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ (Precision -> Integer -> MPFloat
MPFloat.fromIntegerUp Precision
errorBoundPrecision Integer
i) MPFloat -> MPFloat -> MPFloat
*^ MPFloat
b
        | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"trying to multiply ErrorBound by a negative integer"

instance CanMulAsymmetric ErrorBound Rational where
    type MulType ErrorBound Rational = ErrorBound
    mul :: ErrorBound -> Rational -> MulType ErrorBound Rational
mul (ErrorBound MPFloat
a) Rational
r
        | Rational
r forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Rational
0.0 = MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ MPFloat
a MPFloat -> MPFloat -> MPFloat
*^ (Precision -> Rational -> MPFloat
MPFloat.fromRationalUp Precision
errorBoundPrecision Rational
r)
        | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"trying to multiply ErrorBound by a negative integer"
instance CanMulAsymmetric Rational ErrorBound where
    type MulType Rational ErrorBound = ErrorBound
    mul :: Rational -> ErrorBound -> MulType Rational ErrorBound
mul Rational
r (ErrorBound MPFloat
b)
        | Rational
r forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Rational
0.0 = MPFloat -> ErrorBound
ErrorBound forall a b. (a -> b) -> a -> b
$ (Precision -> Rational -> MPFloat
MPFloat.fromRationalUp Precision
errorBoundPrecision Rational
r) MPFloat -> MPFloat -> MPFloat
*^ MPFloat
b
        | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"trying to multiply ErrorBound by a negative integer"

instance CanDiv ErrorBound Integer where
    type DivType ErrorBound Integer = ErrorBound
    divide :: ErrorBound -> Integer -> DivType ErrorBound Integer
divide = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
    -- divide (ErrorBound a) i
    --     | i > 0 = ErrorBound $ a /^ (MPFloat.fromIntegerUp errorBoundPrecision i)
    --     | otherwise = error "trying to multiply ErrorBound by a non-positive integer"

instance Arbitrary ErrorBound where
  arbitrary :: Gen ErrorBound
arbitrary =
    do
    Bool
giveSpecialValue <- forall t a. ConvertibleExactly t Int => [(t, a)] -> Gen a
frequencyElements [(Integer
5, Bool
False),(Integer
1, Bool
True)]
    forall {a}. Convertible Rational a => Bool -> Gen a
aux Bool
giveSpecialValue
    where
      aux :: Bool -> Gen a
aux Bool
giveSpecialValue
        | Bool
giveSpecialValue =
            forall a. [a] -> Gen a
elements (forall a b. (a -> b) -> [a] -> [b]
map forall a b. Convertible a b => a -> b
convert [Rational
0.0,Rational
0.0,Rational
0.0,Rational
10.0,Rational
1.0,Rational
0.5,Rational
0.125])
        | Bool
otherwise =
          do
          (Integer
s :: Integer) <- forall a. Arbitrary a => Gen a
arbitrary
          let resultR :: DivType Integer Integer
resultR = ((forall t. CanAbs t => t -> AbsType t
abs Integer
s) forall a. Integral a => a -> a -> a
`P.mod` (Integer
2forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
35))forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/(Integer
2forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
32)
          let result :: a
result = forall a b. Convertible a b => a -> b
convert DivType Integer Integer
resultR
          forall (m :: * -> *) a. Monad m => a -> m a
return a
result