{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-|
    Module      :  AERN2.MP.Ball.Type
    Description :  Arbitrary precision dyadic balls
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Arbitrary precision dyadic balls
-}
module AERN2.MP.Ball.Type
(
  -- * Auxiliary types
  module AERN2.MP.Precision
  , module AERN2.MP.Accuracy
  , module AERN2.MP.Enclosure
  -- * The Ball type
  , MPBall(..), CanBeMPBall, mpBall, cnMPBall
  , CanBeMPBallP, mpBallP, cnMPBallP
  , reducePrecionIfInaccurate
  -- * Ball construction/extraction functions
  , fromMPFloatEndpoints
  , mpBallEndpoints, fromMPBallEndpoints
)
where

import MixedTypesNumPrelude
-- import qualified Prelude as P

import qualified Numeric.CollectErrors as CN

import GHC.Generics (Generic)
import Control.DeepSeq

import qualified Data.List as List

import Text.Printf

import AERN2.Normalize

import AERN2.Norm

import AERN2.MP.Dyadic
import qualified AERN2.MP.Float as MPFloat
import AERN2.MP.Float (MPFloat, mpFloat)
import AERN2.MP.Float.Operators
import AERN2.MP.Precision
import AERN2.MP.Accuracy
import AERN2.MP.ErrorBound (ErrorBound, errorBound)
import AERN2.MP.Enclosure

