-- |
-- Module      :  Data.IntervalSet
-- Copyright   :  (c) Christoph Breitkopf 2015 - 2017
-- License     :  BSD-style
-- Maintainer  :  chbreitkopf@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (MPTC with FD)
--
-- An implementation of sets of intervals. The intervals may
-- overlap, and the implementation contains efficient search functions
-- for all intervals containing a point or overlapping a given interval.
-- Closed, open, and half-open intervals can be contained in the same set.
--
-- It is an error to insert an empty interval into a set. This precondition is not
-- checked by the various construction functions.
--
-- Since many function names (but not the type name) clash with
-- /Prelude/ names, this module is usually imported @qualified@, e.g.
--
-- >  import Data.IntervalSet.Strict (IntervalSet)
-- >  import qualified Data.IntervalSet.Strict as IS
--
-- It offers most of the same functions as 'Data.Set', but the member type must be an
-- instance of 'Interval'. The 'findMin' and 'findMax' functions deviate from their
-- set counterparts in being total and returning a 'Maybe' value.
-- Some functions differ in asymptotic performance (for example 'size') or have not
-- been tuned for efficiency as much as their equivalents in 'Data.Set'.
--
-- In addition, there are functions specific to sets of intervals, for example to search
-- for all intervals containing a given point or contained in a given interval.
--
-- The implementation is a red-black tree augmented with the maximum upper bound
-- of all keys.
--
-- Parts of this implementation are based on code from the 'Data.Map' implementation,
-- (c) Daan Leijen 2002, (c) Andriy Palamarchuk 2008.
-- The red-black tree deletion is based on code from llrbtree by Kazu Yamamoto.
-- Of course, any errors are mine.
--
{-# LANGUAGE UndecidableInstances #-}
module Data.IntervalSet (
            -- * re-export
            Interval(..)
            -- * Set type
            , IntervalSet(..)      -- instance Eq,Show,Read

            -- * Operators
            , (\\)

            -- * Query
            , null
            , size
            , member
            , notMember
            , lookupLT
            , lookupGT
            , lookupLE
            , lookupGE

            -- ** Interval query
            , containing
            , intersecting
            , within
            
            -- * Construction
            , empty
            , singleton

            -- ** Insertion
            , insert
            
            -- ** Delete\/Update
            , delete

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

            -- * Traversal
            -- ** Map
            , map
            , mapMonotonic

            -- ** Fold
            , foldr, foldl
            , foldl', foldr'

            -- * Flatten
            , flattenWith, flattenWithMonotonic

            -- * Conversion
            , elems

            -- ** Lists
            , toList
            , fromList

            -- ** Ordered lists
            , toAscList
            , toDescList
            , fromAscList
            , fromDistinctAscList

            -- * Filter
            , filter
            , partition

            , split
            , splitMember
            , splitAt
            , splitIntersecting

            -- * Subset
            , isSubsetOf, isProperSubsetOf

            -- * Min\/Max
            , findMin
            , findMax
            , findLast
            , deleteMin
            , deleteMax
            , deleteFindMin
            , deleteFindMax
            , minView
            , maxView

            -- * Debugging
            , valid

            ) where

import Prelude hiding (Foldable(..), map, filter, splitAt)
import Data.Bits (shiftR, (.&.))
import qualified Data.Semigroup as Sem
import Data.Monoid (Monoid(..))
import qualified Data.Foldable as Foldable
import qualified Data.List as L
import Control.DeepSeq
import Control.Applicative ((<|>))

import Data.IntervalMap.Generic.Interval

{--------------------------------------------------------------------
  Operators
--------------------------------------------------------------------}
infixl 9 \\ --

-- | Same as 'difference'.
(\\) :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k
IntervalSet k
m1 \\ :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> IntervalSet k -> IntervalSet k
\\ IntervalSet k
m2 = IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> IntervalSet k -> IntervalSet k
difference IntervalSet k
m1 IntervalSet k
m2


-- | The Color of a tree node.
data Color = R | B deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq)

-- | A set of intervals of type @k@.
data IntervalSet k = Nil
                   | Node !Color
                          !k -- key
                          !k -- interval with maximum upper in tree
                          !(IntervalSet k) -- left subtree
                          !(IntervalSet k) -- right subtree

instance (Eq k) => Eq (IntervalSet k) where
  IntervalSet k
a == :: IntervalSet k -> IntervalSet k -> Bool
== IntervalSet k
b = IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
a [k] -> [k] -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
b

instance (Ord k) => Ord (IntervalSet k) where
  compare :: IntervalSet k -> IntervalSet k -> Ordering
compare IntervalSet k
a IntervalSet k
b = [k] -> [k] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
a) (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
b)

instance (Interval i k, Ord i) => Sem.Semigroup (IntervalSet i) where
  <> :: IntervalSet i -> IntervalSet i -> IntervalSet i
(<>) = IntervalSet i -> IntervalSet i -> IntervalSet i
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> IntervalSet k -> IntervalSet k
union
  sconcat :: NonEmpty (IntervalSet i) -> IntervalSet i
sconcat = [IntervalSet i] -> IntervalSet i
forall k e.
(Interval k e, Ord k) =>
[IntervalSet k] -> IntervalSet k
unions ([IntervalSet i] -> IntervalSet i)
-> (NonEmpty (IntervalSet i) -> [IntervalSet i])
-> NonEmpty (IntervalSet i)
-> IntervalSet i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (IntervalSet i) -> [IntervalSet i]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
  stimes :: forall b. Integral b => b -> IntervalSet i -> IntervalSet i
stimes = b -> IntervalSet i -> IntervalSet i
forall b a. (Integral b, Monoid a) => b -> a -> a
Sem.stimesIdempotentMonoid

instance (Interval i k, Ord i) => Monoid (IntervalSet i) where
    mempty :: IntervalSet i
mempty  = IntervalSet i
forall k. IntervalSet k
empty
    mappend :: IntervalSet i -> IntervalSet i -> IntervalSet i
mappend = IntervalSet i -> IntervalSet i -> IntervalSet i
forall a. Semigroup a => a -> a -> a
(Sem.<>)
    mconcat :: [IntervalSet i] -> IntervalSet i
mconcat = [IntervalSet i] -> IntervalSet i
forall k e.
(Interval k e, Ord k) =>
[IntervalSet k] -> IntervalSet k
unions
              
instance Foldable.Foldable IntervalSet where
    fold :: forall m. Monoid m => IntervalSet m -> m
fold IntervalSet m
t = IntervalSet m -> m
forall m. Monoid m => IntervalSet m -> m
go IntervalSet m
t
      where go :: IntervalSet a -> a
go IntervalSet a
Nil = a
forall a. Monoid a => a
mempty
            go (Node Color
_ a
k a
_ IntervalSet a
l IntervalSet a
r) = IntervalSet a -> a
go IntervalSet a
l a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` (a
k a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` IntervalSet a -> a
go IntervalSet a
r)
    foldr :: forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr = (a -> b -> b) -> b -> IntervalSet a -> b
forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr
    foldl :: forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl = (b -> a -> b) -> b -> IntervalSet a -> b
forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl
    foldMap :: forall m a. Monoid m => (a -> m) -> IntervalSet a -> m
foldMap a -> m
f IntervalSet a
t = IntervalSet a -> m
go IntervalSet a
t
      where go :: IntervalSet a -> m
