module AERN2.BoxFun.TestFunctions where

import MixedTypesNumPrelude
import AERN2.MP.Ball
import qualified Data.List as List

import AERN2.AD.Differential
import AERN2.BoxFun.Type
import AERN2.Linear.Vector.Type ((!), Vector)
import qualified AERN2.Linear.Vector.Type as V

fromListDomain :: [(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain :: [(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [] = Vector (CN MPBall)
forall a. Vector a
V.empty
fromListDomain [(Rational, Rational)
x] = CN MPBall -> Vector (CN MPBall)
forall a. a -> Vector a
V.singleton (CN MPBall -> Vector (CN MPBall))
-> CN MPBall -> Vector (CN MPBall)
forall a b. (a -> b) -> a -> b
$ CN MPBall -> CN MPBall -> CN MPBall
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals (MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$ Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP (Integer -> Precision
prec Integer
53) (Rational -> MPBall) -> Rational -> MPBall
forall a b. (a -> b) -> a -> b
$ ((Rational, Rational) -> Rational
forall a b. (a, b) -> a
fst (Rational, Rational)
x)) (MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$  Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP (Integer -> Precision
prec Integer
53) ((Rational, Rational) -> Rational
forall a b. (a, b) -> b
snd (Rational, Rational)
x))
fromListDomain ((Rational, Rational)
x:[(Rational, Rational)]
xs) = CN MPBall -> Vector (CN MPBall) -> Vector (CN MPBall)
forall a. a -> Vector a -> Vector a
V.cons (CN MPBall -> CN MPBall -> CN MPBall
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals (MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$ Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP (Integer -> Precision
prec Integer
53) (Rational -> MPBall) -> Rational -> MPBall
forall a b. (a -> b) -> a -> b
$ ((Rational, Rational) -> Rational
forall a b. (a, b) -> a
fst (Rational, Rational)
x)) (MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$  Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP (Integer -> Precision
prec Integer
53) ((Rational, Rational) -> Rational
forall a b. (a, b) -> b
snd (Rational, Rational)
x))) ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational, Rational)]
xs)

symmetricDomain :: Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain :: Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain Integer
n Rational
l Rational
r = 
    (Integer -> CN MPBall) -> Vector Integer -> Vector (CN MPBall)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Integer
_ -> CN MPBall -> CN MPBall -> CN MPBall
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals (MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$ Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP (Integer -> Precision
prec Integer
53) (Rational -> MPBall) -> Rational -> MPBall
forall a b. (a -> b) -> a -> b
$ Rational
l) (MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$  Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP (Integer -> Precision
prec Integer
53) Rational
r)) (Vector Integer -> Vector (CN MPBall))
-> Vector Integer -> Vector (CN MPBall)
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Vector Integer
forall a. Enum a => a -> a -> Vector a
V.enumFromTo Integer
1 Integer
n

