{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE RoleAnnotations #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.IntervalSet
-- Copyright   :  (c) Masahiro Sakai 2016
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (CPP, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf)
--
-- Interval datatype and interval arithmetic.
--
-----------------------------------------------------------------------------
module Data.IntervalSet
  (
  -- * IntervalSet type
    IntervalSet
  , module Data.ExtendedReal

  -- * Construction
  , whole
  , empty
  , singleton

  -- * Query
  , null
  , member
  , notMember
  , isSubsetOf
  , isProperSubsetOf
  , span

  -- * Construction
  , complement
  , insert
  , delete

  -- * Combine
  , union
  , unions
  , intersection
  , intersections
  , difference

  -- * Conversion

  -- ** List
  , fromList
  , toList

  -- ** Ordered list
  , 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
import qualified GHC.Exts as GHCExts

-- | A set comprising zero or more non-empty, /disconnected/ intervals.
--
-- Any connected intervals are merged together, and empty intervals are ignored.
newtype IntervalSet r = IntervalSet (Map (Extended r) (Interval r))
  deriving
    ( IntervalSet r -> IntervalSet r -> Bool
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
    , IntervalSet r -> IntervalSet r -> Bool
IntervalSet r -> IntervalSet r -> Ordering
IntervalSet r -> IntervalSet r -> IntervalSet r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {r}. Ord r => Eq (IntervalSet r)
forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
forall r. Ord r => IntervalSet r -> IntervalSet r -> Ordering
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
min :: IntervalSet r -> IntervalSet r -> IntervalSet r
$cmin :: forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
max :: IntervalSet r -> IntervalSet r -> IntervalSet r
$cmax :: forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
>= :: IntervalSet r -> IntervalSet r -> Bool
$c>= :: forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
> :: IntervalSet r -> IntervalSet r -> Bool
$c> :: forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
<= :: IntervalSet r -> IntervalSet r -> Bool
$c<= :: forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
< :: IntervalSet r -> IntervalSet r -> Bool
$c< :: forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
compare :: IntervalSet r -> IntervalSet r -> Ordering
$ccompare :: forall r. Ord r => IntervalSet r -> IntervalSet r -> Ordering
Ord
      -- ^ Note that this Ord is derived and not semantically meaningful.
      -- The primary intended use case is to allow using 'IntervalSet'
      -- in maps and sets that require ordering.
    , Typeable
    )

type role IntervalSet nominal

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 forall a. Ord a => a -> a -> Bool
> Int
appPrec) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecforall a. Num a => a -> a -> a
+Int
1) (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 =
    (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
"fromList",String
s1) <- ReadS String
lex String
s0
      ([Interval r]
xs,String
s2) <- forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecforall a. Num a => a -> a -> a
+Int
1) String
s1
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall r. Ord r => [Interval r] -> IntervalSet r
fromList [Interval r]
xs, String
s2))

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

-- This instance preserves data abstraction at the cost of inefficiency.
-- We provide limited reflection services for the sake of data abstraction.

instance (Ord r, Data r) => Data (IntervalSet r) where
  gfoldl :: forall (c :: * -> *).
(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   = forall g. g -> c g
z forall r. Ord r => [Interval r] -> IntervalSet r
fromList forall d b. Data d => c (d -> b) -> d -> c b
`k` forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
x
  toConstr :: IntervalSet r -> Constr
toConstr IntervalSet r
_     = Constr
fromListConstr
  gunfold :: forall (c :: * -> *).
(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 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall r. Ord r => [Interval r] -> IntervalSet r
fromList)
    Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: IntervalSet r -> DataType
dataTypeOf IntervalSet r
_   = DataType
setDataType
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (IntervalSet r))
dataCast1 forall d. Data d => c (t d)
f    = 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 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) = 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) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (forall k a. Map k a -> [(k, a)]
Map.toList Map (Extended r) (Interval r)
m)

#ifdef MIN_VERSION_lattices
instance (Ord r) => Lattice (IntervalSet r) where
  \/ :: IntervalSet r -> IntervalSet r -> IntervalSet r
(\/) = forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union
  /\ :: 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 = forall r. Ord r => IntervalSet r
empty

instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where
  top :: IntervalSet r
top = forall r. Ord r => IntervalSet r
whole
#endif

instance Ord r => Monoid (IntervalSet r) where
  mempty :: IntervalSet r
mempty = forall r. Ord r => IntervalSet r
empty
  mappend :: IntervalSet r -> IntervalSet r -> IntervalSet r
