{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
#endif
module Data.IntervalSet
(
IntervalSet
, module Data.ExtendedReal
, whole
, empty
, singleton
, null
, member
, notMember
, isSubsetOf
, isProperSubsetOf
, span
, complement
, insert
, delete
, union
, unions
, intersection
, intersections
, difference
, fromList
, toList
, toAscList
, toDescList
, fromAscList
)
where
import Prelude hiding (null, span)
#ifdef MIN_VERSION_lattices
import Algebra.Lattice
#endif
import Control.DeepSeq
import Data.Data
import Data.ExtendedReal
import Data.Function
import Data.Hashable
import Data.List (sortBy, foldl')
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Semigroup as Semigroup
import Data.Interval (Interval, Boundary(..))
import qualified Data.Interval as Interval
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid (Monoid(..))
#endif
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as GHCExts
#endif
newtype IntervalSet r = IntervalSet (Map (Extended r) (Interval r))
deriving (IntervalSet r -> IntervalSet r -> Bool
(IntervalSet r -> IntervalSet r -> Bool)
-> (IntervalSet r -> IntervalSet r -> Bool) -> Eq (IntervalSet r)
forall r. Eq r => IntervalSet r -> IntervalSet r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntervalSet r -> IntervalSet r -> Bool
$c/= :: forall r. Eq r => IntervalSet r -> IntervalSet r -> Bool
== :: IntervalSet r -> IntervalSet r -> Bool
$c== :: forall r. Eq r => IntervalSet r -> IntervalSet r -> Bool
Eq, Typeable)
#if __GLASGOW_HASKELL__ >= 708
type role IntervalSet nominal
#endif
instance (Ord r, Show r) => Show (IntervalSet r) where
showsPrec :: Int -> IntervalSet r -> ShowS
showsPrec Int
p (IntervalSet Map (Extended r) (Interval r)
m) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [Interval r] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Map (Extended r) (Interval r) -> [Interval r]
forall k a. Map k a -> [a]
Map.elems Map (Extended r) (Interval r)
m)
instance (Ord r, Read r) => Read (IntervalSet r) where
readsPrec :: Int -> ReadS (IntervalSet r)
readsPrec Int
p =
(Bool -> ReadS (IntervalSet r) -> ReadS (IntervalSet r)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ReadS (IntervalSet r) -> ReadS (IntervalSet r))
-> ReadS (IntervalSet r) -> ReadS (IntervalSet r)
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
(String
"fromList",String
s1) <- ReadS String
lex String
s0
([Interval r]
xs,String
s2) <- Int -> ReadS [Interval r]
forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
s1
(IntervalSet r, String) -> [(IntervalSet r, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList [Interval r]
xs, String
s2))
appPrec :: Int
appPrec :: Int
appPrec = Int
10
instance (Ord r, Data r) => Data (IntervalSet r) where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntervalSet r -> c (IntervalSet r)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z IntervalSet r
x = ([Interval r] -> IntervalSet r)
-> c ([Interval r] -> IntervalSet r)
forall g. g -> c g
z [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList c ([Interval r] -> IntervalSet r)
-> [Interval r] -> c (IntervalSet r)
forall d b. Data d => c (d -> b) -> d -> c b
`k` IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
x
toConstr :: IntervalSet r -> Constr
toConstr IntervalSet r
_ = Constr
fromListConstr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IntervalSet r)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> c ([Interval r] -> IntervalSet r) -> c (IntervalSet r)
forall b r. Data b => c (b -> r) -> c r
k (([Interval r] -> IntervalSet r)
-> c ([Interval r] -> IntervalSet r)
forall r. r -> c r
z [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList)
Int
_ -> String -> c (IntervalSet r)
forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: IntervalSet r -> DataType
dataTypeOf IntervalSet r
_ = DataType
setDataType
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (IntervalSet r))
dataCast1 forall d. Data d => c (t d)
f = c (t r) -> Maybe (c (IntervalSet r))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t r)
forall d. Data d => c (t d)
f
fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
setDataType String
"fromList" [] Fixity
Prefix
setDataType :: DataType
setDataType :: DataType
setDataType = String -> [Constr] -> DataType
mkDataType String
"Data.IntervalSet.IntervalSet" [Constr
fromListConstr]
instance NFData r => NFData (IntervalSet r) where
rnf :: IntervalSet r -> ()
rnf (IntervalSet Map (Extended r) (Interval r)
m) = Map (Extended r) (Interval r) -> ()
forall a. NFData a => a -> ()
rnf Map (Extended r) (Interval r)
m
instance Hashable r => Hashable (IntervalSet r) where
hashWithSalt :: Int -> IntervalSet r -> Int
hashWithSalt Int
s (IntervalSet Map (Extended r) (Interval r)
m) = Int -> [(Extended r, Interval r)] -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Map (Extended r) (Interval r) -> [(Extended r, Interval r)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Extended r) (Interval r)
m)
#ifdef MIN_VERSION_lattices
#if MIN_VERSION_lattices(2,0,0)
instance (Ord r) => Lattice (IntervalSet r) where
\/ :: IntervalSet r -> IntervalSet r -> IntervalSet r
(\/) = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union
/\ :: IntervalSet r -> IntervalSet r -> IntervalSet r
(/\) = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection
instance (Ord r) => BoundedJoinSemiLattice (IntervalSet r) where
bottom :: IntervalSet r
bottom = IntervalSet r
forall r. Ord r => IntervalSet r
empty
instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where
top :: IntervalSet r
top = IntervalSet r
forall r. Ord r => IntervalSet r
whole
#else
instance (Ord r) => JoinSemiLattice (IntervalSet r) where
join = union
instance (Ord r) => MeetSemiLattice (IntervalSet r) where
meet = intersection
instance (Ord r) => Lattice (IntervalSet r)
instance (Ord r) => BoundedJoinSemiLattice (IntervalSet r) where
bottom = empty
instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where
top = whole
instance (Ord r) => BoundedLattice (IntervalSet r)
#endif
#endif
instance Ord r => Monoid (IntervalSet r) where
mempty :: IntervalSet r
mempty = IntervalSet r
forall r. Ord r => IntervalSet r
empty
mappend :: IntervalSet r -> IntervalSet r -> IntervalSet r
mappend = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union
mconcat :: [IntervalSet r] -> IntervalSet r
mconcat = [IntervalSet r] -> IntervalSet r
forall r. Ord r => [IntervalSet r] -> IntervalSet r
unions
instance (Ord r) => Semigroup.Semigroup (IntervalSet r) where
<> :: IntervalSet r -> IntervalSet r -> IntervalSet r
(<>) = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union
#if !defined(VERSION_semigroups)
stimes :: b -> IntervalSet r -> IntervalSet r
stimes = b -> IntervalSet r -> IntervalSet r
forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesIdempotentMonoid
#else
#if MIN_VERSION_semigroups(0,17,0)
stimes = Semigroup.stimesIdempotentMonoid
#else
times1p _ a = a
#endif
#endif
lift1
:: Ord r => (Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r
lift1 :: (Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
f IntervalSet r
as = [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList [Interval r -> Interval r
f Interval r
a | Interval r
a <- IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
as]
lift2
:: Ord r => (Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 :: (Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 Interval r -> Interval r -> Interval r
f IntervalSet r
as IntervalSet r
bs = [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList [Interval r -> Interval r -> Interval r
f Interval r
a Interval r
b | Interval r
a <- IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
as, Interval r
b <- IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
bs]
instance (Num r, Ord r) => Num (IntervalSet r) where
+ :: IntervalSet r -> IntervalSet r -> IntervalSet r
(+) = (Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 Interval r -> Interval r -> Interval r
forall a. Num a => a -> a -> a
(+)
* :: IntervalSet r -> IntervalSet r -> IntervalSet r
(*) = (Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 Interval r -> Interval r -> Interval r
forall a. Num a => a -> a -> a
(*)
negate :: IntervalSet r -> IntervalSet r
negate = (Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
forall a. Num a => a -> a
negate
abs :: IntervalSet r -> IntervalSet r
abs = (Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
forall a. Num a => a -> a
abs
fromInteger :: Integer -> IntervalSet r
fromInteger Integer
i = Interval r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r
singleton (Integer -> Interval r
forall a. Num a => Integer -> a
fromInteger Integer
i)
signum :: IntervalSet r -> IntervalSet r
signum IntervalSet r
xs = [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList ([Interval r] -> IntervalSet r) -> [Interval r] -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ do
Interval r
x <- IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
xs
Interval r
y <-
[ if r -> Interval r -> Bool
forall r. Ord r => r -> Interval r -> Bool
Interval.member r
0 Interval r
x
then r -> Interval r
forall r. Ord r => r -> Interval r
Interval.singleton r
0
else Interval r
forall r. Ord r => Interval r
Interval.empty
, if Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null ((Extended r
0 Extended r -> Extended r -> Interval r
forall r. Ord r => Extended r -> Extended r -> Interval r
Interval.<..< Extended r
forall r. Extended r
inf) Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
x)
then Interval r
forall r. Ord r => Interval r
Interval.empty
else r -> Interval r
forall r. Ord r => r -> Interval r
Interval.singleton r
1
, if Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null ((-Extended r
forall r. Extended r
inf Extended r -> Extended r -> Interval r
forall r. Ord r => Extended r -> Extended r -> Interval r
Interval.<..< Extended r
0) Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
x)
then Interval r
forall r. Ord r => Interval r
Interval.empty
else r -> Interval r
forall r. Ord r => r -> Interval r
Interval.singleton (-r
1)
]
Interval r -> [Interval r]
forall (m :: * -> *) a. Monad m => a -> m a
return Interval r
y
instance forall r. (Real r, Fractional r) => Fractional (IntervalSet r) where
fromRational :: Rational -> IntervalSet r
fromRational Rational
r = Interval r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r
singleton (Rational -> Interval r
forall a. Fractional a => Rational -> a
fromRational Rational
r)
recip :: IntervalSet r -> IntervalSet r
recip IntervalSet r
xs = (Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
forall a. Fractional a => a -> a
recip (Interval r -> IntervalSet r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete (r -> Interval r
forall r. Ord r => r -> Interval r
Interval.singleton r
0) IntervalSet r
xs)
#if __GLASGOW_HASKELL__ >= 708
instance Ord r => GHCExts.IsList (IntervalSet r) where
type Item (IntervalSet r) = Interval r
fromList :: [Item (IntervalSet r)] -> IntervalSet r
fromList = [Item (IntervalSet r)] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList
toList :: IntervalSet r -> [Item (IntervalSet r)]
toList = IntervalSet r -> [Item (IntervalSet r)]
forall r. Ord r => IntervalSet r -> [Interval r]
toList
#endif
whole :: Ord r => IntervalSet r
whole :: IntervalSet r
whole = Interval r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r
singleton (Interval r -> IntervalSet r) -> Interval r -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ Interval r
forall r. Ord r => Interval r
Interval.whole
empty :: Ord r => IntervalSet r
empty :: IntervalSet r
empty = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet Map (Extended r) (Interval r)
forall k a. Map k a
Map.empty
singleton :: Ord r => Interval r -> IntervalSet r
singleton :: Interval r -> IntervalSet r
singleton Interval r
i
| Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
i = IntervalSet r
forall r. Ord r => IntervalSet r
empty
| Bool
otherwise = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> Map (Extended r) (Interval r) -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ Extended r -> Interval r -> Map (Extended r) (Interval r)
forall k a. k -> a -> Map k a
Map.singleton (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i) Interval r
i
null :: IntervalSet r -> Bool
null :: IntervalSet r -> Bool
null (IntervalSet Map (Extended r) (Interval r)
m) = Map (Extended r) (Interval r) -> Bool
forall k a. Map k a -> Bool
Map.null Map (Extended r) (Interval r)
m
member :: Ord r => r -> IntervalSet r -> Bool
member :: r -> IntervalSet r -> Bool
member r
x (IntervalSet Map (Extended r) (Interval r)
m) =
case Extended r
-> Map (Extended r) (Interval r) -> Maybe (Extended r, Interval r)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (r -> Extended r
forall r. r -> Extended r
Finite r
x) Map (Extended r) (Interval r)
m of
Maybe (Extended r, Interval r)
Nothing -> Bool
False
Just (Extended r
_,Interval r
i) -> r -> Interval r -> Bool
forall r. Ord r => r -> Interval r -> Bool
Interval.member r
x Interval r
i
notMember :: Ord r => r -> IntervalSet r -> Bool
notMember :: r -> IntervalSet r -> Bool
notMember r
x IntervalSet r
is = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ r
x r -> IntervalSet r -> Bool
forall r. Ord r => r -> IntervalSet r -> Bool
`member` IntervalSet r
is
isSubsetOf :: Ord r => IntervalSet r -> IntervalSet r -> Bool
isSubsetOf :: IntervalSet r -> IntervalSet r -> Bool
isSubsetOf IntervalSet r
is1 IntervalSet r
is2 = (Interval r -> Bool) -> [Interval r] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Interval r
i1 -> Interval r -> IntervalSet r -> Bool
forall r. Ord r => Interval r -> IntervalSet r -> Bool
f Interval r
i1 IntervalSet r
is2) (IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is1)
where
f :: Interval r -> IntervalSet r -> Bool
f Interval r
i1 (IntervalSet Map (Extended r) (Interval r)
m) =
case Extended r
-> Map (Extended r) (Interval r) -> Maybe (Extended r, Interval r)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i1) Map (Extended r) (Interval r)
m of
Maybe (Extended r, Interval r)
Nothing -> Bool
False
Just (Extended r
_,Interval r
i2) -> Interval r -> Interval r -> Bool
forall r. Ord r => Interval r -> Interval r -> Bool
Interval.isSubsetOf Interval r
i1 Interval r
i2
isProperSubsetOf :: Ord r => IntervalSet r -> IntervalSet r -> Bool
isProperSubsetOf :: IntervalSet r -> IntervalSet r -> Bool
isProperSubsetOf IntervalSet r
is1 IntervalSet r
is2 = IntervalSet r -> IntervalSet r -> Bool
forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
isSubsetOf IntervalSet r
is1 IntervalSet r
is2 Bool -> Bool -> Bool
&& IntervalSet r
is1 IntervalSet r -> IntervalSet r -> Bool
forall a. Eq a => a -> a -> Bool
/= IntervalSet r
is2
span :: Ord r => IntervalSet r -> Interval r
span :: IntervalSet r -> Interval r
span (IntervalSet Map (Extended r) (Interval r)
m) =
case Map (Extended r) (Interval r)
-> Maybe (Interval r, Map (Extended r) (Interval r))
forall k a. Map k a -> Maybe (a, Map k a)
Map.minView Map (Extended r) (Interval r)
m of
Maybe (Interval r, Map (Extended r) (Interval r))
Nothing -> Interval r
forall r. Ord r => Interval r
Interval.empty
Just (Interval r
i1, Map (Extended r) (Interval r)
_) ->
case Map (Extended r) (Interval r)
-> Maybe (Interval r, Map (Extended r) (Interval r))
forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map (Extended r) (Interval r)
m of
Maybe (Interval r, Map (Extended r) (Interval r))
Nothing -> Interval r
forall r. Ord r => Interval r
Interval.empty
Just (Interval r
i2, Map (Extended r) (Interval r)
_) ->
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i1) (Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i2)
complement :: Ord r => IntervalSet r -> IntervalSet r
complement :: IntervalSet r -> IntervalSet r
complement (IntervalSet Map (Extended r) (Interval r)
m) = [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromAscList ([Interval r] -> IntervalSet r) -> [Interval r] -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ (Extended r, Boundary) -> [Interval r] -> [Interval r]
forall r.
Ord r =>
(Extended r, Boundary) -> [Interval r] -> [Interval r]
f (Extended r
forall r. Extended r
NegInf,Boundary
Open) (Map (Extended r) (Interval r) -> [Interval r]
forall k a. Map k a -> [a]
Map.elems Map (Extended r) (Interval r)
m)
where
f :: (Extended r, Boundary) -> [Interval r] -> [Interval r]
f (Extended r, Boundary)
prev [] = [ (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Extended r, Boundary)
prev (Extended r
forall r. Extended r
PosInf,Boundary
Open) ]
f (Extended r, Boundary)
prev (Interval r
i : [Interval r]
is) =
case (Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i, Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i) of
((Extended r
lb, Boundary
in1), (Extended r
ub, Boundary
in2)) ->
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Extended r, Boundary)
prev (Extended r
lb, Boundary -> Boundary
notB Boundary
in1) Interval r -> [Interval r] -> [Interval r]
forall a. a -> [a] -> [a]
: (Extended r, Boundary) -> [Interval r] -> [Interval r]
f (Extended r
ub, Boundary -> Boundary
notB Boundary
in2) [Interval r]
is
insert :: Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert :: Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is | Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
i = IntervalSet r
is
insert Interval r
i (IntervalSet Map (Extended r) (Interval r)
is) = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> Map (Extended r) (Interval r) -> IntervalSet r
forall a b. (a -> b) -> a -> b
$
case Extended r
-> Map (Extended r) (Interval r)
-> (Map (Extended r) (Interval r), Maybe (Interval r),
Map (Extended r) (Interval r))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i) Map (Extended r) (Interval r)
is of
(Map (Extended r) (Interval r)
smaller, Maybe (Interval r)
m1, Map (Extended r) (Interval r)
xs) ->
case Extended r
-> Map (Extended r) (Interval r)
-> (Map (Extended r) (Interval r), Maybe (Interval r),
Map (Extended r) (Interval r))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.upperBound Interval r
i) Map (Extended r) (Interval r)
xs of
(Map (Extended r) (Interval r)
_, Maybe (Interval r)
m2, Map (Extended r) (Interval r)
larger) ->
[Map (Extended r) (Interval r)] -> Map (Extended r) (Interval r)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
[ Map (Extended r) (Interval r)
smaller
, case [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList ([Interval r] -> IntervalSet r) -> [Interval r] -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ Interval r
i Interval r -> [Interval r] -> [Interval r]
forall a. a -> [a] -> [a]
: Maybe (Interval r) -> [Interval r]
forall a. Maybe a -> [a]
maybeToList Maybe (Interval r)
m1 [Interval r] -> [Interval r] -> [Interval r]
forall a. [a] -> [a] -> [a]
++ Maybe (Interval r) -> [Interval r]
forall a. Maybe a -> [a]
maybeToList Maybe (Interval r)
m2 of
IntervalSet Map (Extended r) (Interval r)
m -> Map (Extended r) (Interval r)
m
, Map (Extended r) (Interval r)
larger
]
delete :: Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete :: Interval r -> IntervalSet r -> IntervalSet r
delete Interval r
i IntervalSet r
is | Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
i = IntervalSet r
is
delete Interval r
i (IntervalSet Map (Extended r) (Interval r)
is) = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> Map (Extended r) (Interval r) -> IntervalSet r
forall a b. (a -> b) -> a -> b
$
case Extended r
-> Map (Extended r) (Interval r)
-> (Map (Extended r) (Interval r), Maybe (Interval r),
Map (Extended r) (Interval r))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i) Map (Extended r) (Interval r)
is of
(Map (Extended r) (Interval r)
smaller, Maybe (Interval r)
m1, Map (Extended r) (Interval r)
xs) ->
case Extended r
-> Map (Extended r) (Interval r)
-> (Map (Extended r) (Interval r), Maybe (Interval r),
Map (Extended r) (Interval r))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.upperBound Interval r
i) Map (Extended r) (Interval r)
xs of
(Map (Extended r) (Interval r)
_, Maybe (Interval r)
m2, Map (Extended r) (Interval r)
larger) ->
[Map (Extended r) (Interval r)] -> Map (Extended r) (Interval r)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
[ Map (Extended r) (Interval r)
smaller
, case Maybe (Interval r)
m1 of
Maybe (Interval r)
Nothing -> Map (Extended r) (Interval r)
forall k a. Map k a
Map.empty
Just Interval r
j -> [(Extended r, Interval r)] -> Map (Extended r) (Interval r)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
k, Interval r
k)
| Interval r
i' <- [Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r
upTo Interval r
i, Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r
downTo Interval r
i], let k :: Interval r
k = Interval r
i' Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
j, Bool -> Bool
not (Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
k)
]
, if
| Just Interval r
j <- Maybe (Interval r)
m2, Interval r
j' <- Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r
downTo Interval r
i Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
j, Bool -> Bool
not (Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
j') ->
Extended r -> Interval r -> Map (Extended r) (Interval r)
forall k a. k -> a -> Map k a
Map.singleton (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
j') Interval r
j'
| Bool
otherwise -> Map (Extended r) (Interval r)
forall k a. Map k a
Map.empty
, Map (Extended r) (Interval r)
larger
]
union :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union :: IntervalSet r -> IntervalSet r -> IntervalSet r
union is1 :: IntervalSet r
is1@(IntervalSet Map (Extended r) (Interval r)
m1) is2 :: IntervalSet r
is2@(IntervalSet Map (Extended r) (Interval r)
m2) =
if Map (Extended r) (Interval r) -> Int
forall k a. Map k a -> Int
Map.size Map (Extended r) (Interval r)
m1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Map (Extended r) (Interval r) -> Int
forall k a. Map k a -> Int
Map.size Map (Extended r) (Interval r)
m2
then (IntervalSet r -> Interval r -> IntervalSet r)
-> IntervalSet r -> [Interval r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> Interval r -> IntervalSet r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is) IntervalSet r
is1 (IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is2)
else (IntervalSet r -> Interval r -> IntervalSet r)
-> IntervalSet r -> [Interval r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> Interval r -> IntervalSet r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is) IntervalSet r
is2 (IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is1)
unions :: Ord r => [IntervalSet r] -> IntervalSet r
unions :: [IntervalSet r] -> IntervalSet r
unions = (IntervalSet r -> IntervalSet r -> IntervalSet r)
-> IntervalSet r -> [IntervalSet r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union IntervalSet r
forall r. Ord r => IntervalSet r
empty
intersection :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection :: IntervalSet r -> IntervalSet r -> IntervalSet r
intersection IntervalSet r
is1 IntervalSet r
is2 = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
difference IntervalSet r
is1 (IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r
complement IntervalSet r
is2)
intersections :: Ord r => [IntervalSet r] -> IntervalSet r
intersections :: [IntervalSet r] -> IntervalSet r
intersections = (IntervalSet r -> IntervalSet r -> IntervalSet r)
-> IntervalSet r -> [IntervalSet r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection IntervalSet r
forall r. Ord r => IntervalSet r
whole
difference :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
difference :: IntervalSet r -> IntervalSet r -> IntervalSet r
difference IntervalSet r
is1 IntervalSet r
is2 =
(IntervalSet r -> Interval r -> IntervalSet r)
-> IntervalSet r -> [Interval r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> Interval r -> IntervalSet r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete Interval r
i IntervalSet r
is) IntervalSet r
is1 (IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is2)
fromList :: Ord r => [Interval r] -> IntervalSet r
fromList :: [Interval r] -> IntervalSet r
fromList = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> ([Interval r] -> Map (Extended r) (Interval r))
-> [Interval r]
-> IntervalSet r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval r] -> Map (Extended r) (Interval r)
forall r. Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList' ([Interval r] -> Map (Extended r) (Interval r))
-> ([Interval r] -> [Interval r])
-> [Interval r]
-> Map (Extended r) (Interval r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interval r -> Interval r -> Ordering)
-> [Interval r] -> [Interval r]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB ((Extended r, Boundary) -> (Extended r, Boundary) -> Ordering)
-> (Interval r -> (Extended r, Boundary))
-> Interval r
-> Interval r
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound')
fromAscList :: Ord r => [Interval r] -> IntervalSet r
fromAscList :: [Interval r] -> IntervalSet r
fromAscList = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> ([Interval r] -> Map (Extended r) (Interval r))
-> [Interval r]
-> IntervalSet r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval r] -> Map (Extended r) (Interval r)
forall r. Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList'
fromAscList' :: Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList' :: [Interval r] -> Map (Extended r) (Interval r)
fromAscList' = [(Extended r, Interval r)] -> Map (Extended r) (Interval r)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(Extended r, Interval r)] -> Map (Extended r) (Interval r))
-> ([Interval r] -> [(Extended r, Interval r)])
-> [Interval r]
-> Map (Extended r) (Interval r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interval r -> (Extended r, Interval r))
-> [Interval r] -> [(Extended r, Interval r)]
forall a b. (a -> b) -> [a] -> [b]
map (\Interval r
i -> (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i, Interval r
i)) ([Interval r] -> [(Extended r, Interval r)])
-> ([Interval r] -> [Interval r])
-> [Interval r]
-> [(Extended r, Interval r)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval r] -> [Interval r]
forall r. Ord r => [Interval r] -> [Interval r]
f
where
f :: Ord r => [Interval r] -> [Interval r]
f :: [Interval r] -> [Interval r]
f [] = []
f (Interval r
x : [Interval r]
xs) = Interval r -> [Interval r] -> [Interval r]
forall r. Ord r => Interval r -> [Interval r] -> [Interval r]
g Interval r
x [Interval r]
xs
g :: Interval r -> [Interval r] -> [Interval r]
g Interval r
x [] = [Interval r
x | Bool -> Bool
not (Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
x)]
g Interval r
x (Interval r
y : [Interval r]
ys)
| Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
x = Interval r -> [Interval r] -> [Interval r]
g Interval r
y [Interval r]
ys
| Interval r -> Interval r -> Bool
forall r. Ord r => Interval r -> Interval r -> Bool
Interval.isConnected Interval r
x Interval r
y = Interval r -> [Interval r] -> [Interval r]
g (Interval r
x Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.hull` Interval r
y) [Interval r]
ys
| Bool
otherwise = Interval r
x Interval r -> [Interval r] -> [Interval r]
forall a. a -> [a] -> [a]
: Interval r -> [Interval r] -> [Interval r]
g Interval r
y [Interval r]
ys
toList :: Ord r => IntervalSet r -> [Interval r]
toList :: IntervalSet r -> [Interval r]
toList = IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toAscList
toAscList :: Ord r => IntervalSet r -> [Interval r]
toAscList :: IntervalSet r -> [Interval r]
toAscList (IntervalSet Map (Extended r) (Interval r)
m) = Map (Extended r) (Interval r) -> [Interval r]
forall k a. Map k a -> [a]
Map.elems Map (Extended r) (Interval r)
m
toDescList :: Ord r => IntervalSet r -> [Interval r]
toDescList :: IntervalSet r -> [Interval r]
toDescList (IntervalSet Map (Extended r) (Interval r)
m) = ((Extended r, Interval r) -> Interval r)
-> [(Extended r, Interval r)] -> [Interval r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extended r, Interval r) -> Interval r
forall a b. (a, b) -> b
snd ([(Extended r, Interval r)] -> [Interval r])
-> [(Extended r, Interval r)] -> [Interval r]
forall a b. (a -> b) -> a -> b
$ Map (Extended r) (Interval r) -> [(Extended r, Interval r)]
forall k a. Map k a -> [(k, a)]
Map.toDescList Map (Extended r) (Interval r)
m
splitLookupLE :: Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE :: k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE k
k Map k v
m =
case k -> Map k v -> (Map k v, Maybe v, Map k v)
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
Map.splitLookup k
k Map k v
m of
(Map k v
smaller, Just v
v, Map k v
larger) -> (Map k v
smaller, v -> Maybe v
forall a. a -> Maybe a
Just v
v, Map k v
larger)
(Map k v
smaller, Maybe v
Nothing, Map k v
larger) ->
case Map k v -> Maybe (v, Map k v)
forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map k v
smaller of
Just (v
v, Map k v
smaller') -> (Map k v
smaller', v -> Maybe v
forall a. a -> Maybe a
Just v
v, Map k v
larger)
Maybe (v, Map k v)
Nothing -> (Map k v
smaller, Maybe v
forall a. Maybe a
Nothing, Map k v
larger)
compareLB :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB :: (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB (Extended r
lb1, Boundary
lb1in) (Extended r
lb2, Boundary
lb2in) =
(Extended r
lb1 Extended r -> Extended r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Extended r
lb2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (Boundary
lb2in Boundary -> Boundary -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Boundary
lb1in)
upTo :: Ord r => Interval r -> Interval r
upTo :: Interval r -> Interval r
upTo Interval r
i =
case Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i of
(Extended r
NegInf, Boundary
_) -> Interval r
forall r. Ord r => Interval r
Interval.empty
(Extended r
PosInf, Boundary
_) -> Interval r
forall r. Ord r => Interval r
Interval.whole
(Finite r
lb, Boundary
incl) ->
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Extended r
forall r. Extended r
NegInf, Boundary
Open) (r -> Extended r
forall r. r -> Extended r
Finite r
lb, Boundary -> Boundary
notB Boundary
incl)
downTo :: Ord r => Interval r -> Interval r
downTo :: Interval r -> Interval r
downTo Interval r
i =
case Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i of
(Extended r
PosInf, Boundary
_) -> Interval r
forall r. Ord r => Interval r
Interval.empty
(Extended r
NegInf, Boundary
_) -> Interval r
forall r. Ord r => Interval r
Interval.whole
(Finite r
ub, Boundary
incl) ->
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (r -> Extended r
forall r. r -> Extended r
Finite r
ub, Boundary -> Boundary
notB Boundary
incl) (Extended r
forall r. Extended r
PosInf, Boundary
Open)
notB :: Boundary -> Boundary
notB :: Boundary -> Boundary
notB = \case
Boundary
Open -> Boundary
Closed
Boundary
Closed -> Boundary
Open