griewank :: Integer -> BoxFun
griewank :: Integer -> BoxFun
griewank Integer
n =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
n
    (\Vector (Differential (CN MPBall))
v ->
        let
            ord :: Integer
ord = Differential (CN MPBall) -> Integer
forall a. Differential a -> Integer
order (Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
0)
            sm :: Differential (CN MPBall)
sm  = (Differential (CN MPBall)
 -> Differential (CN MPBall) -> Differential (CN MPBall))
-> Differential (CN MPBall)
-> [Differential (CN MPBall)]
-> Differential (CN MPBall)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Differential (CN MPBall)
-> Differential (CN MPBall) -> Differential (CN MPBall)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
(+) (Integer -> CN MPBall -> Differential (CN MPBall)
forall a. CanBeDifferential a => Integer -> a -> Differential a
differential Integer
ord (MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$ Integer -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Integer
0)) [let x :: Differential (CN MPBall)
x = (Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
k) in Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 | Integer
k <- [Integer
0 .. Vector (Differential (CN MPBall)) -> Integer
forall a. Vector a -> Integer
V.length Vector (Differential (CN MPBall))
v Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1]]
            prd :: Differential (CN MPBall)
prd = (Differential (CN MPBall)
 -> Differential (CN MPBall) -> Differential (CN MPBall))
-> Differential (CN MPBall)
-> [Differential (CN MPBall)]
-> Differential (CN MPBall)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Differential (CN MPBall)
-> Differential (CN MPBall) -> Differential (CN MPBall)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
(*) (Integer -> CN MPBall -> Differential (CN MPBall)
forall a. CanBeDifferential a => Integer -> a -> Differential a
differential Integer
ord (MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$ Integer -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Integer
1)) [Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
cos (Differential (CN MPBall) -> SinCosType (Differential (CN MPBall)))
-> Differential (CN MPBall)
-> SinCosType (Differential (CN MPBall))
forall a b. (a -> b) -> a -> b
$ (Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
k) Differential (CN MPBall)
-> MPBall -> DivType (Differential (CN MPBall)) MPBall
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ (MPBall -> SqrtType MPBall
forall t. CanSqrt t => t -> SqrtType t
sqrt (MPBall -> SqrtType MPBall) -> MPBall -> SqrtType MPBall
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> MPBall -> AddType Integer MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
k) | Integer
k <- [Integer
0 .. Vector (Differential (CN MPBall)) -> Integer
forall a. Vector a -> Integer
V.length Vector (Differential (CN MPBall))
v Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1]]
            p :: Precision
p   = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
        in
        Integer
1 Integer
-> Differential (CN MPBall)
-> AddType Integer (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ((Precision -> MPBall -> MPBall
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p (MPBall -> MPBall) -> MPBall -> MPBall
forall a b. (a -> b) -> a -> b
$ Integer -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Integer
1)MPBall -> MPBall -> DivType MPBall MPBall
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/(Precision -> MPBall -> MPBall
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p (MPBall -> MPBall) -> MPBall -> MPBall
forall a b. (a -> b) -> a -> b
$ Integer -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Integer
4000)) MPBall
-> Differential (CN MPBall)
-> MulType MPBall (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall)
sm Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall)
prd
    )
    (Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain Integer
n (-Rational
600.0) Rational
600.0)

rosenbrock :: BoxFun
rosenbrock :: BoxFun
rosenbrock =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            p :: Precision
p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
1
            a :: MPBall
a = Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
1
            b :: MPBall
b = Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
100
            amx :: SubType MPBall (Differential (CN MPBall))
amx  = MPBall
a MPBall
-> Differential (CN MPBall)
-> SubType MPBall (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall)
x
            ymxs :: SubType (Differential (CN MPBall)) (Differential (CN MPBall))
ymxs = Differential (CN MPBall)
y Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall)
xDifferential (CN MPBall)
-> Differential (CN MPBall)
-> MulType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*Differential (CN MPBall)
x
        in
            SubType MPBall (Differential (CN MPBall))
Differential (CN MPBall)
amxDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ MPBall
bMPBall
-> Differential (CN MPBall)
-> MulType MPBall (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*SubType (Differential (CN MPBall)) (Differential (CN MPBall))
Differential (CN MPBall)
ymxsDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2
    )
    (Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain Integer
2 (-Rational
1.2) Rational
1.2)

himmelblau :: BoxFun
himmelblau :: BoxFun
himmelblau =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
1
            a :: SubType (Differential (CN MPBall)) Integer
a = (Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall)
y Differential (CN MPBall)
-> Integer -> SubType (Differential (CN MPBall)) Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
11)
            b :: SubType (Differential (CN MPBall)) Integer
b = (Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall)
yDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 Differential (CN MPBall)
-> Integer -> SubType (Differential (CN MPBall)) Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
7)
        in
            SubType (Differential (CN MPBall)) Integer
Differential (CN MPBall)
aDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ SubType (Differential (CN MPBall)) Integer
Differential (CN MPBall)
bDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2
    )
    (Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain Integer
2 (-Rational
600.0) Rational
600.0)

shekel :: BoxFun
shekel :: BoxFun
shekel = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x   = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
0
            y :: Differential (CN MPBall)
