{-# OPTIONS_GHC -Wno-orphans #-}
module AERN2.AD.GenericOperations where

import MixedTypesNumPrelude
import AERN2.AD.Type

instance 
    (CanDiv a a, CanSubSameType a, CanMulSameType a, CanMulBy a Integer, CanAddSameType a,
    CanSubSameType (DivType a a)) 
    =>
    CanDiv (Differential a) (Differential a)
    where
    type DivType     (Differential a) (Differential a) = Differential (DivType a a)
    divide :: Differential a
-> Differential a -> DivType (Differential a) (Differential a)
divide Differential a
a Differential a
b =
        case Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
a) (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
b) of
            MinMaxType Integer Integer
2 -> 
                let
                    dtDiff :: SubType a a
dtDiff    = (a
a_dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dxt)
                    ySqrd :: MulType a a
ySqrd     = a
b_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x
                    exp0 :: SubType a a
exp0      = a
a_d2x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
a_dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dx a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
b_dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
a_dx a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_d2x
                in
                DivType a a
-> DivType a a
-> DivType a a
-> DivType a a
-> Differential (DivType a a)
forall a. a -> a -> a -> a -> Differential a
OrderTwo  (a
a_x a -> a -> DivType a a
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ a
b_x) ((a
a_dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dx)a -> a -> DivType a a
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/a
MulType a a
ySqrd) (a
SubType a a
dtDiffa -> a -> DivType a a
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/a
MulType a a
ySqrd) 
                          (a
SubType a a
exp0a -> a -> DivType a a
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/a
MulType a a
ySqrd DivType a a -> DivType a a -> SubType (DivType a a) (DivType a a)
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Integer
2Integer -> a -> MulType Integer a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*a
b_dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
SubType a a
dtDiff) a -> a -> DivType a a
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ (a
MulType a a
ySqrd a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x))
            MinMaxType Integer Integer
1 -> DivType a a -> DivType a a -> Differential (DivType a a)
forall a. a -> a -> Differential a
OrderOne  (a
a_x a -> a -> DivType a a
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ a
b_x) ((a
a_dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dx)a -> a -> DivType a a
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/(a
b_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x)) 
            MinMaxType Integer Integer
0 -> DivType a a -> Differential (DivType a a)
forall a. a -> Differential a
OrderZero (a
a_x a -> a -> DivType a a
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ a
b_x)
            MinMaxType Integer Integer
_ -> [Char] -> Differential (DivType a a)
forall a. HasCallStack => [Char] -> a
error [Char]
"illegal Differential order"
        where
        a_x :: a
a_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
a
        b_x :: a
b_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
b
        a_dx :: a
a_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
a
        b_dx :: a
b_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
b
        a_dxt :: a
a_dxt = Differential a -> a
forall a. Differential a -> a
diff_dxt Differential a
a
        b_dxt :: a
b_dxt = Differential a -> a
forall a. Differential a -> a
diff_dxt Differential a
b
        a_d2x :: a
a_d2x = Differential a -> a
forall a. Differential a -> a
diff_d2x Differential a
a
        b_d2x :: a
b_d2x = Differential a -> a
forall a. Differential a -> a
diff_d2x Differential a
b

instance 
    (CanExpSameType a, CanMulSameType a, CanAddSameType a) =>
    CanExp (Differential a)
    where
    type ExpType (Differential a) = Differential a
    exp :: Differential a -> ExpType (Differential a)
exp (OrderZero a
x)           = a -> Differential a
forall a. a -> Differential a
OrderZero (a -> ExpType a
forall t. CanExp t => t -> ExpType t
exp a
x)
    exp (OrderOne a
x a
dx)         = a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a -> ExpType a
forall t. CanExp t => t -> ExpType t
exp a
x) (a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> ExpType a
forall t. CanExp t => t -> ExpType t
exp a
x)
    exp (OrderTwo a
x a
dx a
dxt a
d2x) = a -> a -> a -> a -> Differential a
forall a. a -> a -> a -> a -> Differential a
OrderTwo  (a -> ExpType a
forall t. CanExp t => t -> ExpType t
exp a
x) (a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> ExpType a
forall t. CanExp t => t -> ExpType t
exp a
x) (a
dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> ExpType a
forall t. CanExp t => t -> ExpType t
exp a
x) ((a
dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
dx a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
d2x) a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> ExpType a
forall t. CanExp t => t -> ExpType t
exp a
x)


