{-# OPTIONS_GHC -Wno-orphans #-}
module AERN2.MP.Enclosure
(
IsBall(..), ballFunctionUsingLipschitz
, IsInterval(..), endpointL, endpointR
, fromEndpointsAsIntervals, endpointsAsIntervals, endpointLAsInterval, endpointRAsInterval
, intervalFunctionByEndpoints, intervalFunctionByEndpointsUpDown
, CanPlusMinus(..), (+-)
, CanTestContains(..), CanMapInside(..), specCanMapInside
, CanIntersectAsymmetric(..), CanIntersect
, CanIntersectBy, CanIntersectSameType
, CanIntersectCNBy, CanIntersectCNSameType
, CanUnionAsymmetric(..), CanUnion
, CanUnionBy, CanUnionSameType
, CanUnionCNBy, CanUnionCNSameType
)
where
import MixedTypesNumPrelude
import Test.Hspec
import Test.QuickCheck
import qualified Numeric.CollectErrors as CN
import AERN2.Kleenean
import AERN2.MP.ErrorBound
import Control.CollectErrors (CollectErrors(getMaybeValue))
class IsBall t where
type CentreType t
centre :: t -> CentreType t
centreAsBallAndRadius :: t-> (t,ErrorBound)
centreAsBall :: t -> t
centreAsBall = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. IsBall t => t -> (t, ErrorBound)
centreAsBallAndRadius
radius :: t -> ErrorBound
radius = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. IsBall t => t -> (t, ErrorBound)
centreAsBallAndRadius
updateRadius :: (ErrorBound -> ErrorBound) -> (t -> t)
makeExactCentre :: t -> t
makeExactCentre t
v =
forall t. IsBall t => (ErrorBound -> ErrorBound) -> t -> t
updateRadius (forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ErrorBound
r) t
c
where
(t
c, ErrorBound
r) = forall t. IsBall t => t -> (t, ErrorBound)
centreAsBallAndRadius t
v
instance IsBall t => IsBall (CN t) where
type CentreType (CN t) = CN (CentreType t)
centre :: CN t -> CentreType (CN t)
centre = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. IsBall t => t -> CentreType t
centre
centreAsBall :: CN t -> CN t
centreAsBall = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. IsBall t => t -> t
centreAsBall
updateRadius :: (ErrorBound -> ErrorBound) -> CN t -> CN t
updateRadius ErrorBound -> ErrorBound
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall t. IsBall t => (ErrorBound -> ErrorBound) -> t -> t
updateRadius ErrorBound -> ErrorBound
f)
centreAsBallAndRadius :: CN t -> (CN t, ErrorBound)
centreAsBallAndRadius = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"centreAsBallAndRadius not defined for CN types"
ballFunctionUsingLipschitz ::
(IsBall t, HasEqCertainly t t)
=>
(t -> t) ->
(t -> ErrorBound) ->
(t -> t)
ballFunctionUsingLipschitz :: forall t.
(IsBall t, HasEqCertainly t t) =>
(t -> t) -> (t -> ErrorBound) -> t -> t
ballFunctionUsingLipschitz t -> t
fThin t -> ErrorBound
fLip t
x
| ErrorBound
r forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = t -> t
fThin t
c
| Bool
otherwise = forall t. IsBall t => (ErrorBound -> ErrorBound) -> t -> t
updateRadius (forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t -> ErrorBound
fLip t
x)forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*ErrorBound
r) (t -> t
fThin t
c)
where
(t
c, ErrorBound
r) = forall t. IsBall t => t -> (t, ErrorBound)
centreAsBallAndRadius t
x
class IsInterval i where
type IntervalEndpoint i
endpoints :: i -> (IntervalEndpoint i, IntervalEndpoint i)
fromEndpoints :: IntervalEndpoint i -> IntervalEndpoint i -> i
instance (IsInterval t) => (IsInterval (CN t)) where
type (IntervalEndpoint (CN t)) = CN (IntervalEndpoint t)
fromEndpoints :: IntervalEndpoint (CN t) -> IntervalEndpoint (CN t) -> CN t
fromEndpoints IntervalEndpoint (CN t)
l IntervalEndpoint (CN t)
u = forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CN.lift2 forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints IntervalEndpoint (CN t)
l IntervalEndpoint (CN t)
u
endpoints :: CN t -> (IntervalEndpoint (CN t), IntervalEndpoint (CN t))
endpoints = forall es a c d.
Monoid es =>
(a -> (c, d))
-> CollectErrors es a -> (CollectErrors es c, CollectErrors es d)
CN.liftPair forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints
endpointL :: (IsInterval i) => i -> IntervalEndpoint i
endpointL :: forall i. IsInterval i => i -> IntervalEndpoint i
endpointL = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints
endpointR :: (IsInterval i) => i -> IntervalEndpoint i
endpointR :: forall i. IsInterval i => i -> IntervalEndpoint i
endpointR = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints
endpointsAsIntervals ::
(IsInterval i) => i -> (i,i)
endpointsAsIntervals :: forall i. IsInterval i => i -> (i, i)
endpointsAsIntervals i
x = (i
lI,i
rI)
where
lI :: i
lI = forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints IntervalEndpoint i
l IntervalEndpoint i
l
rI :: i
rI = forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints IntervalEndpoint i
r IntervalEndpoint i
r
(IntervalEndpoint i
l,IntervalEndpoint i
r) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints i
x
endpointLAsInterval :: (IsInterval i) => i -> i
endpointLAsInterval :: forall i. IsInterval i => i -> i
endpointLAsInterval = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. IsInterval i => i -> (i, i)
endpointsAsIntervals
endpointRAsInterval :: (IsInterval i) => i -> i
endpointRAsInterval :: forall i. IsInterval i => i -> i
endpointRAsInterval = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. IsInterval i => i -> (i, i)
endpointsAsIntervals
fromEndpointsAsIntervals ::
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals :: forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals i
l i
r =
forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints MinMaxType (IntervalEndpoint i) (IntervalEndpoint i)
lMP MinMaxType (IntervalEndpoint i) (IntervalEndpoint i)
uMP
where
lMP :: MinMaxType (IntervalEndpoint i) (IntervalEndpoint i)
lMP = forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min IntervalEndpoint i
llMP IntervalEndpoint i
rlMP
uMP :: MinMaxType (IntervalEndpoint i) (IntervalEndpoint i)
uMP = forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max IntervalEndpoint i
luMP IntervalEndpoint i
ruMP
(IntervalEndpoint i
llMP, IntervalEndpoint i
luMP) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints i
l
(IntervalEndpoint i
rlMP, IntervalEndpoint i
ruMP) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints i
r
class CanPlusMinus t1 t2 where
type PlusMinusType t1 t2
type PlusMinusType t1 t2 = t1
plusMinus :: t1 -> t2 -> PlusMinusType t1 t2
infixl 6 +-
(+-) :: (CanPlusMinus t1 t2) => t1 -> t2 -> PlusMinusType t1 t2
+- :: forall t1 t2. CanPlusMinus t1 t2 => t1 -> t2 -> PlusMinusType t1 t2
(+-) = forall t1 t2. CanPlusMinus t1 t2 => t1 -> t2 -> PlusMinusType t1 t2
plusMinus
intervalFunctionByEndpoints ::
(IsInterval t, CanMinMaxSameType (IntervalEndpoint t), HasEqCertainly t t)
=>
(t -> t) ->
(t -> t)
intervalFunctionByEndpoints :: forall t.
(IsInterval t, CanMinMaxSameType (IntervalEndpoint t),
HasEqCertainly t t) =>
(t -> t) -> t -> t
intervalFunctionByEndpoints t -> t
fThin t
x
| t
l forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! t
u = t -> t
fThin t
l
| Bool
otherwise = forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals (t -> t
fThin t
l) (t -> t
fThin t
u)
where
(t
l,t
u) = forall i. IsInterval i => i -> (i, i)
endpointsAsIntervals t
x
intervalFunctionByEndpointsUpDown ::
(IsInterval t)
=>
(IntervalEndpoint t -> IntervalEndpoint t) ->
(IntervalEndpoint t -> IntervalEndpoint t) ->
(t -> t)
intervalFunctionByEndpointsUpDown :: forall t.
IsInterval t =>
(IntervalEndpoint t -> IntervalEndpoint t)
-> (IntervalEndpoint t -> IntervalEndpoint t) -> t -> t
intervalFunctionByEndpointsUpDown IntervalEndpoint t -> IntervalEndpoint t
fDown IntervalEndpoint t -> IntervalEndpoint t
fUp t
x =
forall i.
IsInterval i =>
IntervalEndpoint i -> IntervalEndpoint i -> i
fromEndpoints (IntervalEndpoint t -> IntervalEndpoint t
fDown IntervalEndpoint t
l) (IntervalEndpoint t -> IntervalEndpoint t
fUp IntervalEndpoint t
u)
where
(IntervalEndpoint t
l,IntervalEndpoint t
u) = forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints t
x
class CanTestContains dom e where
contains :: dom -> e -> Bool
instance (CanTestContains dom e) => CanTestContains (CN dom) (CN e) where
contains :: CN dom -> CN e -> Bool
contains CN dom
domCN CN e
aCN =
case (forall es v. CollectErrors es v -> Maybe v
getMaybeValue CN dom
domCN, forall es v. CollectErrors es v -> Maybe v
getMaybeValue CN e
aCN) of
(Just dom
dom, Just e
a) -> dom
dom forall dom e. CanTestContains dom e => dom -> e -> Bool
`contains` e
a
(Maybe dom, Maybe e)
_ -> Bool
False
class CanMapInside dom e where
mapInside :: dom -> e -> e
specCanMapInside ::
(CanMapInside d e, CanTestContains d e
, Arbitrary d, Arbitrary e, Show d, Show e)
=>
T d -> T e -> Spec
specCanMapInside :: forall d e.
(CanMapInside d e, CanTestContains d e, Arbitrary d, Arbitrary e,
Show d, Show e) =>
T d -> T e -> Spec
specCanMapInside (T [Char]
dName :: T d) (T [Char]
eName :: T e) =
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it ([Char]
"CanMapInside " forall a. [a] -> [a] -> [a]
++ [Char]
dName forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
eName) forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$
\ (d
d :: d) (e
e :: e) ->
forall dom e. CanTestContains dom e => dom -> e -> Bool
contains d
d forall a b. (a -> b) -> a -> b
$ forall dom e. CanMapInside dom e => dom -> e -> e
mapInside d
d e
e
type CanIntersect e1 e2 =
(CanIntersectAsymmetric e1 e2, CanIntersectAsymmetric e1 e2
, IntersectionType e1 e2 ~ IntersectionType e2 e1)
class CanIntersectAsymmetric e1 e2 where
type IntersectionType e1 e2
type IntersectionType e1 e2 = CN e1
intersect :: e1 -> e2 -> IntersectionType e1 e2
type CanIntersectBy e1 e2 =
(CanIntersect e1 e2, IntersectionType e1 e2 ~ e1)
type CanIntersectSameType e1 =
(CanIntersectBy e1 e1)
type CanIntersectCNBy e1 e2 =
(CanIntersect e1 e2, IntersectionType e1 e2 ~ CN e1)
type CanIntersectCNSameType e1 =
(CanIntersectCNBy e1 e1)
instance
CanIntersectAsymmetric Bool Bool
where
intersect :: Bool -> Bool -> IntersectionType Bool Bool
intersect Bool
b1 Bool
b2
| Bool
b1 forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Bool
b2 = forall v. v -> CN v
cn Bool
b1
| Bool
otherwise =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
CN.NumError [Char]
"empty Boolean intersection"
instance
CanIntersectAsymmetric Kleenean Kleenean
where
intersect :: Kleenean -> Kleenean -> IntersectionType Kleenean Kleenean
intersect Kleenean
CertainTrue Kleenean
CertainFalse =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
CN.NumError [Char]
"empty Kleenean intersection"
intersect Kleenean
CertainFalse Kleenean
CertainTrue =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
CN.NumError [Char]
"empty Kleenean intersection"
intersect Kleenean
TrueOrFalse Kleenean
k2 = forall v. v -> CN v
cn Kleenean
k2
intersect Kleenean
k1 Kleenean
_ = forall v. v -> CN v
cn Kleenean
k1
instance
(CanIntersectAsymmetric a b, IntersectionType a b ~ CN c)
=>
CanIntersectAsymmetric (CN a) (CN b)
where
type IntersectionType (CN a) (CN b) = IntersectionType a b
intersect :: CN a -> CN b -> IntersectionType (CN a) (CN b)
intersect = forall a b c. (a -> b -> CN c) -> CN a -> CN b -> CN c
CN.lift2CN forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect
instance
(CanIntersectAsymmetric (CN Bool) (CN b))
=>
CanIntersectAsymmetric Bool (CN b)
where
type IntersectionType Bool (CN b) = IntersectionType (CN Bool) (CN b)
intersect :: Bool -> CN b -> IntersectionType Bool (CN b)
intersect Bool
b1 = forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect (forall v. v -> CN v
cn Bool
b1)
instance
(CanIntersectAsymmetric (CN a) (CN Bool))
=>
CanIntersectAsymmetric (CN a) Bool
where
type IntersectionType (CN a) Bool = IntersectionType (CN a) (CN Bool)
intersect :: CN a -> Bool -> IntersectionType (CN a) Bool
intersect CN a
b1 Bool
b2 = forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect CN a
b1 (forall v. v -> CN v
cn Bool
b2)
instance
(CanIntersectAsymmetric (CN Kleenean) (CN b))
=>
CanIntersectAsymmetric Kleenean (CN b)
where
type IntersectionType Kleenean (CN b) = IntersectionType (CN Kleenean) (CN b)
intersect :: Kleenean -> CN b -> IntersectionType Kleenean (CN b)
intersect Kleenean
k1 = forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect (forall v. v -> CN v
cn Kleenean
k1)
instance
(CanIntersectAsymmetric (CN a) (CN Kleenean))
=>
CanIntersectAsymmetric (CN a) Kleenean
where
type IntersectionType (CN a) Kleenean = IntersectionType (CN a) (CN Kleenean)
intersect :: CN a -> Kleenean -> IntersectionType (CN a) Kleenean
intersect CN a
k1 Kleenean
k2 = forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect CN a
k1 (forall v. v -> CN v
cn Kleenean
k2)
type CanUnion e1 e2 =
(CanUnionAsymmetric e1 e2, CanUnionAsymmetric e1 e2
, UnionType e1 e2 ~ UnionType e2 e1)
class CanUnionAsymmetric e1 e2 where
type UnionType e1 e2
type UnionType e1 e2 = CN e1
union :: e1 -> e2 -> UnionType e1 e2
type CanUnionBy e1 e2 =
(CanUnion e1 e2, UnionType e1 e2 ~ e1)
type CanUnionSameType e1 =
(CanUnionBy e1 e1)
type CanUnionCNBy e1 e2 =
(CanUnion e1 e2, UnionType e1 e2 ~ CN e1)
type CanUnionCNSameType e1 =
(CanUnionCNBy e1 e1)
instance
(CanUnionAsymmetric a b, UnionType a b ~ CN c)
=>
CanUnionAsymmetric (CN a) (CN b)
where
type UnionType (CN a) (CN b) = UnionType a b
union :: CN a -> CN b -> UnionType (CN a) (CN b)
union = forall a b c. (a -> b -> CN c) -> CN a -> CN b -> CN c
CN.lift2CN forall e1 e2.
CanUnionAsymmetric e1 e2 =>
e1 -> e2 -> UnionType e1 e2
union
instance (CanUnionSameType t, CN.CanTakeCNErrors t) =>
HasIfThenElse Kleenean t
where
type IfThenElseType Kleenean t = t
ifThenElse :: Kleenean -> t -> t -> IfThenElseType Kleenean t
ifThenElse Kleenean
CertainTrue t
e1 t
_ = t
e1
ifThenElse Kleenean
CertainFalse t
_ t
e2 = t
e2
ifThenElse Kleenean
TrueOrFalse t
e1 t
e2 = t
e1 forall e1 e2.
CanUnionAsymmetric e1 e2 =>
e1 -> e2 -> UnionType e1 e2
`union` t
e2