y   = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
1
            c0 :: Integer
c0  = Integer
1;  a00 :: Integer
a00 = Integer
43; a01 :: Integer
a01 = Integer
23
            c1 :: Integer
c1  = Integer
17; a10 :: Integer
a10 = Integer
6;  a11 :: Integer
a11 = Integer
9
        in
            - Integer
1Integer
-> Differential (CN MPBall)
-> DivType Integer (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/(Integer
c0 Integer
-> Differential (CN MPBall)
-> AddType Integer (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Differential (CN MPBall)
x Differential (CN MPBall)
-> Integer -> SubType (Differential (CN MPBall)) Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
a00)Differential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Differential (CN MPBall)
y Differential (CN MPBall)
-> Integer -> SubType (Differential (CN MPBall)) Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
a01)Differential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2)
            Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1Integer
-> Differential (CN MPBall)
-> DivType Integer (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/(Integer
c1 Integer
-> Differential (CN MPBall)
-> AddType Integer (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Differential (CN MPBall)
x Differential (CN MPBall)
-> Integer -> SubType (Differential (CN MPBall)) Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
a10)Differential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Differential (CN MPBall)
y Differential (CN MPBall)
-> Integer -> SubType (Differential (CN MPBall)) Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
a11)Differential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2)
    )
    (Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain Integer
2 (-Rational
600.0) Rational
600.0)

siam4 :: BoxFun
siam4 :: BoxFun
siam4 = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x   = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
0
            y :: Differential (CN MPBall)
y   = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
1
        in
        Differential (CN MPBall) -> ExpType (Differential (CN MPBall))
forall t. CanExp t => t -> ExpType t
exp(Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin(Integer
50 Integer
-> Differential (CN MPBall)
-> MulType Integer (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall)
x)) Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin(Integer
60 Integer
-> Differential (CN MPBall)
-> MulType Integer (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall) -> ExpType (Differential (CN MPBall))
forall t. CanExp t => t -> ExpType t
exp Differential (CN MPBall)
y) 
        Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin(Integer
70 Integer
-> Differential (CN MPBall)
-> MulType Integer (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin(Differential (CN MPBall)
x)) Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin(Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin(Integer
80 Integer
-> Differential (CN MPBall)
-> MulType Integer (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall)
y)) 
        Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin(Integer
10 Integer
-> Differential (CN MPBall)
-> MulType Integer (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall)
y)) 
        Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall)
yDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2) Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ Integer
4
    )
    (Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain Integer
2 (-Rational
10.0) Rational
10.0)

ratz4 :: BoxFun
ratz4 :: BoxFun
ratz4 =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let 
            x :: Differential (CN MPBall)
x  = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
0
            y :: Differential (CN MPBall)
y  = Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
! Integer
1
            xs :: PowType (Differential (CN MPBall)) Integer
xs = Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2
            ys :: PowType (Differential (CN MPBall)) Integer
ys = Differential (CN MPBall)
yDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2
        in 
            Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin(PowType (Differential (CN MPBall)) Integer
Differential (CN MPBall)
xs Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
2 Integer
-> Differential (CN MPBall)
-> MulType Integer (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* PowType (Differential (CN MPBall)) Integer
Differential (CN MPBall)
ys) Differential (CN MPBall)
-> Differential (CN MPBall)
-> MulType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall) -> ExpType (Differential (CN MPBall))
forall t. CanExp t => t -> ExpType t
exp (-PowType (Differential (CN MPBall)) Integer
Differential (CN MPBall)
xs Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- PowType (Differential (CN MPBall)) Integer
Differential (CN MPBall)
ys)
    )
    (Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain Integer
2 (-Rational
3.0) Rational
3.0)

-- global minimum at bukin(-10, 1) ~ 0
-- bukin :: BoxFun
-- bukin =
--     BoxFun
--     2
--     (\v ->
--         let
--             x = v!0
--             y = v!1
--         in
--             100 * sqrt (abs (y - x^2 / 100)) + abs(x + 10) / 100
--     )
--     (fromListDomain [(-15.0, 5.0), (-3.0, 3.0)])

