{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module AERN2.MP.Ball.Type
(
module AERN2.MP.Precision
, module AERN2.MP.Accuracy
, module AERN2.MP.Enclosure
, MPBall(..), CanBeMPBall, mpBall, cnMPBall
, CanBeMPBallP, mpBallP, cnMPBallP
, reducePrecionIfInaccurate
, fromMPFloatEndpoints
, mpBallEndpoints, fromMPBallEndpoints
)
where
import MixedTypesNumPrelude
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
}
deriving (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 = forall t. ShowWithAccuracy t => Accuracy -> t -> String
showWithAccuracy (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) =
forall r. PrintfType r => String -> r
printf String
"[%s ± %s%s]" (ShowS
dropSomeDigits forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show MPFloat
x) String
eDS (Accuracy -> String
showAC forall a b. (a -> b) -> a -> b
$ forall a. HasAccuracy a => a -> Accuracy
getAccuracy MPBall
b)
where
eDS :: String
eDS
| ErrorBound
e forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = String
"0"
| Bool
otherwise =
case forall a b. Convertible a b => a -> ConvertResult b
safeConvert (forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
e) of
Right (Double
eD :: Double) -> forall r. PrintfType r => String -> r
printf String
"~%.4g" forall a b. (a -> b) -> a -> b
$ Double
eD
Either ConvertError Double
_ -> String
""
dropSomeDigits :: ShowS
dropSomeDigits String
s =
case forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (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 (OrderCompareType Integer Integer) String
withDotIx Int
ix
where
withDotIx :: Int -> IfThenElseType (OrderCompareType Integer Integer) String
withDotIx Int
ix =
let maxLength :: AddType Int Integer
maxLength = Int
ix forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
displayAC_n in
let sTrimmed :: String
sTrimmed = forall n a. CanBeInteger n => n -> [a] -> [a]
take AddType Int Integer
maxLength String
s in
if forall (t :: * -> *) a. Foldable t => t a -> Integer
length String
sTrimmed forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< AddType Int Integer
maxLength
then String
sTrimmed
else (forall n a. CanBeInteger n => n -> [a] -> [a]
take (AddType Int Integer
maxLength forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
3) String
sTrimmed) 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
_ -> forall t. CanRound t => t -> RoundType t
round forall a b. (a -> b) -> a -> b
$ (forall t. CanLog t => t -> LogType t
log (forall t. CanBeDouble t => t -> Double
double Integer
2)forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/forall t. CanLog t => t -> LogType t
log (forall t. CanBeDouble t => t -> Double
double Integer
10)) forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (forall t. CanBeInteger t => t -> Integer
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^(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall t. CanNeg t => t -> NegType t
negate forall a b. (a -> b) -> a -> b
$ Accuracy -> Integer
fromAccuracy Accuracy
ac) forall a. [a] -> [a] -> [a]
++ String
")"
instance CanTestIsIntegerType MPBall
instance CanTestValid MPBall where
isValid :: MPBall -> Bool
isValid = forall t. CanTestFinite t => t -> Bool
isFinite
instance CanTestNaN MPBall where
isNaN :: MPBall -> Bool
isNaN = forall t. CanNeg t => t -> NegType t
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanTestFinite t => t -> Bool
isFinite
instance CanTestFinite MPBall where
isInfinite :: MPBall -> Bool
isInfinite = forall a b. a -> b -> a
const Bool
False
isFinite :: MPBall -> Bool
isFinite (MPBall MPFloat
x ErrorBound
e) = forall t. CanTestFinite t => t -> Bool
isFinite MPFloat
x forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& forall t. CanTestFinite t => t -> Bool
isFinite (forall t. CanBeMPFloat t => t -> MPFloat
mpFloat ErrorBound
e)
instance CanNormalize MPBall where
normalize :: MPBall -> MPBall
normalize MPBall
b
| forall t. CanTestFinite t => t -> Bool
isFinite MPBall
b =
MPBall
b
| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"invalid MPBall: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MPBall
b
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 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Precision
p_x -> forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p_e_nb MPBall
b
(Accuracy, NormLog)
_ -> MPBall
b
where
bAcc :: Accuracy
bAcc = forall a. HasAccuracy a => a -> Accuracy
getAccuracy MPBall
b
bNorm :: NormLog
bNorm = forall a. HasNorm a => a -> NormLog
getNormLog MPBall
b
p_x :: Precision
p_x = forall t. HasPrecision t => t -> Precision
getPrecision MPFloat
x
p_e_nb :: Precision
p_e_nb = Integer -> Precision
prec forall a b. (a -> b) -> a -> b
$ forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
2 (Integer
10 forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
nb 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 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 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
1000000 = forall v. NumError -> CN v
CN.noValueNumErrorPotential forall a b. (a -> b) -> a -> b
$ String -> String -> NumError
numErrorVeryInaccurate String
"MPBall" String
""
| Bool
otherwise = forall v. v -> CN v
cn MPBall
b
instance IsInterval MPBall where
type IntervalEndpoint MPBall = MPFloat
fromEndpoints :: IntervalEndpoint MPBall -> IntervalEndpoint MPBall -> MPBall
fromEndpoints IntervalEndpoint MPBall
l IntervalEndpoint MPBall
u
| IntervalEndpoint MPBall
u forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< IntervalEndpoint MPBall
l = forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints IntervalEndpoint MPBall
u IntervalEndpoint MPBall
l
| Bool
otherwise =
MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
c (forall t. CanBeErrorBound t => t -> ErrorBound
errorBound MinMaxType MPFloat MPFloat
e)
where
c :: MPFloat
c = (IntervalEndpoint MPBall
l MPFloat -> MPFloat -> MPFloat
+. IntervalEndpoint MPBall
u) MPFloat -> MPFloat -> MPFloat
*. (forall t. CanBeMPFloat t => t -> MPFloat
mpFloat forall a b. (a -> b) -> a -> b
$ forall t. CanBeDyadic t => t -> Dyadic
dyadic Rational
0.5)
e :: MinMaxType MPFloat MPFloat
e = (IntervalEndpoint MPBall
u MPFloat -> MPFloat -> MPFloat
-^ MPFloat
c) forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` (MPFloat
c MPFloat -> MPFloat -> MPFloat
-^ IntervalEndpoint MPBall
l)
endpoints :: MPBall -> (IntervalEndpoint MPBall, IntervalEndpoint MPBall)
endpoints (MPBall MPFloat
x ErrorBound
e) = (MPFloat
l, MPFloat
u)
where
eFl :: MPFloat
eFl = 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 = forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints
fromMPBallEndpoints :: MPBall -> MPBall -> MPBall
fromMPBallEndpoints :: MPBall -> MPBall -> MPBall
fromMPBallEndpoints = forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals
mpBallEndpoints :: MPBall -> (MPBall, MPBall)
mpBallEndpoints :: MPBall -> (MPBall, MPBall)
mpBallEndpoints = 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) = 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 (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)
type CanBeMPBallP t = (ConvertibleWithPrecision t MPBall)
mpBallP :: (CanBeMPBallP t) => Precision -> t -> MPBall
mpBallP :: forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP = forall t1 t2.
ConvertibleWithPrecision t1 t2 =>
Precision -> t1 -> t2
convertP
cnMPBallP :: (CanBeMPBallP a) => Precision -> CN a -> CN MPBall
cnMPBallP :: forall a. CanBeMPBallP a => Precision -> CN a -> CN MPBall
cnMPBallP Precision
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p)
type CanBeMPBall t = ConvertibleExactly t MPBall
mpBall :: (CanBeMPBall t) => t -> MPBall
mpBall :: forall t. CanBeMPBall t => t -> MPBall
mpBall = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
cnMPBall :: (CanBeMPBall a) => CN a -> CN MPBall
cnMPBall :: forall a. CanBeMPBall a => CN a -> CN MPBall
cnMPBall = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. CanBeMPBall t => t -> MPBall
mpBall
instance HasAccuracy MPBall where
getAccuracy :: MPBall -> Accuracy
getAccuracy = forall a. HasAccuracy a => a -> Accuracy
getAccuracy forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPBall -> ErrorBound
ball_error
instance HasNorm MPBall where
getNormLog :: MPBall -> NormLog
getNormLog MPBall
ball = forall a. HasNorm a => a -> NormLog
getNormLog MPFloat
boundMP
where
(MPBall
_, MPBall MPFloat
boundMP ErrorBound
_) = MPBall -> (MPBall, MPBall)
mpBallEndpoints 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, OrderCompareType Accuracy Accuracy
isAccurate)
where
isAccurate :: OrderCompareType Accuracy Accuracy
isAccurate = forall a. HasAccuracy a => a -> Accuracy
getAccuracy MPBall
b forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Accuracy
ac
approx :: MPFloat
approx
| OrderCompareType MPFloat ErrorBound
closeToN = MPFloat
n
| Bool
otherwise = forall a. BoundsCEDU a -> a
MPFloat.ceduCentre 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 = forall t. CanBeMPFloat t => t -> MPFloat
mpFloat forall a b. (a -> b) -> a -> b
$ forall t. CanRound t => t -> RoundType t
round forall a b. (a -> b) -> a -> b
$ forall t. CanBeRational t => t -> Rational
rational MPFloat
x
closeToN :: OrderCompareType MPFloat ErrorBound
closeToN = ((forall t. CanAbs t => t -> AbsType t
abs forall a b. (a -> b) -> a -> b
$ MPFloat
x MPFloat -> MPFloat -> MPFloat
-^ MPFloat
n) forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= ErrorBound
e)
instance HasPrecision MPBall where
getPrecision :: MPBall -> Precision
getPrecision = forall t. HasPrecision t => t -> Precision
getPrecision 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 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 forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (MPFloat
xErr))
where
pPrev :: Precision
pPrev = forall t. HasPrecision t => t -> Precision
MPFloat.getPrecision MPFloat
x
(MPFloat
xC, MPFloat
xErr) = forall a. BoundsCEDU a -> (a, a)
MPFloat.ceduCentreErr forall a b. (a -> b) -> a -> b
$ Precision -> MPFloat -> BoundsCEDU MPFloat
MPFloat.setPrecisionCEDU Precision
p MPFloat
x
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 = forall t. CanNormalize t => t -> t
normalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPBall -> MPBall
absRaw
absRaw :: MPBall -> MPBall
absRaw :: MPBall -> MPBall
absRaw MPBall
b
| IntervalEndpoint MPBall
l forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Integer
0 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< IntervalEndpoint MPBall
r =
forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints (forall t. CanBeMPFloat t => t -> MPFloat
mpFloat Integer
0) (forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max (-IntervalEndpoint MPBall
l) IntervalEndpoint MPBall
r)
| Integer
0 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= IntervalEndpoint MPBall
l = MPBall
b
| Bool
otherwise = -MPBall
b
where
(IntervalEndpoint MPBall
l,IntervalEndpoint MPBall
r) = 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 forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Dyadic
eLargeDy forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Dyadic
xSmallDy forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Dyadic
eSmallDy
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&&
Dyadic
xSmallDy forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Dyadic
eSmallDy forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Dyadic
xLargeDy forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Dyadic
eLargeDy
where
xLargeDy :: Dyadic
xLargeDy = forall t. CanBeDyadic t => t -> Dyadic
dyadic MPFloat
xLarge
eLargeDy :: Dyadic
eLargeDy = forall t. CanBeDyadic t => t -> Dyadic
dyadic ErrorBound
eLarge
xSmallDy :: Dyadic
xSmallDy = forall t. CanBeDyadic t => t -> Dyadic
dyadic MPFloat
xSmall
eSmallDy :: Dyadic
eSmallDy = 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
|]))