{-# 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) =
    forall t. CanNormalize t => t -> t
normalize forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
sumC (ErrorBound
e1 forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ErrorBound
e2 forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ MPFloat
sumErr)
    where
    (MPFloat
sumC, MPFloat
sumErr) = forall a. BoundsCEDU a -> (a, a)
MPFloat.ceduCentreErr 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 = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall t2 t1 c.
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond 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 = forall t1 t2 c.
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst 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 = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CN.liftT1 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 = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CN.lift1T 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 = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CN.liftT1 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 = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CN.lift1T 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 -> MPBall
mulBalls
  -- mul = mulByEndpoints

mulBalls :: MPBall -> MPBall -> MPBall
mulBalls :: MPBall -> MPBall -> MPBall
mulBalls (MPBall MPFloat
x1 ErrorBound
e1) (MPBall MPFloat
x2 ErrorBound
e2) =
    forall t. CanNormalize t => t -> t
normalize forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
x12C (MPFloat
e12 forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ErrorBound
e1forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(forall t. CanAbs t => t -> AbsType t
abs MPFloat
x2) forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ErrorBound
e2forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(forall t. CanAbs t => t -> AbsType t
abs MPFloat
x1) forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ErrorBound
e1forall 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) = forall a. BoundsCEDU a -> (a, a)
MPFloat.ceduCentreErr 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 =
  forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints MPFloat
l MPFloat
r
  where
  (MPFloat
l,MPFloat
r)
    | Integer
0 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= IntervalEndpoint MPBall
l1 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
l2 = (IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*.IntervalEndpoint MPBall
l2, IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*^IntervalEndpoint MPBall
r2) -- 0 <= l1 <= r1, 0 <= l2 <= r2
    | IntervalEndpoint MPBall
r1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& IntervalEndpoint MPBall
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 = (IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*.IntervalEndpoint MPBall
r2, IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*^IntervalEndpoint MPBall
l2) -- l1 <= r1 <= 0, l2 <= r2 <= 0
    | Integer
0 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= IntervalEndpoint MPBall
l1 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& IntervalEndpoint MPBall
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 = (IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*.IntervalEndpoint MPBall
l2, IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*^IntervalEndpoint MPBall
r2) -- l2 <= r2 <= 0 <= l1 <= r1
    | IntervalEndpoint MPBall
r1 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
l2 = (IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*.IntervalEndpoint MPBall
r2, IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*^IntervalEndpoint MPBall
l2) -- l1 <= r1 <= 0 <= l2 <= r2
    | IntervalEndpoint MPBall
l1 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
r1 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
l2 = (IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*.IntervalEndpoint MPBall
r2, IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*^IntervalEndpoint MPBall
r2) -- l1 < 0 < r1, 0 <= l2 <= r2
    | IntervalEndpoint MPBall
l1 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
r1 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& IntervalEndpoint MPBall
r2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 = (IntervalEndpoint MPBall
r1MPFloat -> MPFloat -> MPFloat
*.IntervalEndpoint MPBall
l2, IntervalEndpoint MPBall
l1MPFloat -> MPFloat -> MPFloat
*^IntervalEndpoint MPBall
l2) -- l1 < 0 < r1, l2 <= r2 <= 0
    | IntervalEndpoint MPBall
l2 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
r2 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
l1 = (IntervalEndpoint MPBall
l2MPFloat -> MPFloat -> MPFloat
*.IntervalEndpoint MPBall
r1, IntervalEndpoint MPBall
r2MPFloat -> MPFloat -> MPFloat
*^IntervalEndpoint MPBall
r1) -- l2 < 0 < r2, 0 <= l1 <= r1
    | IntervalEndpoint MPBall
l2 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
r2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& IntervalEndpoint MPBall
r1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0 = (IntervalEndpoint MPBall
r2MPFloat -> MPFloat -> MPFloat
*.IntervalEndpoint MPBall
l1, IntervalEndpoint MPBall
l2MPFloat -> MPFloat -> MPFloat
*^IntervalEndpoint MPBall
l1) -- l2 < 0 < r2, l1 <= r1 <= 0
    | Bool
otherwise = -- l1 < 0 < r1, l2 < 0 < r2
      ((IntervalEndpoint MPBall
l1 MPFloat -> MPFloat -> MPFloat
*. IntervalEndpoint MPBall
r2) forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` (IntervalEndpoint MPBall
r1 MPFloat -> MPFloat -> MPFloat
*. IntervalEndpoint MPBall
l2)
      ,(IntervalEndpoint MPBall
l1 MPFloat -> MPFloat -> MPFloat
*^ IntervalEndpoint MPBall
l2) forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` (IntervalEndpoint MPBall
r1 MPFloat -> MPFloat -> MPFloat
*^ IntervalEndpoint MPBall
r2))
  (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 CanMulAsymmetric MPBall Int where
  type MulType MPBall Int = MPBall
  mul :: MPBall -> Int -> MulType MPBall Int
mul = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall t2 t1 c.
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond 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 = forall t1 t2 c.
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst 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 = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CN.liftT1 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 = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CN.lift1T 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) = forall t. CanNormalize t => t -> t
normalize forall a b. (a -> b) -> a -> b
$ MPFloat -> ErrorBound -> MPBall
MPBall MPFloat
x12C MulType (AddType ErrorBound ErrorBound) MPFloat
err
    where
    (MPFloat
x12C, MPFloat
e12) = forall a. BoundsCEDU a -> (a, a)
MPFloat.ceduCentreErr forall a b. (a -> b) -> a -> b
$ MPFloat -> MPFloat -> BoundsCEDU MPFloat
MPFloat.divCEDU MPFloat
x1 MPFloat
x2
    x12AbsUp :: MPFloat
x12AbsUp = (forall t. CanAbs t => t -> AbsType t
abs MPFloat
x12C) MPFloat -> MPFloat -> MPFloat
+^ MPFloat
e12
    x2abs :: AbsType MPFloat
x2abs = forall t. CanAbs t => t -> AbsType t
abs MPFloat
x2
    err :: MulType (AddType ErrorBound ErrorBound) MPFloat
err =
        ((MPFloat
e12 MPFloat -> MPFloat -> MPFloat
*^ AbsType MPFloat
x2abs) -- e12 * |x2|
         forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+
         ErrorBound
e1
         forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+
         (ErrorBound
e2 forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* MPFloat
x12AbsUp) -- e2 * |x|
        )
        forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*
        ((forall t. CanBeMPFloat t => t -> MPFloat
mpFloat Integer
1) MPFloat -> MPFloat -> MPFloat
/^ (AbsType MPFloat
x2abs MPFloat -> MPFloat -> 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 = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide (forall t. CanBeMPBall t => t -> MPBall
mpBall Dyadic
a) (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 = forall t2 t1 c.
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond 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 = forall t1 t2 c.
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst 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 = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide (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 = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide CN a
a (forall v. v -> CN v
cn MPBall
b)

{- integer power -}

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

instance CanPow MPBall Int where
  pow :: MPBall -> Int -> PowType MPBall Int
pow = forall e.
(Integral e, ConvertibleExactly e Integer) =>
MPBall -> MPBall -> e -> MPBall
powUsingMulRecipCutNeg (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
  | forall a. Integral a => a -> Bool
even e
e =
      forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
0 forall a b. (a -> b) -> a -> b
$ forall e t.
CanBeInteger e =>
t -> (t -> t -> t) -> (t -> t) -> t -> e -> t
powUsingMulRecip MPBall
one MPBall -> MPBall -> MPBall
mulByEndpoints forall t. CanRecip t => t -> DivType Integer t
recip MPBall
x e
e
  | Bool
otherwise = forall e t.
CanBeInteger e =>
t -> (t -> t -> t) -> (t -> t) -> t -> e -> t
powUsingMulRecip MPBall
one MPBall -> MPBall -> MPBall
mulByEndpoints 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 = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CN.liftT1 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 = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CN.lift1T 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 forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 = (forall a. HasCallStack => [Char] -> a
error [Char]
"Integer division for MPBall undefined", MinMaxType MPBall MPBall
xm')
    | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"modulus not positive: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show MPBall
m
    where
    (IntervalEndpoint MPBall
l, IntervalEndpoint MPBall
r) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints forall a b. (a -> b) -> a -> b
$ MPBall
x forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ MPBall
m
    (RoundType MPFloat
dL, RoundType MPFloat
dR) = (forall t. CanRound t => t -> RoundType t
floor IntervalEndpoint MPBall
l, forall t. CanRound t => t -> RoundType t
floor IntervalEndpoint MPBall
r) 
    xmL :: SubType MPBall MPBall
xmL = MPBall
x forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- MPBall
mforall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*RoundType MPFloat
dL
    xmR :: SubType MPBall MPBall
xmR = MPBall
x forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- MPBall
mforall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*RoundType MPFloat
dR
    xm :: MPBall
xm = MPBall -> MPBall -> MPBall
hullMPBall SubType MPBall MPBall
xmL SubType MPBall MPBall
xmR
    xm' :: MinMaxType MPBall MPBall
xm' = forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
0 MPBall
xm) MPBall
m