ackley :: BoxFun
ackley :: BoxFun
ackley =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            p :: Precision
p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            pi :: MPBall
pi = Precision -> MPBall
piBallP Precision
p
        in
            -Integer
20 Integer
-> Differential (CN MPBall)
-> MulType Integer (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall) -> ExpType (Differential (CN MPBall))
forall t. CanExp t => t -> ExpType t
exp(Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt((Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall)
yDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2) Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ Integer
2) Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ (-Integer
5)) Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall) -> ExpType (Differential (CN MPBall))
forall t. CanExp t => t -> ExpType t
exp((Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
cos (Integer
2 Integer -> MPBall -> MulType Integer MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* MPBall
pi MPBall
-> Differential (CN MPBall)
-> MulType MPBall (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall)
x) Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
cos(Integer
2 Integer -> MPBall -> MulType Integer MPBall
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* MPBall
pi MPBall
-> Differential (CN MPBall)
-> MulType MPBall (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential (CN MPBall)
y)) Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ Integer
2) Differential (CN MPBall)
-> MPBall -> AddType (Differential (CN MPBall)) MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ MPBall -> ExpType MPBall
forall t. CanExp t => t -> ExpType t
exp(Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
1) Differential (CN MPBall)
-> Integer -> AddType (Differential (CN MPBall)) Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
20
    )
    (Integer -> Rational -> Rational -> Vector (CN MPBall)
symmetricDomain Integer
2 (-Rational
5.0) Rational
5.0)

-- eggholder :: BoxFun
-- eggholder =
--     BoxFun
--     2
--     (\v ->
--         let
--             x = v!0
--             y = v!1
--         in
--             -(y + 47) * sin (sqrt (abs (x / 2 + (y + 47)))) - x * sin (sqrt (abs (x - (y + 47))))
--     )
--     (symmetricDomain 2 (-512.0) 512.0)
    
-- heron :: BoxFun
-- heron = 
--     BoxFun
--     2
--     (\v ->
--         let
--             x = v!0
--             y = v!1
--             p = getPrecision v
--             eps = 1/2^(23)
--             i = 2
--         in
--             max
--                 min
--                     max
--                         (y - sqrt x)
--                         ((sqrt x - y) - (mpBallP p 1/2)^(2^(i-1)) - 6 * eps * (i-1))
--                     max
--                         (sqrt x - y)
--                         (- (sqrt x - y) - (mpBallP p 1/2)^(2^(i-1)) - 6 * eps * (i-1))
--                 min
--                     max
--                         ((y + x/y)/2 - sqrt x)
--                         (- (sqrt x - (y+x/y)/2) + (mpBallP p 1/2)^(2^i) + 6 * eps * (i-1))
--                     max
--                         (sqrt x - (y+x/y)/2)
--                         ((sqrt x - (y+x/y)/2) + (mpBallP p 1/2)^(2^i) + 6 * eps * (i-1))

--     )
--     (fromListDomain [(0.5, 2.0), (0.8, 1.8)])

-- max (min (max 1p 1q) (max 2p 2q)) (min (max 3p 3q) (max 4p 4q))

i :: Integer
i :: Integer
i = Integer
3

heron1p :: BoxFun
heron1p :: BoxFun
heron1p = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            _p :: Precision
_p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            _eps :: DivType Integer Integer
_eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
        in
            (Differential (CN MPBall)
y Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x)
     )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.5, Rational
2.0), (Rational
0.8, Rational
1.8)])

    
heron1q :: BoxFun
heron1q :: BoxFun
heron1q = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            p :: Precision
p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            eps :: DivType Integer Integer
eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
        in
            ((Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall)
y) Differential (CN MPBall)
-> MPBall -> SubType (Differential (CN MPBall)) MPBall
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
1MPBall -> Integer -> DivType MPBall Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2)MPBall -> Integer -> PowType MPBall Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
iInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1)) Differential (CN MPBall)
-> MPBall -> SubType (Differential (CN MPBall)) MPBall
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
6) MPBall -> Rational -> MulType MPBall Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Rational
eps MPBall -> Integer -> MulType MPBall Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Integer
iInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1))

    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.5, Rational
