module PropaFP.Translators.BoxFun where

import MixedTypesNumPrelude

import AERN2.AD.Differential
import AERN2.BoxFun.Type
import AERN2.BoxFun.TestFunctions (fromListDomain)
import PropaFP.Expression
import PropaFP.VarMap
import AERN2.MP.Ball
import AERN2.MP.Float
import qualified AERN2.Linear.Vector.Type as V
import qualified Prelude as P
import Data.List
import Numeric.CollectErrors
import PropaFP.DeriveBounds


expressionToBoxFun :: E -> VarMap -> Precision -> BoxFun
expressionToBoxFun :: E -> VarMap -> Precision -> BoxFun
expressionToBoxFun E
expression VarMap
domain Precision
p =
  Integer
-> (Vector (Differential (CN MPBall)) -> Differential (CN MPBall))
-> Vector (CN MPBall)
-> BoxFun
BoxFun
    (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (VarMap -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length VarMap
domain))
    (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
expression)
    Vector (CN MPBall)
vectorDomain
  where

    expressionToDifferential2 :: E -> V.Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
    expressionToDifferential2 :: E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential2 E
e Vector (Differential (CN MPBall))
v = E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v
      where
        ev :: Differential (CN MPBall)
ev  = E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v
        evc :: Differential (CN MPBall)
evc = E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
vc
        vc :: Vector (Differential (CN MPBall))
vc  = (Differential (CN MPBall) -> Differential (CN MPBall))
-> Vector (Differential (CN MPBall))
-> Vector (Differential (CN MPBall))
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((CN MPBall -> CN MPBall)
-> Differential (CN MPBall) -> Differential (CN MPBall)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MPBall -> MPBall) -> CN MPBall -> CN MPBall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MPBall -> MPBall
forall t. IsBall t => t -> t
centreAsBall)) Vector (Differential (CN MPBall))
v
        

    -- TODO: Change to bfEval
    expressionToDifferential :: E -> V.Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
    expressionToDifferential :: E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential e :: E
e@(Float RoundingMode
_ E
_) Vector (Differential (CN MPBall))
_   = String -> Differential (CN MPBall)
forall a. HasCallStack => String -> a
error (String -> Differential (CN MPBall))
-> String -> Differential (CN MPBall)
forall a b. (a -> b) -> a -> b
$ String
"Cannot translate expression containing float to BoxFun: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ E -> String
prettyShowE E
e
    expressionToDifferential e :: E
e@(Float32 RoundingMode
_ E
_) Vector (Differential (CN MPBall))
_ = String -> Differential (CN MPBall)
forall a. HasCallStack => String -> a
error (String -> Differential (CN MPBall))
-> String -> Differential (CN MPBall)
forall a b. (a -> b) -> a -> b
$ String
"Cannot translate expression containing float32 to BoxFun: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ E -> String
prettyShowE E
e
    expressionToDifferential e :: E
e@(Float64 RoundingMode
_ E
_) Vector (Differential (CN MPBall))
_ = String -> Differential (CN MPBall)
forall a. HasCallStack => String -> a
error (String -> Differential (CN MPBall))
-> String -> Differential (CN MPBall)
forall a b. (a -> b) -> a -> b
$ String
"Cannot translate expression containing float64 to BoxFun: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ E -> String
prettyShowE E
e
    expressionToDifferential (RoundToInteger RoundingMode
mode E
e) Vector (Differential (CN MPBall))
v = --FIXME: add round to AD
      case E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v of
        OrderZero CN MPBall
x      -> CN MPBall -> Differential (CN MPBall)
forall a. a -> Differential a
OrderZero (CN MPBall -> Differential (CN MPBall))
-> CN MPBall -> Differential (CN MPBall)
forall a b. (a -> b) -> a -> b
$ RoundingMode -> CN MPBall -> CN MPBall
forall i p.
(Real (IntervalEndpoint i), IsInterval i, IsInterval p,
 ConvertibleExactly Integer (IntervalEndpoint p)) =>
RoundingMode -> i -> p
roundMPBall RoundingMode
mode CN MPBall
x
        OrderOne CN MPBall
x CN MPBall
_     -> CN MPBall -> CN MPBall -> Differential (CN MPBall)
forall a. a -> a -> Differential a
OrderOne (RoundingMode -> CN MPBall -> CN MPBall
forall i p.
(Real (IntervalEndpoint i), IsInterval i, IsInterval p,
 ConvertibleExactly Integer (IntervalEndpoint p)) =>
RoundingMode -> i -> p
roundMPBall RoundingMode
mode CN MPBall
x) CN MPBall
forall {v}. CN v
err
        OrderTwo CN MPBall
x CN MPBall
_ CN MPBall
_ CN MPBall
_ -> CN MPBall
-> CN MPBall -> CN MPBall -> CN MPBall -> Differential (CN MPBall)
forall a. a -> a -> a -> a -> Differential a
OrderTwo (RoundingMode -> CN MPBall -> CN MPBall
forall i p.
(Real (IntervalEndpoint i), IsInterval i, IsInterval p,
 ConvertibleExactly Integer (IntervalEndpoint p)) =>
RoundingMode -> i -> p
roundMPBall RoundingMode
mode CN MPBall
x) CN MPBall
forall {v}. CN v
err CN MPBall
forall {v}. CN v
err CN MPBall
forall {v}. CN v
err
        where
          err :: CN v
err = NumError -> CN v
forall v. NumError -> CN v
noValueNumErrorCertain (NumError -> CN v) -> NumError -> CN v
forall a b. (a -> b) -> a -> b
$ String -> NumError
NumError String
"No derivatives after rounding to integer"

    expressionToDifferential (EBinOp BinOp
op E
e1 E
e2) Vector (Differential (CN MPBall))
v = 
      case BinOp
