{-# LANGUAGE CPP #-}
-- #define DEBUG
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-|
    Module      :  AERN2.RealFun.Operations
    Description :  Classes for real number function operations
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Classes for real number function operations
-}
module AERN2.RealFun.Operations
(
  HasDomain(..)
  , SameDomFnPair(..), ArbitraryWithDom(..)
  , CanApply(..)
  , CanApplyApprox(..), sampledRange
  , HasFnConstructorInfo(..)
  , HasConstFunctions, constFn, specEvalConstFn
  , HasVars(..), specEvalUnaryVarFn
  , CanMaximiseOverDom(..), CanMinimiseOverDom(..)
  , specCanMaximiseOverDom
  , CanIntegrateOverDom(..)
)
where

#ifdef DEBUG
import Debug.Trace (trace)
#define maybeTrace trace
#define maybeTraceIO putStrLn
#else
#define maybeTrace (\ (_ :: String) t -> t)
#define maybeTraceIO (\ (_ :: String) -> return ())
#endif

import MixedTypesNumPrelude
-- import qualified Prelude as P
import Text.Printf

-- import Data.Typeable

-- import qualified Data.List as List

import Test.Hspec
import Test.QuickCheck

import AERN2.Interval

import AERN2.MP.Dyadic
import AERN2.MP.Enclosure

{- domain -}

class HasDomain f where
  type Domain f
  getDomain :: f -> Domain f

data SameDomFnPair f = SameDomFnPair (f,f) deriving Int -> SameDomFnPair f -> ShowS
[SameDomFnPair f] -> ShowS
SameDomFnPair f -> String
(Int -> SameDomFnPair f -> ShowS)
-> (SameDomFnPair f -> String)
-> ([SameDomFnPair f] -> ShowS)
-> Show (SameDomFnPair f)
forall f. Show f => Int -> SameDomFnPair f -> ShowS
forall f. Show f => [SameDomFnPair f] -> ShowS
forall f. Show f => SameDomFnPair f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SameDomFnPair f] -> ShowS
$cshowList :: forall f. Show f => [SameDomFnPair f] -> ShowS
show :: SameDomFnPair f -> String
$cshow :: forall f. Show f => SameDomFnPair f -> String
showsPrec :: Int -> SameDomFnPair f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> SameDomFnPair f -> ShowS
Show

instance (ArbitraryWithDom f, Arbitrary f) => (Arbitrary (SameDomFnPair f)) where
  arbitrary :: Gen (SameDomFnPair f)
arbitrary =
    do
    f
f1 <- Gen f
forall a. Arbitrary a => Gen a
arbitrary
    f
f2 <- Domain f -> Gen f
forall f. ArbitraryWithDom f => Domain f -> Gen f
arbitraryWithDom (f -> Domain f
forall f. HasDomain f => f -> Domain f
getDomain f
f1)
    SameDomFnPair f -> Gen (SameDomFnPair f)
forall (m :: * -> *) a. Monad m => a -> m a
return (SameDomFnPair f -> Gen (SameDomFnPair f))
-> SameDomFnPair f -> Gen (SameDomFnPair f)
forall a b. (a -> b) -> a -> b
$ (f, f) -> SameDomFnPair f
forall f. (f, f) -> SameDomFnPair f
SameDomFnPair (f
f1,f
f2)

class (HasDomain f) => ArbitraryWithDom f where
  arbitraryWithDom :: (Domain f) -> Gen f

{- evaluation -}

class CanApply f x where
  type ApplyType f x
  {-| compute @f(x)@  -}
  apply :: f {-^ @f@ -} -> x {-^ @x@ -} -> ApplyType f x

{-|
  Give an unsafe etimate of the function's range which is fast to compute.
  Intended to be used in optimisation heuristics.
-}
class CanApplyApprox f x where
  type ApplyApproxType f x
  {-| compute a cheap and unsafe approximation of @f(x)@  -}
  applyApprox :: f {-^ @f@ -} -> x {-^ @x@ -} -> ApplyApproxType f x

{-|
  Evaluate a function on a regular grid of the given size and return
  the largerst and smallest values found.  Useful for making instances
  of class 'CanApplyApprox'.
-}
sampledRange ::
  (CanApply f t, ApplyType f t ~ t,
   CanMinMaxSameType t, ConvertibleExactly Dyadic t, Show t)
  =>
  DyadicInterval -> Integer -> f -> Interval t t