data MPBall = MPBall
  { MPBall -> MPFloat
ball_value :: MPFloat
  , MPBall -> ErrorBound
ball_error :: ErrorBound
  }
  -- { ball_value :: {-# UNPACK #-} ! MPFloat
  -- , ball_error :: {-# UNPACK #-} ! ErrorBound
  -- }
  deriving ((forall x. MPBall -> Rep MPBall x)
-> (forall x. Rep MPBall x -> MPBall) -> Generic MPBall
forall x. Rep MPBall x -> MPBall
forall x. MPBall -> Rep MPBall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MPBall x -> MPBall
$cfrom :: forall x. MPBall -> Rep MPBall x
Generic)

instance NFData MPBall

instance Show MPBall where
  show :: MPBall -> String
show  = Accuracy -> MPBall -> String
forall t. ShowWithAccuracy t => Accuracy -> t -> String
showWithAccuracy (Integer -> Accuracy
forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits Integer
50)

instance ShowWithAccuracy MPBall where
  showWithAccuracy :: Accuracy -> MPBall -> String
showWithAccuracy Accuracy
displayAC b :: MPBall
b@(MPBall MPFloat
x ErrorBound
e) =
    -- printf "[%s ± %s](prec=%s)" (show x) (showAC $ getAccuracy b) (show $ integer $ getPrecision b)
    String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"[%s ± %s%s]" (ShowS
dropSomeDigits ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ MPFloat -> String
forall a. Show a => a -> String
show MPFloat
x) String
eDS (Accuracy -> String
showAC (Accuracy -> String) -> Accuracy -> String
forall a b. (a -> b) -> a -> b
$ MPBall -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy MPBall
b)
    -- "[" ++ show x ++ " ± " ++ show e ++ "](prec=" ++ (show $ integer $ getPrecision x) ++ ")"
    where
    eDS :: String
eDS 
      | ErrorBound
e ErrorBound -> Integer -> EqCompareType ErrorBound Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = String
"0"
      | Bool
otherwise  =
        case Dyadic -> ConvertResult Double
forall a b. Convertible a b => a -> ConvertResult b
safeConvert (ErrorBound -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
e) of
          Right (Double
eD :: Double) -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"~%.4g" (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
eD
          ConvertResult Double
_ -> String
""
    dropSomeDigits :: ShowS
dropSomeDigits String
s =
      case (Char -> Bool) -> String -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (Char -> Char -> EqCompareType Char Char
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Char
'.') String
s of
        Maybe Int
Nothing -> String
s
        Just Int
ix -> Int -> IfThenElseType Bool String
withDotIx Int
ix
      where
      withDotIx :: Int -> IfThenElseType Bool String
withDotIx Int
ix =
        let maxLength :: AddType Int Integer
maxLength = Int
ix Int -> Integer -> AddType Int Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
displayAC_n in
        let sTrimmed :: String
sTrimmed = Integer -> ShowS
forall n a. CanBeInteger n => n -> [a] -> [a]
take Integer
AddType Int Integer
maxLength String
s in
        if String -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length String
sTrimmed Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
AddType Int Integer
maxLength
          then String
sTrimmed
          else (Integer -> ShowS
forall n a. CanBeInteger n => n -> [a] -> [a]
take (Integer
AddType Int Integer
maxLength Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
3) String
sTrimmed) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"..."
    displayAC_n :: Integer
displayAC_n = 
      case Accuracy
displayAC of
        Accuracy
Exact -> Integer
1000000000
        Accuracy
NoInformation -> Integer
0
        Accuracy
_ -> Double -> RoundType Double
forall t. CanRound t => t -> RoundType t
round (Double -> RoundType Double) -> Double -> RoundType Double
forall a b. (a -> b) -> a -> b
$ (Double -> LogType Double
forall t. CanLog t => t -> LogType t
log (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
2)Double -> Double -> DivType Double Double
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Double -> LogType Double
forall t. CanLog t => t -> LogType t
log (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
10)) Double -> Integer -> MulType Double Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Precision -> Integer
forall t. CanBeInteger t => t -> Integer
integer (Precision -> Integer) -> Precision -> Integer
forall a b. (a -> b) -> a -> b
$ Accuracy -> Precision
ac2prec Accuracy
displayAC)
    showAC :: Accuracy -> String
showAC Accuracy
Exact = String
""
    showAC Accuracy
NoInformation = String
"(oo)"
    showAC Accuracy
ac = String
" ~2^(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer -> NegType Integer
forall t. CanNeg t => t -> NegType t
negate (Integer -> NegType Integer) -> Integer -> NegType Integer
forall a b. (a -> b) -> a -> b
$ Accuracy -> Integer
fromAccuracy Accuracy
ac) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    
instance CanTestIsIntegerType MPBall -- False by default

instance CanTestValid MPBall where
  isValid :: MPBall -> Bool
isValid = MPBall -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite

instance CanTestNaN MPBall where
  isNaN :: MPBall -> Bool
isNaN = Bool -> Bool
forall t. CanNeg t => t -> NegType t
not (Bool -> Bool) -> (MPBall -> Bool) -> MPBall -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPBall -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite
instance CanTestFinite MPBall where
  isInfinite :: MPBall -> Bool
isInfinite = Bool -> MPBall -> Bool
forall a b. a -> b -> a
const Bool
False
  isFinite :: MPBall -> Bool
isFinite (MPBall MPFloat
x ErrorBound
e) = MPFloat -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite MPFloat
x Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPFloat -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite (ErrorBound -> MPFloat
forall t. CanBeMPFloat t => t -> MPFloat
mpFloat ErrorBound
e)

instance CanNormalize MPBall where
  normalize :: MPBall -> MPBall
normalize MPBall
b
    | MPBall -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite MPBall
b =
        MPBall
b
        -- reducePrecionIfInaccurate b
    | Bool
otherwise = String -> MPBall
forall a. HasCallStack => String -> a
error (String -> MPBall) -> String -> MPBall
forall a b. (a -> b) -> a -> b
$ String
"invalid MPBall: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MPBall -> String
forall a. Show a => a -> String
show MPBall
b

{-|
    Reduce the precision of the ball centre if the
    accuracy of the ball is poor.

    More precisely, reduce the precision of the centre
    so that the ulp is approximately (radius / 1024),
    unless the ulp is already lower than this.
-}
reducePrecionIfInaccurate :: MPBall -> MPBall
reducePrecionIfInaccurate :: MPBall -> MPBall
reducePrecionIfInaccurate b :: MPBall
b@(MPBall MPFloat
x ErrorBound
_) =
    case (Accuracy
bAcc, NormLog
bNorm) of
        (Accuracy
Exact, NormLog
_) -> MPBall
b
        (Accuracy
_, NormLog
NormZero) -> MPBall
b
        (Accuracy, NormLog)
_ | Precision
p_e_nb Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Precision
p_x -> Precision -> MPBall -> MPBall
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p_e_nb MPBall
b
        (Accuracy, NormLog)
_ -> MPBall
b
    where
    bAcc :: Accuracy
bAcc = MPBall -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy MPBall
b
    bNorm :: NormLog
bNorm = MPBall -> NormLog
forall a. HasNorm a => a -> NormLog
getNormLog MPBall
b
    p_x :: Precision
p_x = MPFloat -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision MPFloat
x
    p_e_nb :: Precision
p_e_nb = Integer -> Precision
prec (Integer -> Precision) -> Integer -> Precision
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
2 (Integer
10 Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
nb Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Accuracy -> Integer
fromAccuracy Accuracy
bAcc)
    (NormBits Integer
nb) = NormLog
bNorm

instance CanGiveUpIfVeryInaccurate MPBall where
  giveUpIfVeryInaccurate :: CN MPBall -> CN MPBall
giveUpIfVeryInaccurate = (MPBall -> CN MPBall
aux (MPBall -> CN MPBall) -> CN MPBall -> CN MPBall
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
    where
    aux :: MPBall -> CN MPBall
aux b :: MPBall
b@(MPBall MPFloat
_ ErrorBound
e)
      | ErrorBound
e ErrorBound -> Integer -> OrderCompareType ErrorBound Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
1000000 = NumError -> CN MPBall
forall v. NumError -> CN v
CN.noValueNumErrorPotential (NumError -> CN MPBall) -> NumError -> CN MPBall
forall a b. (a -> b) -> a -> b
$ String -> String -> NumError
numErrorVeryInaccurate String
"MPBall" String
""
      | Bool
otherwise = MPBall -> CN MPBall
forall v. v -> CN v
cn MPBall
b

{- ball construction/extraction functions -}

instance IsInterval MPBall where
  type IntervalEndpoint MPBall = MPFloat
  fromEndpoints :: IntervalEndpoint MPBall -> IntervalEndpoint MPBall -> MPBall
fromEndpoints IntervalEndpoint MPBall
l IntervalEndpoint MPBall
u
    | MPFloat
IntervalEndpoint MPBall
u MPFloat -> MPFloat -> OrderCompareType MPFloat MPFloat
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< MPFloat
IntervalEndpoint MPBall
l = IntervalEndpoint MPBall -> IntervalEndpoint MPBall -> MPBall
forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints IntervalEndpoint MPBall
u IntervalEndpoint MPBall
l
    | Bool
otherwise =
      MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
c (MPFloat -> ErrorBound
forall t. CanBeErrorBound t => t -> ErrorBound
errorBound MinMaxType MPFloat MPFloat
MPFloat
e)
      where
      c :: MPFloat
c = (MPFloat
IntervalEndpoint MPBall
l MPFloat -> MPFloat -> MPFloat
+. MPFloat
IntervalEndpoint MPBall
u) MPFloat -> MPFloat -> MPFloat
*. (Dyadic -> MPFloat
forall t. CanBeMPFloat t => t -> MPFloat
mpFloat (Dyadic -> MPFloat) -> Dyadic -> MPFloat
forall a b. (a -> b) -> a -> b
$ Rational -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic Rational
0.5)
      e :: MinMaxType MPFloat MPFloat
e = (MPFloat
IntervalEndpoint MPBall
u MPFloat -> MPFloat -> MPFloat
-^ MPFloat
c) MPFloat -> MPFloat -> MinMaxType MPFloat MPFloat
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` (MPFloat
c MPFloat -> MPFloat -> MPFloat
-^ MPFloat
IntervalEndpoint MPBall
l)
  endpoints :: MPBall -> (IntervalEndpoint MPBall, IntervalEndpoint MPBall)
endpoints (MPBall MPFloat
x ErrorBound
e) = (MPFloat
IntervalEndpoint MPBall
l, MPFloat
IntervalEndpoint MPBall
u)
      where
      eFl :: MPFloat
eFl = ErrorBound -> MPFloat
forall t. CanBeMPFloat t => t -> MPFloat
mpFloat ErrorBound
e
      l :: MPFloat
l   = MPFloat
x MPFloat -> MPFloat -> MPFloat
-. MPFloat
eFl
      u :: MPFloat
u   = MPFloat
x MPFloat -> MPFloat -> MPFloat
+^ MPFloat
eFl

fromMPFloatEndpoints :: MPFloat -> MPFloat -> MPBall
fromMPFloatEndpoints :: MPFloat -> MPFloat -> MPBall
fromMPFloatEndpoints = MPFloat -> MPFloat -> MPBall
forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints

fromMPBallEndpoints :: MPBall -> MPBall -> MPBall
fromMPBallEndpoints :: MPBall -> MPBall -> MPBall
fromMPBallEndpoints = MPBall -> MPBall -> MPBall
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals

mpBallEndpoints :: MPBall -> (MPBall, MPBall)
mpBallEndpoints :: MPBall -> (MPBall, MPBall)
mpBallEndpoints = MPBall -> (MPBall, MPBall)
forall i. IsInterval i => i -> (i, i)
endpointsAsIntervals

instance IsBall MPBall where
  type CentreType MPBall = Dyadic
  centre :: MPBall -> CentreType MPBall
centre (MPBall MPFloat
cMP ErrorBound
_e) = MPFloat -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic MPFloat
cMP
  centreAsBallAndRadius :: MPBall -> (MPBall, ErrorBound)
centreAsBallAndRadius MPBall
x = (MPBall
cB,ErrorBound
e)
    where
    (MPBall MPFloat
cMP ErrorBound
e) = MPBall
x
    cB :: MPBall
cB = MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
cMP (Integer -> ErrorBound
forall t. CanBeErrorBound t => t -> ErrorBound
errorBound Integer
0)
  radius :: MPBall -> ErrorBound
radius (MPBall MPFloat
_ ErrorBound
e) = ErrorBound
e
  updateRadius :: (ErrorBound -> ErrorBound) -> MPBall -> MPBall
updateRadius ErrorBound -> ErrorBound
updateFn (MPBall MPFloat
c ErrorBound
e) = MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
c (ErrorBound -> ErrorBound
updateFn ErrorBound
e)

{--- constructing a ball with a given precision ---}

type CanBeMPBallP t = (ConvertibleWithPrecision t MPBall)

mpBallP :: (CanBeMPBallP t) => Precision -> t -> MPBall
mpBallP :: Precision -> t -> MPBall
mpBallP = Precision -> t -> MPBall
forall t1 t2.
ConvertibleWithPrecision t1 t2 =>
Precision -> t1 -> t2
convertP

cnMPBallP :: (CanBeMPBallP a) => Precision -> CN a -> CN MPBall
cnMPBallP :: Precision -> CN a -> CN MPBall
cnMPBallP Precision
p = (a -> MPBall) -> CN a -> CN MPBall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Precision -> a -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p)

{--- constructing an exact ball ---}

type CanBeMPBall t = ConvertibleExactly t MPBall

mpBall :: (CanBeMPBall t) => t -> MPBall
mpBall :: t -> MPBall
mpBall = t -> MPBall
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

cnMPBall :: (CanBeMPBall a) => CN a -> CN MPBall
cnMPBall :: CN a -> CN MPBall
cnMPBall = (a -> MPBall) -> CN a -> CN MPBall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall


{-- extracting approximate information about a ball --}

instance HasAccuracy MPBall where
    getAccuracy :: MPBall -> Accuracy
getAccuracy = ErrorBound -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy (ErrorBound -> Accuracy)
-> (MPBall -> ErrorBound) -> MPBall -> Accuracy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPBall -> ErrorBound
ball_error

instance HasNorm MPBall where
    getNormLog :: MPBall -> NormLog
getNormLog MPBall
ball = MPFloat -> NormLog
forall a. HasNorm a => a -> NormLog
getNormLog MPFloat
boundMP
        where
        (MPBall
_, MPBall MPFloat
boundMP ErrorBound
_) = MPBall -> (MPBall, MPBall)
mpBallEndpoints (MPBall -> (MPBall, MPBall)) -> MPBall -> (MPBall, MPBall)
forall a b. (a -> b) -> a -> b
$ MPBall -> MPBall
absRaw MPBall
ball

instance HasApproximate MPBall where
    type Approximate MPBall = (MPFloat, Bool)
    getApproximate :: Accuracy -> MPBall -> Approximate MPBall
getApproximate Accuracy
ac b :: MPBall
b@(MPBall MPFloat
x ErrorBound
e) =
        (MPFloat
approx, Bool
OrderCompareType Accuracy Accuracy
isAccurate)
        where
        isAccurate :: OrderCompareType Accuracy Accuracy
isAccurate = MPBall -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy MPBall
b Accuracy -> Accuracy -> OrderCompareType Accuracy Accuracy
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Accuracy
ac
        approx :: MPFloat
approx
            | Bool
OrderCompareType MPFloat ErrorBound
closeToN = MPFloat
n
            | Bool
otherwise = BoundsCEDU MPFloat -> MPFloat
forall a. BoundsCEDU a -> a
MPFloat.ceduCentre (BoundsCEDU MPFloat -> MPFloat) -> BoundsCEDU MPFloat -> MPFloat
forall a b. (a -> b) -> a -> b
$ Precision -> MPFloat -> BoundsCEDU MPFloat
MPFloat.setPrecisionCEDU (Integer -> Precision
prec (Accuracy -> Integer
fromAccuracy Accuracy
ac)) MPFloat
x
            where
            n :: MPFloat
n = Integer -> MPFloat
forall t. CanBeMPFloat t => t -> MPFloat
mpFloat (Integer -> MPFloat) -> Integer -> MPFloat
forall a b. (a -> b) -> a -> b
$ Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
round (Rational -> RoundType Rational) -> Rational -> RoundType Rational
forall a b. (a -> b) -> a -> b
$ MPFloat -> Rational
forall t. CanBeRational t => t -> Rational
rational MPFloat
x
            closeToN :: OrderCompareType MPFloat ErrorBound
closeToN = ((MPFloat -> AbsType MPFloat
forall t. CanAbs t => t -> AbsType t
abs (MPFloat -> AbsType MPFloat) -> MPFloat -> AbsType MPFloat
forall a b. (a -> b) -> a -> b
$ MPFloat
x MPFloat -> MPFloat -> MPFloat
-^ MPFloat
n) MPFloat -> ErrorBound -> OrderCompareType MPFloat ErrorBound
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= ErrorBound
e)

instance HasPrecision MPBall where
    getPrecision :: MPBall -> Precision
getPrecision  = MPFloat -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision (MPFloat -> Precision)
-> (MPBall -> MPFloat) -> MPBall -> Precision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPBall -> MPFloat
ball_value

instance CanSetPrecision MPBall where
    setPrecision :: Precision -> MPBall -> MPBall
setPrecision Precision
p (MPBall MPFloat
x ErrorBound
e)
        | Precision
p Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Precision
pPrev = MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
xC ErrorBound
e
        | Bool
otherwise  = MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
xC (ErrorBound
e ErrorBound -> MPFloat -> AddType ErrorBound MPFloat
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (MPFloat
xErr))
        where
        pPrev :: Precision
pPrev = MPFloat -> Precision
forall t. HasPrecision t => t -> Precision
MPFloat.getPrecision MPFloat
x
        (MPFloat
xC, MPFloat
xErr) = BoundsCEDU MPFloat -> (MPFloat, MPFloat)
forall a. BoundsCEDU a -> (a, a)
MPFloat.ceduCentreErr (BoundsCEDU MPFloat -> (MPFloat, MPFloat))
-> BoundsCEDU MPFloat -> (MPFloat, MPFloat)
forall a b. (a -> b) -> a -> b
$ Precision -> MPFloat -> BoundsCEDU MPFloat
MPFloat.setPrecisionCEDU Precision
p MPFloat
x

{- negation & abs -}

instance CanNeg MPBall where
  negate :: MPBall -> NegType MPBall
negate (MPBall MPFloat
x ErrorBound
e) = MPFloat -> ErrorBound -> MPBall
MPBall (-MPFloat
x) ErrorBound
e

instance CanAbs MPBall where
  abs :: MPBall -> AbsType MPBall
abs = MPBall -> MPBall
forall t. CanNormalize t => t -> t
normalize (MPBall -> MPBall) -> (MPBall -> MPBall) -> MPBall -> MPBall
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPBall -> MPBall
absRaw

absRaw :: MPBall -> MPBall
absRaw :: MPBall -> MPBall
absRaw MPBall
b
  | MPFloat
l MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Integer
0 Integer -> MPFloat -> OrderCompareType Integer MPFloat
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< MPFloat
r =
    IntervalEndpoint MPBall -> IntervalEndpoint MPBall -> MPBall
forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints (Integer -> MPFloat
forall t. CanBeMPFloat t => t -> MPFloat
mpFloat Integer
0) (MPFloat -> MPFloat -> MinMaxType MPFloat MPFloat
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max (-MPFloat
l) MPFloat
r)
  | Integer
0 Integer -> MPFloat -> OrderCompareType Integer MPFloat
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= MPFloat
l = MPBall
b
  | Bool
otherwise = -MPBall
b
  where
  (MPFloat
l,MPFloat
r) = MPBall -> (IntervalEndpoint MPBall, IntervalEndpoint MPBall)
forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b

instance CanTestContains MPBall MPBall where
  contains :: MPBall -> MPBall -> Bool
contains (MPBall MPFloat
xLarge ErrorBound
eLarge) (MPBall MPFloat
xSmall ErrorBound
eSmall) =
    Dyadic
xLargeDy Dyadic -> Dyadic -> SubType Dyadic Dyadic
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Dyadic
eLargeDy Dyadic -> Dyadic -> OrderCompareType Dyadic Dyadic
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Dyadic
xSmallDy Dyadic -> Dyadic -> SubType Dyadic Dyadic
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Dyadic
eSmallDy
    Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&&
    Dyadic
xSmallDy Dyadic -> Dyadic -> AddType Dyadic Dyadic
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Dyadic
eSmallDy Dyadic -> Dyadic -> OrderCompareType Dyadic Dyadic
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Dyadic
xLargeDy Dyadic -> Dyadic -> AddType Dyadic Dyadic
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Dyadic
eLargeDy
    where
    xLargeDy :: Dyadic
xLargeDy = MPFloat -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic MPFloat
xLarge
    eLargeDy :: Dyadic
eLargeDy = ErrorBound -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
eLarge
    xSmallDy :: Dyadic
xSmallDy = MPFloat -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic MPFloat
xSmall
    eSmallDy :: Dyadic
eSmallDy = ErrorBound -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
eSmall

$(declForTypes
  [[t| Integer |], [t| Int |], [t| Rational |], [t| Dyadic |]]
  (\ t -> [d|
    instance CanTestContains MPBall $t where
      contains (MPBall c e) x =
        l <= x && x <= r
        where
        l = cDy - eDy
        r = cDy + eDy
        cDy = dyadic c
        eDy = dyadic e
  |]))