{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.IntegerInterval
-- Copyright   :  (c) Masahiro Sakai 2011-2014
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (ScopedTypeVariables, DeriveDataTypeable)
--
-- Interval datatype and interval arithmetic over integers.
--
-- Since 1.2.0
--
-- For the purpose of abstract interpretation, it might be convenient to use
-- 'Lattice' instance. See also lattices package
-- (<http://hackage.haskell.org/package/lattices>).
--
-----------------------------------------------------------------------------
module Data.IntegerInterval
  (
  -- * Interval type
    IntegerInterval
  , module Data.ExtendedReal
  , Boundary(..)

  -- * Construction
  , interval
  , (<=..<=)
  , (<..<=)
  , (<=..<)
  , (<..<)
  , whole
  , empty
  , singleton

  -- * Query
  , null
  , isSingleton
  , member
  , notMember
  , isSubsetOf
  , isProperSubsetOf
  , isConnected
  , lowerBound
  , upperBound
  , lowerBound'
  , upperBound'
  , width

  -- * Universal comparison operators
  , (<!), (<=!), (==!), (>=!), (>!), (/=!)

  -- * Existential comparison operators
  , (<?), (<=?), (==?), (>=?), (>?), (/=?)

  -- * Existential comparison operators that produce witnesses (experimental)
  , (<??), (<=??), (==??), (>=??), (>??), (/=??)

  -- * Combine
  , intersection
  , intersections
  , hull
  , hulls

  -- * Map
  , mapMonotonic

  -- * Operations
  , pickup
  , simplestIntegerWithin

  -- * Conversion
  , toInterval
  , fromInterval
  , fromIntervalOver
  , fromIntervalUnder

  -- * Intervals relation
  , relate
  ) where

#ifdef MIN_VERSION_lattices
import Algebra.Lattice
#endif
import Control.Exception (assert)
import Control.Monad hiding (join)
import Data.ExtendedReal
import Data.List (foldl')
import Data.Maybe
import Prelude hiding (null)
import Data.IntegerInterval.Internal
import Data.Interval.Internal (Boundary(..))
import qualified Data.Interval.Internal as Interval
import Data.IntervalRelation

infix 5 <..<=
infix 5 <=..<
infix 5 <..<
infix 4 <!
infix 4 <=!
infix 4 ==!
infix 4 >=!
infix 4 >!
infix 4 /=!
infix 4 <?
infix 4 <=?
infix 4 ==?
infix 4 >=?
infix 4 >?
infix 4 /=?
infix 4 <??
infix 4 <=??
infix 4 ==??
infix 4 >=??
infix 4 >??
infix 4 /=??

-- | 'lowerBound' of the interval and whether it is included in the interval.
-- The result is convenient to use as an argument for 'interval'.
lowerBound' :: IntegerInterval -> (Extended Integer, Boundary)
lowerBound' :: IntegerInterval -> (Extended Integer, Boundary)
lowerBound' IntegerInterval
x =
  case IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x of
    lb :: Extended Integer
lb@(Finite Integer
_) -> (Extended Integer
lb, Boundary
Closed)
    lb :: Extended Integer
lb@Extended Integer
_ -> (Extended Integer
lb, Boundary
Open)

-- | 'upperBound' of the interval and whether it is included in the interval.
-- The result is convenient to use as an argument for 'interval'.
upperBound' :: IntegerInterval -> (Extended Integer, Boundary)
upperBound' :: IntegerInterval -> (Extended Integer, Boundary)
upperBound' IntegerInterval
x =
  case IntegerInterval -> Extended Integer
upperBound IntegerInterval
x of
    ub :: Extended Integer
ub@(Finite Integer
_) -> (Extended Integer
ub, Boundary
Closed)
    ub :: Extended Integer
ub@Extended Integer
_ -> (Extended Integer
ub, Boundary
Open)

#ifdef MIN_VERSION_lattices
#if MIN_VERSION_lattices(2,0,0)

instance Lattice IntegerInterval where
  (\/) = hull
  (/\) = intersection

instance BoundedJoinSemiLattice IntegerInterval where
  bottom = empty

instance BoundedMeetSemiLattice IntegerInterval where
  top = whole

#else

instance JoinSemiLattice IntegerInterval where
  join = hull

instance MeetSemiLattice IntegerInterval where
  meet = intersection

instance Lattice IntegerInterval

instance BoundedJoinSemiLattice IntegerInterval where
  bottom = empty

instance BoundedMeetSemiLattice IntegerInterval where
  top = whole

instance BoundedLattice IntegerInterval

#endif
#endif

instance Show IntegerInterval where
  showsPrec :: Int -> IntegerInterval -> ShowS
showsPrec Int
_ IntegerInterval
x | IntegerInterval -> Bool
null IntegerInterval
x = String -> ShowS
showString String
"empty"
  showsPrec Int
p IntegerInterval
x =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rangeOpPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      Int -> Extended Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
rangeOpPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
showString String
" <=..<= " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> Extended Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
rangeOpPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x)

instance Read IntegerInterval where
  readsPrec :: Int -> ReadS IntegerInterval
readsPrec Int
p String
r =
    (Bool -> ReadS IntegerInterval -> ReadS IntegerInterval
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ReadS IntegerInterval -> ReadS IntegerInterval)
-> ReadS IntegerInterval -> ReadS IntegerInterval
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
      (String
"interval",String
s1) <- ReadS String
lex String
s0
      ((Extended Integer, Boundary)
lb,String
s2) <- Int -> ReadS (Extended Integer, Boundary)
forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
s1
      ((Extended Integer, Boundary)
ub,String
s3) <- Int -> ReadS (Extended Integer, Boundary)
forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
s2
      (IntegerInterval, String) -> [(IntegerInterval, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Extended Integer, Boundary)
-> (Extended Integer, Boundary) -> IntegerInterval
interval (Extended Integer, Boundary)
lb (Extended Integer, Boundary)
ub, String
s3)) String
r
    [(IntegerInterval, String)]
-> [(IntegerInterval, String)] -> [(IntegerInterval, String)]
forall a. [a] -> [a] -> [a]
++
    (Bool -> ReadS IntegerInterval -> ReadS IntegerInterval
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rangeOpPrec) (ReadS IntegerInterval -> ReadS IntegerInterval)
-> ReadS IntegerInterval -> ReadS IntegerInterval
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
      (do (Extended Integer
lb,String
s1) <- Int -> ReadS (Extended Integer)
forall a. Read a => Int -> ReadS a
readsPrec (Int
rangeOpPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
s0
          (String
"<=..<=",String
s2) <- ReadS String
lex String
s1
          (Extended Integer
ub,String
s3) <- Int -> ReadS (Extended Integer)
forall a. Read a => Int -> ReadS a
readsPrec (Int
rangeOpPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
s2
          (IntegerInterval, String) -> [(IntegerInterval, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Extended Integer
lb Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ub, String
s3))) String
r
    [(IntegerInterval, String)]
-> [(IntegerInterval, String)] -> [(IntegerInterval, String)]
forall a. [a] -> [a] -> [a]
++
    (do (String
"empty", String
s) <- ReadS String
lex String
r
        (IntegerInterval, String) -> [(IntegerInterval, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (IntegerInterval
empty, String
s))

-- | smart constructor for 'IntegerInterval'
interval
  :: (Extended Integer, Boundary) -- ^ lower bound and whether it is included
  -> (Extended Integer, Boundary) -- ^ upper bound and whether it is included
  -> IntegerInterval
interval :: (Extended Integer, Boundary)
-> (Extended Integer, Boundary) -> IntegerInterval
interval (Extended Integer
x1,Boundary
in1) (Extended Integer
x2,Boundary
in2) =
  (if Boundary
in1 Boundary -> Boundary -> Bool
forall a. Eq a => a -> a -> Bool
== Boundary
Closed then Extended Integer
x1 else Extended Integer
x1 Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
+ Extended Integer
1) Extended Integer -> Extended Integer -> IntegerInterval
<=..<= (if Boundary
in2 Boundary -> Boundary -> Bool
forall a. Eq a => a -> a -> Bool
== Boundary
Closed then Extended Integer
x2 else Extended Integer
x2 Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
- Extended Integer
1)

-- | left-open right-closed interval (@l@,@u@]
(<..<=)
  :: Extended Integer -- ^ lower bound @l@
  -> Extended Integer -- ^ upper bound @u@
  -> IntegerInterval
<..<= :: Extended Integer -> Extended Integer -> IntegerInterval
(<..<=) Extended Integer
lb Extended Integer
ub = (Extended Integer
lbExtended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
+Extended Integer
1) Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ub

-- | left-closed right-open interval [@l@, @u@)
(<=..<)
  :: Extended Integer -- ^ lower bound @l@
  -> Extended Integer -- ^ upper bound @u@
  -> IntegerInterval
<=..< :: Extended Integer -> Extended Integer -> IntegerInterval
(<=..<) Extended Integer
lb Extended Integer
ub = Extended Integer
lb Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ubExtended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
-Extended Integer
1

-- | open interval (@l@, @u@)
(<..<)
  :: Extended Integer -- ^ lower bound @l@
  -> Extended Integer -- ^ upper bound @u@
  -> IntegerInterval
<..< :: Extended Integer -> Extended Integer -> IntegerInterval
(<..<) Extended Integer
lb Extended Integer
ub = Extended Integer
lbExtended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
+Extended Integer
1 Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ubExtended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
-Extended Integer
1

-- | whole real number line (-∞, ∞)
whole :: IntegerInterval
whole :: IntegerInterval
whole = Extended Integer
forall r. Extended r
NegInf Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
forall r. Extended r
PosInf

-- | singleton set [x,x]
singleton :: Integer -> IntegerInterval
singleton :: Integer -> IntegerInterval
singleton Integer
x = Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
x Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
x

-- | intersection of two intervals
intersection :: IntegerInterval -> IntegerInterval -> IntegerInterval
intersection :: IntegerInterval -> IntegerInterval -> IntegerInterval
intersection IntegerInterval
x1 IntegerInterval
x2 =
  Extended Integer -> Extended Integer -> Extended Integer
forall a. Ord a => a -> a -> a
max (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x1) (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x2) Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer -> Extended Integer -> Extended Integer
forall a. Ord a => a -> a -> a
min (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x1) (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x2)

-- | intersection of a list of intervals.
intersections :: [IntegerInterval] -> IntegerInterval
intersections :: [IntegerInterval] -> IntegerInterval
intersections = (IntegerInterval -> IntegerInterval -> IntegerInterval)
-> IntegerInterval -> [IntegerInterval] -> IntegerInterval
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntegerInterval -> IntegerInterval -> IntegerInterval
intersection IntegerInterval
whole

-- | convex hull of two intervals
hull :: IntegerInterval -> IntegerInterval -> IntegerInterval
hull :: IntegerInterval -> IntegerInterval -> IntegerInterval
hull IntegerInterval
x1 IntegerInterval
x2
  | IntegerInterval -> Bool
null IntegerInterval
x1 = IntegerInterval
x2
  | IntegerInterval -> Bool
null IntegerInterval
x2 = IntegerInterval
x1
hull IntegerInterval
x1 IntegerInterval
x2 =
  Extended Integer -> Extended Integer -> Extended Integer
forall a. Ord a => a -> a -> a
min (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x1) (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x2) Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer -> Extended Integer -> Extended Integer
forall a. Ord a => a -> a -> a
max (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x1) (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x2)

-- | convex hull of a list of intervals.
hulls :: [IntegerInterval] -> IntegerInterval
hulls :: [IntegerInterval] -> IntegerInterval
hulls = (IntegerInterval -> IntegerInterval -> IntegerInterval)
-> IntegerInterval -> [IntegerInterval] -> IntegerInterval
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntegerInterval -> IntegerInterval -> IntegerInterval
hull IntegerInterval
empty

-- | @mapMonotonic f i@ is the image of @i@ under @f@, where @f@ must be a strict monotone function.
mapMonotonic :: (Integer -> Integer) -> IntegerInterval -> IntegerInterval
mapMonotonic :: (Integer -> Integer) -> IntegerInterval -> IntegerInterval
mapMonotonic Integer -> Integer
f IntegerInterval
x = (Integer -> Integer) -> Extended Integer -> Extended Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Integer
f (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x) Extended Integer -> Extended Integer -> IntegerInterval
<=..<= (Integer -> Integer) -> Extended Integer -> Extended Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Integer
f (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x)

-- | Is the interval empty?
null :: IntegerInterval -> Bool
null :: IntegerInterval -> Bool
null IntegerInterval
x = IntegerInterval -> Extended Integer
upperBound IntegerInterval
x Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
< IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x

-- | Is the interval single point?
--
-- @since 2.0.0
isSingleton :: IntegerInterval -> Bool
isSingleton :: IntegerInterval -> Bool
isSingleton IntegerInterval
x = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x Extended Integer -> Extended Integer -> Bool
forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
upperBound IntegerInterval
x

-- | Is the element in the interval?
member :: Integer -> IntegerInterval -> Bool
member :: Integer -> IntegerInterval -> Bool
member Integer
x IntegerInterval
i = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
x Bool -> Bool -> Bool
&& Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
x Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
upperBound IntegerInterval
i

-- | Is the element not in the interval?
notMember :: Integer -> IntegerInterval -> Bool
notMember :: Integer -> IntegerInterval -> Bool
notMember Integer
a IntegerInterval
i = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Integer -> IntegerInterval -> Bool
member Integer
a IntegerInterval
i

-- | Is this a subset?
-- @(i1 \``isSubsetOf`\` i2)@ tells whether @i1@ is a subset of @i2@.
isSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
isSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
isSubsetOf IntegerInterval
i1 IntegerInterval
i2 = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i2 Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i1 Bool -> Bool -> Bool
&& IntegerInterval -> Extended Integer
upperBound IntegerInterval
i1 Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
upperBound IntegerInterval
i2

-- | Is this a proper subset? (/i.e./ a subset but not equal).
isProperSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
isProperSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
isProperSubsetOf IntegerInterval
i1 IntegerInterval
i2 = IntegerInterval
i1 IntegerInterval -> IntegerInterval -> Bool
forall a. Eq a => a -> a -> Bool
/= IntegerInterval
i2 Bool -> Bool -> Bool
&& IntegerInterval
i1 IntegerInterval -> IntegerInterval -> Bool
`isSubsetOf` IntegerInterval
i2

-- | Does the union of two range form a set which is the intersection between the integers and a connected real interval?
isConnected :: IntegerInterval -> IntegerInterval -> Bool
isConnected :: IntegerInterval -> IntegerInterval -> Bool
isConnected IntegerInterval
x IntegerInterval
y = IntegerInterval -> Bool
null IntegerInterval
x Bool -> Bool -> Bool
|| IntegerInterval -> Bool
null IntegerInterval
y Bool -> Bool -> Bool
|| IntegerInterval
x IntegerInterval -> IntegerInterval -> Bool
==? IntegerInterval
y Bool -> Bool -> Bool
|| Bool
lb1nearUb2 Bool -> Bool -> Bool
|| Bool
ub1nearLb2
  where
    lb1 :: Extended Integer
lb1 = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x
    lb2 :: Extended Integer
lb2 = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
y
    ub1 :: Extended Integer
ub1 = IntegerInterval -> Extended Integer
upperBound IntegerInterval
x
    ub2 :: Extended Integer
ub2 = IntegerInterval -> Extended Integer
upperBound IntegerInterval
y

    lb1nearUb2 :: Bool
lb1nearUb2 = case (Extended Integer
lb1, Extended Integer
ub2) of
      (Finite Integer
lb1Int, Finite Integer
ub2Int) -> Integer
lb1Int Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
ub2Int Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
      (Extended Integer, Extended Integer)
_                              -> Bool
False

    ub1nearLb2 :: Bool
ub1nearLb2 = case (Extended Integer
ub1, Extended Integer
lb2) of
      (Finite Integer
ub1Int, Finite Integer
lb2Int) -> Integer
ub1Int Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
lb2Int
      (Extended Integer, Extended Integer)
_                              -> Bool
False

-- | Width of a interval. Width of an unbounded interval is @undefined@.
width :: IntegerInterval -> Integer
width :: IntegerInterval -> Integer
width IntegerInterval
x
  | IntegerInterval -> Bool
null IntegerInterval
x = Integer
0
  | Bool
otherwise =
      case (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x, IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x) of
        (Finite Integer
lb, Finite Integer
ub) -> Integer
ub Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lb
        (Extended Integer, Extended Integer)
_ -> String -> Integer
forall a. HasCallStack => String -> a
error String
"Data.IntegerInterval.width: unbounded interval"

-- | pick up an element from the interval if the interval is not empty.
pickup :: IntegerInterval -> Maybe Integer
pickup :: IntegerInterval -> Maybe Integer
pickup IntegerInterval
x =
  case (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x, IntegerInterval -> Extended Integer
upperBound IntegerInterval
x) of
    (Extended Integer
NegInf, Extended Integer
PosInf) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
    (Finite Integer
l, Extended Integer
_) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
l
    (Extended Integer
_, Finite Integer
u) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
u
    (Extended Integer, Extended Integer)
_ -> Maybe Integer
forall a. Maybe a
Nothing

-- | 'simplestIntegerWithin' returns the simplest rational number within the interval.
--
-- An integer @y@ is said to be /simpler/ than another @y'@ if
--
-- * @'abs' y <= 'abs' y'@
--
-- (see also 'Data.Ratio.approxRational' and 'Interval.simplestRationalWithin')
simplestIntegerWithin :: IntegerInterval -> Maybe Integer
simplestIntegerWithin :: IntegerInterval -> Maybe Integer
simplestIntegerWithin IntegerInterval
i
  | IntegerInterval -> Bool
null IntegerInterval
i    = Maybe Integer
forall a. Maybe a
Nothing
  | IntegerInterval
0 IntegerInterval -> IntegerInterval -> Bool
<! IntegerInterval
i    = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ let Finite Integer
x = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i in Integer
x
  | IntegerInterval
i IntegerInterval -> IntegerInterval -> Bool
<! IntegerInterval
0    = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ let Finite Integer
x = IntegerInterval -> Extended Integer
upperBound IntegerInterval
i in Integer
x
  | Bool
otherwise = Bool -> Maybe Integer -> Maybe Integer
forall a. HasCallStack => Bool -> a -> a
assert (Integer
0 Integer -> IntegerInterval -> Bool
`member` IntegerInterval
i) (Maybe Integer -> Maybe Integer) -> Maybe Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0

-- | For all @x@ in @X@, @y@ in @Y@. @x '<' y@?
(<!) :: IntegerInterval -> IntegerInterval -> Bool
--a <! b = upperBound a < lowerBound b
IntegerInterval
a <! :: IntegerInterval -> IntegerInterval -> Bool
<! IntegerInterval
b = IntegerInterval
aIntegerInterval -> IntegerInterval -> IntegerInterval
forall a. Num a => a -> a -> a
+IntegerInterval
1 IntegerInterval -> IntegerInterval -> Bool
<=! IntegerInterval
b

-- | For all @x@ in @X@, @y@ in @Y@. @x '<=' y@?
(<=!) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a <=! :: IntegerInterval -> IntegerInterval -> Bool
<=! IntegerInterval
b = IntegerInterval -> Extended Integer
upperBound IntegerInterval
a Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
lowerBound IntegerInterval
b

-- | For all @x@ in @X@, @y@ in @Y@. @x '==' y@?
(==!) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a ==! :: IntegerInterval -> IntegerInterval -> Bool
==! IntegerInterval
b = IntegerInterval
a IntegerInterval -> IntegerInterval -> Bool
<=! IntegerInterval
b Bool -> Bool -> Bool
&& IntegerInterval
a IntegerInterval -> IntegerInterval -> Bool
>=! IntegerInterval
b

-- | For all @x@ in @X@, @y@ in @Y@. @x '/=' y@?
(/=!) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a /=! :: IntegerInterval -> IntegerInterval -> Bool
/=! IntegerInterval
b = IntegerInterval -> Bool
null (IntegerInterval -> Bool) -> IntegerInterval -> Bool
forall a b. (a -> b) -> a -> b
$ IntegerInterval
a IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
b

-- | For all @x@ in @X@, @y@ in @Y@. @x '>=' y@?
(>=!) :: IntegerInterval -> IntegerInterval -> Bool
>=! :: IntegerInterval -> IntegerInterval -> Bool
(>=!) = (IntegerInterval -> IntegerInterval -> Bool)
-> IntegerInterval -> IntegerInterval -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Bool
(<=!)

-- | For all @x@ in @X@, @y@ in @Y@. @x '>' y@?
(>!) :: IntegerInterval -> IntegerInterval -> Bool
>! :: IntegerInterval -> IntegerInterval -> Bool
(>!) = (IntegerInterval -> IntegerInterval -> Bool)
-> IntegerInterval -> IntegerInterval -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Bool
(<!)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@?
(<?) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a <? :: IntegerInterval -> IntegerInterval -> Bool
<? IntegerInterval
b = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
a Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
< IntegerInterval -> Extended Integer
upperBound IntegerInterval
b

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@?
(<??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
IntegerInterval
a <?? :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
<?? IntegerInterval
b = do
  (Integer
x,Integer
y) <- IntegerInterval
aIntegerInterval -> IntegerInterval -> IntegerInterval
forall a. Num a => a -> a -> a
+IntegerInterval
1 IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
<=?? IntegerInterval
b
  (Integer, Integer) -> Maybe (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1,Integer
y)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<=' y@?
(<=?) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a <=? :: IntegerInterval -> IntegerInterval -> Bool
<=? IntegerInterval
b =
  case Extended Integer
lb_a Extended Integer -> Extended Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Extended Integer
ub_b of
    Ordering
LT -> Bool
True
    Ordering
GT -> Bool
False
    Ordering
EQ ->
      case Extended Integer
lb_a of
        Extended Integer
NegInf -> Bool
False -- b is empty
        Extended Integer
PosInf -> Bool
False -- a is empty
        Finite Integer
_ -> Bool
True
  where
    lb_a :: Extended Integer
lb_a = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
a
    ub_b :: Extended Integer
ub_b = IntegerInterval -> Extended Integer
upperBound IntegerInterval
b

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<=' y@?
(<=??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer,Integer)
IntegerInterval
a <=?? :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
<=?? IntegerInterval
b =
  case IntegerInterval -> Maybe Integer
pickup (IntegerInterval -> IntegerInterval -> IntegerInterval
intersection IntegerInterval
a IntegerInterval
b) of
    Just Integer
x -> (Integer, Integer) -> Maybe (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x,Integer
x)
    Maybe Integer
Nothing -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ IntegerInterval -> Extended Integer
upperBound IntegerInterval
a Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
lowerBound IntegerInterval
b
      Integer
x <- IntegerInterval -> Maybe Integer
pickup IntegerInterval
a
      Integer
y <- IntegerInterval -> Maybe Integer
pickup IntegerInterval
b
      (Integer, Integer) -> Maybe (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x,Integer
y)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?
(==?) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a ==? :: IntegerInterval -> IntegerInterval -> Bool
==? IntegerInterval
b = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntegerInterval -> Bool
null (IntegerInterval -> Bool) -> IntegerInterval -> Bool
forall a b. (a -> b) -> a -> b
$ IntegerInterval -> IntegerInterval -> IntegerInterval
intersection IntegerInterval
a IntegerInterval
b

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?
(==??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer,Integer)
IntegerInterval
a ==?? :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
==?? IntegerInterval
b = do
  Integer
x <- IntegerInterval -> Maybe Integer
pickup (IntegerInterval -> IntegerInterval -> IntegerInterval
intersection IntegerInterval
a IntegerInterval
b)
  (Integer, Integer) -> Maybe (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x,Integer
x)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@?
(/=?) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a /=? :: IntegerInterval -> IntegerInterval -> Bool
/=? IntegerInterval
b = Bool -> Bool
not (IntegerInterval -> Bool
null IntegerInterval
a) Bool -> Bool -> Bool
&& Bool -> Bool
not (IntegerInterval -> Bool
null IntegerInterval
b) Bool -> Bool -> Bool
&& Bool -> Bool
not (IntegerInterval
a IntegerInterval -> IntegerInterval -> Bool
forall a. Eq a => a -> a -> Bool
== IntegerInterval
b Bool -> Bool -> Bool
&& IntegerInterval -> Bool
isSingleton IntegerInterval
a)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@?
(/=??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer,Integer)
IntegerInterval
a /=?? :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
/=?? IntegerInterval
b = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntegerInterval -> Bool
null IntegerInterval
a
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntegerInterval -> Bool
null IntegerInterval
b
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntegerInterval
a IntegerInterval -> IntegerInterval -> Bool
forall a. Eq a => a -> a -> Bool
== IntegerInterval
b Bool -> Bool -> Bool
&& IntegerInterval -> Bool
isSingleton IntegerInterval
a
  if Bool -> Bool
not (IntegerInterval -> Bool
isSingleton IntegerInterval
b)
    then IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
f IntegerInterval
a IntegerInterval
b
    else ((Integer, Integer) -> (Integer, Integer))
-> Maybe (Integer, Integer) -> Maybe (Integer, Integer)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\(Integer
y,Integer
x) -> (Integer
x,Integer
y)) (Maybe (Integer, Integer) -> Maybe (Integer, Integer))
-> Maybe (Integer, Integer) -> Maybe (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
f IntegerInterval
b IntegerInterval
a
  where
    f :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
f IntegerInterval
i IntegerInterval
j = do
      Integer
x <- IntegerInterval -> Maybe Integer
pickup IntegerInterval
i
      Integer
y <- [Maybe Integer] -> Maybe Integer
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [IntegerInterval -> Maybe Integer
pickup (IntegerInterval
j IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
c) | IntegerInterval
c <- [-Extended Integer
forall r. Extended r
inf Extended Integer -> Extended Integer -> IntegerInterval
<..< Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
x, Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
x Extended Integer -> Extended Integer -> IntegerInterval
<..< Extended Integer
forall r. Extended r
inf]]
      (Integer, Integer) -> Maybe (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x,Integer
y)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?
(>=?) :: IntegerInterval -> IntegerInterval -> Bool
>=? :: IntegerInterval -> IntegerInterval -> Bool
(>=?) = (IntegerInterval -> IntegerInterval -> Bool)
-> IntegerInterval -> IntegerInterval -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Bool
(<=?)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@?
(>?) :: IntegerInterval -> IntegerInterval -> Bool
>? :: IntegerInterval -> IntegerInterval -> Bool
(>?) = (IntegerInterval -> IntegerInterval -> Bool)
-> IntegerInterval -> IntegerInterval -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Bool
(<?)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?
(>=??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
>=?? :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
(>=??) = (IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer))
-> IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
(<=??)

-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@?
(>??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
>?? :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
(>??) = (IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer))
-> IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
(<??)

appPrec :: Int
appPrec :: Int
appPrec = Int
10

rangeOpPrec :: Int
rangeOpPrec :: Int
rangeOpPrec = Int
5

scaleInterval :: Integer -> IntegerInterval -> IntegerInterval
scaleInterval :: Integer -> IntegerInterval -> IntegerInterval
scaleInterval Integer
_ IntegerInterval
x | IntegerInterval -> Bool
null IntegerInterval
x = IntegerInterval
empty
scaleInterval Integer
c IntegerInterval
x =
  case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
c Integer
0 of
    Ordering
EQ -> Integer -> IntegerInterval
singleton Integer
0
    Ordering
LT -> Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
c Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
* IntegerInterval -> Extended Integer
upperBound IntegerInterval
x Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
c Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
* IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x
    Ordering
GT -> Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
c Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
* IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
c Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
* IntegerInterval -> Extended Integer
upperBound IntegerInterval
x

instance Num IntegerInterval where
  IntegerInterval
a + :: IntegerInterval -> IntegerInterval -> IntegerInterval
+ IntegerInterval
b
      | IntegerInterval -> Bool
null IntegerInterval
a Bool -> Bool -> Bool
|| IntegerInterval -> Bool
null IntegerInterval
b = IntegerInterval
empty
      | Bool
otherwise = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
a Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
+ IntegerInterval -> Extended Integer
lowerBound IntegerInterval
b Extended Integer -> Extended Integer -> IntegerInterval
<=..<= IntegerInterval -> Extended Integer
upperBound IntegerInterval
a Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
+ IntegerInterval -> Extended Integer
upperBound IntegerInterval
b

  negate :: IntegerInterval -> IntegerInterval
negate = Integer -> IntegerInterval -> IntegerInterval
scaleInterval (-Integer
1)

  fromInteger :: Integer -> IntegerInterval
fromInteger Integer
i = Integer -> IntegerInterval
singleton (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
i)

  abs :: IntegerInterval -> IntegerInterval
abs IntegerInterval
x = (IntegerInterval
x IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
nonneg) IntegerInterval -> IntegerInterval -> IntegerInterval
`hull` (IntegerInterval -> IntegerInterval
forall a. Num a => a -> a
negate IntegerInterval
x IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
nonneg)
    where
      nonneg :: IntegerInterval
nonneg = Extended Integer
0 Extended Integer -> Extended Integer -> IntegerInterval
<=..< Extended Integer
forall r. Extended r
inf

  signum :: IntegerInterval -> IntegerInterval
signum IntegerInterval
x = IntegerInterval
zero IntegerInterval -> IntegerInterval -> IntegerInterval
`hull` IntegerInterval
pos IntegerInterval -> IntegerInterval -> IntegerInterval
`hull` IntegerInterval
neg
    where
      zero :: IntegerInterval
zero = if Integer -> IntegerInterval -> Bool
member Integer
0 IntegerInterval
x then Integer -> IntegerInterval
singleton Integer
0 else IntegerInterval
empty
      pos :: IntegerInterval
pos = if IntegerInterval -> Bool
null (IntegerInterval -> Bool) -> IntegerInterval -> Bool
forall a b. (a -> b) -> a -> b
$ (Extended Integer
0 Extended Integer -> Extended Integer -> IntegerInterval
<..< Extended Integer
forall r. Extended r
inf) IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
x
            then IntegerInterval
empty
            else Integer -> IntegerInterval
singleton Integer
1
      neg :: IntegerInterval
neg = if IntegerInterval -> Bool
null (IntegerInterval -> Bool) -> IntegerInterval -> Bool
forall a b. (a -> b) -> a -> b
$ (-Extended Integer
forall r. Extended r
inf Extended Integer -> Extended Integer -> IntegerInterval
<..< Extended Integer
0) IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
x
            then IntegerInterval
empty
            else Integer -> IntegerInterval
singleton (-Integer
1)

  IntegerInterval
a * :: IntegerInterval -> IntegerInterval -> IntegerInterval
* IntegerInterval
b
    | IntegerInterval -> Bool
null IntegerInterval
a Bool -> Bool -> Bool
|| IntegerInterval -> Bool
null IntegerInterval
b = IntegerInterval
empty
    | Bool
otherwise = [Extended Integer] -> Extended Integer
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Extended Integer]
xs Extended Integer -> Extended Integer -> IntegerInterval
<=..<= [Extended Integer] -> Extended Integer
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Extended Integer]
xs
    where
      xs :: [Extended Integer]
xs = [ Extended Integer -> Extended Integer -> Extended Integer
mul Extended Integer
x1 Extended Integer
x2 | Extended Integer
x1 <- [IntegerInterval -> Extended Integer
lowerBound IntegerInterval
a, IntegerInterval -> Extended Integer
upperBound IntegerInterval
a], Extended Integer
x2 <- [IntegerInterval -> Extended Integer
lowerBound IntegerInterval
b, IntegerInterval -> Extended Integer
upperBound IntegerInterval
b] ]

      mul :: Extended Integer -> Extended Integer -> Extended Integer
      mul :: Extended Integer -> Extended Integer -> Extended Integer
mul Extended Integer
0 Extended Integer
_ = Extended Integer
0
      mul Extended Integer
_ Extended Integer
0 = Extended Integer
0
      mul Extended Integer
x1 Extended Integer
x2 = Extended Integer
x1Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
*Extended Integer
x2

-- | Convert the interval to 'Interval.Interval' data type.
toInterval :: Real r => IntegerInterval -> Interval.Interval r
toInterval :: IntegerInterval -> Interval r
toInterval IntegerInterval
x = (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval
  ((Integer -> r) -> Extended Integer -> Extended r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> r
forall a. Num a => Integer -> a
fromInteger (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x), Boundary
Closed)
  ((Integer -> r) -> Extended Integer -> Extended r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> r
forall a. Num a => Integer -> a
fromInteger (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x), Boundary
Closed)

-- | Conversion from 'Interval.Interval' data type.
fromInterval :: Interval.Interval Integer -> IntegerInterval
fromInterval :: Interval Integer -> IntegerInterval
fromInterval Interval Integer
i = Extended Integer
x1' Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
x2'
  where
    (Extended Integer
x1,Boundary
in1) = Interval Integer -> (Extended Integer, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval Integer
i
    (Extended Integer
x2,Boundary
in2) = Interval Integer -> (Extended Integer, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval Integer
i
    x1' :: Extended Integer
x1' = case Boundary
in1 of
      Boundary
Interval.Open   -> Extended Integer
x1 Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
+ Extended Integer
1
      Boundary
Interval.Closed -> Extended Integer
x1
    x2' :: Extended Integer
x2' = case Boundary
in2 of
      Boundary
Interval.Open   -> Extended Integer
x2 Extended Integer -> Extended Integer -> Extended Integer
forall a. Num a => a -> a -> a
- Extended Integer
1
      Boundary
Interval.Closed -> Extended Integer
x2

-- | Given a 'Interval.Interval' @I@ over R, compute the smallest 'IntegerInterval' @J@ such that @I ⊆ J@.
fromIntervalOver :: RealFrac r => Interval.Interval r -> IntegerInterval
fromIntervalOver :: Interval r -> IntegerInterval
fromIntervalOver Interval r
i = (r -> Integer) -> Extended r -> Extended Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Extended r
lb Extended Integer -> Extended Integer -> IntegerInterval
<=..<= (r -> Integer) -> Extended r -> Extended Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Extended r
ub
  where
    (Extended r
lb, Boundary
_) = Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i
    (Extended r
ub, Boundary
_) = Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i

-- | Given a 'Interval.Interval' @I@ over R, compute the largest 'IntegerInterval' @J@ such that @J ⊆ I@.
fromIntervalUnder :: RealFrac r => Interval.Interval r -> IntegerInterval
fromIntervalUnder :: Interval r -> IntegerInterval
fromIntervalUnder Interval r
i = Extended Integer
lb Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ub
  where
    lb :: Extended Integer
lb = case Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i of
      (Finite r
x, Boundary
Open)
        | Integer -> r
forall a. Num a => Integer -> a
fromInteger (r -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling r
x) r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
x
        -> Integer -> Extended Integer
forall r. r -> Extended r
Finite (r -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling r
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
      (Extended r
x, Boundary
_) -> (r -> Integer) -> Extended r -> Extended Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Extended r
x
    ub :: Extended Integer
ub = case Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i of
      (Finite r
x, Boundary
Open)
        | Integer -> r
forall a. Num a => Integer -> a
fromInteger (r -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor r
x) r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
x
        -> Integer -> Extended Integer
forall r. r -> Extended r
Finite (r -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor r
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
      (Extended r
x, Boundary
_) -> (r -> Integer) -> Extended r -> Extended Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Extended r
x

-- | Computes how two intervals are related according to the @`Data.IntervalRelation.Relation`@ classification
relate :: IntegerInterval -> IntegerInterval -> Relation
relate :: IntegerInterval -> IntegerInterval -> Relation
relate IntegerInterval
i1 IntegerInterval
i2 =
  case (IntegerInterval
i1 IntegerInterval -> IntegerInterval -> Bool
`isSubsetOf` IntegerInterval
i2, IntegerInterval
i2 IntegerInterval -> IntegerInterval -> Bool
`isSubsetOf` IntegerInterval
i1) of
    -- 'i1' ad 'i2' are equal
    (Bool
True , Bool
True ) -> Relation
Equal
    -- 'i1' is strictly contained in `i2`
    (Bool
True , Bool
False) | IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i1 Extended Integer -> Extended Integer -> Bool
forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i2 -> Relation
Starts
                   | IntegerInterval -> Extended Integer
upperBound IntegerInterval
i1 Extended Integer -> Extended Integer -> Bool
forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
upperBound IntegerInterval
i2 -> Relation
Finishes
                   | Bool
otherwise                      -> Relation
During
    -- 'i2' is strictly contained in `i1`
    (Bool
False, Bool
True ) | IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i1 Extended Integer -> Extended Integer -> Bool
forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i2 -> Relation
StartedBy
                   | IntegerInterval -> Extended Integer
upperBound IntegerInterval
i1 Extended Integer -> Extended Integer -> Bool
forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
upperBound IntegerInterval
i2 -> Relation
FinishedBy
                   | Bool
otherwise                      -> Relation
Contains
    -- neither `i1` nor `i2` is contained in the other
    (Bool
False, Bool
False) -> case ( IntegerInterval -> Bool
null (IntegerInterval
i1 IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
i2)
                           , IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i1 Extended Integer -> Extended Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i2
                           , IntegerInterval
i1 IntegerInterval -> IntegerInterval -> Bool
`isConnected` IntegerInterval
i2
                           ) of
      (Bool
True , Bool
True , Bool
True ) -> Relation
JustBefore
      (Bool
True , Bool
True , Bool
False) -> Relation
Before
      (Bool
True , Bool
False, Bool
True ) -> Relation
JustAfter
      (Bool
True , Bool
False, Bool
False) -> Relation
After
      (Bool
False, Bool
True , Bool
_    ) -> Relation
Overlaps
      (Bool
False, Bool
False, Bool
_    ) -> Relation
OverlappedBy