{- TODO: fix this in AERN2.MP -}
clampedCos :: (CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) => a -> a
clampedCos :: a -> a
clampedCos (a
x :: a) = a -> a -> MinMaxType a a
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max (Integer -> a
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ -Integer
1 :: a) (a -> MinMaxType a a) -> a -> MinMaxType a a
forall a b. (a -> b) -> a -> b
$ a -> a -> MinMaxType a a
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min ((Integer -> a
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1) :: a) (a -> SinCosType a
forall t. CanSinCos t => t -> SinCosType t
cos a
x)

clampedSin :: (CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) => a -> a
clampedSin :: a -> a
clampedSin (a
x :: a) = a -> a -> MinMaxType a a
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max (Integer -> a
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ -Integer
1 :: a) (a -> MinMaxType a a) -> a -> MinMaxType a a
forall a b. (a -> b) -> a -> b
$ a -> a -> MinMaxType a a
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min ((Integer -> a
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1) :: a) (a -> SinCosType a
forall t. CanSinCos t => t -> SinCosType t
sin a
x)

instance 
    (CanSinCosSameType a, CanMulSameType a, CanNegSameType a, CanSubSameType a, CanAddSameType a
    , HasIntegers a, CanMinMaxSameType a) 
    =>
    CanSinCos (Differential a)
    where
    type SinCosType (Differential a) = Differential a
    cos :: Differential a -> SinCosType (Differential a)
cos (OrderZero a
x)            = a -> Differential a
forall a. a -> Differential a
OrderZero (a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedCos a
x)
    cos (OrderOne  a
x a
dx)         = a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedCos a
x) (-a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedSin a
x)
    cos (OrderTwo  a
x a
dx a
dxt a
d2x) = a -> a -> a -> a -> Differential a
forall a. a -> a -> a -> a -> Differential a
OrderTwo  (a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedCos a
x) (-a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedSin a
x) (-a
dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedSin a
x) 
                                                (-a
dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedCos a
x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
d2x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedSin a
x)
    
    sin :: Differential a -> SinCosType (Differential a)
sin (OrderZero a
x)            = a -> Differential a
forall a. a -> Differential a
OrderZero (a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedSin a
x)
    sin (OrderOne a
x a
dx)          = a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedSin a
x) (a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedCos a
x)
    sin (OrderTwo a
x a
dx a
dxt a
d2x)  = a -> a -> a -> a -> Differential a
forall a. a -> a -> a -> a -> Differential a
OrderTwo  (a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedSin a
x) (a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedCos a
x) (a
dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedCos a
x)
                                                (a
d2x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedCos a
x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> a
forall a.
(CanSinCosSameType a, CanMinMaxSameType a, HasIntegers a) =>
a -> a
clampedSin a
x)

instance 
    (CanAddSameType a) => 
    CanAddAsymmetric (Differential a) (Differential a)
    where
    type AddType (Differential a) (Differential a) = Differential a
    add :: Differential a
-> Differential a -> AddType (Differential a) (Differential a)
add Differential a
a Differential a
b =
        case Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
a) (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
b) of
            MinMaxType Integer Integer
2 -> a -> a -> a -> a -> Differential a
forall a. a -> a -> a -> a -> Differential a
OrderTwo  (a
a_x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
b_x) (a
a_dx a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
b_dx) (a
a_dxt a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
b_dxt) (a
a_d2x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
b_d2x)
            MinMaxType Integer Integer
1 -> a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a
a_x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
b_x) (a
a_dx a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
b_dx)
            MinMaxType Integer Integer
