{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-|
    Module      :  AERN2.MP.Ball.Field
    Description :  Field operations on arbitrary precision dyadic balls
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Field operations on arbitrary precision dyadic balls
-}
module AERN2.MP.Ball.Field
(mulBalls, mulByEndpoints)
where

import MixedTypesNumPrelude
-- import qualified Prelude as P

import qualified Numeric.CollectErrors as CN

import AERN2.Normalize

import AERN2.MP.Dyadic (Dyadic)
import qualified AERN2.MP.Float as MPFloat
import AERN2.MP.Float (mpFloat)
import AERN2.MP.Float.Operators
import AERN2.MP.Precision
-- import qualified AERN2.MP.ErrorBound as EB

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

{- addition -}

instance CanAddAsymmetric MPBall MPBall where
  type AddType MPBall MPBall = MPBall
  add :: MPBall -> MPBall -> AddType MPBall MPBall
add (MPBall MPFloat
x1 ErrorBound
e1) (MPBall MPFloat
x2 ErrorBound
e2) =
    MPBall -> MPBall
forall t. CanNormalize t => t -> t
normalize (MPBall -> MPBall) -> MPBall -> MPBall
forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
sumC (ErrorBound
e1 ErrorBound -> ErrorBound -> AddType ErrorBound ErrorBound
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ErrorBound
e2 ErrorBound -> MPFloat -> AddType ErrorBound MPFloat
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ MPFloat
sumErr)
    where
    (MPFloat
sumC, MPFloat
sumErr) = 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
$ MPFloat -> MPFloat -> BoundsCEDU MPFloat
MPFloat.addCEDU MPFloat
x1 MPFloat
x2

instance CanAddAsymmetric MPBall Int where
  type AddType MPBall Int = MPBall
  add :: MPBall -> Int -> AddType MPBall Int
add = (MPBall -> MPBall -> MPBall) -> MPBall -> Int -> MPBall
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond MPBall -> MPBall -> AddType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Int MPBall where
  type AddType Int MPBall = MPBall
  add :: Int -> MPBall -> AddType Int MPBall
add = (MPBall -> MPBall -> MPBall) -> Int -> MPBall -> MPBall
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst MPBall -> MPBall -> AddType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance CanAddAsymmetric MPBall Integer where
  type AddType MPBall Integer = MPBall
  add :: MPBall -> Integer -> AddType MPBall Integer
add = (MPBall -> MPBall -> MPBall) -> MPBall -> Integer -> MPBall
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond MPBall -> MPBall -> AddType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Integer MPBall where
  type AddType Integer MPBall = MPBall
  add :: Integer -> MPBall -> AddType Integer MPBall
add = (MPBall -> MPBall -> MPBall) -> Integer -> MPBall -> MPBall
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst MPBall -> MPBall -> AddType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance CanAddAsymmetric MPBall Dyadic where
  type AddType MPBall Dyadic = MPBall
  add :: MPBall -> Dyadic -> AddType MPBall Dyadic
add = (MPBall -> MPBall -> MPBall) -> MPBall -> Dyadic -> MPBall
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond MPBall -> MPBall -> AddType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Dyadic MPBall where
  type AddType Dyadic MPBall = MPBall
  add :: Dyadic -> MPBall -> AddType Dyadic MPBall
add = (MPBall -> MPBall -> MPBall) -> Dyadic -> MPBall -> MPBall
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst MPBall -> MPBall -> AddType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance CanAddAsymmetric MPBall Rational where
  type AddType MPBall Rational = MPBall
  add :: MPBall -> Rational -> AddType MPBall Rational
add = (MPBall -> MPBall -> MPBall) -> MPBall -> Rational -> MPBall
forall t2 t1 c.
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond MPBall -> MPBall -> AddType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Rational MPBall where
  type AddType Rational MPBall = MPBall
  add :: Rational -> MPBall -> AddType Rational MPBall
