{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module AERN2.Interval
(
Interval(..), singleton
, width, split
, arbitraryNonEmptyInterval
, arbitraryNonEmptySmallInterval
, intersect, intersects
, DyadicInterval, CanBeDyadicInterval, dyadicInterval
, RealInterval, CanBeRealInterval, realInterval
)
where
import MixedTypesNumPrelude
import qualified Numeric.CollectErrors as CN
import qualified Prelude as P
import Text.Printf
import GHC.Generics
import Data.Typeable
import Test.QuickCheck
import AERN2.MP.Enclosure
import AERN2.MP.Dyadic
import AERN2.MP.Ball hiding (intersect)
import AERN2.Real
data Interval l r = Interval l r
deriving (Interval l r -> Interval l r -> Bool
(Interval l r -> Interval l r -> Bool)
-> (Interval l r -> Interval l r -> Bool) -> Eq (Interval l r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l r. (Eq l, Eq r) => Interval l r -> Interval l r -> Bool
/= :: Interval l r -> Interval l r -> Bool
$c/= :: forall l r. (Eq l, Eq r) => Interval l r -> Interval l r -> Bool
== :: Interval l r -> Interval l r -> Bool
$c== :: forall l r. (Eq l, Eq r) => Interval l r -> Interval l r -> Bool
P.Eq, (forall x. Interval l r -> Rep (Interval l r) x)
-> (forall x. Rep (Interval l r) x -> Interval l r)
-> Generic (Interval l r)
forall x. Rep (Interval l r) x -> Interval l r
forall x. Interval l r -> Rep (Interval l r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l r x. Rep (Interval l r) x -> Interval l r
forall l r x. Interval l r -> Rep (Interval l r) x
$cto :: forall l r x. Rep (Interval l r) x -> Interval l r
$cfrom :: forall l r x. Interval l r -> Rep (Interval l r) x
Generic)
instance (Show l, Show r) => Show (Interval l r) where
show :: Interval l r -> String
show (Interval l
l r
r) =
String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Interval (%s) (%s)" (l -> String
forall a. Show a => a -> String
show l
l) (r -> String
forall a. Show a => a -> String
show r
r)
instance (Read l, Read r) => Read (Interval l r) where
readsPrec :: Int -> ReadS (Interval l r)
readsPrec Int
_pr String
intervalS
| String
prefix1 String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== String
"Interval (" =
case ReadS l
forall a. Read a => ReadS a
reads String
afterP1 of
[(l
l,String
afterL)] ->
if String
prefix2 String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== String
") ("
then
case ReadS r
forall a. Read a => ReadS a
reads String
afterP2 of
[(r
r,Char
')':String
rest)] -> [(l -> r -> Interval l r
forall l r. l -> r -> Interval l r
Interval l
l r
r, String
rest)]
[(r, String)]
_ -> []
else []
where
(String
prefix2, String
afterP2) = Integer -> String -> (String, String)
forall n a. CanBeInteger n => n -> [a] -> ([a], [a])
splitAt (String -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length String
") (") String
afterL
[(l, String)]
_ -> []
| Bool
otherwise = []
where
(String
prefix1, String
afterP1) = Integer -> String -> (String, String)
forall n a. CanBeInteger n => n -> [a] -> ([a], [a])
splitAt (String -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length String
"Interval (") String
intervalS
singleton :: a -> Interval a a
singleton :: a -> Interval a a
singleton a
a = a -> a -> Interval a a
forall l r. l -> r -> Interval l r
Interval a
a a
a
instance IsInterval (Interval e e) where
type IntervalEndpoint (Interval e e) = e
fromEndpoints :: IntervalEndpoint (Interval e e)
-> IntervalEndpoint (Interval e e) -> Interval e e
fromEndpoints IntervalEndpoint (Interval e e)
l IntervalEndpoint (Interval e e)
r = e -> e -> Interval e e
forall l r. l -> r -> Interval l r
Interval e
IntervalEndpoint (Interval e e)
l e
IntervalEndpoint (Interval e e)
r
endpoints :: Interval e e
-> (IntervalEndpoint (Interval e e),
IntervalEndpoint (Interval e e))
endpoints (Interval e
l e
r) = (e
IntervalEndpoint (Interval e e)
l,e
IntervalEndpoint (Interval e e)
r)
width :: (CanSub r l) => Interval l r -> SubType r l
width :: Interval l r -> SubType r l
width (Interval l
l r
r) = r
r r -> l -> SubType r l
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- l
l
split ::
(CanAddSameType t, CanMulBy t Dyadic)
=>
(Interval t t) -> (Interval t t, Interval t t)
split :: Interval t t -> (Interval t t, Interval t t)
split (Interval t
l t
r) = (t -> t -> Interval t t
forall l r. l -> r -> Interval l r
Interval t
l t
MulType t Dyadic
m, t -> t -> Interval t t
forall l r. l -> r -> Interval l r
Interval t
MulType t Dyadic
m t
r)
where
m :: MulType t Dyadic
m = (t
l t -> t -> AddType t t
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t
r)t -> Dyadic -> MulType t Dyadic
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(Rational -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic Rational
0.5)
instance
(Arbitrary l, Arbitrary r, HasOrderCertainlyAsymmetric l r)
=>
Arbitrary (Interval l r)
where
arbitrary :: Gen (Interval l r)
arbitrary =
do
l
l <- Gen l
forall a. Arbitrary a => Gen a
arbitrary
r
r <- Gen r
forall a. Arbitrary a => Gen a
arbitrary
if l
l l -> r -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! r
r then Interval l r -> Gen (Interval l r)
forall (m :: * -> *) a. Monad m => a -> m a
return (l -> r -> Interval l r
forall l r. l -> r -> Interval l r
Interval l
l r
r) else Gen (Interval l r)
forall a. Arbitrary a => Gen a
arbitrary
arbitraryNonEmptyInterval ::
(Arbitrary l, Arbitrary r, HasOrderCertainlyAsymmetric l r)
=>
Gen (Interval l r)
arbitraryNonEmptyInterval :: Gen (Interval l r)
arbitraryNonEmptyInterval =
do
l
l <- Gen l
forall a. Arbitrary a => Gen a
arbitrary
r
r <- Gen r
forall a. Arbitrary a => Gen a
arbitrary
if l
l l -> r -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! r
r then Interval l r -> Gen (Interval l r)
forall (m :: * -> *) a. Monad m => a -> m a
return (l -> r -> Interval l r
forall l r. l -> r -> Interval l r
Interval l
l r
r) else Gen (Interval l r)
forall l r.
(Arbitrary l, Arbitrary r, HasOrderCertainlyAsymmetric l r) =>
Gen (Interval l r)
arbitraryNonEmptyInterval
arbitraryNonEmptySmallInterval ::
(Arbitrary e, CanAddThis e Integer)
=>
Gen (Interval e e)
arbitraryNonEmptySmallInterval :: Gen (Interval e e)
arbitraryNonEmptySmallInterval =
do
e
l <- Gen e
forall a. Arbitrary a => Gen a
arbitrary
Integer
w <- [Integer] -> Gen Integer
forall a. [a] -> Gen a
growingElements [Integer
1..Integer
10]
Interval e e -> Gen (Interval e e)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> e -> Interval e e
forall l r. l -> r -> Interval l r
Interval e
l (e
le -> Integer -> AddType e Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
w))
instance
(HasOrderAsymmetric l l', OrderCompareType l l' ~ Bool,
HasOrderAsymmetric r' r, OrderCompareType r' r ~ Bool)
=>
CanTestContains (Interval l r) (Interval l' r')
where
contains :: Interval l r -> Interval l' r' -> Bool
contains (Interval l
l r
r) (Interval l'
l' r'
r') =
l
l l -> l' -> OrderCompareType l l'
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= l'
l' Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& r'
r' r' -> r -> OrderCompareType r' r
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= r
r
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Dyadic |]]
(\ t -> [d|
instance
(HasOrderAsymmetric l $t, OrderCompareType l $t ~ Bool,
HasOrderAsymmetric $t r, OrderCompareType $t r ~ Bool)
=>
CanTestContains (Interval l r) $t
where
contains (Interval l r) e = l <= e && e <= r
|]))
instance
(CanSubSameType e, CanAddSubMulBy t e
, HasIntegerBounds t, CanSubThis t Integer, CanDivBy t Integer)
=>
CanMapInside (Interval e e) t
where
mapInside :: Interval e e -> t -> t
mapInside (Interval e
l e
r) t
x =
e
l e -> t -> AddType e t
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t
DivType t Integer
xUnit t -> e -> MulType t e
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (e
r e -> e -> SubType e e
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- e
l)
where
xUnit :: DivType t Integer
xUnit = (t
x t -> Integer -> SubType t Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
xL) t -> Integer -> DivType t Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ (Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
1 (Integer -> MinMaxType Integer Integer)
-> Integer -> MinMaxType Integer Integer
forall a b. (a -> b) -> a -> b
$ Integer
xU Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
xL)
(Integer
xL,Integer
xU) = t -> (Integer, Integer)
forall t. HasIntegerBounds t => t -> (Integer, Integer)
integerBounds t
x
instance
(CanMinMaxSameType l, CanMinMaxSameType r, HasOrderCertainly l r)
=>
CanIntersectAsymmetric (Interval l r) (Interval l r)
where
type IntersectionType (Interval l r) (Interval l r) = CN (Interval l r)
intersect :: Interval l r
-> Interval l r -> IntersectionType (Interval l r) (Interval l r)
intersect (Interval l
l1 r
r1) (Interval l
l2 r
r2)
| l
MinMaxType l l
l l -> r -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! r
MinMaxType r r
r = Interval l r -> CollectErrors NumErrors (Interval l r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (l -> r -> Interval l r
forall l r. l -> r -> Interval l r
Interval l
MinMaxType l l
l r
MinMaxType r r
r)
| l
MinMaxType l l
l l -> r -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! r
MinMaxType r r
r = NumError -> CollectErrors NumErrors (Interval l r)
forall v. NumError -> CN v
CN.noValueNumErrorCertain NumError
err
| Bool
otherwise = NumError
-> CollectErrors NumErrors (Interval l r)
-> CollectErrors NumErrors (Interval l r)
forall t. NumError -> CN t -> CN t
CN.prependErrorPotential NumError
err (CollectErrors NumErrors (Interval l r)
-> CollectErrors NumErrors (Interval l r))
-> CollectErrors NumErrors (Interval l r)
-> CollectErrors NumErrors (Interval l r)
forall a b. (a -> b) -> a -> b
$ Interval l r -> CollectErrors NumErrors (Interval l r)
forall v. v -> CN v
cn (l -> r -> Interval l r
forall l r. l -> r -> Interval l r
Interval l
MinMaxType l l
l r
MinMaxType r r
r)
where
l :: MinMaxType l l
l = l
l1 l -> l -> MinMaxType l l
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` l
l2
r :: MinMaxType r r
r = r
r1 r -> r -> MinMaxType r r
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` r
r2
err :: NumError
err = String -> NumError
CN.NumError String
"empty intersection"
intersects ::
(CanMinMaxSameType l, CanMinMaxSameType r, HasOrderCertainly l r)
=>
Interval l r -> Interval l r -> Bool
intersects :: Interval l r -> Interval l r -> Bool
intersects Interval l r
i1 Interval l r
i2 = Bool -> Bool
forall t. CanNeg t => t -> NegType t
not (Bool -> Bool)
-> (CN (Interval l r) -> Bool) -> CN (Interval l r) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CN (Interval l r) -> Bool
forall es. CanTestErrorsPresent es => es -> Bool
CN.hasError (CN (Interval l r) -> Bool) -> CN (Interval l r) -> Bool
forall a b. (a -> b) -> a -> b
$ Interval l r
-> Interval l r -> IntersectionType (Interval l r) (Interval l r)
forall e1 e2.
CanIntersectAsymmetric e1 e2 =>
e1 -> e2 -> IntersectionType e1 e2
intersect Interval l r
i1 Interval l r
i2
instance
(HasEqAsymmetric l1 l2, HasEqAsymmetric r1 r2
, EqCompareType l1 l2 ~ EqCompareType r1 r2
, CanAndOrSameType (EqCompareType l1 l2))
=>
HasEqAsymmetric (Interval l1 r1) (Interval l2 r2)
where
type EqCompareType (Interval l1 r1) (Interval l2 r2) = EqCompareType l1 l2
equalTo :: Interval l1 r1
-> Interval l2 r2
-> EqCompareType (Interval l1 r1) (Interval l2 r2)
equalTo (Interval l1
l1 r1
r1) (Interval l2
l2 r2
r2) =
(l1
l1 l1 -> l2 -> EqCompareType l1 l2
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== l2
l2) EqCompareType r1 r2
-> EqCompareType r1 r2
-> AndOrType (EqCompareType r1 r2) (EqCompareType r1 r2)
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (r1
r1 r1 -> r2 -> EqCompareType r1 r2
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== r2
r2)
type DyadicInterval = Interval Dyadic Dyadic
type CanBeDyadicInterval t = ConvertibleExactly t DyadicInterval
dyadicInterval :: (CanBeDyadicInterval t) => t -> DyadicInterval
dyadicInterval :: t -> DyadicInterval
dyadicInterval = t -> DyadicInterval
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
instance
(CanBeDyadic l, CanBeDyadic r, HasOrderCertainly l r, Show l, Show r,
Typeable l, Typeable r)
=>
ConvertibleExactly (l, r) DyadicInterval where
safeConvertExactly :: (l, r) -> ConvertResult DyadicInterval
safeConvertExactly (l
l,r
r)
| l
l l -> r -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! r
r = DyadicInterval -> ConvertResult DyadicInterval
forall a b. b -> Either a b
Right (DyadicInterval -> ConvertResult DyadicInterval)
-> DyadicInterval -> ConvertResult DyadicInterval
forall a b. (a -> b) -> a -> b
$ Dyadic -> Dyadic -> DyadicInterval
forall l r. l -> r -> Interval l r
Interval (l -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic l
l) (r -> Dyadic
forall t. CanBeDyadic t => t -> Dyadic
dyadic r
r)
| Bool
otherwise = String -> (l, r) -> ConvertResult DyadicInterval
forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
"endpoints are not in the correct order" (l
l,r
r)
instance ConvertibleExactly Dyadic DyadicInterval where
safeConvertExactly :: Dyadic -> ConvertResult DyadicInterval
safeConvertExactly Dyadic
d =
DyadicInterval -> ConvertResult DyadicInterval
forall a b. b -> Either a b
Right (DyadicInterval -> ConvertResult DyadicInterval)
-> DyadicInterval -> ConvertResult DyadicInterval
forall a b. (a -> b) -> a -> b
$ Dyadic -> Dyadic -> DyadicInterval
forall l r. l -> r -> Interval l r
Interval Dyadic
d Dyadic
d
instance ConvertibleExactly Integer DyadicInterval where
safeConvertExactly :: Integer -> ConvertResult DyadicInterval
safeConvertExactly Integer
n =
do
Dyadic
nD <- Integer -> ConvertResult Dyadic
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> ConvertResult t2
safeConvertExactly Integer
n
DyadicInterval -> ConvertResult DyadicInterval
forall a b. b -> Either a b
Right (DyadicInterval -> ConvertResult DyadicInterval)
-> DyadicInterval -> ConvertResult DyadicInterval
forall a b. (a -> b) -> a -> b
$ Dyadic -> Dyadic -> DyadicInterval
forall l r. l -> r -> Interval l r
Interval Dyadic
nD Dyadic
nD
instance ConvertibleExactly Rational DyadicInterval where
safeConvertExactly :: Rational -> ConvertResult DyadicInterval
safeConvertExactly Rational
r =
do
Dyadic
rD <- Rational -> ConvertResult Dyadic
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> ConvertResult t2
safeConvertExactly Rational
r
DyadicInterval -> ConvertResult DyadicInterval
forall a b. b -> Either a b
Right (DyadicInterval -> ConvertResult DyadicInterval)
-> DyadicInterval -> ConvertResult DyadicInterval
forall a b. (a -> b) -> a -> b
$ Dyadic -> Dyadic -> DyadicInterval
forall l r. l -> r -> Interval l r
Interval Dyadic
rD Dyadic
rD
instance ConvertibleExactly MPBall DyadicInterval where
safeConvertExactly :: MPBall -> ConvertResult DyadicInterval
safeConvertExactly MPBall
ball =
DyadicInterval -> ConvertResult DyadicInterval
forall a b. b -> Either a b
Right (DyadicInterval -> ConvertResult DyadicInterval)
-> DyadicInterval -> ConvertResult DyadicInterval
forall a b. (a -> b) -> a -> b
$ Dyadic -> Dyadic -> DyadicInterval
forall l r. l -> r -> Interval l r
Interval (MPBall -> CentreType MPBall
forall t. IsBall t => t -> CentreType t
centre MPBall
l) (MPBall -> CentreType MPBall
forall t. IsBall t => t -> CentreType t
centre MPBall
r)
where
(MPBall
l,MPBall
r) = MPBall -> (MPBall, MPBall)
forall i. IsInterval i => i -> (i, i)
endpointsAsIntervals MPBall
ball
instance ConvertibleExactly DyadicInterval MPBall where
safeConvertExactly :: DyadicInterval -> ConvertResult MPBall
safeConvertExactly (Interval Dyadic
lD Dyadic
rD) =
MPBall -> ConvertResult MPBall
forall a b. b -> Either a b
Right (MPBall -> ConvertResult MPBall) -> MPBall -> ConvertResult MPBall
forall a b. (a -> b) -> a -> b
$ MPBall -> MPBall -> MPBall
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals (Dyadic -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Dyadic
lD) (Dyadic -> MPBall
forall t. CanBeMPBall t => t -> MPBall
mpBall Dyadic
rD)
type RealInterval = Interval CReal CReal
type CanBeRealInterval t = ConvertibleExactly t RealInterval
realInterval :: (CanBeRealInterval t) => t -> RealInterval
realInterval :: t -> RealInterval
realInterval = t -> RealInterval
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
instance
(CanBeCReal l, CanBeCReal r, HasOrderCertainly l r, Show l, Show r,
Typeable l, Typeable r)
=>
ConvertibleExactly (l, r) RealInterval where
safeConvertExactly :: (l, r) -> ConvertResult RealInterval
safeConvertExactly (l
l,r
r)
| l
l l -> r -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! r
r = RealInterval -> ConvertResult RealInterval
forall a b. b -> Either a b
Right (RealInterval -> ConvertResult RealInterval)
-> RealInterval -> ConvertResult RealInterval
forall a b. (a -> b) -> a -> b
$ CReal -> CReal -> RealInterval
forall l r. l -> r -> Interval l r
Interval (l -> CReal
forall t. CanBeCReal t => t -> CReal
creal l
l) (r -> CReal
forall t. CanBeCReal t => t -> CReal
creal r
r)
| Bool
otherwise = String -> (l, r) -> ConvertResult RealInterval
forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
"endpoints are not in the correct order" (l
l,r
r)