0 -> a -> Differential a
forall a. a -> Differential a
OrderZero (a
a_x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
b_x)
            MinMaxType Integer Integer
_ -> [Char] -> Differential a
forall a. HasCallStack => [Char] -> a
error [Char]
"illegal Differential order"
        where
        a_x :: a
a_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
a
        b_x :: a
b_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
b
        a_dx :: a
a_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
a
        b_dx :: a
b_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
b
        a_dxt :: a
a_dxt = Differential a -> a
forall a. Differential a -> a
diff_dxt Differential a
a
        b_dxt :: a
b_dxt = Differential a -> a
forall a. Differential a -> a
diff_dxt Differential a
b
        a_d2x :: a
a_d2x = Differential a -> a
forall a. Differential a -> a
diff_d2x Differential a
a
        b_d2x :: a
b_d2x = Differential a -> a
forall a. Differential a -> a
diff_d2x Differential a
b
        
instance 
    (CanMulSameType a, CanAddSameType a) =>
    CanMulAsymmetric (Differential a) (Differential a)
    where
    type MulType (Differential a) (Differential a) = Differential a
    mul :: Differential a
-> Differential a -> MulType (Differential a) (Differential a)
mul Differential a
a Differential a
b =
        case Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
a) (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
b) of
            MinMaxType Integer Integer
2 -> a -> a -> a -> a -> Differential a
forall a. a -> a -> a -> a -> Differential a
OrderTwo  (a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x) (a
a_dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dx) (a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dxt a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
b_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
a_dxt) 
                           (a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_d2x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
a_dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dxt a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
a_dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dx a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
a_d2x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x)
            MinMaxType Integer Integer
1 -> a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x) (a
a_dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dx)
            MinMaxType Integer Integer
0 -> a -> Differential a
forall a. a -> Differential a
OrderZero (a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_x)
            MinMaxType Integer Integer
_ -> [Char] -> Differential a
forall a. HasCallStack => [Char] -> a
error [Char]
"illegal Differential order"
        where
        a_x :: a
a_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
a
        b_x :: a
b_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
b
        a_dx :: a
a_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
a
        b_dx :: a
b_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
b
        a_dxt :: a
a_dxt = Differential a -> a
forall a. Differential a -> a
diff_dxt Differential a
a
        b_dxt :: a
b_dxt = Differential a -> a
forall a. Differential a -> a
diff_dxt Differential a
b
        a_d2x :: a
a_d2x = Differential a -> a
forall a. Differential a -> a
diff_d2x Differential a
a
        b_d2x :: a
b_d2x = Differential a -> a
forall a. Differential a -> a
diff_d2x Differential a
b

instance 
    (CanMulSameType a, CanAddSameType a, CanPowBy a a, CanSubThis a Integer, CanLogSameType a, CanDivSameType a) =>
    CanPow (Differential a) (Differential a)
    where
    type PowType        (Differential a) (Differential a) = (Differential a)
    pow :: Differential a
-> Differential a -> PowType (Differential a) (Differential a)
pow Differential a
a Differential a
b =
        case Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
a) (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
b) of
            MinMaxType Integer Integer
2 -> a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a
a_x a -> a -> PowType a a
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ a
b_x) ((a
a_x a -> a -> PowType a a
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ (a
b_x a -> Integer -> SubType a Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1)) a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (a
b_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
a_dx a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (a -> LogType a
forall t. CanLog t => t -> LogType t
log a
a_x) a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dx)) --FIXME: Add real OrderTwo definition here
            -- 2 -> OrderTwo   (x a ^ x b) 
            --                 ((x a ^ (x b - (convertExactly 1 :: a))) * (x b * dx a + x a * log (x a) * dx b)) 
            --                 ((x a ^ (x b - (convertExactly 1 :: a))) * (x b * dxt a + x a * log (x a) * dxt b))
            --                 (x a)
                            
            --                 where
            --                     ta = convertExactly 2 :: a
            MinMaxType Integer Integer