sampledRange :: DyadicInterval -> Integer -> f -> Interval t t
sampledRange (Interval Dyadic
l Dyadic
r) Integer
depth f
f =
    maybeTrace
    ( String
"sampledRange:"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n samplePointsT = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([t] -> String
forall a. Show a => a -> String
show [t]
samplePointsT)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n samples = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [t] -> String
forall a. Show a => a -> String
show [t]
samples
    ) (Interval t t -> Interval t t) -> Interval t t -> Interval t t
forall a b. (a -> b) -> a -> b
$
    t -> t -> Interval t t
forall l r. l -> r -> Interval l r
Interval t
minValue t
maxValue
    where
    minValue :: t
minValue = (t -> t -> t) -> [t] -> t
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 t -> t -> t
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min [t]
samples
    maxValue :: t
maxValue = (t -> t -> t) -> [t] -> t
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 t -> t -> t
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max [t]
samples
    samples :: [t]
samples = (t -> t) -> [t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (f -> t -> ApplyType f t
forall f x. CanApply f x => f -> x -> ApplyType f x
apply f
f) [t]
samplePointsT
    samplePointsT :: [t]
samplePointsT = (Dyadic -> t) -> [Dyadic] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Dyadic -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly [Dyadic]
samplePoints
    [t]
_ = t
minValue t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
samplePointsT
    samplePoints :: [Dyadic]
    samplePoints :: [Dyadic]
samplePoints = [(Dyadic
lDyadic -> Integer -> MulType Dyadic Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*Integer
i Dyadic -> Dyadic -> AddType Dyadic Dyadic
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Dyadic
rDyadic -> Integer -> MulType Dyadic Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(Integer
PowType Integer Integer
size Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
i))Dyadic -> Dyadic -> MulType Dyadic Dyadic
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(Rational -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic (Integer
1Integer -> Integer -> DivType Integer Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
PowType Integer Integer
size)) | Integer
i <- [Integer
0..Integer
PowType Integer Integer
size]]
    size :: PowType Integer Integer
size = Integer
2Integer -> Integer -> PowType Integer Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
depth


{- constructing basic functions -}

class HasFnConstructorInfo f where
  type FnConstructorInfo f
  getFnConstructorInfo :: f -> FnConstructorInfo f

type HasConstFunctions t f =
  (ConvertibleExactly (FnConstructorInfo f, t) f)

constFn :: (HasConstFunctions t f) => (FnConstructorInfo f) -> t -> f
constFn :: FnConstructorInfo f -> t -> f
constFn = ((FnConstructorInfo f, t) -> f) -> FnConstructorInfo f -> t -> f
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (FnConstructorInfo f, t) -> f
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

specEvalConstFn ::
  _ => T c-> T f -> T x -> Spec
specEvalConstFn :: T c -> T f -> T x -> Spec
specEvalConstFn (T String
cName :: T c) (T String
fName :: T f) (T String
xName :: T x) =
  String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Evaluating %s-constant functions %s on %s" String
cName String
fName String
xName) (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
    (c -> FnConstructorInfo f -> [x] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> FnConstructorInfo f -> [x] -> Bool) -> Property)
