{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-|
    Module      :  AERN2.Interval
    Description :  Intervals for use as function domains
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Intervals for use as function domains
-}
module AERN2.Interval
(
  Interval(..), singleton
  , width, split
  , arbitraryNonEmptyInterval
  , arbitraryNonEmptySmallInterval
  , intersect, intersects
  , DyadicInterval, CanBeDyadicInterval, dyadicInterval
  , RealInterval, CanBeRealInterval, realInterval
)
where

import MixedTypesNumPrelude
-- import Numeric.CollectErrors (NumErrors, CanTakeErrors(..))
import qualified Numeric.CollectErrors as CN

import qualified Prelude as P
import Text.Printf
-- import Text.Regex.TDFA

-- import Data.Maybe


import GHC.Generics
import Data.Typeable

-- import qualified Data.List as List

-- import Test.Hspec
import Test.QuickCheck

import AERN2.MP.Enclosure
import AERN2.MP.Dyadic
import AERN2.MP.Ball hiding (intersect)
-- import qualified AERN2.MP.Ball as MPBall

import AERN2.Real

{- type -}

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)
      -- printf "[%s,%s]" (show l) (show 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))

{- containment -}

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

{- intersection -}

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

{- comparison -}

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)

{- Dyadic intervals -}

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)

{- CauchyReal intervals -}

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)