op of
        BinOp
Min -> Differential (CN MPBall)
-> Differential (CN MPBall)
-> MinMaxType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e1 Vector (Differential (CN MPBall))
v) (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e2 Vector (Differential (CN MPBall))
v)
        BinOp
Max -> Differential (CN MPBall)
-> Differential (CN MPBall)
-> MinMaxType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e1 Vector (Differential (CN MPBall))
v) (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e2 Vector (Differential (CN MPBall))
v)
        BinOp
Pow -> Differential (CN MPBall)
-> Differential (CN MPBall)
-> PowType (Differential (CN MPBall)) (Differential (CN MPBall))
forall b e. CanPow b e => b -> e -> PowType b e
pow (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e1 Vector (Differential (CN MPBall))
v) (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e2 Vector (Differential (CN MPBall))
v)
        BinOp
Add -> E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e1 Vector (Differential (CN MPBall))
v Differential (CN MPBall)
-> Differential (CN MPBall)
-> AddType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e2 Vector (Differential (CN MPBall))
v
        BinOp
Sub -> E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e1 Vector (Differential (CN MPBall))
v Differential (CN MPBall)
-> Differential (CN MPBall)
-> SubType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e2 Vector (Differential (CN MPBall))
v
        BinOp
Mul -> E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e1 Vector (Differential (CN MPBall))
v Differential (CN MPBall)
-> Differential (CN MPBall)
-> MulType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e2 Vector (Differential (CN MPBall))
v
        BinOp
Div -> E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e1 Vector (Differential (CN MPBall))
v Differential (CN MPBall)
-> Differential (CN MPBall)
-> DivType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e2 Vector (Differential (CN MPBall))
v
        BinOp
Mod -> E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e1 Vector (Differential (CN MPBall))
v Differential (CN MPBall)
-> Differential (CN MPBall)
-> ModType (Differential (CN MPBall)) (Differential (CN MPBall))
forall t1 t2. CanDivIMod t1 t2 => t1 -> t2 -> ModType t1 t2
`mod` E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e2 Vector (Differential (CN MPBall))
v
    expressionToDifferential (EUnOp UnOp
op E
e) Vector (Differential (CN MPBall))
v = 
      case UnOp
op of
        UnOp
Abs -> Differential (CN MPBall) -> AbsType (Differential (CN MPBall))
forall t. CanAbs t => t -> AbsType t
abs (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v)
        UnOp
Sqrt -> Differential (CN MPBall) -> SqrtType (Differential (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v)
        UnOp
Negate -> Differential (CN MPBall) -> NegType (Differential (CN MPBall))
forall t. CanNeg t => t -> NegType t
negate (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v)
        UnOp
Sin -> Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
sin (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v)
        UnOp
Cos -> Differential (CN MPBall) -> SinCosType (Differential (CN MPBall))
forall t. CanSinCos t => t -> SinCosType t
cos (E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v)
    expressionToDifferential (Lit Rational
e) Vector (Differential (CN MPBall))
_ = Integer -> CN MPBall -> Differential (CN MPBall)
forall a. CanBeDifferential a => Integer -> a -> Differential a
differential Integer
2 (CN MPBall -> Differential (CN MPBall))
-> CN MPBall -> Differential (CN MPBall)
forall a b. (a -> b) -> a -> b
$ MPBall -> CN MPBall
forall v. v -> CN v
cn (Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Rational
e)
    expressionToDifferential (Var String
e) Vector (Differential (CN MPBall))
v = 
      case String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
e [String]
variableOrder of
        Maybe Int
Nothing -> String -> Differential (CN MPBall)
forall a. HasCallStack => String -> a
error (String -> Differential (CN MPBall))
-> String -> Differential (CN MPBall)
forall a b. (a -> b) -> a -> b
$ String
"Variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found in varMap: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarMap -> String
forall a. Show a => a -> String
show VarMap
domain String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" when translating expression: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
e 
        Just Int
i -> Vector (Differential (CN MPBall))
v Vector (Differential (CN MPBall))
-> Integer -> Differential (CN MPBall)
forall a. Vector a -> Integer -> a
V.! (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    expressionToDifferential E
Pi Vector (Differential (CN MPBall))
_ = Integer -> CN MPBall -> Differential (CN MPBall)
forall a. CanBeDifferential a => Integer -> a -> Differential a
differential Integer
2 (CN MPBall -> Differential (CN MPBall))
-> CN MPBall -> Differential (CN MPBall)
forall a b. (a -> b) -> a -> b
$ MPBall -> CN MPBall
forall v. v -> CN v
cn (Precision -> MPBall
piBallP Precision
p)
    expressionToDifferential (PowI E
e Integer
i) Vector (Differential (CN MPBall))
v = E -> Vector (Differential (CN MPBall)) -> Differential (CN MPBall)
expressionToDifferential E
e Vector (Differential (CN MPBall))
v Differential (CN MPBall)
-> Integer -> PowType (Differential (CN MPBall)) Integer
forall b e. CanPow b e => b -> e -> PowType b e
^ Integer
i

    variableOrder :: [String]
variableOrder = ((String, (Rational, Rational)) -> String) -> VarMap -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Rational, Rational)) -> String
forall a b. (a, b) -> a
fst VarMap
domain
    vectorDomain :: Vector (CN MPBall)
vectorDomain  = [(Rational, Rational)] -> Vector (CN MPBall)
fromListDomain (((String, (Rational, Rational)) -> (Rational, Rational))
-> VarMap -> [(Rational, Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Rational, Rational)) -> (Rational, Rational)
forall a b. (a, b) -> b
snd VarMap
domain)