add = (MPBall -> MPBall -> MPBall) -> Rational -> MPBall -> MPBall
forall t1 t2 c.
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst MPBall -> MPBall -> AddType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance
  (CanAddAsymmetric MPBall b)
  =>
  CanAddAsymmetric MPBall (CN b)
  where
  type AddType MPBall (CN b) = CN (AddType MPBall b)
  add :: MPBall -> CN b -> AddType MPBall (CN b)
add = (MPBall -> b -> AddType MPBall b)
-> MPBall -> CN b -> CollectErrors NumErrors (AddType MPBall b)
forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CN.liftT1 MPBall -> b -> AddType MPBall b
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance
  (CanAddAsymmetric a MPBall)
  =>
  CanAddAsymmetric (CN a) MPBall
  where
  type AddType (CN a) MPBall = CN (AddType a MPBall)
  add :: CN a -> MPBall -> AddType (CN a) MPBall
add = (a -> MPBall -> AddType a MPBall)
-> CN a -> MPBall -> CollectErrors NumErrors (AddType a MPBall)
forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CN.lift1T a -> MPBall -> AddType a MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

{- subtraction -}

instance CanSub MPBall MPBall

instance CanSub MPBall Integer
instance CanSub Integer MPBall

instance CanSub MPBall Int
instance CanSub Int MPBall

instance CanSub MPBall Rational
instance CanSub Rational MPBall

instance CanSub MPBall Dyadic
instance CanSub Dyadic MPBall

instance
  (CanSub MPBall b)
  =>
  CanSub MPBall (CN b)
  where
  type SubType MPBall (CN b) = CN (SubType MPBall b)
  sub :: MPBall -> CN b -> SubType MPBall (CN b)
sub = (MPBall -> b -> SubType MPBall b)
-> MPBall -> CN b -> CollectErrors NumErrors (SubType MPBall b)
forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CN.liftT1 MPBall -> b -> SubType MPBall b
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub

instance
  (CanSub a MPBall)
  =>
  CanSub (CN a) MPBall
  where
  type SubType (CN a) MPBall = CN (SubType a MPBall)
  sub :: CN a -> MPBall -> SubType (CN a) MPBall
sub = (a -> MPBall -> SubType a MPBall)
-> CN a -> MPBall -> CollectErrors NumErrors (SubType a MPBall)
forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CN.lift1T a -> MPBall -> SubType a MPBall
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub

{- multiplication -}

instance CanMulAsymmetric MPBall MPBall where
  mul :: MPBall -> MPBall -> MulType MPBall MPBall
mul = MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
mulBalls
  -- mul = mulByEndpoints

mulBalls :: MPBall -> MPBall -> MPBall
mulBalls :: MPBall -> MPBall -> MPBall
mulBalls (MPBall MPFloat
x1 ErrorBound
e1) (MPBall MPFloat
x2 ErrorBound
e2) =
    MPBall -> MPBall
forall t. CanNormalize t => t -> t
normalize (MPBall -> MPBall) -> MPBall -> MPBall
forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
x12C (MPFloat
e12 MPFloat
-> MulType ErrorBound MPFloat
-> AddType MPFloat (MulType ErrorBound MPFloat)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ErrorBound
e1ErrorBound -> MPFloat -> MulType ErrorBound MPFloat
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(MPFloat -> AbsType MPFloat
forall t. CanAbs t => t -> AbsType t
abs MPFloat
x2) AddType MPFloat (MulType ErrorBound MPFloat)
-> MulType ErrorBound MPFloat
-> AddType
     (AddType MPFloat (MulType ErrorBound MPFloat))
     (MulType ErrorBound MPFloat)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ErrorBound
e2ErrorBound -> MPFloat -> MulType ErrorBound MPFloat
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(MPFloat -> AbsType MPFloat
forall t. CanAbs t => t -> AbsType t
abs MPFloat
x1) AddType
  (AddType MPFloat (MulType ErrorBound MPFloat))
  (MulType ErrorBound MPFloat)
-> ErrorBound
-> AddType
     (AddType
        (AddType MPFloat (MulType ErrorBound MPFloat))
        (MulType ErrorBound MPFloat))
     ErrorBound
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ErrorBound
e1ErrorBound -> ErrorBound -> MulType ErrorBound ErrorBound
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*ErrorBound
e2)
      -- the mixed operations above automatically convert
      -- MPFloat to ErrorBound, checking non-negativity
    where
    (MPFloat
x12C, MPFloat
e12) = 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
$ MPFloat -> MPFloat -> BoundsCEDU MPFloat
MPFloat.mulCEDU MPFloat
x1 MPFloat
x2