2.0), (Rational
0.8, Rational
1.8)])

    
heron2p :: BoxFun
heron2p :: BoxFun
heron2p = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            _p :: Precision
_p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            _eps :: DivType Integer Integer
_eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
        in
            (Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall)
y)
    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.5, Rational
2.0), (Rational
0.8, Rational
1.8)])

    
heron2q :: BoxFun
heron2q :: BoxFun
heron2q = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            p :: Precision
p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            eps :: DivType Integer Integer
eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
        in
            (- (Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall)
y) Differential (CN MPBall)
-> MPBall -> SubType (Differential (CN MPBall)) MPBall
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
1MPBall -> Integer -> DivType MPBall Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2)MPBall -> Integer -> PowType MPBall Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
iInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1)) Differential (CN MPBall)
-> MPBall -> SubType (Differential (CN MPBall)) MPBall
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
6) MPBall -> Rational -> MulType MPBall Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Rational
eps MPBall -> Integer -> MulType MPBall Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Integer
iInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1))

    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.5, Rational
2.0), (Rational
0.8, Rational
1.8)])

    
heron3p :: BoxFun
heron3p :: BoxFun
heron3p = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            _p :: Precision
_p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            _eps :: DivType Integer Integer
_eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
        in
            ((Differential (CN MPBall)
y Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall)
xDifferential (CN MPBall)
-> Differential (CN MPBall)
-> DivType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Differential (CN MPBall)
y)Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x)
    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.5, Rational
2.0), (Rational
0.8, Rational
1.8)])
    
heron3q :: BoxFun
heron3q :: BoxFun
heron3q = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            p :: Precision
p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            eps :: DivType Integer Integer
eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
        in
            (- (Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Differential (CN MPBall)
yDifferential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Differential (CN MPBall)
xDifferential (CN MPBall)
-> Differential (CN MPBall)
-> DivType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Differential (CN MPBall)
y)Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2) Differential (CN MPBall)
-> MPBall -> AddType (Differential (CN MPBall)) MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
1MPBall -> Integer -> DivType MPBall Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2)MPBall -> Integer -> PowType MPBall Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
i) Differential (CN MPBall)
-> MPBall -> AddType (Differential (CN MPBall)) MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
6) MPBall -> Rational -> MulType MPBall Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Rational
eps MPBall -> Integer -> MulType MPBall Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Integer
iInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1))
    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.5, Rational
2.0), (Rational
0.8, Rational
1.8)])

    
heron3p2 :: BoxFun
heron3p2 :: BoxFun
heron3p2 = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            _p :: Precision
_p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            _eps :: DivType Integer Integer
_eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
            _i :: Integer
_i = Integer
4
        in
            ((Differential (CN MPBall)
y Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Differential (CN MPBall)
xDifferential (CN MPBall)
-> Differential (CN MPBall)
-> DivType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Differential (CN MPBall)
y)Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2 Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x)
    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.633758544921875, Rational
0.63385009765625), (Rational
0.79999999999999982236431605997495353221893310546875, Rational
0.80006103515624982239142111428709114306911942549049854278564453125)])
    
heron3q2 :: BoxFun
heron3q2 :: BoxFun
heron3q2 = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            p :: Precision
p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            eps :: DivType Integer Integer
eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
            _i :: Integer
_i = Integer
4
        in
            (- (Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Differential (CN MPBall)
yDifferential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Differential (CN MPBall)
xDifferential (CN MPBall)
-> Differential (CN MPBall)
-> DivType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Differential (CN MPBall)
y)Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2) Differential (CN MPBall)
-> MPBall -> AddType (Differential (CN MPBall)) MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
1MPBall -> Integer -> DivType MPBall Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2)MPBall -> Integer -> PowType MPBall Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
i) Differential (CN MPBall)
-> MPBall -> AddType (Differential (CN MPBall)) MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
6) MPBall -> Rational -> MulType MPBall Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Rational
eps MPBall -> Integer -> MulType MPBall Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Integer
iInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1))
    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.633758544921875, Rational
