{-# LANGUAGE CPP #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
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 Text.Printf
import Test.Hspec
import Test.QuickCheck
import AERN2.Interval
import AERN2.MP.Dyadic
import AERN2.MP.Enclosure
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
class CanApply f x where
type ApplyType f x
apply :: f -> x -> ApplyType f x
class CanApplyApprox f x where
type ApplyApproxType f x
applyApprox :: f -> x -> ApplyApproxType f x
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
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
varFn ::
FnConstructorInfo f ->
Var f ->
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
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) -> (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
class CanIntegrateOverDom f bounds where
type IntegralOverDomType f bounds
integrateOverDom :: f -> bounds -> IntegralOverDomType f bounds