mappend = forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
  mconcat :: [IntervalSet r] -> IntervalSet r
mconcat = forall r. Ord r => [IntervalSet r] -> IntervalSet r
unions

instance (Ord r) => Semigroup.Semigroup (IntervalSet r) where
  <> :: IntervalSet r -> IntervalSet r -> IntervalSet r
(<>)    = forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union
  stimes :: forall b. Integral b => b -> IntervalSet r -> IntervalSet r
stimes  = forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesIdempotentMonoid

lift1
  :: Ord r => (Interval r -> Interval r)
  -> IntervalSet r -> IntervalSet r
lift1 :: forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
f IntervalSet r
as = forall r. Ord r => [Interval r] -> IntervalSet r
fromList [Interval r -> Interval r
f Interval r
a | Interval r
a <- 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 :: forall r.
Ord r =>
(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 = 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 <- forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
as, Interval r
b <- 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
(+) = forall r.
Ord r =>
(Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 forall a. Num a => a -> a -> a
(+)

  * :: IntervalSet r -> IntervalSet r -> IntervalSet r
(*) = forall r.
Ord r =>
(Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 forall a. Num a => a -> a -> a
(*)

  negate :: IntervalSet r -> IntervalSet r
negate = forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 forall a. Num a => a -> a
negate

  abs :: IntervalSet r -> IntervalSet r
abs = forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 forall a. Num a => a -> a
abs

  fromInteger :: Integer -> IntervalSet r
fromInteger Integer
i = forall r. Ord r => Interval r -> IntervalSet r
singleton (forall a. Num a => Integer -> a
fromInteger Integer
i)

  signum :: IntervalSet r -> IntervalSet r
signum IntervalSet r
xs = forall r. Ord r => [Interval r] -> IntervalSet r
fromList forall a b. (a -> b) -> a -> b
$ do
    Interval r
x <- forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
xs
    Interval r
y <-
      [ if forall r. Ord r => r -> Interval r -> Bool
Interval.member r
0 Interval r
x
        then forall r. Ord r => r -> Interval r
Interval.singleton r
0
        else forall r. Ord r => Interval r
Interval.empty
      , if forall r. Ord r => Interval r -> Bool
Interval.null ((Extended r
0 forall r. Ord r => Extended r -> Extended r -> Interval r
Interval.<..< forall r. Extended r
inf) forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
x)
        then forall r. Ord r => Interval r
Interval.empty
        else forall r. Ord r => r -> Interval r
Interval.singleton r
1
      , if forall r. Ord r => Interval r -> Bool
Interval.null ((-forall r. Extended r
inf forall r. Ord r => Extended r -> Extended r -> Interval r
Interval.<..< Extended r
0) forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
x)
        then forall r. Ord r => Interval r
Interval.empty
        else forall r. Ord r => r -> Interval r
Interval.singleton (-r
1)
      ]
    forall (m :: * -> *) a. Monad m => a -> m a
return Interval r
y

-- | @recip (recip xs) == delete 0 xs@
instance forall r. (Real r, Fractional r) => Fractional (IntervalSet r) where
  fromRational :: Rational -> IntervalSet r
fromRational Rational
r = forall r. Ord r => Interval r -> IntervalSet r
singleton (forall a. Fractional a => Rational -> a
fromRational Rational
r)
  recip :: IntervalSet r -> IntervalSet r
recip IntervalSet r
xs = forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 forall a. Fractional a => a -> a
recip (forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete (forall r. Ord r => r -> Interval r
Interval.singleton r
0) IntervalSet r
xs)

instance Ord r => GHCExts.IsList (IntervalSet r) where
  type Item (IntervalSet r) = Interval r
  fromList :: [Item (IntervalSet r)] -> IntervalSet r
fromList = forall r. Ord r => [Interval r] -> IntervalSet r
fromList
  toList :: IntervalSet r -> [Item (IntervalSet r)]
toList = forall r. Ord r => IntervalSet r -> [Interval r]
toList

-- -----------------------------------------------------------------------

-- | whole real number line (-∞, ∞)
whole :: Ord r => IntervalSet r
whole :: forall r. Ord r => IntervalSet r
whole = forall r. Ord r => Interval r -> IntervalSet r
singleton forall a b. (a -> b) -> a -> b
$ forall r. Ord r => Interval r
Interval.whole

-- | empty interval set
empty :: Ord r => IntervalSet r
empty :: forall r. Ord r => IntervalSet r
empty = forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet forall k a. Map k a
Map.empty

-- | single interval
singleton :: Ord r => Interval r -> IntervalSet r
singleton :: forall r. Ord r => Interval r -> IntervalSet r
singleton Interval r
i
  | forall r. Ord r => Interval r -> Bool
Interval.null Interval r
i = forall r. Ord r => IntervalSet r
empty
  | Bool
otherwise = forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i) Interval r
i

-- -----------------------------------------------------------------------

-- | Is the interval set empty?
null :: IntervalSet r -> Bool
null :: forall r. IntervalSet r -> Bool
null (IntervalSet Map (Extended r) (Interval r)
m) = forall k a. Map k a -> Bool
Map.null Map (Extended r) (Interval r)
m

-- | Is the element in the interval set?
member :: Ord r => r -> IntervalSet r -> Bool
member :: forall r. Ord r => r -> IntervalSet r -> Bool
member r
x (IntervalSet Map (Extended r) (Interval r)
m) =
  case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (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) -> forall r. Ord r => r -> Interval r -> Bool
Interval.member r
x Interval r
i

-- | Is the element not in the interval set?
notMember :: Ord r => r -> IntervalSet r -> Bool
notMember :: forall r. Ord r => r -> IntervalSet r -> Bool
notMember r
x IntervalSet r
is = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ r
x forall r. Ord r => r -> IntervalSet r -> Bool
`member` IntervalSet r
is

-- | Is this a subset?
-- @(is1 \``isSubsetOf`\` is2)@ tells whether @is1@ is a subset of @is2@.
isSubsetOf :: Ord r => IntervalSet r -> IntervalSet r -> Bool
isSubsetOf :: forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
isSubsetOf IntervalSet r
is1 IntervalSet r
is2 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Interval r
i1 -> forall {r}. Ord r => Interval r -> IntervalSet r -> Bool
f Interval r
i1 IntervalSet r
is2) (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 forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (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) -> forall r. Ord r => Interval r -> Interval r -> Bool
Interval.isSubsetOf Interval r
i1 Interval r
i2

-- | Is this a proper subset? (/i.e./ a subset but not equal).
isProperSubsetOf :: Ord r => IntervalSet r -> IntervalSet r -> Bool
isProperSubsetOf :: forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
isProperSubsetOf IntervalSet r
is1 IntervalSet r
is2 = forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
isSubsetOf IntervalSet r
is1 IntervalSet r
is2 Bool -> Bool -> Bool
&& IntervalSet r
is1 forall a. Eq a => a -> a -> Bool
/= IntervalSet r
is2

-- | convex hull of a set of intervals.
span :: Ord r => IntervalSet r -> Interval r
span :: forall r. Ord r => IntervalSet r -> Interval r
span (IntervalSet Map (Extended r) (Interval r)
m) =
  case 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 -> forall r. Ord r => Interval r
Interval.empty
    Just (Interval r
i1, Map (Extended r) (Interval r)
_) ->
      case 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 -> forall r. Ord r => Interval r
Interval.empty
        Just (Interval r
i2, Map (Extended r) (Interval r)
_) ->
          forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i1) (forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i2)

-- -----------------------------------------------------------------------

-- | Complement the interval set.
complement :: Ord r => IntervalSet r -> IntervalSet r
complement :: forall r. Ord r => IntervalSet r -> IntervalSet r
complement (IntervalSet Map (Extended r) (Interval r)
m) = forall r. Ord r => [Interval r] -> IntervalSet r
fromAscList forall a b. (a -> b) -> a -> b
$ forall {r}.
Ord r =>
(Extended r, Boundary) -> [Interval r] -> [Interval r]
f (forall r. Extended r
NegInf,Boundary
Open) (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 [] = [ forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Extended r, Boundary)
prev (forall r. Extended r
PosInf,Boundary
Open) ]
    f (Extended r, Boundary)
prev (Interval r
i : [Interval r]
is) =
      case (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i, forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i) of
        ((Extended r
lb, Boundary
in1), (Extended r
ub, Boundary
in2)) ->
          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) 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 a new interval into the interval set.
insert :: Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert :: forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is | 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) = forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
  [ Map (Extended r) (Interval r)
smaller'
  , case forall r. Ord r => [Interval r] -> IntervalSet r
fromList forall a b. (a -> b) -> a -> b
$ Interval r
i forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe (Interval r)
m0 forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (Interval r)
m1 forall a. [a] -> [a] -> [a]
++ 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
  ]
  where
    (Map (Extended r) (Interval r)
smaller, Maybe (Interval r)
m1, Map (Extended r) (Interval r)
xs) = forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i) Map (Extended r) (Interval r)
is
    (Map (Extended r) (Interval r)
_, Maybe (Interval r)
m2, Map (Extended r) (Interval r)
larger) = forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (forall r. Interval r -> Extended r
Interval.upperBound Interval r
i) Map (Extended r) (Interval r)
xs

    -- A tricky case is when an interval @i@ connects two adjacent
    -- members of IntervalSet, e. g., inserting {0} into (whole \\ {0}).
    (Map (Extended r) (Interval r)
smaller', Maybe (Interval r)
m0) = case forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map (Extended r) (Interval r)
smaller of
      Maybe (Interval r, Map (Extended r) (Interval r))
Nothing -> (Map (Extended r) (Interval r)
smaller, forall a. Maybe a
Nothing)
      Just (Interval r
v, Map (Extended r) (Interval r)
rest)
        | forall r. Ord r => Interval r -> Interval r -> Bool
Interval.isConnected Interval r
v Interval r
i -> (Map (Extended r) (Interval r)
rest, forall a. a -> Maybe a
Just Interval r
v)
      Maybe (Interval r, Map (Extended r) (Interval r))
_ -> (Map (Extended r) (Interval r)
smaller, forall a. Maybe a
Nothing)

-- | Delete an interval from the interval set.
delete :: Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete :: forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete Interval r
i IntervalSet r
is | 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) = forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet forall a b. (a -> b) -> a -> b
$
  case forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (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 forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (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) ->
          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 -> forall k a. Map k a
Map.empty
              Just Interval r
j -> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (forall r. Interval r -> Extended r
Interval.lowerBound Interval r
k, Interval r
k)
                | Interval r
i' <- [forall r. Ord r => Interval r -> Interval r
upTo Interval r
i, forall r. Ord r => Interval r -> Interval r
downTo Interval r
i], let k :: Interval r
k = Interval r
i' forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
j, Bool -> Bool
not (forall r. Ord r => Interval r -> Bool
Interval.null Interval r
k)
                ]
          , if
            | Just Interval r
j <- Maybe (Interval r)
m2, Interval r
j' <- forall r. Ord r => Interval r -> Interval r
downTo Interval r
i forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
j, Bool -> Bool
not (forall r. Ord r => Interval r -> Bool
Interval.null Interval r
j') ->
                forall k a. k -> a -> Map k a
Map.singleton (forall r. Interval r -> Extended r
Interval.lowerBound Interval r
j') Interval r
j'
            | Bool
otherwise -> forall k a. Map k a
Map.empty
          , Map (Extended r) (Interval r)
larger
          ]

-- | union of two interval sets
union :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union :: forall r. Ord r => 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 forall k a. Map k a -> Int
Map.size Map (Extended r) (Interval r)
m1 forall a. Ord a => a -> a -> Bool
>= forall k a. Map k a -> Int
Map.size Map (Extended r) (Interval r)
m2
  then forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is) IntervalSet r
is1 (forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is2)
  else forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is) IntervalSet r
is2 (forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is1)

-- | union of a list of interval sets
unions :: Ord r => [IntervalSet r] -> IntervalSet r
unions :: forall r. Ord r => [IntervalSet r] -> IntervalSet r
unions = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union forall r. Ord r => IntervalSet r
empty

-- | intersection of two interval sets
intersection :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection :: forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection IntervalSet r
is1 IntervalSet r
is2 = forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
difference IntervalSet r
is1 (forall r. Ord r => IntervalSet r -> IntervalSet r
complement IntervalSet r
is2)

-- | intersection of a list of interval sets
intersections :: Ord r => [IntervalSet r] -> IntervalSet r
intersections :: forall r. Ord r => [IntervalSet r] -> IntervalSet r
intersections = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection forall r. Ord r => IntervalSet r
whole

-- | difference of two interval sets
difference :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
difference :: forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
difference IntervalSet r
is1 IntervalSet r
is2 =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete Interval r
i IntervalSet r
is) IntervalSet r
is1 (forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is2)

-- -----------------------------------------------------------------------

-- | Build a interval set from a list of intervals.
fromList :: Ord r => [Interval r] -> IntervalSet r
fromList :: forall r. Ord r => [Interval r] -> IntervalSet r
fromList = forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound')

-- | Build a map from an ascending list of intervals.
-- /The precondition is not checked./
fromAscList :: Ord r => [Interval r] -> IntervalSet r
fromAscList :: forall r. Ord r => [Interval r] -> IntervalSet r
fromAscList = forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList'

fromAscList' :: Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList' :: forall r. Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList' = forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Interval r
i -> (forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i, Interval r
i)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Ord r => [Interval r] -> [Interval r]
f
  where
    f :: Ord r => [Interval r] -> [Interval r]
    f :: forall r. Ord r => [Interval r] -> [Interval r]
f [] = []
    f (Interval r
x : [Interval r]
xs) = 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 (forall r. Ord r => Interval r -> Bool
Interval.null Interval r
x)]
    g Interval r
x (Interval r
y : [Interval r]
ys)
      | 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
      | 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 forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.hull` Interval r
y) [Interval r]
ys
      | Bool
otherwise = Interval r
x forall a. a -> [a] -> [a]
: Interval r -> [Interval r] -> [Interval r]
g Interval r
y [Interval r]
ys

-- | Convert a interval set into a list of intervals.
toList :: Ord r => IntervalSet r -> [Interval r]
toList :: forall r. Ord r => IntervalSet r -> [Interval r]
toList = forall r. Ord r => IntervalSet r -> [Interval r]
toAscList

-- | Convert a interval set into a list of intervals in ascending order.
toAscList :: Ord r => IntervalSet r -> [Interval r]
toAscList :: forall r. Ord r => IntervalSet r -> [Interval r]
toAscList (IntervalSet Map (Extended r) (Interval r)
m) = forall k a. Map k a -> [a]
Map.elems Map (Extended r) (Interval r)
m

-- | Convert a interval set into a list of intervals in descending order.
toDescList :: Ord r => IntervalSet r -> [Interval r]
toDescList :: forall r. Ord r => IntervalSet r -> [Interval r]
toDescList (IntervalSet Map (Extended r) (Interval r)
m) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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 :: forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE k
k Map k v
m =
  case forall k a. (k -> Bool) -> Map k a -> (Map k a, Map k a)
Map.spanAntitone (forall a. Ord a => a -> a -> Bool
<= k
k) Map k v
m of
    (Map k v
lessOrEqual, Map k v
greaterThan) ->
      case forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map k v
lessOrEqual of
        Just (v
v, Map k v
lessOrEqual') -> (Map k v
lessOrEqual', forall a. a -> Maybe a
Just v
v, Map k v
greaterThan)
        Maybe (v, Map k v)
Nothing -> (Map k v
lessOrEqual, forall a. Maybe a
Nothing, Map k v
greaterThan)

compareLB :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB :: forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB (Extended r
lb1, Boundary
lb1in) (Extended r
lb2, Boundary
lb2in) =
  -- inclusive lower endpoint shuold be considered smaller
  (Extended r
lb1 forall a. Ord a => a -> a -> Ordering
`compare` Extended r
lb2) forall a. Monoid a => a -> a -> a
`mappend` (Boundary
lb2in forall a. Ord a => a -> a -> Ordering
`compare` Boundary
lb1in)

upTo :: Ord r => Interval r -> Interval r
upTo :: forall r. Ord r => Interval r -> Interval r
upTo Interval r
i =
  case forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i of
    (Extended r
NegInf, Boundary
_) -> forall r. Ord r => Interval r
Interval.empty
    (Extended r
PosInf, Boundary
_) -> forall r. Ord r => Interval r
Interval.whole
    (Finite r
lb, Boundary
incl) ->
      forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (forall r. Extended r
NegInf, Boundary
Open) (forall r. r -> Extended r
Finite r
lb, Boundary -> Boundary
notB Boundary
incl)

downTo :: Ord r => Interval r -> Interval r
downTo :: forall r. Ord r => Interval r -> Interval r
downTo Interval r
i =
  case forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i of
    (Extended r
PosInf, Boundary
_) -> forall r. Ord r => Interval r
Interval.empty
    (Extended r
NegInf, Boundary
_) -> forall r. Ord r => Interval r
Interval.whole
    (Finite r
ub, Boundary
incl) ->
      forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (forall r. r -> Extended r
Finite r
ub, Boundary -> Boundary
notB Boundary
incl) (forall r. Extended r
PosInf, Boundary
Open)

notB :: Boundary -> Boundary
notB :: Boundary -> Boundary
notB = \case
  Boundary
Open   -> Boundary
Closed
  Boundary
Closed -> Boundary
Open