0.63385009765625), (Rational
0.79999999999999982236431605997495353221893310546875, Rational
0.80006103515624982239142111428709114306911942549049854278564453125)])

heron4p :: BoxFun
heron4p :: BoxFun
heron4p = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            _p :: Precision
_p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            _eps :: DivType Integer Integer
_eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
        in
            (Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Differential (CN MPBall)
yDifferential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Differential (CN MPBall)
xDifferential (CN MPBall)
-> Differential (CN MPBall)
-> DivType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Differential (CN MPBall)
y)Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2)
    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.5, Rational
2.0), (Rational
0.8, Rational
1.8)])

    
heron4q :: BoxFun
heron4q :: BoxFun
heron4q = 
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            y :: Differential (CN MPBall)
y = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
1
            p :: Precision
p = Vector (Differential (CN MPBall)) -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision Vector (Differential (CN MPBall))
v
            eps :: DivType Integer Integer
eps = Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
23)
        in
            ((Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt Differential (CN MPBall)
x Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Differential (CN MPBall)
yDifferential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Differential (CN MPBall)
xDifferential (CN MPBall)
-> Differential (CN MPBall)
-> DivType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Differential (CN MPBall)
y)Differential (CN MPBall)
-> Integer -> DivType (Differential (CN MPBall)) Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2) Differential (CN MPBall)
-> MPBall -> AddType (Differential (CN MPBall)) MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
1MPBall -> Integer -> DivType MPBall Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2)MPBall -> Integer -> PowType MPBall Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
i) Differential (CN MPBall)
-> MPBall -> AddType (Differential (CN MPBall)) MPBall
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Precision -> Integer -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Integer
6) MPBall -> Rational -> MulType MPBall Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Rational
eps MPBall -> Integer -> MulType MPBall Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Integer
iInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1))

    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.5, Rational
2.0), (Rational
0.8, Rational
1.8)])

-- heronFull :: BoxFun
-- heronFull =
--     BoxFun
--     3
--     (\v ->
--         let
--             x = v!0
--             y = v!1
--             i = v!2
--             p = getPrecision v
--             eps = 1/2^(23)
--         in
--             ((sqrt x - (y+x/y)/2) + (mpBallP p 1/2)^(2^i) + (mpBallP p 6) * eps * (i-1))

--     )
--     (fromListDomain [(0.5, 2.0), (0.8, 1.8), (1.0, 5.0)])


mxp1 :: BoxFun
mxp1 :: BoxFun
mxp1 =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            -- y = v!1
        in
            -Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> AddType (Differential (CN MPBall)) Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
1

    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.0, Rational
2.0), (Rational
0.0, Rational
2.0)])

xm1 :: BoxFun
xm1 :: BoxFun
xm1 =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            -- y = v!1
        in
            Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> SubType (Differential (CN MPBall)) Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1

    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.0, Rational
2.0), (Rational
0.0, Rational
2.0)])

xe2p1 :: BoxFun
xe2p1 :: BoxFun
xe2p1 =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            -- y = v!1
        in
            Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2Differential (CN MPBall)
-> Integer -> AddType (Differential (CN MPBall)) Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
1
    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.0, Rational
2.0), (Rational
0.0, Rational
2.0)])

xe2m1 :: BoxFun
xe2m1 :: BoxFun
xe2m1 =
    Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    Integer
2
    (\Vector (Differential (CN MPBall))
v ->
        let
            x :: Differential (CN MPBall)
x = Vector (Differential (CN MPBall))
vVector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
!Integer
0
            -- y = v!1
        in
            Differential (CN MPBall)
xDifferential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2Differential (CN MPBall)
-> Integer -> SubType (Differential (CN MPBall)) Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1
    )
    ([(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain [(Rational
0.0, Rational
2.0), (Rational
0.0, Rational
2.0)])