go IntervalSet a
Nil = m
forall a. Monoid a => a
mempty
            go (Node Color
_ a
k a
_ IntervalSet a
l IntervalSet a
r) = IntervalSet a -> m
go IntervalSet a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m
f a
k m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` IntervalSet a -> m
go IntervalSet a
r)

instance (NFData k) => NFData (IntervalSet k) where
    rnf :: IntervalSet k -> ()
rnf IntervalSet k
Nil = ()
    rnf (Node Color
_ k
kx k
_ IntervalSet k
l IntervalSet k
r) = k
kx k -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` IntervalSet k
l IntervalSet k -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` IntervalSet k
r IntervalSet k -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()

instance (Interval i k, Ord i, Read i) => Read (IntervalSet i) where
  readsPrec :: Int -> ReadS (IntervalSet i)
readsPrec Int
p = Bool -> ReadS (IntervalSet i) -> ReadS (IntervalSet i)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (IntervalSet i) -> ReadS (IntervalSet i))
-> ReadS (IntervalSet i) -> ReadS (IntervalSet i)
forall a b. (a -> b) -> a -> b
$ \ String
r -> do
    (String
"fromList",String
s) <- ReadS String
lex String
r
    ([i]
xs,String
t) <- ReadS [i]
forall a. Read a => ReadS a
reads String
s
    (IntervalSet i, String) -> [(IntervalSet i, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([i] -> IntervalSet i
forall k e. (Interval k e, Ord k) => [k] -> IntervalSet k
fromList [i]
xs,String
t)

instance (Show k) => Show (IntervalSet k) where
  showsPrec :: Int -> IntervalSet k -> ShowS
showsPrec Int
d IntervalSet k
m  = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (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
. [k] -> ShowS
forall a. Show a => a -> ShowS
shows (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toList IntervalSet k
m)


isRed :: IntervalSet k -> Bool
isRed :: forall a. IntervalSet a -> Bool
isRed (Node Color
R k
_ k
_ IntervalSet k
_ IntervalSet k
_) = Bool
True
isRed IntervalSet k
_ = Bool
False

turnBlack :: IntervalSet k -> IntervalSet k
turnBlack :: forall k. IntervalSet k -> IntervalSet k
turnBlack (Node Color
R k
k k
m IntervalSet k
l IntervalSet k
r) = Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node Color
B k
k k
m IntervalSet k
l IntervalSet k
r
turnBlack IntervalSet k
t = IntervalSet k
t

turnRed :: IntervalSet k -> IntervalSet k
turnRed :: forall k. IntervalSet k -> IntervalSet k
turnRed IntervalSet k
Nil = String -> IntervalSet k
forall a. HasCallStack => String -> a
error String
"turnRed: Leaf"
turnRed (Node Color
B k
k k
m IntervalSet k
l IntervalSet k
r) = Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node Color
R k
k k
m IntervalSet k
l IntervalSet k
r
turnRed IntervalSet k
t = IntervalSet k
t

-- construct node, recomputing the upper key bound.
mNode :: (Interval k e) => Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode :: forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c k
k IntervalSet k
l IntervalSet k
r = Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node Color
c k
k (k -> IntervalSet k -> IntervalSet k -> k
forall i k.
Interval i k =>
i -> IntervalSet i -> IntervalSet i -> i
maxUpper k
k IntervalSet k
l IntervalSet k
r) IntervalSet k
l IntervalSet k
r

maxUpper :: (Interval i k) => i -> IntervalSet i -> IntervalSet i -> i
maxUpper :: forall i k.
Interval i k =>
i -> IntervalSet i -> IntervalSet i -> i
maxUpper i
k IntervalSet i
Nil              IntervalSet i
Nil              = i
k
maxUpper i
k IntervalSet i
Nil              (Node Color
_ i
_ i
m IntervalSet i
_ IntervalSet i
_) = i -> i -> i
forall i e. Interval i e => i -> i -> i
maxByUpper i
k i
m
maxUpper i
k (Node Color
_ i
_ i
m IntervalSet i
_ IntervalSet i
_) IntervalSet i
Nil              = i -> i -> i
forall i e. Interval i e => i -> i -> i
maxByUpper i
k i
m
maxUpper i
k (Node Color
_ i
_ i
l IntervalSet i
_ IntervalSet i
_) (Node Color
_ i
_ i
r IntervalSet i
_ IntervalSet i
_) = i -> i -> i
forall i e. Interval i e => i -> i -> i
maxByUpper i
k (i -> i -> i
forall i e. Interval i e => i -> i -> i
maxByUpper i
l i
r)

-- interval with the greatest upper bound. The lower bound is ignored!
maxByUpper :: (Interval i e) => i -> i -> i
maxByUpper :: forall i e. Interval i e => i -> i -> i
maxByUpper i
a i
b = i
a i -> i -> i
forall a b. a -> b -> b
`seq` i
b i -> i -> i
forall a b. a -> b -> b
`seq`
                 case i -> i -> Ordering
forall i e. Interval i e => i -> i -> Ordering
compareUpperBounds i
a i
b of
                   Ordering
LT -> i
b
                   Ordering
_  -> i
a

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

-- | /O(1)/. The empty set.
empty :: IntervalSet k
empty :: forall k. IntervalSet k
empty =  IntervalSet k
forall k. IntervalSet k
Nil

-- | /O(1)/. A set with one entry.
singleton :: k -> IntervalSet k
singleton :: forall k. k -> IntervalSet k
singleton k
k = Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node Color
B k
k k
k IntervalSet k
forall k. IntervalSet k
Nil IntervalSet k
forall k. IntervalSet k
Nil


-- | /O(1)/. Is the set empty?
null :: IntervalSet k -> Bool
null :: forall a. IntervalSet a -> Bool
null IntervalSet k
Nil = Bool
True
null IntervalSet k
_   = Bool
False

-- | /O(n)/. Number of keys in the set.
--
-- Caution: unlike 'Data.Set.size', this takes linear time!
size :: IntervalSet k -> Int
size :: forall a. IntervalSet a -> Int
size IntervalSet k
t = Int -> IntervalSet k -> Int
forall {t} {k}. Num t => t -> IntervalSet k -> t
h Int
0 IntervalSet k
t
  where
    h :: t -> IntervalSet k -> t
h t
n IntervalSet k
s = t
n t -> t -> t
forall a b. a -> b -> b
`seq` case IntervalSet k
s of
                      IntervalSet k
Nil -> t
n
                      Node Color
_ k
_ k
_ IntervalSet k
l IntervalSet k
r -> t -> IntervalSet k -> t
h (t -> IntervalSet k -> t
h t
n IntervalSet k
l t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) IntervalSet k
r

-- | /O(log n)/. Does the set contain the given value? See also 'notMember'.
member :: (Ord k) => k -> IntervalSet k -> Bool
member :: forall k. Ord k => k -> IntervalSet k -> Bool
member k
k IntervalSet k
Nil = k
k k -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False
member k
k (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                                Ordering
LT -> k -> IntervalSet k -> Bool
forall k. Ord k => k -> IntervalSet k -> Bool
member k
k IntervalSet k
l
                                Ordering
GT -> k -> IntervalSet k -> Bool
forall k. Ord k => k -> IntervalSet k -> Bool
member k
k IntervalSet k
r
                                Ordering
EQ -> Bool
True

-- | /O(log n)/. Does the set not contain the given value? See also 'member'.
notMember :: (Ord k) => k -> IntervalSet k -> Bool
notMember :: forall k. Ord k => k -> IntervalSet k -> Bool
notMember k
key IntervalSet k
tree = Bool -> Bool
not (k -> IntervalSet k -> Bool
forall k. Ord k => k -> IntervalSet k -> Bool
member k
key IntervalSet k
tree)


-- | /O(log n)/. Find the largest key smaller than the given one.
lookupLT :: (Ord k) => k -> IntervalSet k -> Maybe k
lookupLT :: forall k. Ord k => k -> IntervalSet k -> Maybe k
lookupLT k
k IntervalSet k
m = IntervalSet k -> Maybe k
go IntervalSet k
m
  where
    go :: IntervalSet k -> Maybe k
go IntervalSet k
Nil = Maybe k
forall a. Maybe a
Nothing
    go (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
key  = IntervalSet k -> Maybe k
go IntervalSet k
l
                          | Bool
otherwise = k -> IntervalSet k -> Maybe k
go1 k
key IntervalSet k
r
    go1 :: k -> IntervalSet k -> Maybe k
go1 k
rk IntervalSet k
Nil = k -> Maybe k
forall a. a -> Maybe a
Just k
rk
    go1 k
rk (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
key  = k -> IntervalSet k -> Maybe k
go1 k
rk IntervalSet k
l
                              | Bool
otherwise = k -> IntervalSet k -> Maybe k
go1 k
key IntervalSet k
r

-- | /O(log n)/. Find the smallest key larger than the given one.
lookupGT :: (Ord k) => k -> IntervalSet k -> Maybe k
lookupGT :: forall k. Ord k => k -> IntervalSet k -> Maybe k
lookupGT k
k IntervalSet k
m = IntervalSet k -> Maybe k
go IntervalSet k
m
  where
    go :: IntervalSet k -> Maybe k
go IntervalSet k
Nil = Maybe k
forall a. Maybe a
Nothing
    go (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= k
key  = IntervalSet k -> Maybe k
go IntervalSet k
r
                          | Bool
otherwise = k -> IntervalSet k -> Maybe k
go1 k
key IntervalSet k
l
    go1 :: k -> IntervalSet k -> Maybe k
go1 k
rk IntervalSet k
Nil = k -> Maybe k
forall a. a -> Maybe a
Just k
rk
    go1 k
rk (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= k
key  = k -> IntervalSet k -> Maybe k
go1 k
rk IntervalSet k
r
                              | Bool
otherwise = k -> IntervalSet k -> Maybe k
go1 k
key IntervalSet k
l

-- | /O(log n)/. Find the largest key equal to or smaller than the given one.
lookupLE :: (Ord k) => k -> IntervalSet k -> Maybe k
lookupLE :: forall k. Ord k => k -> IntervalSet k -> Maybe k
lookupLE k
k IntervalSet k
m = IntervalSet k -> Maybe k
go IntervalSet k
m
  where
    go :: IntervalSet k -> Maybe k
go IntervalSet k
Nil = Maybe k
forall a. Maybe a
Nothing
    go (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                              Ordering
LT -> IntervalSet k -> Maybe k
go IntervalSet k
l
                              Ordering
EQ -> k -> Maybe k
forall a. a -> Maybe a
Just k
key
                              Ordering
GT -> k -> IntervalSet k -> Maybe k
go1 k
key IntervalSet k
r
    go1 :: k -> IntervalSet k -> Maybe k
go1 k
rk IntervalSet k
Nil = k -> Maybe k
forall a. a -> Maybe a
Just k
rk
    go1 k
rk (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                                  Ordering
LT -> k -> IntervalSet k -> Maybe k
go1 k
rk IntervalSet k
l
                                  Ordering
EQ -> k -> Maybe k
forall a. a -> Maybe a
Just k
key
                                  Ordering
GT -> k -> IntervalSet k -> Maybe k
go1 k
key IntervalSet k
r

-- | /O(log n)/. Find the smallest key equal to or larger than the given one.
lookupGE :: (Ord k) => k -> IntervalSet k -> Maybe k
lookupGE :: forall k. Ord k => k -> IntervalSet k -> Maybe k
lookupGE k
k IntervalSet k
m = IntervalSet k -> Maybe k
go IntervalSet k
m
  where
    go :: IntervalSet k -> Maybe k
go IntervalSet k
Nil = Maybe k
forall a. Maybe a
Nothing
    go (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                              Ordering
LT -> k -> IntervalSet k -> Maybe k
go1 k
key IntervalSet k
l
                              Ordering
EQ -> k -> Maybe k
forall a. a -> Maybe a
Just k
key
                              Ordering
GT -> IntervalSet k -> Maybe k
go IntervalSet k
r
    go1 :: k -> IntervalSet k -> Maybe k
go1 k
rk IntervalSet k
Nil = k -> Maybe k
forall a. a -> Maybe a
Just k
rk
    go1 k
rk (Node Color
_ k
key k
_ IntervalSet k
l IntervalSet k
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                                  Ordering
LT -> k -> IntervalSet k -> Maybe k
go1 k
key IntervalSet k
l
                                  Ordering
EQ -> k -> Maybe k
forall a. a -> Maybe a
Just k
key
                                  Ordering
GT -> k -> IntervalSet k -> Maybe k
go1 k
rk IntervalSet k
r

-- | Return the set of all intervals containing the given point.
-- This is the second element of the value of 'splitAt':
--
-- > set `containing` p == let (_,s,_) = set `splitAt` p in s
--
-- /O(n)/, since potentially all intervals could contain the point.
-- /O(log n)/ average case. This is also the worst case for sets containing no overlapping intervals.
containing :: (Interval k e) => IntervalSet k -> e -> IntervalSet k
IntervalSet k
t containing :: forall k e. Interval k e => IntervalSet k -> e -> IntervalSet k
`containing` e
p = e
p e -> IntervalSet k -> IntervalSet k
forall a b. a -> b -> b
`seq` [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ([k] -> IntervalSet k -> [k]
forall {a}. Interval a e => [a] -> IntervalSet a -> [a]
go [] IntervalSet k
t)
  where
    go :: [a] -> IntervalSet a -> [a]
go [a]
xs IntervalSet a
Nil = [a]
xs
    go [a]
xs (Node Color
_ a
k a
m IntervalSet a
l IntervalSet a
r)
       | e
p e -> a -> Bool
forall i e. Interval i e => e -> i -> Bool
`above` a
m  =  [a]
xs         -- above all intervals in the tree: no result
       | e
p e -> a -> Bool
forall i e. Interval i e => e -> i -> Bool
`below` a
k  =  [a] -> IntervalSet a -> [a]
go [a]
xs IntervalSet a
l    -- to the left of the lower bound: can't be in right subtree
       | e
p e -> a -> Bool
forall i e. Interval i e => e -> i -> Bool
`inside` a
k =  [a] -> IntervalSet a -> [a]
go (a
k a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> IntervalSet a -> [a]
go [a]
xs IntervalSet a
r) IntervalSet a
l
       | Bool
otherwise    =  [a] -> IntervalSet a -> [a]
go ([a] -> IntervalSet a -> [a]
go [a]
xs IntervalSet a
r) IntervalSet a
l

-- | Return the set of all intervals overlapping (intersecting) the given interval.
-- This is the second element of the result of 'splitIntersecting':
--
-- > set `intersecting` i == let (_,s,_) = set `splitIntersecting` i in s
--
-- /O(n)/, since potentially all values could intersect the interval.
-- /O(log n)/ average case, if few values intersect the interval.
intersecting :: (Interval k e) => IntervalSet k -> k -> IntervalSet k
IntervalSet k
t intersecting :: forall k e. Interval k e => IntervalSet k -> k -> IntervalSet k
`intersecting` k
i = k
i k -> IntervalSet k -> IntervalSet k
forall a b. a -> b -> b
`seq` [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ([k] -> IntervalSet k -> [k]
go [] IntervalSet k
t)
  where
    go :: [k] -> IntervalSet k -> [k]
go [k]
xs IntervalSet k
Nil = [k]
xs
    go [k]
xs (Node Color
_ k
k k
m IntervalSet k
l IntervalSet k
r)
       | k
i k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
`after` k
m     =  [k]
xs
       | k
i k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
`before` k
k    =  [k] -> IntervalSet k -> [k]
go [k]
xs IntervalSet k
l
       | k
i k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
`overlaps` k
k  =  [k] -> IntervalSet k -> [k]
go (k
k k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k] -> IntervalSet k -> [k]
go [k]
xs IntervalSet k
r) IntervalSet k
l
       | Bool
otherwise       =  [k] -> IntervalSet k -> [k]
go ([k] -> IntervalSet k -> [k]
go [k]
xs IntervalSet k
r) IntervalSet k
l

-- | Return the set of all intervals which are completely inside the given interval.
--
-- /O(n)/, since potentially all values could be inside the interval.
-- /O(log n)/ average case, if few keys are inside the interval.
within :: (Interval k e) => IntervalSet k -> k -> IntervalSet k
IntervalSet k
t within :: forall k e. Interval k e => IntervalSet k -> k -> IntervalSet k
`within` k
i = k
i k -> IntervalSet k -> IntervalSet k
forall a b. a -> b -> b
`seq` [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ([k] -> IntervalSet k -> [k]
go [] IntervalSet k
t)
  where
    go :: [k] -> IntervalSet k -> [k]
go [k]
xs IntervalSet k
Nil = [k]
xs
    go [k]
xs (Node Color
_ k
k k
m IntervalSet k
l IntervalSet k
r)
       | k
i k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
`after` k
m     =  [k]
xs
       | k
i k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
`before` k
k    =  [k] -> IntervalSet k -> [k]
go [k]
xs IntervalSet k
l
       | k
i k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
`subsumes` k
k  =  [k] -> IntervalSet k -> [k]
go (k
k k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k] -> IntervalSet k -> [k]
go [k]
xs IntervalSet k
r) IntervalSet k
l
       | Bool
otherwise       =  [k] -> IntervalSet k -> [k]
go ([k] -> IntervalSet k -> [k]
go [k]
xs IntervalSet k
r) IntervalSet k
l


-- | /O(log n)/. Insert a new value. If the set already contains an element equal to the value,
-- it is replaced by the new value.
insert :: (Interval k e, Ord k) => k -> IntervalSet k -> IntervalSet k
insert :: forall k e.
(Interval k e, Ord k) =>
k -> IntervalSet k -> IntervalSet k
insert k
v IntervalSet k
s = k
v k -> IntervalSet k -> IntervalSet k
forall a b. a -> b -> b
`seq` IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack (IntervalSet k -> IntervalSet k
ins IntervalSet k
s)
  where
    singletonR :: k -> IntervalSet k
singletonR k
k = Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node Color
R k
k k
k IntervalSet k
forall k. IntervalSet k
Nil IntervalSet k
forall k. IntervalSet k
Nil
    ins :: IntervalSet k -> IntervalSet k
ins IntervalSet k
Nil = k -> IntervalSet k
forall k. k -> IntervalSet k
singletonR k
v
    ins (Node Color
color k
k k
m IntervalSet k
l IntervalSet k
r) =
      case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
v k
k of
        Ordering
LT -> Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceL Color
color k
k (IntervalSet k -> IntervalSet k
ins IntervalSet k
l) IntervalSet k
r
        Ordering
GT -> Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceR Color
color k
k IntervalSet k
l (IntervalSet k -> IntervalSet k
ins IntervalSet k
r)
        Ordering
EQ -> Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node Color
color k
v k
m IntervalSet k
l IntervalSet k
r

balanceL :: (Interval k e) => Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceL :: forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceL Color
B k
zk (Node Color
R k
yk k
_ (Node Color
R k
xk k
_ IntervalSet k
a IntervalSet k
b) IntervalSet k
c) IntervalSet k
d =
    Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
R k
yk (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
xk IntervalSet k
a IntervalSet k
b) (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
zk IntervalSet k
c IntervalSet k
d)
balanceL Color
B k
zk (Node Color
R k
xk k
_ IntervalSet k
a (Node Color
R k
yk k
_ IntervalSet k
b IntervalSet k
c)) IntervalSet k
d =
    Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
R k
yk (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
xk IntervalSet k
a IntervalSet k
b) (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
zk IntervalSet k
c IntervalSet k
d)
balanceL Color
c k
xk IntervalSet k
l IntervalSet k
r = Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c k
xk IntervalSet k
l IntervalSet k
r

balanceR :: (Interval k e) => Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceR :: forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceR Color
B k
xk IntervalSet k
a (Node Color
R k
yk k
_ IntervalSet k
b (Node Color
R k
zk k
_ IntervalSet k
c IntervalSet k
d)) =
    Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
R k
yk (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
xk IntervalSet k
a IntervalSet k
b) (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
zk IntervalSet k
c IntervalSet k
d)
balanceR Color
B k
xk IntervalSet k
a (Node Color
R k
zk k
_ (Node Color
R k
yk k
_ IntervalSet k
b IntervalSet k
c) IntervalSet k
d) =
    Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
R k
yk (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
xk IntervalSet k
a IntervalSet k
b) (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
zk IntervalSet k
c IntervalSet k
d)
balanceR Color
c k
xk IntervalSet k
l IntervalSet k
r = Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c k
xk IntervalSet k
l IntervalSet k
r


-- min/max

-- | /O(log n)/. Returns the minimal value in the set.
findMin :: IntervalSet k -> Maybe k
findMin :: forall k. IntervalSet k -> Maybe k
findMin (Node Color
_ k
k k
_ IntervalSet k
Nil IntervalSet k
_) = k -> Maybe k
forall a. a -> Maybe a
Just k
k
findMin (Node Color
_ k
_ k
_ IntervalSet k
l IntervalSet k
_) = IntervalSet k -> Maybe k
forall k. IntervalSet k -> Maybe k
findMin IntervalSet k
l
findMin IntervalSet k
Nil = Maybe k
forall a. Maybe a
Nothing

-- | /O(log n)/. Returns the maximal value in the set.
findMax :: IntervalSet k -> Maybe k
findMax :: forall k. IntervalSet k -> Maybe k
findMax (Node Color
_ k
k k
_ IntervalSet k
_ IntervalSet k
Nil) = k -> Maybe k
forall a. a -> Maybe a
Just k
k
findMax (Node Color
_ k
_ k
_ IntervalSet k
_ IntervalSet k
r) = IntervalSet k -> Maybe k
forall k. IntervalSet k -> Maybe k
findMax IntervalSet k
r
findMax IntervalSet k
Nil = Maybe k
forall a. Maybe a
Nothing

-- | Returns the interval with the largest endpoint.
-- If there is more than one interval with that endpoint,
-- return the rightmost.
--
-- /O(n)/, since all intervals could have the same endpoint.
-- /O(log n)/ average case.
findLast :: (Interval k e) => IntervalSet k -> Maybe k
findLast :: forall k e. Interval k e => IntervalSet k -> Maybe k
findLast IntervalSet k
Nil = Maybe k
forall a. Maybe a
Nothing
findLast t :: IntervalSet k
t@(Node Color
_ k
_ k
mx IntervalSet k
_ IntervalSet k
_) = IntervalSet k -> Maybe k
go IntervalSet k
t
  where
    go :: IntervalSet k -> Maybe k
go (Node Color
_ k
k k
m IntervalSet k
l IntervalSet k
r) | k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
sameU k
m k
mx = if k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
sameU k
k k
m then IntervalSet k -> Maybe k
go IntervalSet k
r Maybe k -> Maybe k -> Maybe k
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> k -> Maybe k
forall a. a -> Maybe a
Just k
k
                                                    else IntervalSet k -> Maybe k
go IntervalSet k
r Maybe k -> Maybe k -> Maybe k
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IntervalSet k -> Maybe k
go IntervalSet k
l
                        | Bool
otherwise  = Maybe k
forall a. Maybe a
Nothing
    go IntervalSet k
Nil = Maybe k
forall a. Maybe a
Nothing
    sameU :: i -> i -> Bool
sameU i
a i
b = i -> i -> Ordering
forall i e. Interval i e => i -> i -> Ordering
compareUpperBounds i
a i
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ


-- Type to indicate whether the number of black nodes changed or stayed the same.
data DeleteResult k = U !(IntervalSet k)   -- Unchanged
                    | S !(IntervalSet k)   -- Shrunk

unwrap :: DeleteResult k -> IntervalSet k
unwrap :: forall k. DeleteResult k -> IntervalSet k
unwrap (U IntervalSet k
m) = IntervalSet k
m
unwrap (S IntervalSet k
m) = IntervalSet k
m

-- DeleteResult with value
data DeleteResult' k a = U' !(IntervalSet k) a
                       | S' !(IntervalSet k) a

unwrap' :: DeleteResult' k a -> IntervalSet k
unwrap' :: forall k a. DeleteResult' k a -> IntervalSet k
unwrap' (U' IntervalSet k
m a
_) = IntervalSet k
m
unwrap' (S' IntervalSet k
m a
_) = IntervalSet k
m

-- annotate DeleteResult with value
annotate :: DeleteResult k -> a -> DeleteResult' k a
annotate :: forall k a. DeleteResult k -> a -> DeleteResult' k a
annotate (U IntervalSet k
m) a
x = IntervalSet k -> a -> DeleteResult' k a
forall k a. IntervalSet k -> a -> DeleteResult' k a
U' IntervalSet k
m a
x
annotate (S IntervalSet k
m) a
x = IntervalSet k -> a -> DeleteResult' k a
forall k a. IntervalSet k -> a -> DeleteResult' k a
S' IntervalSet k
m a
x


-- | /O(log n)/. Remove the smallest element from the set. Return the empty set if the set is empty.
deleteMin :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k
deleteMin :: forall k e. (Interval k e, Ord k) => IntervalSet k -> IntervalSet k
deleteMin IntervalSet k
Nil = IntervalSet k
forall k. IntervalSet k
Nil
deleteMin IntervalSet k
m   = IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack (DeleteResult' k k -> IntervalSet k
forall k a. DeleteResult' k a -> IntervalSet k
unwrap' (IntervalSet k -> DeleteResult' k k
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMin' IntervalSet k
m))

deleteMin' :: (Interval k e, Ord k) => IntervalSet k -> DeleteResult' k k
deleteMin' :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMin' IntervalSet k
Nil = String -> DeleteResult' k k
forall a. HasCallStack => String -> a
error String
"deleteMin': Nil"
deleteMin' (Node Color
B k
k k
_ IntervalSet k
Nil IntervalSet k
Nil) = IntervalSet k -> k -> DeleteResult' k k
forall k a. IntervalSet k -> a -> DeleteResult' k a
S' IntervalSet k
forall k. IntervalSet k
Nil k
k
deleteMin' (Node Color
B k
k k
_ IntervalSet k
Nil r :: IntervalSet k
r@(Node Color
R k
_ k
_ IntervalSet k
_ IntervalSet k
_)) = IntervalSet k -> k -> DeleteResult' k k
forall k a. IntervalSet k -> a -> DeleteResult' k a
U' (IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack IntervalSet k
r) k
k
deleteMin' (Node Color
R k
k k
_ IntervalSet k
Nil IntervalSet k
r) = IntervalSet k -> k -> DeleteResult' k k
forall k a. IntervalSet k -> a -> DeleteResult' k a
U' IntervalSet k
r k
k
deleteMin' (Node Color
c k
k k
_ IntervalSet k
l IntervalSet k
r) =
  case IntervalSet k -> DeleteResult' k k
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMin' IntervalSet k
l of
    (U' IntervalSet k
l' k
kv) -> IntervalSet k -> k -> DeleteResult' k k
forall k a. IntervalSet k -> a -> DeleteResult' k a
U' (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c k
k IntervalSet k
l' IntervalSet k
r) k
kv
    (S' IntervalSet k
l' k
kv) -> DeleteResult k -> k -> DeleteResult' k k
forall k a. DeleteResult k -> a -> DeleteResult' k a
annotate (Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
unbalancedR Color
c k
k IntervalSet k
l' IntervalSet k
r) k
kv

deleteMax' :: (Interval k e, Ord k) => IntervalSet k -> DeleteResult' k k
deleteMax' :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMax' IntervalSet k
Nil = String -> DeleteResult' k k
forall a. HasCallStack => String -> a
error String
"deleteMax': Nil"
deleteMax' (Node Color
B k
k k
_ IntervalSet k
Nil IntervalSet k
Nil) = IntervalSet k -> k -> DeleteResult' k k
forall k a. IntervalSet k -> a -> DeleteResult' k a
S' IntervalSet k
forall k. IntervalSet k
Nil k
k
deleteMax' (Node Color
B k
k k
_ l :: IntervalSet k
l@(Node Color
R k
_ k
_ IntervalSet k
_ IntervalSet k
_) IntervalSet k
Nil) = IntervalSet k -> k -> DeleteResult' k k
forall k a. IntervalSet k -> a -> DeleteResult' k a
U' (IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack IntervalSet k
l) k
k
deleteMax' (Node Color
R k
k k
_ IntervalSet k
l IntervalSet k
Nil) = IntervalSet k -> k -> DeleteResult' k k
forall k a. IntervalSet k -> a -> DeleteResult' k a
U' IntervalSet k
l k
k
deleteMax' (Node Color
c k
k k
_ IntervalSet k
l IntervalSet k
r) =
  case IntervalSet k -> DeleteResult' k k
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMax' IntervalSet k
r of
    (U' IntervalSet k
r' k
kv) -> IntervalSet k -> k -> DeleteResult' k k
forall k a. IntervalSet k -> a -> DeleteResult' k a
U' (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c k
k IntervalSet k
l IntervalSet k
r') k
kv
    (S' IntervalSet k
r' k
kv) -> DeleteResult k -> k -> DeleteResult' k k
forall k a. DeleteResult k -> a -> DeleteResult' k a
annotate (Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
unbalancedL Color
c k
k IntervalSet k
l IntervalSet k
r') k
kv

-- The left tree lacks one Black node
unbalancedR :: (Interval k e) => Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
-- Decreasing one Black node in the right
unbalancedR :: forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
unbalancedR Color
B k
k IntervalSet k
l r :: IntervalSet k
r@(Node Color
B k
_ k
_ IntervalSet k
_ IntervalSet k
_) = IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
S (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceR Color
B k
k IntervalSet k
l (IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnRed IntervalSet k
r))
unbalancedR Color
R k
k IntervalSet k
l r :: IntervalSet k
r@(Node Color
B k
_ k
_ IntervalSet k
_ IntervalSet k
_) = IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceR Color
B k
k IntervalSet k
l (IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnRed IntervalSet k
r))
-- Taking one Red node from the right and adding it to the right as Black
unbalancedR Color
B k
k IntervalSet k
l (Node Color
R k
rk k
_ rl :: IntervalSet k
rl@(Node Color
B k
_ k
_ IntervalSet k
_ IntervalSet k
_) IntervalSet k
rr)
  = IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
rk (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceR Color
B k
k IntervalSet k
l (IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnRed IntervalSet k
rl)) IntervalSet k
rr)
unbalancedR Color
_ k
_ IntervalSet k
_ IntervalSet k
_ = String -> DeleteResult k
forall a. HasCallStack => String -> a
error String
"unbalancedR"

unbalancedL :: (Interval k e) => Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
unbalancedL :: forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
unbalancedL Color
R k
k l :: IntervalSet k
l@(Node Color
B k
_ k
_ IntervalSet k
_ IntervalSet k
_) IntervalSet k
r = IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceL Color
B k
k (IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnRed IntervalSet k
l) IntervalSet k
r)
unbalancedL Color
B k
k l :: IntervalSet k
l@(Node Color
B k
_ k
_ IntervalSet k
_ IntervalSet k
_) IntervalSet k
r = IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
S (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceL Color
B k
k (IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnRed IntervalSet k
l) IntervalSet k
r)
unbalancedL Color
B k
k (Node Color
R k
lk k
_ IntervalSet k
ll lr :: IntervalSet k
lr@(Node Color
B k
_ k
_ IntervalSet k
_ IntervalSet k
_)) IntervalSet k
r
  = IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
lk IntervalSet k
ll (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
balanceL Color
B k
k (IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnRed IntervalSet k
lr) IntervalSet k
r))
unbalancedL Color
_ k
_ IntervalSet k
_ IntervalSet k
_ = String -> DeleteResult k
forall a. HasCallStack => String -> a
error String
"unbalancedL"


-- | /O(log n)/. Remove the largest element from the set. Return the empty set if the set is empty.
deleteMax :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k
deleteMax :: forall k e. (Interval k e, Ord k) => IntervalSet k -> IntervalSet k
deleteMax IntervalSet k
Nil = IntervalSet k
forall k. IntervalSet k
Nil
deleteMax IntervalSet k
m   = IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack (DeleteResult' k k -> IntervalSet k
forall k a. DeleteResult' k a -> IntervalSet k
unwrap' (IntervalSet k -> DeleteResult' k k
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMax' IntervalSet k
m))

-- | /O(log n)/. Delete and return the smallest element.
deleteFindMin :: (Interval k e, Ord k) => IntervalSet k -> (k, IntervalSet k)
deleteFindMin :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> (k, IntervalSet k)
deleteFindMin IntervalSet k
mp = case IntervalSet k -> DeleteResult' k k
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMin' IntervalSet k
mp of
                     (U' IntervalSet k
r k
v) -> (k
v, IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack IntervalSet k
r)
                     (S' IntervalSet k
r k
v) -> (k
v, IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack IntervalSet k
r)

-- | /O(log n)/. Delete and return the largest element.
deleteFindMax :: (Interval k e, Ord k) => IntervalSet k -> (k, IntervalSet k)
deleteFindMax :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> (k, IntervalSet k)
deleteFindMax IntervalSet k
mp = case IntervalSet k -> DeleteResult' k k
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMax' IntervalSet k
mp of
                     (U' IntervalSet k
r k
v) -> (k
v, IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack IntervalSet k
r)
                     (S' IntervalSet k
r k
v) -> (k
v, IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack IntervalSet k
r)

-- | /O(log n)/. Retrieves the minimal element of the set, and
-- the set stripped of that element, or 'Nothing' if passed an empty set.
minView :: (Interval k e, Ord k) => IntervalSet k -> Maybe (k, IntervalSet k)
minView :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> Maybe (k, IntervalSet k)
minView IntervalSet k
Nil = Maybe (k, IntervalSet k)
forall a. Maybe a
Nothing
minView IntervalSet k
x   = (k, IntervalSet k) -> Maybe (k, IntervalSet k)
forall a. a -> Maybe a
Just (IntervalSet k -> (k, IntervalSet k)
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> (k, IntervalSet k)
deleteFindMin IntervalSet k
x)

-- | /O(log n)/. Retrieves the maximal element of the set, and
-- the set stripped of that element, or 'Nothing' if passed an empty set.
maxView :: (Interval k e, Ord k) => IntervalSet k -> Maybe (k, IntervalSet k)
maxView :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> Maybe (k, IntervalSet k)
maxView IntervalSet k
Nil = Maybe (k, IntervalSet k)
forall a. Maybe a
Nothing
maxView IntervalSet k
x   = (k, IntervalSet k) -> Maybe (k, IntervalSet k)
forall a. a -> Maybe a
Just (IntervalSet k -> (k, IntervalSet k)
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> (k, IntervalSet k)
deleteFindMax IntervalSet k
x)


-- folding

-- | /O(n)/. Fold the values in the set using the given right-associative
-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.
foldr :: (k -> b -> b) -> b -> IntervalSet k -> b
foldr :: forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr k -> b -> b
_ b
z IntervalSet k
Nil = b
z
foldr k -> b -> b
f b
z (Node Color
_ k
k k
_ IntervalSet k
l IntervalSet k
r) = (k -> b -> b) -> b -> IntervalSet k -> b
forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr k -> b -> b
f (k -> b -> b
f k
k ((k -> b -> b) -> b -> IntervalSet k -> b
forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr k -> b -> b
f b
z IntervalSet k
r)) IntervalSet k
l

-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldr' :: (k -> b -> b) -> b -> IntervalSet k -> b
foldr' :: forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr' k -> b -> b
f b
z IntervalSet k
s = b
z b -> b -> b
forall a b. a -> b -> b
`seq` case IntervalSet k
s of
                         IntervalSet k
Nil -> b
z
                         Node Color
_ k
k k
_ IntervalSet k
l IntervalSet k
r -> (k -> b -> b) -> b -> IntervalSet k -> b
forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr' k -> b -> b
f (k -> b -> b
f k
k ((k -> b -> b) -> b -> IntervalSet k -> b
forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr' k -> b -> b
f b
z IntervalSet k
r)) IntervalSet k
l

-- | /O(n)/. Fold the values in the set using the given left-associative
-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.
foldl :: (b -> k -> b) -> b -> IntervalSet k -> b
foldl :: forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl b -> k -> b
_ b
z IntervalSet k
Nil = b
z
foldl b -> k -> b
f b
z (Node Color
_ k
k k
_ IntervalSet k
l IntervalSet k
r) = (b -> k -> b) -> b -> IntervalSet k -> b
forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl b -> k -> b
f (b -> k -> b
f ((b -> k -> b) -> b -> IntervalSet k -> b
forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl b -> k -> b
f b
z IntervalSet k
l) k
k) IntervalSet k
r

-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldl' :: (b -> k -> b) -> b -> IntervalSet k -> b
foldl' :: forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl' b -> k -> b
f b
z IntervalSet k
s = b
z b -> b -> b
forall a b. a -> b -> b
`seq` case IntervalSet k
s of
                         IntervalSet k
Nil -> b
z
                         Node Color
_ k
k k
_ IntervalSet k
l IntervalSet k
r -> (b -> k -> b) -> b -> IntervalSet k -> b
forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl' b -> k -> b
f (b -> k -> b
f ((b -> k -> b) -> b -> IntervalSet k -> b
forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl' b -> k -> b
f b
z IntervalSet k
l) k
k) IntervalSet k
r

-- delete

-- | /O(log n)/. Delete an element from the set. If the set does not contain the value,
-- it is returned unchanged.
delete :: (Interval k e, Ord k) => k -> IntervalSet k -> IntervalSet k
delete :: forall k e.
(Interval k e, Ord k) =>
k -> IntervalSet k -> IntervalSet k
delete k
key IntervalSet k
mp = IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack (DeleteResult k -> IntervalSet k
forall k. DeleteResult k -> IntervalSet k
unwrap (k -> IntervalSet k -> DeleteResult k
forall k e.
(Interval k e, Ord k) =>
k -> IntervalSet k -> DeleteResult k
delete' k
key IntervalSet k
mp))

delete' :: (Interval k e, Ord k) => k -> IntervalSet k -> DeleteResult k
delete' :: forall k e.
(Interval k e, Ord k) =>
k -> IntervalSet k -> DeleteResult k
delete' k
x IntervalSet k
Nil = k
x k -> DeleteResult k -> DeleteResult k
forall a b. a -> b -> b
`seq` IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U IntervalSet k
forall k. IntervalSet k
Nil
delete' k
x (Node Color
c k
k k
_ IntervalSet k
l IntervalSet k
r) =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
x k
k of
    Ordering
LT -> case k -> IntervalSet k -> DeleteResult k
forall k e.
(Interval k e, Ord k) =>
k -> IntervalSet k -> DeleteResult k
delete' k
x IntervalSet k
l of
            (U IntervalSet k
l') -> IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c k
k IntervalSet k
l' IntervalSet k
r)
            (S IntervalSet k
l')    -> Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
unbalancedR Color
c k
k IntervalSet k
l' IntervalSet k
r
    Ordering
GT -> case k -> IntervalSet k -> DeleteResult k
forall k e.
(Interval k e, Ord k) =>
k -> IntervalSet k -> DeleteResult k
delete' k
x IntervalSet k
r of
            (U IntervalSet k
r') -> IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c k
k IntervalSet k
l IntervalSet k
r')
            (S IntervalSet k
r')    -> Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
unbalancedL Color
c k
k IntervalSet k
l IntervalSet k
r'
    Ordering
EQ -> case IntervalSet k
r of
            IntervalSet k
Nil -> if Color
c Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
B then IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
blackify IntervalSet k
l else IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U IntervalSet k
l
            IntervalSet k
_ -> case IntervalSet k -> DeleteResult' k k
forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> DeleteResult' k k
deleteMin' IntervalSet k
r of
                   (U' IntervalSet k
r' k
rk) -> IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c k
rk IntervalSet k
l IntervalSet k
r')
                   (S' IntervalSet k
r' k
rk) -> Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> DeleteResult k
unbalancedL Color
c k
rk IntervalSet k
l IntervalSet k
r'

blackify :: IntervalSet k -> DeleteResult k
blackify :: forall k. IntervalSet k -> DeleteResult k
blackify (Node Color
R k
k k
m IntervalSet k
l IntervalSet k
r) = IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
U (Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node Color
B k
k k
m IntervalSet k
l IntervalSet k
r)
blackify IntervalSet k
s                = IntervalSet k -> DeleteResult k
forall k. IntervalSet k -> DeleteResult k
S IntervalSet k
s


-- | /O(n+m)/. The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. 
-- It prefers @t1@ when duplicate elements are encountered.
union :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k
union :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> IntervalSet k -> IntervalSet k
union IntervalSet k
m1 IntervalSet k
m2 = [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ([k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListUnion (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
m1) (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
m2))

-- | The union of a list of sets:
--   (@'unions' == 'Prelude.foldl' 'union' 'empty'@).
unions :: (Interval k e, Ord k) => [IntervalSet k] -> IntervalSet k
unions :: forall k e.
(Interval k e, Ord k) =>
[IntervalSet k] -> IntervalSet k
unions []  = IntervalSet k
forall k. IntervalSet k
empty
unions [IntervalSet k
s] = IntervalSet k
s
unions [IntervalSet k]
iss = [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ([[k]] -> [k]
forall a. HasCallStack => [a] -> a
head ([[k]] -> [[k]]
forall {k}. Ord k => [[k]] -> [[k]]
go ((IntervalSet k -> [k]) -> [IntervalSet k] -> [[k]]
forall a b. (a -> b) -> [a] -> [b]
L.map IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList [IntervalSet k]
iss)))
  where
    go :: [[k]] -> [[k]]
go []       = []
    go xs :: [[k]]
xs@[[k]
_]   = [[k]]
xs
    go ([k]
x:[k]
y:[[k]]
xs) = [[k]] -> [[k]]
go ([k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListUnion [k]
x [k]
y [k] -> [[k]] -> [[k]]
forall a. a -> [a] -> [a]
: [[k]] -> [[k]]
go [[k]]
xs)

-- | /O(n+m)/. Difference of two sets.
-- Return elements of the first set not existing in the second set.
difference :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k
difference :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> IntervalSet k -> IntervalSet k
difference IntervalSet k
m1 IntervalSet k
m2 = [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ([k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListDifference (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
m1) (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
m2))

-- | /O(n+m)/. Intersection of two sets.
-- Return elements in the first set also existing in the second set.
intersection :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k
intersection :: forall k e.
(Interval k e, Ord k) =>
IntervalSet k -> IntervalSet k -> IntervalSet k
intersection IntervalSet k
m1 IntervalSet k
m2 = [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ([k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListIntersection (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
m1) (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
m2))

ascListUnion :: Ord k => [k] -> [k] -> [k]
ascListUnion :: forall k. Ord k => [k] -> [k] -> [k]
ascListUnion [] [] = []
ascListUnion [] [k]
ys = [k]
ys
ascListUnion [k]
xs [] = [k]
xs
ascListUnion xs :: [k]
xs@(k
x:[k]
xs') ys :: [k]
ys@(k
y:[k]
ys') =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
x k
y of
    Ordering
LT -> k
x k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListUnion [k]
xs' [k]
ys
    Ordering
GT -> k
y k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListUnion [k]
xs [k]
ys'
    Ordering
EQ -> k
x k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListUnion [k]
xs' [k]
ys'

ascListDifference :: Ord k => [k] -> [k] -> [k]
ascListDifference :: forall k. Ord k => [k] -> [k] -> [k]
ascListDifference [] [k]
_  = []
ascListDifference [k]
xs [] = [k]
xs
ascListDifference xs :: [k]
xs@(k
xk:[k]
xs') ys :: [k]
ys@(k
yk:[k]
ys') =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
xk k
yk of
    Ordering
LT -> k
xk k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListDifference [k]
xs' [k]
ys
    Ordering
GT -> [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListDifference [k]
xs [k]
ys'
    Ordering
EQ -> [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListDifference [k]
xs' [k]
ys'

ascListIntersection :: Ord k => [k] -> [k] -> [k]
ascListIntersection :: forall k. Ord k => [k] -> [k] -> [k]
ascListIntersection [] [k]
_ = []
ascListIntersection [k]
_ [] = []
ascListIntersection xs :: [k]
xs@(k
xk:[k]
xs') ys :: [k]
ys@(k
yk:[k]
ys') =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
xk k
yk of
    Ordering
LT -> [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListIntersection [k]
xs' [k]
ys
    Ordering
GT -> [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListIntersection [k]
xs [k]
ys'
    Ordering
EQ -> k
xk k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k] -> [k] -> [k]
forall k. Ord k => [k] -> [k] -> [k]
ascListIntersection [k]
xs' [k]
ys'


-- --- Conversion ---

-- | /O(n)/. The list of all values contained in the set, in ascending order.
toAscList :: IntervalSet k -> [k]
toAscList :: forall k. IntervalSet k -> [k]
toAscList IntervalSet k
set = IntervalSet k -> [k] -> [k]
forall k. IntervalSet k -> [k] -> [k]
toAscList' IntervalSet k
set []

toAscList' :: IntervalSet k -> [k] -> [k]
toAscList' :: forall k. IntervalSet k -> [k] -> [k]
toAscList' IntervalSet k
m [k]
xs = (k -> [k] -> [k]) -> [k] -> IntervalSet k -> [k]
forall a b. (a -> b -> b) -> b -> IntervalSet a -> b
foldr (:) [k]
xs IntervalSet k
m



-- | /O(n)/. The list of all values in the set, in no particular order.
toList :: IntervalSet k -> [k]
toList :: forall k. IntervalSet k -> [k]
toList IntervalSet k
s = IntervalSet k -> [k] -> [k]
forall k. IntervalSet k -> [k] -> [k]
go IntervalSet k
s []
  where
    go :: IntervalSet a -> [a] -> [a]
go IntervalSet a
Nil              [a]
xs = [a]
xs
    go (Node Color
_ a
k a
_ IntervalSet a
l IntervalSet a
r) [a]
xs = a
k a -> [a] -> [a]
forall a. a -> [a] -> [a]
: IntervalSet a -> [a] -> [a]
go IntervalSet a
l (IntervalSet a -> [a] -> [a]
go IntervalSet a
r [a]
xs)

-- | /O(n)/. The list of all values in the set, in descending order.
toDescList :: IntervalSet k -> [k]
toDescList :: forall k. IntervalSet k -> [k]
toDescList IntervalSet k
m = ([k] -> k -> [k]) -> [k] -> IntervalSet k -> [k]
forall b a. (b -> a -> b) -> b -> IntervalSet a -> b
foldl ((k -> [k] -> [k]) -> [k] -> k -> [k]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] IntervalSet k
m

-- | /O(n log n)/. Build a set from a list of elements. See also 'fromAscList'.
-- If the list contains duplicate values, the last value is retained.
fromList :: (Interval k e, Ord k) => [k] -> IntervalSet k
fromList :: forall k e. (Interval k e, Ord k) => [k] -> IntervalSet k
fromList [k]
xs = (IntervalSet k -> k -> IntervalSet k)
-> IntervalSet k -> [k] -> IntervalSet k
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' ((k -> IntervalSet k -> IntervalSet k)
-> IntervalSet k -> k -> IntervalSet k
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> IntervalSet k -> IntervalSet k
forall k e.
(Interval k e, Ord k) =>
k -> IntervalSet k -> IntervalSet k
insert) IntervalSet k
forall k. IntervalSet k
empty [k]
xs

-- | /O(n)/. Build a set from an ascending list in linear time.
-- /The precondition (input list is ascending) is not checked./
fromAscList :: (Interval k e, Eq k) => [k] -> IntervalSet k
fromAscList :: forall k e. (Interval k e, Eq k) => [k] -> IntervalSet k
fromAscList [k]
xs = [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ([k] -> [k]
forall k. Eq k => [k] -> [k]
uniq [k]
xs)

uniq :: Eq k => [k] -> [k]
uniq :: forall k. Eq k => [k] -> [k]
uniq [] = []
uniq (k
x:[k]
xs) = k -> [k] -> [k]
forall {t}. Eq t => t -> [t] -> [t]
go k
x [k]
xs
  where
    go :: t -> [t] -> [t]
go t
v [] = [t
v]
    go t
v (t
y:[t]
ys) | t
v t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
y    = t -> [t] -> [t]
go t
v [t]
ys
                | Bool
otherwise = t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t] -> [t]
go t
y [t]
ys

-- Strict tuple
data T2 a b = T2 !a !b


-- | /O(n)/. Build a set from an ascending list of distinct elements in linear time.
-- /The precondition is not checked./
fromDistinctAscList :: (Interval k e) => [k] -> IntervalSet k
-- exactly 2^n-1 items have height n. They can be all black
-- from 2^n - 2^n-2 items have height n+1. The lowest "row" should be red.
fromDistinctAscList :: forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList [k]
lyst = case Int -> [k] -> T2 (IntervalSet k) [k]
forall {k} {e}.
Interval k e =>
Int -> [k] -> T2 (IntervalSet k) [k]
h ([k] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [k]
lyst) [k]
lyst of
                             (T2 IntervalSet k
result []) -> IntervalSet k
result
                             T2 (IntervalSet k) [k]
_ -> String -> IntervalSet k
forall a. HasCallStack => String -> a
error String
"fromDistinctAscList: list not fully consumed"
  where
    h :: Int -> [k] -> T2 (IntervalSet k) [k]
h Int
n [k]
xs | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0      = IntervalSet k -> [k] -> T2 (IntervalSet k) [k]
forall a b. a -> b -> T2 a b
T2 IntervalSet k
forall k. IntervalSet k
Nil [k]
xs
           | Int -> Bool
isPerfect Int
n = Int -> [k] -> T2 (IntervalSet k) [k]
forall {t} {k} {e}.
(Integral t, Interval k e) =>
t -> [k] -> T2 (IntervalSet k) [k]
buildB Int
n [k]
xs
           | Bool
otherwise   = Int -> Int -> [k] -> T2 (IntervalSet k) [k]
forall {t} {t} {k} {e}.
(Num t, Integral t, Interval k e, Eq t) =>
t -> t -> [k] -> T2 (IntervalSet k) [k]
buildR Int
n (Int -> Int
log2 Int
n) [k]
xs

    buildB :: t -> [k] -> T2 (IntervalSet k) [k]
buildB t
n [k]
xs | [k]
xs [k] -> Bool -> Bool
forall a b. a -> b -> b
`seq` t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = String -> T2 (IntervalSet k) [k]
forall a. HasCallStack => String -> a
error String
"fromDictinctAscList: buildB 0"
                | t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1     = case [k]
xs of (k
k:[k]
xs') -> IntervalSet k -> [k] -> T2 (IntervalSet k) [k]
forall a b. a -> b -> T2 a b
T2 (Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node Color
B k
k k
k IntervalSet k
forall k. IntervalSet k
Nil IntervalSet k
forall k. IntervalSet k
Nil) [k]
xs'
                                          [k]
_ -> String -> T2 (IntervalSet k) [k]
forall a. HasCallStack => String -> a
error String
"fromDictinctAscList: buildB 1"
                | Bool
otherwise  =
                     case t
n t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
2 of { t
n' ->
                     case t -> [k] -> T2 (IntervalSet k) [k]
buildB t
n' [k]
xs of { (T2 IntervalSet k
_ []) -> String -> T2 (IntervalSet k) [k]
forall a. HasCallStack => String -> a
error String
"fromDictinctAscList: buildB n";
                                            (T2 IntervalSet k
l (k
k:[k]
xs')) ->
                     case t -> [k] -> T2 (IntervalSet k) [k]
buildB t
n' [k]
xs' of { (T2 IntervalSet k
r [k]
xs'') ->
                     IntervalSet k -> [k] -> T2 (IntervalSet k) [k]
forall a b. a -> b -> T2 a b
T2 (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
k IntervalSet k
l IntervalSet k
r) [k]
xs'' }}}

    buildR :: t -> t -> [k] -> T2 (IntervalSet k) [k]
buildR t
n t
d [k]
xs | t
d t -> Bool -> Bool
forall a b. a -> b -> b
`seq` [k]
xs [k] -> Bool -> Bool
forall a b. a -> b -> b
`seq` t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = IntervalSet k -> [k] -> T2 (IntervalSet k) [k]
forall a b. a -> b -> T2 a b
T2 IntervalSet k
forall k. IntervalSet k
Nil [k]
xs
                  | t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1    = case [k]
xs of (k
k:[k]
xs') -> IntervalSet k -> [k] -> T2 (IntervalSet k) [k]
forall a b. a -> b -> T2 a b
T2 (Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k.
Color -> k -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
Node (if t
dt -> t -> Bool
forall a. Eq a => a -> a -> Bool
==t
0 then Color
R else Color
B) k
k k
k IntervalSet k
forall k. IntervalSet k
Nil IntervalSet k
forall k. IntervalSet k
Nil) [k]
xs'
                                           [k]
_ -> String -> T2 (IntervalSet k) [k]
forall a. HasCallStack => String -> a
error String
"fromDistinctAscList: buildR 1"
                  | Bool
otherwise =
                      case t
n t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
2 of { t
n' ->
                      case t -> t -> [k] -> T2 (IntervalSet k) [k]
buildR t
n' (t
dt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [k]
xs of { (T2 IntervalSet k
_ []) -> String -> T2 (IntervalSet k) [k]
forall a. HasCallStack => String -> a
error String
"fromDistinctAscList: buildR n";
                                                   (T2 IntervalSet k
l (k
k:[k]
xs')) ->
                      case t -> t -> [k] -> T2 (IntervalSet k) [k]
buildR (t
n t -> t -> t
forall a. Num a => a -> a -> a
- (t
n' t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)) (t
dt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [k]
xs' of { (T2 IntervalSet k
r [k]
xs'') ->
                      IntervalSet k -> [k] -> T2 (IntervalSet k) [k]
forall a b. a -> b -> T2 a b
T2 (Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
B k
k IntervalSet k
l IntervalSet k
r) [k]
xs'' }}}


-- is n a perfect binary tree size (2^m-1)?
isPerfect :: Int -> Bool
isPerfect :: Int -> Bool
isPerfect Int
n = (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

log2 :: Int -> Int
log2 :: Int -> Int
log2 Int
m = Int -> Int -> Int
forall {t} {t}. (Ord t, Num t, Num t, Bits t) => t -> t -> t
h (-Int
1) Int
m
  where
    h :: t -> t -> t
h t
r t
n | t
r t -> Bool -> Bool
forall a b. a -> b -> b
`seq` t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = t
r
          | Bool
otherwise      = t -> t -> t
h (t
r t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (t
n t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)


-- | /O(n)/. List of all values in the set, in ascending order.
elems :: IntervalSet k -> [k]
elems :: forall k. IntervalSet k -> [k]
elems IntervalSet k
s = IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
s

-- --- Mapping ---

-- | /O(n log n)/. Map a function over all values in the set.
--
-- The size of the result may be smaller if @f@ maps two or more distinct
-- elements to the same value.
map :: (Interval b e2, Ord b) => (a -> b) -> IntervalSet a -> IntervalSet b
map :: forall b e2 a.
(Interval b e2, Ord b) =>
(a -> b) -> IntervalSet a -> IntervalSet b
map a -> b
f IntervalSet a
s = [b] -> IntervalSet b
forall k e. (Interval k e, Ord k) => [k] -> IntervalSet k
fromList [a -> b
f a
x | a
x <- IntervalSet a -> [a]
forall k. IntervalSet k -> [k]
toList IntervalSet a
s]

-- | /O(n)/. @'mapMonotonic' f s == 'map' f s@, but works only when @f@
-- is strictly monotonic.
-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
-- /The precondition is not checked./
mapMonotonic :: (Interval k2 e, Ord k2) => (k1 -> k2) -> IntervalSet k1 -> IntervalSet k2
mapMonotonic :: forall b e2 a.
(Interval b e2, Ord b) =>
(a -> b) -> IntervalSet a -> IntervalSet b
mapMonotonic k1 -> k2
_ IntervalSet k1
Nil = IntervalSet k2
forall k. IntervalSet k
Nil
mapMonotonic k1 -> k2
f (Node Color
c k1
k k1
_ IntervalSet k1
l IntervalSet k1
r) =
    Color -> k2 -> IntervalSet k2 -> IntervalSet k2 -> IntervalSet k2
forall k e.
Interval k e =>
Color -> k -> IntervalSet k -> IntervalSet k -> IntervalSet k
mNode Color
c (k1 -> k2
f k1
k) ((k1 -> k2) -> IntervalSet k1 -> IntervalSet k2
forall b e2 a.
(Interval b e2, Ord b) =>
(a -> b) -> IntervalSet a -> IntervalSet b
mapMonotonic k1 -> k2
f IntervalSet k1
l) ((k1 -> k2) -> IntervalSet k1 -> IntervalSet k2
forall b e2 a.
(Interval b e2, Ord b) =>
(a -> b) -> IntervalSet a -> IntervalSet b
mapMonotonic k1 -> k2
f IntervalSet k1
r)

-- | /O(n)/. Filter values satisfying a predicate.
filter :: (Interval k e) => (k -> Bool) -> IntervalSet k -> IntervalSet k
filter :: forall k e.
Interval k e =>
(k -> Bool) -> IntervalSet k -> IntervalSet k
filter k -> Bool
p IntervalSet k
s = [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ((k -> Bool) -> [k] -> [k]
forall a. (a -> Bool) -> [a] -> [a]
L.filter k -> Bool
p (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
s))

-- | /O(n)/. Partition the set according to a predicate. The first
-- set contains all elements that satisfy the predicate, the second all
-- elements that fail the predicate. See also 'split'.
partition :: (Interval k e) => (k -> Bool) -> IntervalSet k -> (IntervalSet k, IntervalSet k)
partition :: forall k e.
Interval k e =>
(k -> Bool) -> IntervalSet k -> (IntervalSet k, IntervalSet k)
partition k -> Bool
p IntervalSet k
s = let ([k]
xs,[k]
ys) = (k -> Bool) -> [k] -> ([k], [k])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition k -> Bool
p (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
s)
                in ([k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList [k]
xs, [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList [k]
ys)

-- | /O(n)/. The expression (@'split' k set@) is a pair @(set1,set2)@ where
-- the elements in @set1@ are smaller than @k@ and the elements in @set2@ larger than @k@.
-- Any key equal to @k@ is found in neither @set1@ nor @set2@.
split :: (Interval i k, Ord i) => i -> IntervalSet i -> (IntervalSet i, IntervalSet i)
split :: forall i k.
(Interval i k, Ord i) =>
i -> IntervalSet i -> (IntervalSet i, IntervalSet i)
split i
x IntervalSet i
m = (IntervalSet i
l, IntervalSet i
r)
  where (IntervalSet i
l, Bool
_, IntervalSet i
r) = i -> IntervalSet i -> (IntervalSet i, Bool, IntervalSet i)
forall i k.
(Interval i k, Ord i) =>
i -> IntervalSet i -> (IntervalSet i, Bool, IntervalSet i)
splitMember i
x IntervalSet i
m
     
-- | /O(n)/. The expression (@'splitMember' k set@) splits a set just
-- like 'split' but also returns @'member' k set@.
splitMember :: (Interval i k, Ord i) => i -> IntervalSet i -> (IntervalSet i, Bool, IntervalSet i)
splitMember :: forall i k.
(Interval i k, Ord i) =>
i -> IntervalSet i -> (IntervalSet i, Bool, IntervalSet i)
splitMember i
x IntervalSet i
s = case (i -> Bool) -> [i] -> ([i], [i])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
x) (IntervalSet i -> [i]
forall k. IntervalSet k -> [k]
toAscList IntervalSet i
s) of
                    ([], [])                    -> (IntervalSet i
forall k. IntervalSet k
empty, Bool
False, IntervalSet i
forall k. IntervalSet k
empty)
                    ([], i
y:[i]
_)       | i
y i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
x    -> (IntervalSet i
forall k. IntervalSet k
empty, Bool
True, IntervalSet i -> IntervalSet i
forall k e. (Interval k e, Ord k) => IntervalSet k -> IntervalSet k
deleteMin IntervalSet i
s)
                                    | Bool
otherwise -> (IntervalSet i
forall k. IntervalSet k
empty, Bool
False, IntervalSet i
s)
                    ([i]
_, [])                     -> (IntervalSet i
s, Bool
False, IntervalSet i
forall k. IntervalSet k
empty)
                    ([i]
lt, ge :: [i]
ge@(i
y:[i]
gt)) | i
y i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
x    -> ([i] -> IntervalSet i
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList [i]
lt, Bool
True, [i] -> IntervalSet i
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList [i]
gt)
                                    | Bool
otherwise -> ([i] -> IntervalSet i
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList [i]
lt, Bool
False, [i] -> IntervalSet i
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList [i]
ge)

-- Helper for building sets from distinct ascending values and subsets
data Union k = UEmpty | Union !(Union k) !(Union k)
             | UCons !k !(Union k)
             | UAppend !(IntervalSet k) !(Union k)

mkUnion :: Union a -> Union a -> Union a
mkUnion :: forall a. Union a -> Union a -> Union a
mkUnion Union a
UEmpty Union a
u = Union a
u
mkUnion Union a
u Union a
UEmpty = Union a
u
mkUnion Union a
u1 Union a
u2 = Union a -> Union a -> Union a
forall a. Union a -> Union a -> Union a
Union Union a
u1 Union a
u2

fromUnion :: Interval k e => Union k -> IntervalSet k
fromUnion :: forall k e. Interval k e => Union k -> IntervalSet k
fromUnion Union k
UEmpty               = IntervalSet k
forall k. IntervalSet k
empty
fromUnion (UCons k
key Union k
UEmpty)   = k -> IntervalSet k
forall k. k -> IntervalSet k
singleton k
key
fromUnion (UAppend IntervalSet k
set Union k
UEmpty) = IntervalSet k -> IntervalSet k
forall k. IntervalSet k -> IntervalSet k
turnBlack IntervalSet k
set
fromUnion Union k
x                    = [k] -> IntervalSet k
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList (Union k -> [k] -> [k]
forall {a}. Union a -> [a] -> [a]
unfold Union k
x [])
  where
    unfold :: Union a -> [a] -> [a]
unfold Union a
UEmpty        [a]
r = [a]
r
    unfold (Union Union a
a Union a
b)   [a]
r = Union a -> [a] -> [a]
unfold Union a
a (Union a -> [a] -> [a]
unfold Union a
b [a]
r)
    unfold (UCons a
k Union a
u)   [a]
r = a
k a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Union a -> [a] -> [a]
unfold Union a
u [a]
r
    unfold (UAppend IntervalSet a
s Union a
u) [a]
r = IntervalSet a -> [a] -> [a]
forall k. IntervalSet k -> [k] -> [k]
toAscList' IntervalSet a
s (Union a -> [a] -> [a]
unfold Union a
u [a]
r)


-- | /O(n)/. Split around a point.
-- Splits the set into three subsets: intervals below the point,
-- intervals containing the point, and intervals above the point.
splitAt :: (Interval i k) => IntervalSet i -> k -> (IntervalSet i, IntervalSet i, IntervalSet i)
splitAt :: forall i k.
Interval i k =>
IntervalSet i -> k -> (IntervalSet i, IntervalSet i, IntervalSet i)
splitAt IntervalSet i
set k
p = (Union i -> IntervalSet i
forall k e. Interval k e => Union k -> IntervalSet k
fromUnion (IntervalSet i -> Union i
forall {i}. Interval i k => IntervalSet i -> Union i
lower IntervalSet i
set), IntervalSet i
set IntervalSet i -> k -> IntervalSet i
forall k e. Interval k e => IntervalSet k -> e -> IntervalSet k
`containing` k
p, Union i -> IntervalSet i
forall k e. Interval k e => Union k -> IntervalSet k
fromUnion (IntervalSet i -> Union i
forall {i}. Interval i k => IntervalSet i -> Union i
higher IntervalSet i
set))
  where
    lower :: IntervalSet i -> Union i
lower IntervalSet i
Nil = Union i
forall k. Union k
UEmpty
    lower s :: IntervalSet i
s@(Node Color
_ i
k i
m IntervalSet i
l IntervalSet i
r)
      | k
p k -> i -> Bool
forall i e. Interval i e => e -> i -> Bool
`above`  i
m  =  IntervalSet i -> Union i -> Union i
forall k. IntervalSet k -> Union k -> Union k
UAppend IntervalSet i
s Union i
forall k. Union k
UEmpty
      | k
p k -> i -> Bool
forall i e. Interval i e => e -> i -> Bool
`below`  i
k  =  IntervalSet i -> Union i
lower IntervalSet i
l
      | k
p k -> i -> Bool
forall i e. Interval i e => e -> i -> Bool
`inside` i
k  =  Union i -> Union i -> Union i
forall a. Union a -> Union a -> Union a
mkUnion (IntervalSet i -> Union i
lower IntervalSet i
l) (IntervalSet i -> Union i
lower IntervalSet i
r)
      | Bool
otherwise     =  Union i -> Union i -> Union i
forall a. Union a -> Union a -> Union a
mkUnion (IntervalSet i -> Union i
lower IntervalSet i
l) (i -> Union i -> Union i
forall k. k -> Union k -> Union k
UCons i
k (IntervalSet i -> Union i
lower IntervalSet i
r))
    higher :: IntervalSet k -> Union k
higher IntervalSet k
Nil = Union k
forall k. Union k
UEmpty
    higher (Node Color
_ k
k k
m IntervalSet k
l IntervalSet k
r)
      | k
p k -> k -> Bool
forall i e. Interval i e => e -> i -> Bool
`above`  k
m  =  Union k
forall k. Union k
UEmpty
      | k
p k -> k -> Bool
forall i e. Interval i e => e -> i -> Bool
`below`  k
k  =  Union k -> Union k -> Union k
forall a. Union a -> Union a -> Union a
mkUnion (IntervalSet k -> Union k
higher IntervalSet k
l) (k -> Union k -> Union k
forall k. k -> Union k -> Union k
UCons k
k (IntervalSet k -> Union k -> Union k
forall k. IntervalSet k -> Union k -> Union k
UAppend IntervalSet k
r Union k
forall k. Union k
UEmpty))
      | Bool
otherwise     =  IntervalSet k -> Union k
higher IntervalSet k
r

-- | /O(n)/. Split around an interval.
-- Splits the set into three subsets: intervals below the given interval,
-- intervals intersecting the given interval, and intervals above the
-- given interval.
splitIntersecting :: (Interval i k, Ord i) => IntervalSet i -> i -> (IntervalSet i, IntervalSet i, IntervalSet i)
splitIntersecting :: forall i k.
(Interval i k, Ord i) =>
IntervalSet i -> i -> (IntervalSet i, IntervalSet i, IntervalSet i)
splitIntersecting IntervalSet i
set i
i = (Union i -> IntervalSet i
forall k e. Interval k e => Union k -> IntervalSet k
fromUnion (IntervalSet i -> Union i
lower IntervalSet i
set), IntervalSet i
set IntervalSet i -> i -> IntervalSet i
forall k e. Interval k e => IntervalSet k -> k -> IntervalSet k
`intersecting` i
i, Union i -> IntervalSet i
forall k e. Interval k e => Union k -> IntervalSet k
fromUnion (IntervalSet i -> Union i
higher IntervalSet i
set))
  where
    lower :: IntervalSet i -> Union i
lower IntervalSet i
Nil = Union i
forall k. Union k
UEmpty
    lower s :: IntervalSet i
s@(Node Color
_ i
k i
m IntervalSet i
l IntervalSet i
r)
      -- whole set lower: all
      | i
i i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`after`  i
m   =  IntervalSet i -> Union i -> Union i
forall k. IntervalSet k -> Union k -> Union k
UAppend IntervalSet i
s Union i
forall k. Union k
UEmpty
      -- interval before key: only from left subtree
      | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
k         =  IntervalSet i -> Union i
lower IntervalSet i
l
      -- interval intersects key to the right: both subtrees could contain lower intervals
      | i
i i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`overlaps` i
k =  Union i -> Union i -> Union i
forall a. Union a -> Union a -> Union a
mkUnion (IntervalSet i -> Union i
lower IntervalSet i
l) (IntervalSet i -> Union i
lower IntervalSet i
r)
      -- interval to the right of the key: key and both subtrees
      | Bool
otherwise      =  Union i -> Union i -> Union i
forall a. Union a -> Union a -> Union a
mkUnion (IntervalSet i -> Union i
lower IntervalSet i
l) (i -> Union i -> Union i
forall k. k -> Union k -> Union k
UCons i
k (IntervalSet i -> Union i
lower IntervalSet i
r))
    higher :: IntervalSet i -> Union i
higher IntervalSet i
Nil = Union i
forall k. Union k
UEmpty
    higher (Node Color
_ i
k i
m IntervalSet i
l IntervalSet i
r)
      -- whole set lower: nothing
      | i
i i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`after` i
m    =  Union i
forall k. Union k
UEmpty
      -- interval before key: node and complete right subtree + maybe part of the left subtree
      | i
i i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`before`  i
k  =  Union i -> Union i -> Union i
forall a. Union a -> Union a -> Union a
mkUnion (IntervalSet i -> Union i
higher IntervalSet i
l) (i -> Union i -> Union i
forall k. k -> Union k -> Union k
UCons i
k (IntervalSet i -> Union i -> Union i
forall k. IntervalSet k -> Union k -> Union k
UAppend IntervalSet i
r Union i
forall k. Union k
UEmpty))
      -- interval overlaps or to the right of key: only from right subtree
      | Bool
otherwise      =  IntervalSet i -> Union i
higher IntervalSet i
r


-- subsets

-- | /O(n+m)/. Is the first set a subset of the second set?
-- This is always true for equal sets.
isSubsetOf :: (Ord k) => IntervalSet k -> IntervalSet k -> Bool
isSubsetOf :: forall k. Ord k => IntervalSet k -> IntervalSet k -> Bool
isSubsetOf IntervalSet k
set1 IntervalSet k
set2 = [k] -> [k] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
ascListSubset (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
set1) (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
set2)

ascListSubset :: (Ord a) => [a] -> [a] -> Bool
ascListSubset :: forall a. Ord a => [a] -> [a] -> Bool
ascListSubset []    [a]
_  =  Bool
True
ascListSubset (a
_:[a]
_) [] =  Bool
False
ascListSubset s1 :: [a]
s1@(a
k1:[a]
r1) (a
k2:[a]
r2) =
  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2 of
    Ordering
GT -> [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
ascListSubset [a]
s1 [a]
r2
    Ordering
EQ -> [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
ascListSubset [a]
r1 [a]
r2
    Ordering
LT -> Bool
False

-- | /O(n+m)/. Is the first set a proper subset of the second set?
-- (i.e. a subset but not equal).
isProperSubsetOf :: (Ord k) => IntervalSet k -> IntervalSet k -> Bool
isProperSubsetOf :: forall k. Ord k => IntervalSet k -> IntervalSet k -> Bool
isProperSubsetOf IntervalSet k
set1 IntervalSet k
set2 = [k] -> [k] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
go (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
set1) (IntervalSet k -> [k]
forall k. IntervalSet k -> [k]
toAscList IntervalSet k
set2)
  where
    go :: [a] -> [a] -> Bool
go [] (a
_:[a]
_) = Bool
True
    go [a]
_  []    = Bool
False
    go s1 :: [a]
s1@(a
k1:[a]
r1) (a
k2:[a]
r2) =
       case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2 of
         Ordering
GT -> [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
ascListSubset [a]
s1 [a]
r2
         Ordering
EQ -> [a] -> [a] -> Bool
go [a]
r1 [a]
r2
         Ordering
LT -> Bool
False

-- | /O(n log n)/. Build a new set by combining successive values.
flattenWith :: (Ord a, Interval a e) => (a -> a -> Maybe a) -> IntervalSet a -> IntervalSet a
flattenWith :: forall a e.
(Ord a, Interval a e) =>
(a -> a -> Maybe a) -> IntervalSet a -> IntervalSet a
flattenWith a -> a -> Maybe a
combine IntervalSet a
set = [a] -> IntervalSet a
forall k e. (Interval k e, Ord k) => [k] -> IntervalSet k
fromList ((a -> a -> Maybe a) -> IntervalSet a -> [a]
forall a. (a -> a -> Maybe a) -> IntervalSet a -> [a]
combineSuccessive a -> a -> Maybe a
combine IntervalSet a
set)

-- | /O(n)/. Build a new set by combining successive values.
-- Same as 'flattenWith', but works only when the combining functions returns
-- strictly monotonic values.
flattenWithMonotonic :: (Interval a e) => (a -> a -> Maybe a) -> IntervalSet a -> IntervalSet a
flattenWithMonotonic :: forall a e.
Interval a e =>
(a -> a -> Maybe a) -> IntervalSet a -> IntervalSet a
flattenWithMonotonic a -> a -> Maybe a
combine IntervalSet a
set = [a] -> IntervalSet a
forall k e. Interval k e => [k] -> IntervalSet k
fromDistinctAscList ((a -> a -> Maybe a) -> IntervalSet a -> [a]
forall a. (a -> a -> Maybe a) -> IntervalSet a -> [a]
combineSuccessive a -> a -> Maybe a
combine IntervalSet a
set)

combineSuccessive :: (a -> a -> Maybe a) -> IntervalSet a -> [a]
combineSuccessive :: forall a. (a -> a -> Maybe a) -> IntervalSet a -> [a]
combineSuccessive a -> a -> Maybe a
combine IntervalSet a
set = [a] -> [a]
go (IntervalSet a -> [a]
forall k. IntervalSet k -> [k]
toAscList IntervalSet a
set)
  where
    go :: [a] -> [a]
go (a
x : xs :: [a]
xs@(a
_:[a]
_)) = a -> [a] -> [a]
go1 a
x [a]
xs
    go [a]
xs             = [a]
xs
    go1 :: a -> [a] -> [a]
go1 a
x (a
y:[a]
ys) = case a -> a -> Maybe a
combine a
x a
y of
                     Maybe a
Nothing -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
go1 a
y [a]
ys
                     Just a
x' -> a -> [a] -> [a]
go1 a
x' [a]
ys
    go1 a
x []     = [a
x]


-- debugging

-- | The height of the tree. For testing/debugging only.
height :: IntervalSet k -> Int
height :: forall a. IntervalSet a -> Int
height IntervalSet k
Nil = Int
0
height (Node Color
_ k
_ k
_ IntervalSet k
l IntervalSet k
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (IntervalSet k -> Int
forall a. IntervalSet a -> Int
height IntervalSet k
l) (IntervalSet k -> Int
forall a. IntervalSet a -> Int
height IntervalSet k
r)

-- | The maximum height of a red-black tree with the given number of nodes.
-- For testing/debugging only.
maxHeight :: Int -> Int
maxHeight :: Int -> Int
maxHeight Int
nodes = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
log2 (Int
nodes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)


-- | Check red-black-tree and interval search augmentation invariants.
-- For testing/debugging only.
valid :: (Interval i k, Ord i) => IntervalSet i -> Bool
valid :: forall i k. (Interval i k, Ord i) => IntervalSet i -> Bool
valid IntervalSet i
mp = IntervalSet i -> Bool
forall i k. (Interval i k, Ord i) => IntervalSet i -> Bool
test IntervalSet i
mp Bool -> Bool -> Bool
&& IntervalSet i -> Int
forall a. IntervalSet a -> Int
height IntervalSet i
mp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int
maxHeight (IntervalSet i -> Int
forall a. IntervalSet a -> Int
size IntervalSet i
mp) Bool -> Bool -> Bool
&& IntervalSet i -> Bool
forall a. IntervalSet a -> Bool
validColor IntervalSet i
mp
  where
    test :: IntervalSet a -> Bool
test IntervalSet a
Nil = Bool
True
    test n :: IntervalSet a
n@(Node Color
_ a
_ a
_ IntervalSet a
l IntervalSet a
r) = IntervalSet a -> Bool
forall {a}. Ord a => IntervalSet a -> Bool
validOrder IntervalSet a
n Bool -> Bool -> Bool
&& IntervalSet a -> Bool
forall {a} {k}. (Interval a k, Eq a) => IntervalSet a -> Bool
validMax IntervalSet a
n Bool -> Bool -> Bool
&& IntervalSet a -> Bool
test IntervalSet a
l Bool -> Bool -> Bool
&& IntervalSet a -> Bool
test IntervalSet a
r
    validMax :: IntervalSet a -> Bool
validMax (Node Color
_ a
k a
m IntervalSet a
lo IntervalSet a
hi) =  a
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> IntervalSet a -> IntervalSet a -> a
forall i k.
Interval i k =>
i -> IntervalSet i -> IntervalSet i -> i
maxUpper a
k IntervalSet a
lo IntervalSet a
hi
    validMax IntervalSet a
Nil = Bool
True

    validOrder :: IntervalSet a -> Bool
validOrder (Node Color
_ a
_ a
_ IntervalSet a
Nil IntervalSet a
Nil) = Bool
True
    validOrder (Node Color
_ a
k1 a
_ IntervalSet a
Nil (Node Color
_ a
k2 a
_ IntervalSet a
_ IntervalSet a
_)) = a
k1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k2
    validOrder (Node Color
_ a
k2 a
_ (Node Color
_ a
k1 a
_ IntervalSet a
_ IntervalSet a
_) IntervalSet a
Nil) = a
k1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k2
    validOrder (Node Color
_ a
k2 a
_ (Node Color
_ a
k1 a
_ IntervalSet a
_ IntervalSet a
_) (Node Color
_ a
k3 a
_ IntervalSet a
_ IntervalSet a
_)) = a
k1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k2 Bool -> Bool -> Bool
&& a
k2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k3
    validOrder IntervalSet a
Nil = Bool
True

    -- validColor parentColor blackCount tree
    validColor :: IntervalSet k -> Bool
validColor IntervalSet k
n = IntervalSet k -> Int
forall a. IntervalSet a -> Int
blackDepth IntervalSet k
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0

    -- return -1 if subtrees have diffrent black depths or two consecutive red nodes are encountered
    blackDepth :: IntervalSet k -> Int
    blackDepth :: forall a. IntervalSet a -> Int
blackDepth IntervalSet k
Nil  = Int
0
    blackDepth (Node Color
c k
_ k
_ IntervalSet k
l IntervalSet k
r) = case IntervalSet k -> Int
forall a. IntervalSet a -> Int
blackDepth IntervalSet k
l of
                                      Int
ld -> if Int
ld Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
ld
                                            else
                                              case IntervalSet k -> Int
forall a. IntervalSet a -> Int
blackDepth IntervalSet k
r of
                                                Int
rd | Int
rd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0       -> Int
rd
                                                   | Int
rd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ld Bool -> Bool -> Bool
|| (Color
c Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
R Bool -> Bool -> Bool
&& (IntervalSet k -> Bool
forall a. IntervalSet a -> Bool
isRed IntervalSet k
l Bool -> Bool -> Bool
|| IntervalSet k -> Bool
forall a. IntervalSet a -> Bool
isRed IntervalSet k
r)) -> -Int
1
                                                   | Color
c Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
B       -> Int
rd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                                                   | Bool
otherwise    -> Int
rd