mulByEndpoints :: MPBall -> MPBall -> MPBall
mulByEndpoints :: MPBall -> MPBall -> MPBall
mulByEndpoints MPBall
b1 MPBall
b2 =
  IntervalEndpoint MPBall -> IntervalEndpoint MPBall -> MPBall
forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints MPFloat
IntervalEndpoint MPBall
l MPFloat
IntervalEndpoint MPBall
r
  where
  (MPFloat
l,MPFloat
r)
    | Integer
0 Integer -> MPFloat -> OrderCompareType Integer MPFloat
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= MPFloat
IntervalEndpoint MPBall
l1 OrderCompareType Integer MPFloat
-> OrderCompareType Integer MPFloat
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType Integer MPFloat)
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
IntervalEndpoint MPBall
l2 = (MPFloat
IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*.MPFloat
IntervalEndpoint MPBall
l2, MPFloat
IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*^MPFloat
IntervalEndpoint MPBall
r2) -- 0 <= l1 <= r1, 0 <= l2 <= r2
    | MPFloat
IntervalEndpoint MPBall
r1 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 OrderCompareType MPFloat Integer
-> OrderCompareType MPFloat Integer
-> AndOrType
     (OrderCompareType MPFloat Integer)
     (OrderCompareType MPFloat Integer)
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPFloat
IntervalEndpoint MPBall
r2 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 = (MPFloat
IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*.MPFloat
IntervalEndpoint MPBall
r2, MPFloat
IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*^MPFloat
IntervalEndpoint MPBall
l2) -- l1 <= r1 <= 0, l2 <= r2 <= 0
    | Integer
0 Integer -> MPFloat -> OrderCompareType Integer MPFloat
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= MPFloat
IntervalEndpoint MPBall
l1 OrderCompareType Integer MPFloat
-> OrderCompareType MPFloat Integer
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType MPFloat Integer)
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPFloat
IntervalEndpoint MPBall
r2 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 = (MPFloat
IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*.MPFloat
IntervalEndpoint MPBall
l2, MPFloat
IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*^MPFloat
IntervalEndpoint MPBall
r2) -- l2 <= r2 <= 0 <= l1 <= r1
    | MPFloat
IntervalEndpoint MPBall
r1 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 OrderCompareType MPFloat Integer
-> OrderCompareType Integer MPFloat
-> AndOrType
     (OrderCompareType MPFloat Integer)
     (OrderCompareType Integer MPFloat)
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
IntervalEndpoint MPBall
l2 = (MPFloat
IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*.MPFloat
IntervalEndpoint MPBall
r2, MPFloat
IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*^MPFloat
IntervalEndpoint MPBall
l2) -- l1 <= r1 <= 0 <= l2 <= r2
    | MPFloat
IntervalEndpoint MPBall
l1 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 OrderCompareType MPFloat Integer
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType Integer MPFloat)
-> AndOrType
     (OrderCompareType MPFloat Integer)
     (AndOrType
        (OrderCompareType Integer MPFloat)
        (OrderCompareType Integer MPFloat))
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
IntervalEndpoint MPBall
r1 OrderCompareType Integer MPFloat
-> OrderCompareType Integer MPFloat
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType Integer MPFloat)
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
IntervalEndpoint MPBall
l2 = (MPFloat
IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*.MPFloat
IntervalEndpoint MPBall
r2, MPFloat
IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*^MPFloat
IntervalEndpoint MPBall
r2) -- l1 < 0 < r1, 0 <= l2 <= r2
    | MPFloat