1 -> a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a
a_x a -> a -> PowType a a
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ a
b_x) ((a
a_x a -> a -> PowType a a
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ (a
b_x a -> Integer -> SubType a Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1)) a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (a
b_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
a_dx a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ a
a_x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (a -> LogType a
forall t. CanLog t => t -> LogType t
log a
a_x) a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
b_dx))
            MinMaxType Integer Integer
0 -> a -> Differential a
forall a. a -> Differential a
OrderZero (a
a_x a -> a -> PowType a a
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ a
b_x)
            MinMaxType Integer Integer
_ -> PowType (Differential a) (Differential a)
forall a. HasCallStack => a
undefined
        where
        a_x :: a
a_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
a
        b_x :: a
b_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
b
        a_dx :: a
a_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
a
        b_dx :: a
b_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
b
        -- a_dxt = diff_dxt a
        -- b_dxt = diff_dxt b
        -- a_d2x = diff_d2x a
        -- b_d2x = diff_d2x b

instance 
    (CanSubSameType a) =>
    CanSub (Differential a) (Differential a)
    where
    type SubType (Differential a) (Differential a) = Differential a
    sub :: Differential a
-> Differential a -> SubType (Differential a) (Differential a)
sub Differential a
a Differential a
b =
        case Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
a) (Differential a -> Integer
forall a. Differential a -> Integer
order Differential a
b) of
            MinMaxType Integer Integer
2 -> a -> a -> a -> a -> Differential a
forall a. a -> a -> a -> a -> Differential a
OrderTwo  (a
a_x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
b_x) (a
a_dx a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
b_dx) (a
a_dxt a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
b_dxt) (a
a_d2x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
b_d2x)
            MinMaxType Integer Integer
1 -> a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a
a_x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
b_x) (a
a_dx a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
b_dx)
            MinMaxType Integer Integer
0 -> a -> Differential a
forall a. a -> Differential a
OrderZero (a
a_x a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- a
b_x)
            MinMaxType Integer Integer
_ -> [Char] -> Differential a
forall a. HasCallStack => [Char] -> a
error [Char]
"illegal Differential order"
        where
        a_x :: a
a_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
a
        b_x :: a
b_x = Differential a -> a
forall a. Differential a -> a
diff_x Differential a
b
        a_dx :: a
a_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
a
        b_dx :: a
b_dx = Differential a -> a
forall a. Differential a -> a
diff_dx Differential a
b
        a_dxt :: a
a_dxt = Differential a -> a
forall a. Differential a -> a
diff_dxt Differential a
a
        b_dxt :: a
b_dxt = Differential a -> a
forall a. Differential a -> a
diff_dxt Differential a
b
        a_d2x :: a
a_d2x = Differential a -> a
forall a. Differential a -> a
diff_d2x Differential a
a
        b_d2x :: a
b_d2x = Differential a -> a
forall a. Differential a -> a
diff_d2x Differential a
b

instance 
    (CanMulBy (Differential a) Integer) =>
    CanNeg (Differential a)
    where
    type NegType (Differential a) = Differential a
    negate :: Differential a -> NegType (Differential a)
negate Differential a
x = (-Integer
1) Integer -> Differential a -> MulType Integer (Differential a)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Differential a
x

instance 
    (CanSqrtSameType a, CanMulSameType a, CanNegSameType a, CanAddSameType a, CanMulBy a Integer, CanRecipSameType a) 
    =>
    CanSqrt (Differential a)
    where
    type SqrtType (Differential a) = Differential a
    sqrt :: Differential a -> SqrtType (Differential a)
