{-# LANGUAGE CPP #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module AERN2.RealFun.Tests
(
FnAndDescr(..)
, specFnPointwiseOp1, specFnPointwiseOp2
)
where
#ifdef DEBUG
import Debug.Trace (trace)
#define maybeTrace trace
#else
#define maybeTrace (flip const)
#endif
import MixedTypesNumPrelude
import Test.Hspec
import Test.QuickCheck
import AERN2.MP.Enclosure
import AERN2.RealFun.Operations
data FnAndDescr f = FnAndDescr f String
instance Show f => Show (FnAndDescr f) where
show :: FnAndDescr f -> String
show (FnAndDescr f
f String
descr) =
f -> String
forall a. Show a => a -> String
show f
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
descr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
instance (HasDomain f) => HasDomain (FnAndDescr f) where
type Domain (FnAndDescr f) = Domain f
getDomain :: FnAndDescr f -> Domain (FnAndDescr f)
getDomain (FnAndDescr f
f String
_) = f -> Domain f
forall f. HasDomain f => f -> Domain f
getDomain f
f
specFnPointwiseOp2 ::
_ =>
(T f) -> (T x) ->
String ->
(f -> f -> f) ->
(v -> v -> v) ->
(FnAndDescr f -> FnAndDescr f) ->
(FnAndDescr f -> FnAndDescr f) ->
Spec
specFnPointwiseOp2 :: T f
-> T x
-> String
-> (f -> f -> f)
-> (v -> v -> v)
-> (FnAndDescr f -> FnAndDescr f)
-> (FnAndDescr f -> FnAndDescr f)
-> Spec
specFnPointwiseOp2
(T String
fName :: T f) (T String
_xName :: T x)
String
opName f -> f -> f
opFn (v -> v -> v
opVal :: v -> v -> v) FnAndDescr f -> FnAndDescr f
reshapeFn1 FnAndDescr f -> FnAndDescr f
reshapeFn2
=
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (String
"pointwise " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
opName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fName String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" corresponds to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
opName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" on values") (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ (SameDomFnPair (FnAndDescr f) -> [x] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((SameDomFnPair (FnAndDescr f) -> [x] -> Bool) -> Property)
-> (SameDomFnPair (FnAndDescr f) -> [x] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$
\ (SameDomFnPair (FnAndDescr f
f1Pre,FnAndDescr f
f2Pre) :: SameDomFnPair (FnAndDescr f)) ([x]
xPres :: [x]) ->
let FnAndDescr f
f1 String
_d1 = FnAndDescr f -> FnAndDescr f
reshapeFn1 FnAndDescr f
f1Pre in
let FnAndDescr f
f2 String
_d2 = FnAndDescr f -> FnAndDescr f
reshapeFn2 FnAndDescr f
f2Pre 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 (f -> Domain f
forall f. HasDomain f => f -> Domain f
getDomain f
f1) 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
f1 x
x in
let v2 :: ApplyType f x
v2 = f -> x -> ApplyType f x
forall f x. CanApply f x => f -> x -> ApplyType f x
apply f
f2 x
x in
let vr :: v
vr = v -> v -> v
opVal v
ApplyType f x
v1 v
ApplyType f x
v2 in
f -> x -> ApplyType f x
forall f x. CanApply f x => f -> x -> ApplyType f x
apply (f -> f -> f
opFn f
f1 f
f2) x
x v -> v -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? (v
vr :: v)
specFnPointwiseOp1 ::
_ =>
(T f) -> (T x) ->
String ->
(f -> f) ->
(v -> v) ->
(FnAndDescr f -> FnAndDescr f) ->
Spec
specFnPointwiseOp1 :: T f
-> T x
-> String
-> (f -> f)
-> (v -> v)
-> (FnAndDescr f -> FnAndDescr f)
-> Spec
specFnPointwiseOp1
(T String
fName :: T f) (T String
_xName :: T x)
String
opName f -> f
opFn (v -> v
opVal :: v -> v) FnAndDescr f -> FnAndDescr f
reshapeFn1
=
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (String
"pointwise " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
opName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fName String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" corresponds to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
opName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" on values") (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ (FnAndDescr f -> [x] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((FnAndDescr f -> [x] -> Bool) -> Property)
-> (FnAndDescr f -> [x] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$
\ (FnAndDescr f
f1Pre :: FnAndDescr f) ([x]
xPres :: [x]) ->
let FnAndDescr f
f1 String
_d1 = FnAndDescr f -> FnAndDescr f
reshapeFn1 FnAndDescr f
f1Pre 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 (f -> Domain f
forall f. HasDomain f => f -> Domain f
getDomain f
f1) 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
f1 x
x in
let vr :: v
vr = v -> v
opVal v
ApplyType f x
v1 in
f -> x -> ApplyType f x
forall f x. CanApply f x => f -> x -> ApplyType f x
apply (f -> f
opFn f
f1) x
x v -> v -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? (v
vr :: v)