IntervalEndpoint MPBall
l1 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 OrderCompareType MPFloat Integer
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType MPFloat Integer)
-> AndOrType
     (OrderCompareType MPFloat Integer)
     (AndOrType
        (OrderCompareType Integer MPFloat)
        (OrderCompareType MPFloat Integer))
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
IntervalEndpoint MPBall
r1 OrderCompareType Integer MPFloat
-> OrderCompareType MPFloat Integer
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType MPFloat Integer)
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPFloat
IntervalEndpoint MPBall
r2 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 = (MPFloat
IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*.MPFloat
IntervalEndpoint MPBall
l2, MPFloat
IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*^MPFloat
IntervalEndpoint MPBall
l2) -- l1 < 0 < r1, l2 <= r2 <= 0
    | MPFloat
IntervalEndpoint MPBall
l2 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 OrderCompareType MPFloat Integer
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType Integer MPFloat)
-> AndOrType
     (OrderCompareType MPFloat Integer)
     (AndOrType
        (OrderCompareType Integer MPFloat)
        (OrderCompareType Integer MPFloat))
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
IntervalEndpoint MPBall
r2 OrderCompareType Integer MPFloat
-> OrderCompareType Integer MPFloat
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType Integer MPFloat)
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
IntervalEndpoint MPBall
l1 = (MPFloat
IntervalEndpoint MPBall
l2MPFloat -> MPFloat -> MPFloat
*.MPFloat
IntervalEndpoint MPBall
r1, MPFloat
IntervalEndpoint MPBall
r2MPFloat -> MPFloat -> MPFloat
*^MPFloat
IntervalEndpoint MPBall
r1) -- l2 < 0 < r2, 0 <= l1 <= r1
    | MPFloat
IntervalEndpoint MPBall
l2 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 OrderCompareType MPFloat Integer
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType MPFloat Integer)
-> AndOrType
     (OrderCompareType MPFloat Integer)
     (AndOrType
        (OrderCompareType Integer MPFloat)
        (OrderCompareType MPFloat Integer))
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
IntervalEndpoint MPBall
r2 OrderCompareType Integer MPFloat
-> OrderCompareType MPFloat Integer
-> AndOrType
     (OrderCompareType Integer MPFloat)
     (OrderCompareType MPFloat Integer)
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& MPFloat
IntervalEndpoint MPBall
r1 MPFloat -> Integer -> OrderCompareType MPFloat Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 = (MPFloat
IntervalEndpoint MPBall
r2MPFloat -> MPFloat -> MPFloat
*.MPFloat
IntervalEndpoint MPBall
l1, MPFloat
IntervalEndpoint MPBall
l2MPFloat -> MPFloat -> MPFloat
*^MPFloat
IntervalEndpoint MPBall
l1) -- l2 < 0 < r2, l1 <= r1 <= 0
    | Bool
otherwise = -- l1 < 0 < r1, l2 < 0 < r2
      ((MPFloat
IntervalEndpoint MPBall
l1 MPFloat -> MPFloat -> MPFloat
*. MPFloat
IntervalEndpoint MPBall
r2) MPFloat -> MPFloat -> MinMaxType MPFloat MPFloat
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` (MPFloat
IntervalEndpoint MPBall
r1 MPFloat -> MPFloat -> MPFloat
*. MPFloat
IntervalEndpoint MPBall
l2)
      ,(MPFloat
IntervalEndpoint MPBall
l1 MPFloat -> MPFloat -> MPFloat
*^ MPFloat
IntervalEndpoint MPBall
l2) MPFloat -> MPFloat -> MinMaxType MPFloat MPFloat
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` (MPFloat
IntervalEndpoint MPBall
r1 MPFloat -> MPFloat -> MPFloat
*^ MPFloat
IntervalEndpoint MPBall
r2))
  (IntervalEndpoint MPBall
l1,IntervalEndpoint MPBall
r1) = MPBall -> (IntervalEndpoint MPBall, IntervalEndpoint MPBall)
forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b1
  (IntervalEndpoint MPBall
l2,IntervalEndpoint MPBall
r2) = MPBall -> (IntervalEndpoint MPBall, IntervalEndpoint MPBall)
forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints MPBall
b2