sqrt (OrderZero a
x)             = a -> Differential a
forall a. a -> Differential a
OrderZero (a -> SqrtType a
forall t. CanSqrt t => t -> SqrtType t
sqrt a
x)
    sqrt (OrderOne a
x a
dx)           = a -> a -> Differential a
forall a. a -> a -> Differential a
OrderOne  (a -> SqrtType a
forall t. CanSqrt t => t -> SqrtType t
sqrt a
x) (a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
DivType Integer a
sqrtx')
                                        where sqrtx' :: DivType Integer a
sqrtx' = a -> DivType Integer a
forall t. CanRecip t => t -> DivType Integer t
recip (Integer
2 Integer -> a -> MulType Integer a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> SqrtType a
forall t. CanSqrt t => t -> SqrtType t
sqrt a
x)
    sqrt (OrderTwo a
x a
dx a
dxt a
d2x)   = a -> a -> a -> a -> Differential a
forall a. a -> a -> a -> a -> Differential a
OrderTwo  (a -> SqrtType a
forall t. CanSqrt t => t -> SqrtType t
sqrt a
x) (a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
DivType Integer a
sqrtx') (a
dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
DivType Integer a
sqrtx') 
                                               ((a
d2x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
DivType Integer a
sqrtx') a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (a
dx a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
dxt a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
NegType a
sqrtx'')) 
                                        where 
                                        sqrtx' :: DivType Integer a
sqrtx'  = a -> DivType Integer a
forall t. CanRecip t => t -> DivType Integer t
recip (Integer
2 Integer -> a -> MulType Integer a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> SqrtType a
forall t. CanSqrt t => t -> SqrtType t
sqrt a
x)
                                        sqrtx'' :: NegType a
sqrtx'' = a -> NegType a
forall t. CanNeg t => t -> NegType t
negate (a -> NegType a) -> a -> NegType a
forall a b. (a -> b) -> a -> b
$ a -> DivType Integer a
forall t. CanRecip t => t -> DivType Integer t
recip (Integer
4 Integer -> a -> MulType Integer a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a
x a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* a -> SqrtType a
forall t. CanSqrt t => t -> SqrtType t
sqrt a
x)
                                            -- sqrtx'  == 1 / (2 * sqrt(x))
                                            -- sqrtx'' == -1 / (4 * x * sqrt(x)) == -1 / (4 * x^(3/2))

instance
    CanMinMaxSameType a =>
    CanMinMaxAsymmetric (Differential a) (Differential a)
    where
    type MinMaxType (Differential a) (Differential a) = Differential a
    min :: Differential a
-> Differential a -> MinMaxType (Differential a) (Differential a)
min Differential a
a Differential a
b = a -> Differential a
forall a. a -> Differential a
OrderZero (a -> a -> MinMaxType a a
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (Differential a -> a
forall a. Differential a -> a
diff_x Differential a
a) (Differential a -> a
forall a. Differential a -> a
diff_x Differential a
b))
    max :: Differential a
-> Differential a -> MinMaxType (Differential a) (Differential a)
max Differential a
a Differential a
b = a -> Differential a
forall a. a -> Differential a
OrderZero (a -> a -> MinMaxType a a
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max (Differential a -> a
forall a. Differential a -> a
diff_x Differential a
a) (Differential a -> a
forall a. Differential a -> a
diff_x Differential a
b))


-- instance
--     (CanMinMaxSameType a, HasIntegers a) =>
--     CanMinMaxAsymmetric (Differential a) (Differential a)
--     where
--     type MinMaxType (Differential a) (Differential a) = Differential a
--     min a b = 
--         case min (order a) (order b) of
--             2 -> OrderTwo  (min (a_x) (b_x)) (min (a_dx) (b_dx)) (min (a_dxt) (b_dxt)) 
--                            (min (a_d2x) (b_d2x))
--             1 -> OrderOne  (min (a_x) (b_x)) (min (a_dx) (b_dx))
--             0 -> OrderZero (min (a_x) (b_x))
--     max a b =
--         case min (order a) (order b) of
--             2 -> OrderTwo  (max (a_x) (b_x)) (max (a_dx) (b_dx)) (max (a_dxt) (b_dxt)) 
--                            (max (a_d2x) (b_d2x))
--             1 -> OrderOne  (max (a_x) (b_x)) (max (a_dx) (b_dx))
--             0 -> OrderZero (max (a_x) (b_x))

-- instance
--     (CanAbsSameType a) =>
--     CanAbs (Differential a)
--     where
--     type AbsType (Differential a) = Differential a
--     abs = fmap abs