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

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

    Test support for real number function operations
-}
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 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

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)