instance CanMulAsymmetric MPBall Int where
  type MulType MPBall Int = MPBall
  mul :: MPBall -> Int -> MulType MPBall Int
mul = (MPBall -> MPBall -> MPBall) -> MPBall -> Int -> MPBall
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Int MPBall where
  type MulType Int MPBall = MPBall
  mul :: Int -> MPBall -> MulType Int MPBall
mul = (MPBall -> MPBall -> MPBall) -> Int -> MPBall -> MPBall
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric MPBall Integer where
  type MulType MPBall Integer = MPBall
  mul :: MPBall -> Integer -> MulType MPBall Integer
mul = (MPBall -> MPBall -> MPBall) -> MPBall -> Integer -> MPBall
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Integer MPBall where
  type MulType Integer MPBall = MPBall
  mul :: Integer -> MPBall -> MulType Integer MPBall
mul = (MPBall -> MPBall -> MPBall) -> Integer -> MPBall -> MPBall
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric MPBall Dyadic where
  type MulType MPBall Dyadic = MPBall
  mul :: MPBall -> Dyadic -> MulType MPBall Dyadic
mul = (MPBall -> MPBall -> MPBall) -> MPBall -> Dyadic -> MPBall
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Dyadic MPBall where
  type MulType Dyadic MPBall = MPBall
  mul :: Dyadic -> MPBall -> MulType Dyadic MPBall
mul = (MPBall -> MPBall -> MPBall) -> Dyadic -> MPBall -> MPBall
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric MPBall Rational where
  type MulType MPBall Rational = MPBall
  mul :: MPBall -> Rational -> MulType MPBall Rational
mul = (MPBall -> MPBall -> MPBall) -> MPBall -> Rational -> MPBall
forall t2 t1 c.
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Rational MPBall where
  type MulType Rational MPBall = MPBall
  mul :: Rational -> MPBall -> MulType Rational MPBall
mul = (MPBall -> MPBall -> MPBall) -> Rational -> MPBall -> MPBall
forall t1 t2 c.
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst MPBall -> MPBall -> MulType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance
  (CanMulAsymmetric MPBall b)
  =>
  CanMulAsymmetric MPBall (CN b)
  where
  type MulType MPBall (CN b) = CN (MulType MPBall b)
  mul :: MPBall -> CN b -> MulType MPBall (CN b)
mul = (MPBall -> b -> MulType MPBall b)
-> MPBall -> CN b -> CollectErrors NumErrors (MulType MPBall b)
forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CN.liftT1 MPBall -> b -> MulType MPBall b
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance
  (CanMulAsymmetric a MPBall)
  =>
  CanMulAsymmetric (CN a) MPBall
  where
  type MulType (CN a) MPBall = CN (MulType a MPBall)
  mul :: CN a -> MPBall -> MulType (CN a) MPBall
mul = (a -> MPBall -> MulType a MPBall)
-> CN a -> MPBall -> CollectErrors NumErrors (MulType a MPBall)
forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CN.lift1T a -> MPBall -> MulType a MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul


{- division -}

instance CanDiv MPBall MPBall where
  type DivType MPBall MPBall = MPBall
  divide :: MPBall -> MPBall -> DivType MPBall MPBall
