{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
module Data.IntegerInterval
(
IntegerInterval
, module Data.ExtendedReal
, Boundary(..)
, interval
, (<=..<=)
, (<..<=)
, (<=..<)
, (<..<)
, whole
, empty
, singleton
, null
, isSingleton
, member
, notMember
, isSubsetOf
, isProperSubsetOf
, isConnected
, lowerBound
, upperBound
, lowerBound'
, upperBound'
, width
, memberCount
, (<!), (<=!), (==!), (>=!), (>!), (/=!)
, (<?), (<=?), (==?), (>=?), (>?), (/=?)
, (<??), (<=??), (==??), (>=??), (>??), (/=??)
, intersection
, intersections
, hull
, hulls
, mapMonotonic
, pickup
, simplestIntegerWithin
, toInterval
, fromInterval
, fromIntervalOver
, fromIntervalUnder
, 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' :: 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' :: 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
instance Lattice IntegerInterval where
\/ :: IntegerInterval -> IntegerInterval -> IntegerInterval
(\/) = IntegerInterval -> IntegerInterval -> IntegerInterval
hull
/\ :: IntegerInterval -> IntegerInterval -> IntegerInterval
(/\) = IntegerInterval -> IntegerInterval -> IntegerInterval
intersection
instance BoundedJoinSemiLattice IntegerInterval where
bottom :: IntegerInterval
bottom = IntegerInterval
empty
instance BoundedMeetSemiLattice IntegerInterval where
top :: IntegerInterval
top = IntegerInterval
whole
#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 forall a. Ord a => a -> a -> Bool
> Int
rangeOpPrec) forall a b. (a -> b) -> a -> b
$
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
rangeOpPrecforall a. Num a => a -> a -> a
+Int
1) (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
" <=..<= " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
rangeOpPrecforall 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 =
(forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
appPrec) 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) <- forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecforall a. Num a => a -> a -> a
+Int
1) String
s1
((Extended Integer, Boundary)
ub,String
s3) <- forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecforall a. Num a => a -> a -> a
+Int
1) String
s2
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
forall a. [a] -> [a] -> [a]
++
(forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
rangeOpPrec) forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
(do (Extended Integer
lb,String
s1) <- forall a. Read a => Int -> ReadS a
readsPrec (Int
rangeOpPrecforall a. Num a => a -> a -> a
+Int
1) String
s0
(String
"<=..<=",String
s2) <- ReadS String
lex String
s1
(Extended Integer
ub,String
s3) <- forall a. Read a => Int -> ReadS a
readsPrec (Int
rangeOpPrecforall a. Num a => a -> a -> a
+Int
1) String
s2
forall (m :: * -> *) a. Monad m => a -> m a
return (Extended Integer
lb Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ub, String
s3))) String
r
forall a. [a] -> [a] -> [a]
++
(do (String
"empty", String
s) <- ReadS String
lex String
r
forall (m :: * -> *) a. Monad m => a -> m a
return (IntegerInterval
empty, String
s))
interval
:: (Extended Integer, Boundary)
-> (Extended Integer, Boundary)
-> IntegerInterval
interval :: (Extended Integer, Boundary)
-> (Extended Integer, Boundary) -> IntegerInterval
interval (Extended Integer
x1,Boundary
in1) (Extended Integer
x2,Boundary
in2) =
(if Boundary
in1 forall a. Eq a => a -> a -> Bool
== Boundary
Closed then Extended Integer
x1 else Extended Integer
x1 forall a. Num a => a -> a -> a
+ Extended Integer
1) Extended Integer -> Extended Integer -> IntegerInterval
<=..<= (if Boundary
in2 forall a. Eq a => a -> a -> Bool
== Boundary
Closed then Extended Integer
x2 else Extended Integer
x2 forall a. Num a => a -> a -> a
- Extended Integer
1)
(<..<=)
:: Extended Integer
-> Extended Integer
-> IntegerInterval
<..<= :: Extended Integer -> Extended Integer -> IntegerInterval
(<..<=) Extended Integer
lb Extended Integer
ub = (Extended Integer
lbforall a. Num a => a -> a -> a
+Extended Integer
1) Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ub
(<=..<)
:: Extended Integer
-> Extended Integer
-> IntegerInterval
<=..< :: Extended Integer -> Extended Integer -> IntegerInterval
(<=..<) Extended Integer
lb Extended Integer
ub = Extended Integer
lb Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ubforall a. Num a => a -> a -> a
-Extended Integer
1
(<..<)
:: Extended Integer
-> Extended Integer
-> IntegerInterval
<..< :: Extended Integer -> Extended Integer -> IntegerInterval
(<..<) Extended Integer
lb Extended Integer
ub = Extended Integer
lbforall a. Num a => a -> a -> a
+Extended Integer
1 Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ubforall a. Num a => a -> a -> a
-Extended Integer
1
whole :: IntegerInterval
whole :: IntegerInterval
whole = forall r. Extended r
NegInf Extended Integer -> Extended Integer -> IntegerInterval
<=..<= forall r. Extended r
PosInf
singleton :: Integer -> IntegerInterval
singleton :: Integer -> IntegerInterval
singleton Integer
x = forall r. r -> Extended r
Finite Integer
x Extended Integer -> Extended Integer -> IntegerInterval
<=..<= forall r. r -> Extended r
Finite Integer
x
intersection :: IntegerInterval -> IntegerInterval -> IntegerInterval
intersection :: IntegerInterval -> IntegerInterval -> IntegerInterval
intersection IntegerInterval
x1 IntegerInterval
x2 =
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
<=..<= forall a. Ord a => a -> a -> a
min (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x1) (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x2)
intersections :: [IntegerInterval] -> IntegerInterval
intersections :: [IntegerInterval] -> IntegerInterval
intersections = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntegerInterval -> IntegerInterval -> IntegerInterval
intersection IntegerInterval
whole
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 =
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
<=..<= forall a. Ord a => a -> a -> a
max (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x1) (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x2)
hulls :: [IntegerInterval] -> IntegerInterval
hulls :: [IntegerInterval] -> IntegerInterval
hulls = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntegerInterval -> IntegerInterval -> IntegerInterval
hull IntegerInterval
empty
mapMonotonic :: (Integer -> Integer) -> IntegerInterval -> IntegerInterval
mapMonotonic :: (Integer -> Integer) -> IntegerInterval -> IntegerInterval
mapMonotonic Integer -> Integer
f IntegerInterval
x = 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
<=..<= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Integer
f (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x)
null :: IntegerInterval -> Bool
null :: IntegerInterval -> Bool
null IntegerInterval
x = IntegerInterval -> Extended Integer
upperBound IntegerInterval
x forall a. Ord a => a -> a -> Bool
< IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x
isSingleton :: IntegerInterval -> Bool
isSingleton :: IntegerInterval -> Bool
isSingleton IntegerInterval
x = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
upperBound IntegerInterval
x
member :: Integer -> IntegerInterval -> Bool
member :: Integer -> IntegerInterval -> Bool
member Integer
x IntegerInterval
i = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i forall a. Ord a => a -> a -> Bool
<= forall r. r -> Extended r
Finite Integer
x Bool -> Bool -> Bool
&& forall r. r -> Extended r
Finite Integer
x forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
upperBound IntegerInterval
i
notMember :: Integer -> IntegerInterval -> Bool
notMember :: Integer -> IntegerInterval -> Bool
notMember Integer
a IntegerInterval
i = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Integer -> IntegerInterval -> Bool
member Integer
a IntegerInterval
i
isSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
isSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
isSubsetOf IntegerInterval
i1 IntegerInterval
i2 = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i2 forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i1 Bool -> Bool -> Bool
&& IntegerInterval -> Extended Integer
upperBound IntegerInterval
i1 forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
upperBound IntegerInterval
i2
isProperSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
isProperSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
isProperSubsetOf IntegerInterval
i1 IntegerInterval
i2 = IntegerInterval
i1 forall a. Eq a => a -> a -> Bool
/= IntegerInterval
i2 Bool -> Bool -> Bool
&& IntegerInterval
i1 IntegerInterval -> IntegerInterval -> Bool
`isSubsetOf` IntegerInterval
i2
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 forall a. Eq a => a -> a -> Bool
== Integer
ub2Int 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 forall a. Num a => a -> a -> a
+ Integer
1 forall a. Eq a => a -> a -> Bool
== Integer
lb2Int
(Extended Integer, Extended Integer)
_ -> Bool
False
width :: IntegerInterval -> Integer
width :: IntegerInterval -> Integer
width IntegerInterval
x
| IntegerInterval -> Bool
null IntegerInterval
x = Integer
0
| Bool
otherwise =
case (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x, IntegerInterval -> Extended Integer
upperBound IntegerInterval
x) of
(Finite Integer
lb, Finite Integer
ub) -> Integer
ub forall a. Num a => a -> a -> a
- Integer
lb
(Extended Integer, Extended Integer)
_ -> forall a. HasCallStack => String -> a
error String
"Data.IntegerInterval.width: unbounded interval"
memberCount :: IntegerInterval -> Maybe Integer
memberCount :: IntegerInterval -> Maybe Integer
memberCount IntegerInterval
x
| IntegerInterval -> Bool
null IntegerInterval
x = forall a. a -> Maybe a
Just Integer
0
| Bool
otherwise =
case (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x, IntegerInterval -> Extended Integer
upperBound IntegerInterval
x) of
(Finite Integer
lb, Finite Integer
ub) -> forall a. a -> Maybe a
Just (Integer
ub forall a. Num a => a -> a -> a
- Integer
lb forall a. Num a => a -> a -> a
+ Integer
1)
(Extended Integer, Extended Integer)
_ -> forall a. Maybe a
Nothing
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) -> forall a. a -> Maybe a
Just Integer
0
(Finite Integer
l, Extended Integer
_) -> forall a. a -> Maybe a
Just Integer
l
(Extended Integer
_, Finite Integer
u) -> forall a. a -> Maybe a
Just Integer
u
(Extended Integer, Extended Integer)
_ -> forall a. Maybe a
Nothing
simplestIntegerWithin :: IntegerInterval -> Maybe Integer
simplestIntegerWithin :: IntegerInterval -> Maybe Integer
simplestIntegerWithin IntegerInterval
i
| IntegerInterval -> Bool
null IntegerInterval
i = forall a. Maybe a
Nothing
| IntegerInterval
0 IntegerInterval -> IntegerInterval -> Bool
<! IntegerInterval
i = forall a. a -> Maybe a
Just 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ let Finite Integer
x = IntegerInterval -> Extended Integer
upperBound IntegerInterval
i in Integer
x
| Bool
otherwise = forall a. HasCallStack => Bool -> a -> a
assert (Integer
0 Integer -> IntegerInterval -> Bool
`member` IntegerInterval
i) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Integer
0
(<!) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a <! :: IntegerInterval -> IntegerInterval -> Bool
<! IntegerInterval
b = IntegerInterval
aforall a. Num a => a -> a -> a
+IntegerInterval
1 IntegerInterval -> IntegerInterval -> Bool
<=! IntegerInterval
b
(<=!) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a <=! :: IntegerInterval -> IntegerInterval -> Bool
<=! IntegerInterval
b = IntegerInterval -> Extended Integer
upperBound IntegerInterval
a forall a. Ord a => a -> a -> Bool
<= IntegerInterval -> Extended Integer
lowerBound IntegerInterval
b
(==!) :: 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
(/=!) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a /=! :: IntegerInterval -> IntegerInterval -> Bool
/=! IntegerInterval
b = IntegerInterval -> Bool
null forall a b. (a -> b) -> a -> b
$ IntegerInterval
a IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
b
(>=!) :: IntegerInterval -> IntegerInterval -> Bool
>=! :: IntegerInterval -> IntegerInterval -> Bool
(>=!) = forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Bool
(<=!)
(>!) :: IntegerInterval -> IntegerInterval -> Bool
>! :: IntegerInterval -> IntegerInterval -> Bool
(>!) = forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Bool
(<!)
(<?) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a <? :: IntegerInterval -> IntegerInterval -> Bool
<? IntegerInterval
b = IntegerInterval -> Extended Integer
lowerBound IntegerInterval
a forall a. Ord a => a -> a -> Bool
< IntegerInterval -> Extended Integer
upperBound IntegerInterval
b
(<??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
IntegerInterval
a <?? :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
<?? IntegerInterval
b = do
(Integer
x,Integer
y) <- IntegerInterval
aforall a. Num a => a -> a -> a
+IntegerInterval
1 IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
<=?? IntegerInterval
b
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
xforall a. Num a => a -> a -> a
-Integer
1,Integer
y)
(<=?) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a <=? :: IntegerInterval -> IntegerInterval -> Bool
<=? IntegerInterval
b =
case Extended Integer
lb_a 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
Extended Integer
PosInf -> Bool
False
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
(<=??) :: 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x,Integer
x)
Maybe Integer
Nothing -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ IntegerInterval -> Extended Integer
upperBound IntegerInterval
a 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
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x,Integer
y)
(==?) :: IntegerInterval -> IntegerInterval -> Bool
IntegerInterval
a ==? :: IntegerInterval -> IntegerInterval -> Bool
==? IntegerInterval
b = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ IntegerInterval -> Bool
null forall a b. (a -> b) -> a -> b
$ IntegerInterval -> IntegerInterval -> IntegerInterval
intersection IntegerInterval
a IntegerInterval
b
(==??) :: 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)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x,Integer
x)
(/=?) :: 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 forall a. Eq a => a -> a -> Bool
== IntegerInterval
b Bool -> Bool -> Bool
&& IntegerInterval -> Bool
isSingleton IntegerInterval
a)
(/=??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer,Integer)
IntegerInterval
a /=?? :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)
/=?? IntegerInterval
b = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ IntegerInterval -> Bool
null IntegerInterval
a
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ IntegerInterval -> Bool
null IntegerInterval
b
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ IntegerInterval
a 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 forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\(Integer
y,Integer
x) -> (Integer
x,Integer
y)) 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 <- 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 <- [-forall r. Extended r
inf Extended Integer -> Extended Integer -> IntegerInterval
<..< forall r. r -> Extended r
Finite Integer
x, forall r. r -> Extended r
Finite Integer
x Extended Integer -> Extended Integer -> IntegerInterval
<..< forall r. Extended r
inf]]
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x,Integer
y)
(>=?) :: IntegerInterval -> IntegerInterval -> Bool
>=? :: IntegerInterval -> IntegerInterval -> Bool
(>=?) = forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Bool
(<=?)
(>?) :: IntegerInterval -> IntegerInterval -> Bool
>? :: IntegerInterval -> IntegerInterval -> Bool
(>?) = forall a b c. (a -> b -> c) -> b -> a -> c
flip IntegerInterval -> IntegerInterval -> Bool
(<?)
(>=??) :: 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)
(<=??)
(>??) :: 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 forall a. Ord a => a -> a -> Ordering
compare Integer
c Integer
0 of
Ordering
EQ -> Integer -> IntegerInterval
singleton Integer
0
Ordering
LT -> forall r. r -> Extended r
Finite Integer
c forall a. Num a => a -> a -> a
* IntegerInterval -> Extended Integer
upperBound IntegerInterval
x Extended Integer -> Extended Integer -> IntegerInterval
<=..<= forall r. r -> Extended r
Finite Integer
c forall a. Num a => a -> a -> a
* IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x
Ordering
GT -> forall r. r -> Extended r
Finite Integer
c forall a. Num a => a -> a -> a
* IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x Extended Integer -> Extended Integer -> IntegerInterval
<=..<= forall r. r -> Extended r
Finite Integer
c 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 forall a. Num a => a -> a -> a
+ IntegerInterval -> Extended Integer
lowerBound IntegerInterval
b Extended Integer -> Extended Integer -> IntegerInterval
<=..<= IntegerInterval -> Extended Integer
upperBound IntegerInterval
a 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 (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` (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
<=..< 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 forall a b. (a -> b) -> a -> b
$ (Extended Integer
0 Extended Integer -> Extended Integer -> IntegerInterval
<..< 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 forall a b. (a -> b) -> a -> b
$ (-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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Extended Integer]
xs Extended Integer -> Extended Integer -> IntegerInterval
<=..<= 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
x1forall a. Num a => a -> a -> a
*Extended Integer
x2
toInterval :: Real r => IntegerInterval -> Interval.Interval r
toInterval :: forall r. Real r => IntegerInterval -> Interval r
toInterval IntegerInterval
x = forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => Integer -> a
fromInteger (IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x), Boundary
Closed)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => Integer -> a
fromInteger (IntegerInterval -> Extended Integer
upperBound IntegerInterval
x), Boundary
Closed)
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) = forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval Integer
i
(Extended Integer
x2,Boundary
in2) = 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 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 forall a. Num a => a -> a -> a
- Extended Integer
1
Boundary
Interval.Closed -> Extended Integer
x2
fromIntervalOver :: RealFrac r => Interval.Interval r -> IntegerInterval
fromIntervalOver :: forall r. RealFrac r => Interval r -> IntegerInterval
fromIntervalOver Interval r
i = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (RealFrac a, Integral b) => a -> b
floor Extended r
lb Extended Integer -> Extended Integer -> IntegerInterval
<=..<= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (RealFrac a, Integral b) => a -> b
ceiling Extended r
ub
where
(Extended r
lb, Boundary
_) = forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i
(Extended r
ub, Boundary
_) = forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i
fromIntervalUnder :: RealFrac r => Interval.Interval r -> IntegerInterval
fromIntervalUnder :: forall r. RealFrac r => Interval r -> IntegerInterval
fromIntervalUnder Interval r
i = Extended Integer
lb Extended Integer -> Extended Integer -> IntegerInterval
<=..<= Extended Integer
ub
where
lb :: Extended Integer
lb = case forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i of
(Finite r
x, Boundary
Open)
| forall a. Num a => Integer -> a
fromInteger (forall a b. (RealFrac a, Integral b) => a -> b
ceiling r
x) forall a. Eq a => a -> a -> Bool
== r
x
-> forall r. r -> Extended r
Finite (forall a b. (RealFrac a, Integral b) => a -> b
ceiling r
x forall a. Num a => a -> a -> a
+ Integer
1)
(Extended r
x, Boundary
_) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (RealFrac a, Integral b) => a -> b
ceiling Extended r
x
ub :: Extended Integer
ub = case forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i of
(Finite r
x, Boundary
Open)
| forall a. Num a => Integer -> a
fromInteger (forall a b. (RealFrac a, Integral b) => a -> b
floor r
x) forall a. Eq a => a -> a -> Bool
== r
x
-> forall r. r -> Extended r
Finite (forall a b. (RealFrac a, Integral b) => a -> b
floor r
x forall a. Num a => a -> a -> a
- Integer
1)
(Extended r
x, Boundary
_) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (RealFrac a, Integral b) => a -> b
floor Extended r
x
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
(Bool
True , Bool
True ) -> Relation
Equal
(Bool
True , Bool
False) | IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i1 forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i2 -> Relation
Starts
| IntegerInterval -> Extended Integer
upperBound IntegerInterval
i1 forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
upperBound IntegerInterval
i2 -> Relation
Finishes
| Bool
otherwise -> Relation
During
(Bool
False, Bool
True ) | IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i1 forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i2 -> Relation
StartedBy
| IntegerInterval -> Extended Integer
upperBound IntegerInterval
i1 forall a. Eq a => a -> a -> Bool
== IntegerInterval -> Extended Integer
upperBound IntegerInterval
i2 -> Relation
FinishedBy
| Bool
otherwise -> Relation
Contains
(Bool
False, Bool
False) -> case ( IntegerInterval -> Bool
null (IntegerInterval
i1 IntegerInterval -> IntegerInterval -> IntegerInterval
`intersection` IntegerInterval
i2)
, IntegerInterval -> Extended Integer
lowerBound IntegerInterval
i1 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