-> (c -> FnConstructorInfo f -> [x] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$
      \ (c
c :: c) (FnConstructorInfo f
constrInfo :: FnConstructorInfo f) ([x]
xPres :: [x]) ->
        let f :: f
f = FnConstructorInfo f -> c -> f
forall t f. HasConstFunctions t f => FnConstructorInfo f -> t -> f
constFn FnConstructorInfo f
constrInfo c
c :: f in
        let dom :: Domain f
dom = f -> Domain f
forall f. HasDomain f => f -> Domain f
getDomain f
f in
        [Bool] -> Bool
forall t. (CanAndOrSameType t, CanTestCertainly t) => [t] -> t
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((x -> Bool) -> [x] -> [Bool]) -> [x] -> (x -> Bool) -> [Bool]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> Bool) -> [x] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map [x]
xPres ((x -> Bool) -> [Bool]) -> (x -> Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ \x
xPre ->
          f -> x -> ApplyType f x
forall f x. CanApply f x => f -> x -> ApplyType f x
apply f
f (Domain f -> x -> x
forall dom e. CanMapInside dom e => dom -> e -> e
mapInside Domain f
dom x
xPre) ApplyType f x -> c -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? c
c

class HasVars f where
  type Var f
  {-| the function @x@, ie the function that project the domain to the given variable @x@  -}
  varFn ::
    FnConstructorInfo f {-^ eg domain and/or accuracy guide -}->
    Var f {-^ @x@ -} ->
    f

specEvalUnaryVarFn ::
  _ => T f -> T x -> Spec
specEvalUnaryVarFn :: T f -> T x -> Spec
specEvalUnaryVarFn (T String
fName :: T f) (T String
xName :: T x) =
  String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Evaluating variable functions %s on %s" String
fName String
xName) (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ (FnConstructorInfo f -> [x] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((FnConstructorInfo f -> [x] -> Bool) -> Property)
-> (FnConstructorInfo f -> [x] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$
    \ (FnConstructorInfo f
constrInfo :: FnConstructorInfo f) ([x]
xPres :: [x]) ->
      [Bool] -> Bool
forall t. (CanAndOrSameType t, CanTestCertainly t) => [t] -> t
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((x -> Bool) -> [x] -> [Bool]) -> [x] -> (x -> Bool) -> [Bool]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> Bool) -> [x] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map [x]
xPres ((x -> Bool) -> [Bool]) -> (x -> Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ \x
xPre ->
        let f :: f
f = FnConstructorInfo f -> Var f -> f
forall f. HasVars f => FnConstructorInfo f -> Var f -> f
varFn FnConstructorInfo f
constrInfo () :: f in
        let x :: x
x = Domain f -> x -> x
forall dom e. CanMapInside dom e => dom -> e -> e
mapInside (f -> Domain f
forall f. HasDomain f => f -> Domain f
getDomain f
f) x
xPre in
        f -> x -> ApplyType f x
forall f x. CanApply f x => f -> x -> ApplyType f x
apply f
f x
x ApplyType f x -> x -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? x
x


{- range computation -}

class CanMaximiseOverDom f d where
  type MaximumOverDomType f d
  maximumOverDom :: f -> d -> MaximumOverDomType f d

class CanMinimiseOverDom f d where
  type MinimumOverDomType f d
  minimumOverDom :: f -> d -> MinimumOverDomType f d

-- specCanMaximiseOverDom ::
--   _ => (T f) -> Spec
-- specCanMaximiseOverDom (T fName :: T f) =
--   describe ("CanMaximiseOverDom " ++ fName) $ do
--     it "is consistent over a split domain" $ property $
--         \ (f :: f) ->
--           let dom = getDomain f in
--           let (dom1, dom2) = split dom in
--           let maxOnDom = maximumOverDom f dom in
--           let maxOnDom1 = maximumOverDom f dom1 in
--           let maxOnDom2 = maximumOverDom f dom2 in
--           maxOnDom ?>=? maxOnDom1
--           &&
--           maxOnDom ?>=? maxOnDom2

specCanMaximiseOverDom ::
  _ => (T f) -> (T x) -> Spec
specCanMaximiseOverDom :: T f -> T x -> Spec
specCanMaximiseOverDom (T String
fName :: T f) (T String
_xName :: T x) =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"CanMaximiseOverDom " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"is consistent with evaluation" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ (f -> [x] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((f -> [x] -> Bool) -> Property) -> (f -> [x] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$
      \ (f
f :: f) ([x]
xPres :: [x]) ->
        let dom :: Domain f
dom = f -> Domain f
forall f. HasDomain f => f -> Domain f
getDomain f
f in
        let maxOnDom :: MaximumOverDomType f (Domain f)
maxOnDom = f -> Domain f -> MaximumOverDomType f (Domain f)
forall f d.
CanMaximiseOverDom f d =>
f -> d -> MaximumOverDomType f d
maximumOverDom f
f Domain f
dom in
        [Bool] -> Bool
forall t. (CanAndOrSameType t, CanTestCertainly t) => [t] -> t
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((x -> Bool) -> [x] -> [Bool]) -> [x] -> (x -> Bool) -> [Bool]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> Bool) -> [x] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map [x]
xPres ((x -> Bool) -> [Bool]) -> (x -> Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ \x
xPre ->
          let x :: x
x = Domain f -> x -> x
forall dom e. CanMapInside dom e => dom -> e -> e
mapInside Domain f
dom x
xPre in
          let v1 :: ApplyType f x
v1 = f -> x -> ApplyType f x
forall f x. CanApply f x => f -> x -> ApplyType f x
apply f
f x
x in
          MaximumOverDomType f (Domain f)
maxOnDom MaximumOverDomType f (Domain f) -> ApplyType f x -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?>=? ApplyType f x
v1


{- integration -}

class CanIntegrateOverDom f bounds where
  type IntegralOverDomType f bounds
  integrateOverDom :: f -> bounds -> IntegralOverDomType f bounds