divide (MPBall MPFloat
x1 ErrorBound
e1) (MPBall MPFloat
x2 ErrorBound
e2) = MPBall -> MPBall
forall t. CanNormalize t => t -> t
normalize (MPBall -> MPBall) -> MPBall -> MPBall
forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
x12C MulType (AddType ErrorBound ErrorBound) MPFloat
ErrorBound
err
    where
    (MPFloat
x12C, MPFloat
e12) = 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
$ MPFloat -> MPFloat -> BoundsCEDU MPFloat
MPFloat.divCEDU MPFloat
x1 MPFloat
x2
    x12AbsUp :: MPFloat
x12AbsUp = (MPFloat -> AbsType MPFloat
forall t. CanAbs t => t -> AbsType t
abs MPFloat
x12C) MPFloat -> MPFloat -> MPFloat
+^ MPFloat
e12
    x2abs :: AbsType MPFloat
x2abs = MPFloat -> AbsType MPFloat
forall t. CanAbs t => t -> AbsType t
abs MPFloat
x2
    err :: MulType (AddType ErrorBound ErrorBound) MPFloat
err =
        ((MPFloat
e12 MPFloat -> MPFloat -> MPFloat
*^ AbsType MPFloat
MPFloat
x2abs) -- e12 * |x2|
         MPFloat -> ErrorBound -> AddType MPFloat ErrorBound
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+
         ErrorBound
e1
         ErrorBound -> ErrorBound -> AddType ErrorBound ErrorBound
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+
         (ErrorBound
e2 ErrorBound -> MPFloat -> MulType ErrorBound MPFloat
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* MPFloat
x12AbsUp) -- e2 * |x|
        )
        AddType ErrorBound ErrorBound
