{-# OPTIONS_GHC -Wno-orphans #-}
{-|
    Module      :  AERN2.MP.Ball.Comparisons
    Description :  Comparisons of arbitrary precision dyadic balls
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Comparisons of arbitrary precision dyadic balls
-}
module AERN2.MP.Ball.Comparisons
(
  -- * Auxiliary types
  module AERN2.Norm
  -- * Ball operations (see also instances)
  , reducePrecionIfInaccurate
  -- * Helpers for constructing ball functions
  , byEndpointsMP
  -- * intersection and hull
  , intersectCNMPBall
  , hullMPBall
)
where

import MixedTypesNumPrelude
-- import qualified Prelude as P

import qualified Control.CollectErrors as CE
import Control.CollectErrors
    ( CollectErrors(getMaybeValue), CanBeErrors )
import qualified Numeric.CollectErrors as CN

import AERN2.Kleenean
import AERN2.Norm
import AERN2.MP.Dyadic (Dyadic)
import AERN2.MP.Float (MPFloat)
-- import AERN2.MP.Float.Operators
import AERN2.MP.Precision

import AERN2.MP.Ball.Type
import AERN2.MP.Ball.Conversions ()

{- comparisons -}

instance HasEqAsymmetric MPBall MPBall where
  type EqCompareType MPBall MPBall = Kleenean
  MPBall
b1 equalTo :: MPBall -> MPBall -> EqCompareType MPBall MPBall
`equalTo` MPBall
b2 =   MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= MPBall
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= MPBall
b2

instance HasEqAsymmetric MPBall Integer where
  type EqCompareType MPBall Integer = Kleenean
  MPBall
b1 equalTo :: MPBall -> Integer -> EqCompareType MPBall Integer
`equalTo` Integer
b2 =   MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Integer
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
b2
instance HasEqAsymmetric Integer MPBall where
  type EqCompareType Integer MPBall = Kleenean
  Integer
b1 equalTo :: Integer -> MPBall -> EqCompareType Integer MPBall
`equalTo` MPBall
b2 =   Integer
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= MPBall
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Integer
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= MPBall
b2

instance HasEqAsymmetric MPBall Int where
  type EqCompareType MPBall Int = Kleenean
  MPBall
b1 equalTo :: MPBall -> Int -> EqCompareType MPBall Int
`equalTo` Int
b2 =   MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Int
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Int
b2
instance HasEqAsymmetric Int MPBall where
  type EqCompareType Int MPBall = Kleenean
  Int
b1 equalTo :: Int -> MPBall -> EqCompareType Int MPBall
`equalTo` MPBall
b2 =   Int
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= MPBall
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Int
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= MPBall
b2

instance HasEqAsymmetric MPBall Rational where
  type EqCompareType MPBall Rational = Kleenean
  MPBall
b1 equalTo :: MPBall -> Rational -> EqCompareType MPBall Rational
`equalTo` Rational
b2 =   MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Rational
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Rational
b2
instance HasEqAsymmetric Rational MPBall where
  type EqCompareType Rational MPBall = Kleenean
  Rational
b1 equalTo :: Rational -> MPBall -> EqCompareType Rational MPBall
`equalTo` MPBall
b2 =   Rational
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= MPBall
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Rational
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= MPBall
b2

instance HasEqAsymmetric MPBall Dyadic where
  type EqCompareType MPBall Dyadic = Kleenean
  MPBall
b1 equalTo :: MPBall -> Dyadic -> EqCompareType MPBall Dyadic
`equalTo` Dyadic
b2 =   MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Dyadic
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPBall
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Dyadic
b2
instance HasEqAsymmetric Dyadic MPBall where
  type EqCompareType Dyadic MPBall = Kleenean
  Dyadic
b1 equalTo :: Dyadic -> MPBall -> EqCompareType Dyadic MPBall
`equalTo` MPBall
b2 =   Dyadic
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= MPBall
b2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Dyadic
b1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= MPBall
b2

instance
  (HasEqAsymmetric MPBall b
  , IsBool (EqCompareType MPBall b)
  , CanTestCertainly (EqCompareType MPBall b)
  , CanBeErrors es)
  =>
  HasEqAsymmetric MPBall (CollectErrors es b)
  where
  type EqCompareType MPBall (CollectErrors es b) =
    CollectErrors es (EqCompareType MPBall b)
  equalTo :: MPBall
-> CollectErrors es b -> EqCompareType MPBall (CollectErrors es b)
equalTo = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

instance
  (HasEqAsymmetric a MPBall
  , IsBool (EqCompareType a MPBall)
  , CanTestCertainly (EqCompareType a MPBall)
  , CanBeErrors es)
  =>
  HasEqAsymmetric (CollectErrors es a) MPBall
  where
  type EqCompareType (CollectErrors es a) MPBall =
    CollectErrors es (EqCompareType a MPBall)
  equalTo :: CollectErrors es a
-> MPBall -> EqCompareType (CollectErrors es a) MPBall
equalTo = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

instance HasOrderAsymmetric MPBall MPBall where
  type OrderCompareType MPBall MPBall = Kleenean
  lessThan :: MPBall -> MPBall -> OrderCompareType MPBall MPBall
lessThan MPBall
b1 MPBall
b2
    | IntervalEndpoint MPBall
r1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< IntervalEndpoint MPBall
l2 = Kleenean
CertainTrue
    | IntervalEndpoint MPBall
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= IntervalEndpoint MPBall
l1 = Kleenean
CertainFalse
    | Bool
otherwise = Kleenean
TrueOrFalse
    where
    (IntervalEndpoint MPBall
l1, IntervalEndpoint MPBall
r1) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b1
    (IntervalEndpoint MPBall
l2, IntervalEndpoint MPBall
r2) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b2
  leq :: MPBall -> MPBall -> OrderCompareType MPBall MPBall
leq MPBall
b1 MPBall
b2
    | IntervalEndpoint MPBall
r1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= IntervalEndpoint MPBall
l2 = Kleenean
CertainTrue
    | IntervalEndpoint MPBall
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< IntervalEndpoint MPBall
l1 = Kleenean
CertainFalse
    | Bool
otherwise = Kleenean
TrueOrFalse
    where
    (IntervalEndpoint MPBall
l1, IntervalEndpoint MPBall
r1) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b1
    (IntervalEndpoint MPBall
l2, IntervalEndpoint MPBall
r2) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b2

instance HasOrderAsymmetric Integer MPBall where
  type OrderCompareType Integer MPBall = Kleenean
  lessThan :: Integer -> MPBall -> OrderCompareType Integer MPBall
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 :: Integer -> MPBall -> OrderCompareType Integer MPBall
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 MPBall Integer where
  type OrderCompareType MPBall Integer = Kleenean
  lessThan :: MPBall -> Integer -> OrderCompareType MPBall Integer
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 :: MPBall -> Integer -> OrderCompareType MPBall Integer
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 HasOrderAsymmetric Int MPBall where
  type OrderCompareType Int MPBall = Kleenean
  lessThan :: Int -> MPBall -> OrderCompareType Int MPBall
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 :: Int -> MPBall -> OrderCompareType Int MPBall
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 MPBall Int where
  type OrderCompareType MPBall Int = Kleenean
  lessThan :: MPBall -> Int -> OrderCompareType MPBall Int
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 :: MPBall -> Int -> OrderCompareType MPBall Int
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 HasOrderAsymmetric Dyadic MPBall where
  type OrderCompareType Dyadic MPBall = Kleenean
  lessThan :: Dyadic -> MPBall -> OrderCompareType Dyadic MPBall
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 :: Dyadic -> MPBall -> OrderCompareType Dyadic MPBall
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 MPBall Dyadic where
  type OrderCompareType MPBall Dyadic = Kleenean
  lessThan :: MPBall -> Dyadic -> OrderCompareType MPBall Dyadic
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 :: MPBall -> Dyadic -> OrderCompareType MPBall Dyadic
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 HasOrderAsymmetric MPBall Rational where
  type OrderCompareType MPBall Rational = Kleenean
  lessThan :: MPBall -> Rational -> OrderCompareType MPBall Rational
lessThan MPBall
b1 Rational
q2
    | IntervalEndpoint MPBall
r1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Rational
l2 = Kleenean
CertainTrue
    | Rational
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= IntervalEndpoint MPBall
l1 = Kleenean
CertainFalse
    | Bool
otherwise = Kleenean
TrueOrFalse
    where
    (IntervalEndpoint MPBall
l1, IntervalEndpoint MPBall
r1) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b1
    l2 :: Rational
l2 = Rational
q2
    r2 :: Rational
r2 = Rational
q2
  leq :: MPBall -> Rational -> OrderCompareType MPBall Rational
leq MPBall
b1 Rational
q2
    | IntervalEndpoint MPBall
r1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Rational
l2 = Kleenean
CertainTrue
    | Rational
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< IntervalEndpoint MPBall
l1 = Kleenean
CertainFalse
    | Bool
otherwise = Kleenean
TrueOrFalse
    where
    (IntervalEndpoint MPBall
l1, IntervalEndpoint MPBall
r1) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b1
    l2 :: Rational
l2 = Rational
q2
    r2 :: Rational
r2 = Rational
q2

instance HasOrderAsymmetric Rational MPBall where
  type OrderCompareType Rational MPBall = Kleenean
  lessThan :: Rational -> MPBall -> OrderCompareType Rational MPBall
lessThan Rational
q1 MPBall
b2
    | Rational
r1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< IntervalEndpoint MPBall
l2 = Kleenean
CertainTrue
    | IntervalEndpoint MPBall
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Rational
l1 = Kleenean
CertainFalse
    | Bool
otherwise = Kleenean
TrueOrFalse
    where
    (IntervalEndpoint MPBall
l2, IntervalEndpoint MPBall
r2) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b2
    l1 :: Rational
l1 = Rational
q1
    r1 :: Rational
r1 = Rational
q1
  leq :: Rational -> MPBall -> OrderCompareType Rational MPBall
leq Rational
q1 MPBall
b2
    | Rational
r1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= IntervalEndpoint MPBall
l2 = Kleenean
CertainTrue
    | IntervalEndpoint MPBall
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Rational
l1 = Kleenean
CertainFalse
    | Bool
otherwise = Kleenean
TrueOrFalse
    where
    (IntervalEndpoint MPBall
l2, IntervalEndpoint MPBall
r2) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b2
    l1 :: Rational
l1 = Rational
q1
    r1 :: Rational
r1 = Rational
q1

instance
  (HasOrderAsymmetric MPBall b
  , IsBool (OrderCompareType MPBall b)
  , CanTestCertainly (OrderCompareType MPBall b)
  , CanBeErrors es)
  =>
  HasOrderAsymmetric MPBall (CollectErrors es  b)
  where
  type OrderCompareType MPBall (CollectErrors es  b) =
    CollectErrors es (OrderCompareType MPBall b)
  lessThan :: MPBall
-> CollectErrors es b
-> OrderCompareType MPBall (CollectErrors es b)
lessThan = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: MPBall
-> CollectErrors es b
-> OrderCompareType MPBall (CollectErrors es b)
leq = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
  greaterThan :: MPBall
-> CollectErrors es b
-> OrderCompareType MPBall (CollectErrors es b)
greaterThan = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
greaterThan
  geq :: MPBall
-> CollectErrors es b
-> OrderCompareType MPBall (CollectErrors es b)
geq = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
geq

instance
  (HasOrderAsymmetric a MPBall
  , IsBool (OrderCompareType a MPBall)
  , CanTestCertainly (OrderCompareType a MPBall)
  , CanBeErrors es)
  =>
  HasOrderAsymmetric (CollectErrors es a) MPBall
  where
  type OrderCompareType (CollectErrors es  a) MPBall =
    CollectErrors es (OrderCompareType a MPBall)
  lessThan :: CollectErrors es a
-> MPBall -> OrderCompareType (CollectErrors es a) MPBall
lessThan = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: CollectErrors es a
-> MPBall -> OrderCompareType (CollectErrors es a) MPBall
leq = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
  greaterThan :: CollectErrors es a
-> MPBall -> OrderCompareType (CollectErrors es a) MPBall
greaterThan = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
greaterThan
  geq :: CollectErrors es a
-> MPBall -> OrderCompareType (CollectErrors es a) MPBall
geq = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
geq

instance CanTestZero MPBall
instance CanTestPosNeg MPBall

instance CanTestInteger MPBall where
  certainlyNotInteger :: MPBall -> Bool
certainlyNotInteger MPBall
b =
    (Integer
rN forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
lN) forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
1 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Integer
lN forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! MPBall
b forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPBall
b forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
rN
    where
      (Integer
lN, Integer
rN) = forall t. HasIntegerBounds t => t -> (Integer, Integer)
integerBounds MPBall
b
  certainlyIntegerGetIt :: MPBall -> Maybe Integer
certainlyIntegerGetIt MPBall
b
    | Integer
rN forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
lN = forall a. a -> Maybe a
Just Integer
lN
    | Bool
otherwise = forall a. Maybe a
Nothing
    where
      (Integer
lN, Integer
rN) = forall t. HasIntegerBounds t => t -> (Integer, Integer)
integerBounds MPBall
b

instance CanMinMaxAsymmetric MPBall MPBall where
  min :: MPBall -> MPBall -> MinMaxType MPBall MPBall
min = (MPFloat -> MPFloat -> MPFloat) -> MPBall -> MPBall -> MPBall
byEndpointsMP forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: MPBall -> MPBall -> MinMaxType MPBall MPBall
max = (MPFloat -> MPFloat -> MPFloat) -> MPBall -> MPBall -> MPBall
byEndpointsMP forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

instance CanMinMaxAsymmetric MPBall Integer where
  type MinMaxType MPBall Integer = MPBall
  min :: MPBall -> Integer -> MinMaxType MPBall Integer
min = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: MPBall -> Integer -> MinMaxType MPBall Integer
max = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Integer MPBall where
  type MinMaxType Integer MPBall = MPBall
  min :: Integer -> MPBall -> MinMaxType Integer MPBall
min = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Integer -> MPBall -> MinMaxType Integer MPBall
max = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

instance CanMinMaxAsymmetric MPBall Int where
  type MinMaxType MPBall Int = MPBall
  min :: MPBall -> Int -> MinMaxType MPBall Int
min = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: MPBall -> Int -> MinMaxType MPBall Int
max = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Int MPBall where
  type MinMaxType Int MPBall = MPBall
  min :: Int -> MPBall -> MinMaxType Int MPBall
min = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Int -> MPBall -> MinMaxType Int MPBall
max = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

instance CanMinMaxAsymmetric MPBall Dyadic where
  type MinMaxType MPBall Dyadic = MPBall
  min :: MPBall -> Dyadic -> MinMaxType MPBall Dyadic
min = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: MPBall -> Dyadic -> MinMaxType MPBall Dyadic
max = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Dyadic MPBall where
  type MinMaxType Dyadic MPBall = MPBall
  min :: Dyadic -> MPBall -> MinMaxType Dyadic MPBall
min = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Dyadic -> MPBall -> MinMaxType Dyadic MPBall
max = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

instance CanMinMaxAsymmetric MPBall Rational where
  type MinMaxType MPBall Rational = MPBall
  min :: MPBall -> Rational -> MinMaxType MPBall Rational
min = forall t2 t1 c.
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: MPBall -> Rational -> MinMaxType MPBall Rational
max = forall t2 t1 c.
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Rational MPBall where
  type MinMaxType Rational MPBall = MPBall
  min :: Rational -> MPBall -> MinMaxType Rational MPBall
min = forall t1 t2 c.
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Rational -> MPBall -> MinMaxType Rational MPBall
max = forall t1 t2 c.
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

instance
  (CanMinMaxAsymmetric MPBall b
  , CanBeErrors es)
  =>
  CanMinMaxAsymmetric MPBall (CollectErrors es  b)
  where
  type MinMaxType MPBall (CollectErrors es  b) =
    CollectErrors es (MinMaxType MPBall b)
  min :: MPBall
-> CollectErrors es b -> MinMaxType MPBall (CollectErrors es b)
min = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: MPBall
-> CollectErrors es b -> MinMaxType MPBall (CollectErrors es b)
max = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

instance
  (CanMinMaxAsymmetric a MPBall
  , CanBeErrors es)
  =>
  CanMinMaxAsymmetric (CollectErrors es a) MPBall
  where
  type MinMaxType (CollectErrors es  a) MPBall =
    CollectErrors es (MinMaxType a MPBall)
  min :: CollectErrors es a
-> MPBall -> MinMaxType (CollectErrors es a) MPBall
min = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: CollectErrors es a
-> MPBall -> MinMaxType (CollectErrors es a) MPBall
max = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

{- intersection -}

instance CanIntersectAsymmetric MPBall MPBall where
  intersect :: MPBall -> MPBall -> IntersectionType MPBall MPBall
intersect MPBall
a MPBall
b
    | MinMaxType MPFloat MPFloat
l forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> MinMaxType MPFloat MPFloat
r =
        forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.NumError forall a b. (a -> b) -> a -> b
$ String
"intersect: empty intersection: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MPBall
a forall a. [a] -> [a] -> [a]
++ String
"; " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MPBall
b
    | Bool
otherwise = forall v. v -> CN v
cn forall a b. (a -> b) -> a -> b
$ forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p forall a b. (a -> b) -> a -> b
$ MPFloat -> MPFloat -> MPBall
fromMPFloatEndpoints MinMaxType MPFloat MPFloat
l MinMaxType MPFloat MPFloat
r
    where
    p :: Precision
p  = forall t. HasPrecision t => t -> Precision
getPrecision MPBall
a
    l :: MinMaxType MPFloat MPFloat
l = forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max IntervalEndpoint MPBall
aL IntervalEndpoint MPBall
bL
    r :: MinMaxType MPFloat MPFloat
r = forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min IntervalEndpoint MPBall
aR IntervalEndpoint MPBall
bR
    (IntervalEndpoint MPBall
aL,IntervalEndpoint MPBall
aR) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
a
    (IntervalEndpoint MPBall
bL,IntervalEndpoint MPBall
bR) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b

intersectCNMPBall :: CN MPBall -> CN MPBall -> CN MPBall
intersectCNMPBall :: CN MPBall -> CN MPBall -> CN MPBall
intersectCNMPBall = forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect
  -- case (fst $ ensureNoCN x, fst $ ensureNoCN y) of 
  --   (Nothing, Nothing) -> x
  --   (Just _ , Nothing) -> x
  --   (Nothing, Just _ ) -> y
  --   (Just _ , Just _ ) -> lift2CE intersect x y

instance
  (CanIntersectAsymmetric MPBall b
  , CanBeErrors es)
  =>
  CanIntersectAsymmetric MPBall (CollectErrors es b)
  where
  type IntersectionType MPBall (CollectErrors es b) =
    CollectErrors es (IntersectionType MPBall b)
  intersect :: MPBall
-> CollectErrors es b
-> IntersectionType MPBall (CollectErrors es b)
intersect = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect

instance
  (CanIntersectAsymmetric a MPBall
  , CanBeErrors es)
  =>
  CanIntersectAsymmetric (CollectErrors es a) MPBall
  where
  type IntersectionType (CollectErrors es  a) MPBall =
    CollectErrors es (IntersectionType a MPBall)
  intersect :: CollectErrors es a
-> MPBall -> IntersectionType (CollectErrors es a) MPBall
intersect = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect

{- hull -}

hullMPBall :: MPBall -> MPBall -> MPBall
hullMPBall :: MPBall -> MPBall -> MPBall
hullMPBall MPBall
a MPBall
b = 
  forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints MinMaxType MPFloat MPFloat
rL MinMaxType MPFloat MPFloat
rR
  where
  rL :: MinMaxType MPFloat MPFloat
rL = forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min IntervalEndpoint MPBall
aL IntervalEndpoint MPBall
bL
  rR :: MinMaxType MPFloat MPFloat
rR = forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max IntervalEndpoint MPBall
aR IntervalEndpoint MPBall
bR
  (IntervalEndpoint MPBall
aL,IntervalEndpoint MPBall
aR) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
a
  (IntervalEndpoint MPBall
bL,IntervalEndpoint MPBall
bR) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b

{- union -}

instance CanUnionAsymmetric MPBall MPBall where
  union :: MPBall -> MPBall -> UnionType MPBall MPBall
union MPBall
a MPBall
b =
    case forall es v. CollectErrors es v -> Maybe v
getMaybeValue (MPBall
a forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
`intersect` MPBall
b) of
      Just MPBall
_ -> CN MPBall
r
      Maybe MPBall
_ -> forall t. NumError -> CN t -> CN t
CN.prependErrorCertain NumError
err CN MPBall
r
    where
    err :: NumError
err = String -> NumError
CN.NumError forall a b. (a -> b) -> a -> b
$ String
"union of enclosures: not enclosing the same value"
    r :: CN MPBall
r = forall v. v -> CN v
cn forall a b. (a -> b) -> a -> b
$ MPBall -> MPBall -> MPBall
hullMPBall MPBall
a MPBall
b

instance
  (CanUnionAsymmetric MPBall b
  , CanBeErrors es)
  =>
  CanUnionAsymmetric MPBall (CollectErrors es b)
  where
  type UnionType MPBall (CollectErrors es b) =
    CollectErrors es (UnionType MPBall b)
  union :: MPBall
-> CollectErrors es b -> UnionType MPBall (CollectErrors es b)
union = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall e1 e2.
CanUnionAsymmetric e1 e2 =>
e1 -> e2 -> UnionType e1 e2
union

instance
  (CanUnionAsymmetric a MPBall
  , CanBeErrors es)
  =>
  CanUnionAsymmetric (CollectErrors es a) MPBall
  where
  type UnionType (CollectErrors es  a) MPBall =
    CollectErrors es (UnionType a MPBall)
  union :: CollectErrors es a
-> MPBall -> UnionType (CollectErrors es a) MPBall
union = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall e1 e2.
CanUnionAsymmetric e1 e2 =>
e1 -> e2 -> UnionType e1 e2
union

{-|
  Compute an MPBall function from *exact* MPFloat operations on interval endpoints.
  This works only for *non-decreasing* operations, eg addition, min, max.
-}
byEndpointsMP ::
    (MPFloat -> MPFloat -> MPFloat) ->
    (MPBall -> MPBall -> MPBall)
byEndpointsMP :: (MPFloat -> MPFloat -> MPFloat) -> MPBall -> MPBall -> MPBall
byEndpointsMP MPFloat -> MPFloat -> MPFloat
op MPBall
b1 MPBall
b2 =
    forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints (IntervalEndpoint MPBall
l1 MPFloat -> MPFloat -> MPFloat
`op` IntervalEndpoint MPBall
l2) (IntervalEndpoint MPBall
r1 MPFloat -> MPFloat -> MPFloat
`op` IntervalEndpoint MPBall
r2)
    where
    (IntervalEndpoint MPBall
l1,IntervalEndpoint MPBall
r1) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b1
    (IntervalEndpoint MPBall
l2,IntervalEndpoint MPBall
r2) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b2