-> MPFloat -> MulType (AddType ErrorBound ErrorBound) MPFloat
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*
        ((Integer -> MPFloat
forall t. CanBeMPFloat t => t -> MPFloat
mpFloat Integer
1) MPFloat -> MPFloat -> MPFloat
/^ (AbsType MPFloat
MPFloat
x2abs MPFloat -> MPFloat -> MPFloat
-. (ErrorBound -> MPFloat
forall t. CanBeMPFloat t => t -> MPFloat
mpFloat ErrorBound
e2)))
            -- 1/(|x2| - e2) rounded upwards
{-
A derivation of the above formula for an upper bound on the error:

    * e =
        * = max ( (x1 ± e1) / (x2 ± e2) - x )
        * = max ( ( x1 ± e1 - (x*(x2 ± e2) ) / (x2 ± e2) )
        * ≤ max ( ( x1 ± e1 - ((x1/x2) ± e12)x2 ± x*e2 ) / (x2 ± e2) )
        * = max ( ( x1 ± e1 - x1 ± e12*x2 ± x*e2 ) / (x2 ± e2) )
        * = max ( ( ± e1 ± e12*x2 ± x*e2 ) / (x2 ± e2) )
        * ≤ (e1 + e12*|x2| + |x|*e2 ) / (|x2| - e2)
        * ≤ (e1 +^ e12*^|x2| +^ |x|*^e2 ) /^ (|x2| -. e2)
-}

$(declForTypes
  [[t| Integer |], [t| Int |], [t| Dyadic |]]
  (\ t -> [d|
    instance CanDiv MPBall $t where
      type DivType MPBall $t = MPBall
      divide = convertSecond divide
    instance CanDiv $t MPBall where
      type DivType $t MPBall = MPBall
      divide = convertFirst divide
  |]))

instance CanDiv Dyadic Dyadic where
  type DivType Dyadic Dyadic = MPBall
  divide :: Dyadic -> Dyadic -> DivType Dyadic Dyadic
divide Dyadic
a Dyadic
b = MPBall -> MPBall -> DivType MPBall MPBall
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide (Dyadic -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Dyadic
a) (Dyadic -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Dyadic
b)

instance CanDiv MPBall Rational where
  type DivType MPBall Rational = MPBall
  divide :: MPBall -> Rational -> DivType MPBall Rational
divide = (MPBall -> MPBall -> MPBall) -> MPBall -> Rational -> MPBall
forall t2 t1 c.
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond MPBall -> MPBall -> DivType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
instance CanDiv Rational MPBall where
  type DivType Rational MPBall = MPBall
  divide :: Rational -> MPBall -> DivType Rational MPBall
divide = (MPBall -> MPBall -> MPBall) -> Rational -> MPBall -> MPBall
forall t1 t2 c.
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst MPBall -> MPBall -> DivType MPBall MPBall
MPBall -> MPBall -> MPBall
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide

instance
  (CanDiv MPBall b, CanTestZero b)
  =>
  CanDiv MPBall (CN b)
  where
  type DivType MPBall (CN b) = CN (DivType MPBall b)
  divide :: MPBall -> CN b -> DivType MPBall (CN b)
divide MPBall
a CN b
b = CN MPBall -> CN b -> DivType (CN MPBall) (CN b)
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide (MPBall -> CN MPBall
forall v. v -> CN v
cn MPBall
a) CN b
b

instance
  (CanDiv a MPBall)
  =>
  CanDiv (CN a) MPBall
  where
  type DivType (CN a) MPBall = CN (DivType a MPBall)
  divide :: CN a -> MPBall -> DivType (CN a) MPBall
divide CN a
a MPBall
b = CN a -> CN MPBall -> DivType (CN a) (CN MPBall)
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide CN a
a (MPBall -> CN MPBall
forall v. v -> CN v
cn MPBall
b)

{- integer power -}

instance CanPow MPBall Integer where
  pow :: MPBall -> Integer -> PowType MPBall Integer
pow = MPBall -> MPBall -> Integer -> MPBall
forall e.
(Integral e, ConvertibleExactly e Integer) =>
MPBall -> MPBall -> e -> MPBall
powUsingMulRecipCutNeg (Integer -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Integer
1)

instance CanPow MPBall Int where
  pow :: MPBall -> Int -> PowType MPBall Int
pow = MPBall -> MPBall -> Int -> MPBall
forall e.
(Integral e, ConvertibleExactly e Integer) =>
MPBall -> MPBall -> e -> MPBall
powUsingMulRecipCutNeg (Integer -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Integer
1)

powUsingMulRecipCutNeg :: _ => MPBall -> MPBall -> e -> MPBall
powUsingMulRecipCutNeg :: MPBall -> MPBall -> e -> MPBall
powUsingMulRecipCutNeg MPBall
one MPBall
x e
e
  | e -> Bool
forall a. Integral a => a -> Bool
even e
e =
      Integer -> MPBall -> MinMaxType Integer MPBall
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
0 (MPBall -> MinMaxType Integer MPBall)
-> MPBall -> MinMaxType Integer MPBall
forall a b. (a -> b) -> a -> b
$ MPBall
-> (MPBall -> MPBall -> MPBall)
-> (MPBall -> MPBall)
-> MPBall
-> e
-> MPBall
forall e t.
CanBeInteger e =>
t -> (t -> t -> t) -> (t -> t) -> t -> e -> t
powUsingMulRecip MPBall
one MPBall -> MPBall -> MPBall
mulByEndpoints MPBall -> DivType Integer MPBall
MPBall -> MPBall
forall t. CanRecip t => t -> DivType Integer t
recip MPBall
x e
e
  | Bool
otherwise = MPBall
-> (MPBall -> MPBall -> MPBall)
-> (MPBall -> MPBall)
-> MPBall
-> e
-> MPBall
forall e t.
CanBeInteger e =>
t -> (t -> t -> t) -> (t -> t) -> t -> e -> t
powUsingMulRecip MPBall
one MPBall -> MPBall -> MPBall
mulByEndpoints MPBall -> DivType Integer MPBall
MPBall -> MPBall
forall t. CanRecip t => t -> DivType Integer t
recip MPBall
x e
e

instance
  (CanPow MPBall b)
  =>
  CanPow MPBall (CN b)
  where
  type PowType MPBall (CN b) = CN (PowType MPBall b)
  pow :: MPBall -> CN b -> PowType MPBall (CN b)
pow = (MPBall -> b -> PowType MPBall b)
-> MPBall -> CN b -> CN (PowType MPBall b)
forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CN.liftT1 MPBall -> b -> PowType MPBall b
forall b e. CanPow b e => b -> e -> PowType b e
pow

instance
  (CanPow a MPBall)
  =>
  CanPow (CN a) MPBall
  where
  type PowType (CN a) MPBall = CN (PowType a MPBall)
  pow :: CN a -> MPBall -> PowType (CN a) MPBall
pow = (a -> MPBall -> PowType a MPBall)
-> CN a -> MPBall -> CN (PowType a MPBall)
forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CN.lift1T a -> MPBall -> PowType a MPBall
forall b e. CanPow b e => b -> e -> PowType b e
pow

instance
  CanDivIMod MPBall MPBall
  where
  type DivIType MPBall MPBall = Integer
  divIMod :: MPBall -> MPBall -> (DivIType MPBall MPBall, ModType MPBall MPBall)
divIMod MPBall
x MPBall
m
    | MPBall
m MPBall -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 = ([Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"Integer division for MPBall undefined", MinMaxType MPBall MPBall
ModType MPBall MPBall
xm')
    | Bool
otherwise = [Char] -> (DivIType MPBall MPBall, ModType MPBall MPBall)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (DivIType MPBall MPBall, ModType MPBall MPBall))
-> [Char] -> (DivIType MPBall MPBall, ModType MPBall MPBall)
forall a b. (a -> b) -> a -> b
$ [Char]
"modulus not positive: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ MPBall -> [Char]
forall a. Show a => a -> [Char]
show MPBall
m
    where
    (IntervalEndpoint MPBall
l, IntervalEndpoint MPBall
r) = MPBall -> (IntervalEndpoint MPBall, IntervalEndpoint MPBall)
forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints (MPBall -> (IntervalEndpoint MPBall, IntervalEndpoint MPBall))
-> MPBall -> (IntervalEndpoint MPBall, IntervalEndpoint MPBall)
forall a b. (a -> b) -> a -> b
$ MPBall
x MPBall -> MPBall -> DivType MPBall MPBall
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ MPBall
m
    (RoundType MPFloat
dL, RoundType MPFloat
dR) = (MPFloat -> RoundType MPFloat
forall t. CanRound t => t -> RoundType t
floor MPFloat
IntervalEndpoint MPBall
l, MPFloat -> RoundType MPFloat
forall t. CanRound t => t -> RoundType t
floor MPFloat
IntervalEndpoint MPBall
r) 
    xmL :: SubType MPBall MPBall
xmL = MPBall
x MPBall -> MPBall -> SubType MPBall MPBall
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- MPBall
mMPBall -> RoundType MPFloat -> MulType MPBall (RoundType MPFloat)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*RoundType MPFloat
dL
    xmR :: SubType MPBall MPBall
xmR = MPBall
x MPBall -> MPBall -> SubType MPBall MPBall
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- MPBall
mMPBall -> RoundType MPFloat -> MulType MPBall (RoundType MPFloat)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*RoundType MPFloat
dR
    xm :: MPBall
xm = MPBall -> MPBall -> MPBall
hullMPBall SubType MPBall MPBall
MPBall
xmL SubType MPBall MPBall
MPBall
xmR
    xm' :: MinMaxType MPBall MPBall
xm' = MPBall -> MPBall -> MinMaxType MPBall MPBall
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (Integer -> MPBall -> MinMaxType Integer MPBall
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
0 MPBall
xm) MPBall
m