{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE DeriveGeneric #-}
#endif
#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802
{-# LANGUAGE AutoDeriveTypeable #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.PriorityQueue.FingerTree
-- Copyright   :  (c) Ross Paterson 2008
-- License     :  BSD-style
-- Maintainer  :  R.Paterson@city.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable (MPTCs and functional dependencies)
--
-- Interval maps implemented using the 'FingerTree' type, following
-- section 4.8 of
--
--  * Ralf Hinze and Ross Paterson,
--    \"Finger trees: a simple general-purpose data structure\",
--    /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
--    <http://staff.city.ac.uk/~ross/papers/FingerTree.html>
--
-- An amortized running time is given for each operation, with /n/
-- referring to the size of the priority queue.  These bounds hold even
-- in a persistent (shared) setting.
--
-- /Note/: Many of these operations have the same names as similar
-- operations on lists in the "Prelude".  The ambiguity may be resolved
-- using either qualification or the @hiding@ clause.
--
-----------------------------------------------------------------------------

module Data.IntervalMap.FingerTree (
    -- * Intervals
    Interval(..), low, high, point,
    -- * Interval maps
    IntervalMap, empty, singleton, insert, union,
    -- * Searching
    search, intersections, dominators,
    -- * Extraction
    bounds, leastView, splitAfter
    ) where

import qualified Data.FingerTree as FT
import Data.FingerTree (FingerTree, Measured(..), ViewL(..), (<|), (><))

import Prelude hiding (null)
#if MIN_VERSION_base(4,6,0)
import GHC.Generics
#endif
#if MIN_VERSION_base(4,8,0)
import qualified Prelude (null)
#else
import Control.Applicative ((<$>))
import Data.Foldable (Foldable(foldMap))
import Data.Monoid
import Data.Traversable (Traversable(traverse))
#endif
#if (MIN_VERSION_base(4,9,0)) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Foldable (toList)

----------------------------------
-- 4.8 Application: interval trees
----------------------------------

-- | A closed interval.  The lower bound should be less than or equal
-- to the upper bound.
data Interval v = Interval v v -- ^ Lower and upper bounds of the interval.
    deriving (Interval v -> Interval v -> Bool
(Interval v -> Interval v -> Bool)
-> (Interval v -> Interval v -> Bool) -> Eq (Interval v)
forall v. Eq v => Interval v -> Interval v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval v -> Interval v -> Bool
$c/= :: forall v. Eq v => Interval v -> Interval v -> Bool
== :: Interval v -> Interval v -> Bool
$c== :: forall v. Eq v => Interval v -> Interval v -> Bool
Eq, Eq (Interval v)
Eq (Interval v)
-> (Interval v -> Interval v -> Ordering)
-> (Interval v -> Interval v -> Bool)
-> (Interval v -> Interval v -> Bool)
-> (Interval v -> Interval v -> Bool)
-> (Interval v -> Interval v -> Bool)
-> (Interval v -> Interval v -> Interval v)
-> (Interval v -> Interval v -> Interval v)
-> Ord (Interval v)
Interval v -> Interval v -> Bool
Interval v -> Interval v -> Ordering
Interval v -> Interval v -> Interval v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v. Ord v => Eq (Interval v)
forall v. Ord v => Interval v -> Interval v -> Bool
forall v. Ord v => Interval v -> Interval v -> Ordering
forall v. Ord v => Interval v -> Interval v -> Interval v
min :: Interval v -> Interval v -> Interval v
$cmin :: forall v. Ord v => Interval v -> Interval v -> Interval v
max :: Interval v -> Interval v -> Interval v
$cmax :: forall v. Ord v => Interval v -> Interval v -> Interval v
>= :: Interval v -> Interval v -> Bool
$c>= :: forall v. Ord v => Interval v -> Interval v -> Bool
> :: Interval v -> Interval v -> Bool
$c> :: forall v. Ord v => Interval v -> Interval v -> Bool
<= :: Interval v -> Interval v -> Bool
$c<= :: forall v. Ord v => Interval v -> Interval v -> Bool
< :: Interval v -> Interval v -> Bool
$c< :: forall v. Ord v => Interval v -> Interval v -> Bool
compare :: Interval v -> Interval v -> Ordering
$ccompare :: forall v. Ord v => Interval v -> Interval v -> Ordering
$cp1Ord :: forall v. Ord v => Eq (Interval v)
Ord, Int -> Interval v -> ShowS
[Interval v] -> ShowS
Interval v -> String
(Int -> Interval v -> ShowS)
-> (Interval v -> String)
-> ([Interval v] -> ShowS)
-> Show (Interval v)
forall v. Show v => Int -> Interval v -> ShowS
forall v. Show v => [Interval v] -> ShowS
forall v. Show v => Interval v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval v] -> ShowS
$cshowList :: forall v. Show v => [Interval v] -> ShowS
show :: Interval v -> String
$cshow :: forall v. Show v => Interval v -> String
showsPrec :: Int -> Interval v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> Interval v -> ShowS
Show, ReadPrec [Interval v]
ReadPrec (Interval v)
Int -> ReadS (Interval v)
ReadS [Interval v]
(Int -> ReadS (Interval v))
-> ReadS [Interval v]
-> ReadPrec (Interval v)
-> ReadPrec [Interval v]
-> Read (Interval v)
forall v. Read v => ReadPrec [Interval v]
forall v. Read v => ReadPrec (Interval v)
forall v. Read v => Int -> ReadS (Interval v)
forall v. Read v => ReadS [Interval v]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Interval v]
$creadListPrec :: forall v. Read v => ReadPrec [Interval v]
readPrec :: ReadPrec (Interval v)
$creadPrec :: forall v. Read v => ReadPrec (Interval v)
readList :: ReadS [Interval v]
$creadList :: forall v. Read v => ReadS [Interval v]
readsPrec :: Int -> ReadS (Interval v)
$creadsPrec :: forall v. Read v => Int -> ReadS (Interval v)
Read
#if __GLASGOW_HASKELL__ >= 706
        , (forall x. Interval v -> Rep (Interval v) x)
-> (forall x. Rep (Interval v) x -> Interval v)
-> Generic (Interval v)
forall x. Rep (Interval v) x -> Interval v
forall x. Interval v -> Rep (Interval v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (Interval v) x -> Interval v
forall v x. Interval v -> Rep (Interval v) x
$cto :: forall v x. Rep (Interval v) x -> Interval v
$cfrom :: forall v x. Interval v -> Rep (Interval v) x
Generic
#endif
        )

-- | Lower bound of the interval
low :: Interval v -> v
low :: Interval v -> v
low (Interval v
lo v
_) = v
lo

-- | Upper bound of the interval
high :: Interval v -> v
high :: Interval v -> v
high (Interval v
_ v
hi) = v
hi

-- | An interval in which the lower and upper bounds are equal.
point :: v -> Interval v
point :: v -> Interval v
point v
v = v -> v -> Interval v
forall v. v -> v -> Interval v
Interval v
v v
v

data Node v a = Node (Interval v) a
    deriving (Node v a -> Node v a -> Bool
(Node v a -> Node v a -> Bool)
-> (Node v a -> Node v a -> Bool) -> Eq (Node v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v a. (Eq v, Eq a) => Node v a -> Node v a -> Bool
/= :: Node v a -> Node v a -> Bool
$c/= :: forall v a. (Eq v, Eq a) => Node v a -> Node v a -> Bool
== :: Node v a -> Node v a -> Bool
$c== :: forall v a. (Eq v, Eq a) => Node v a -> Node v a -> Bool
Eq, Eq (Node v a)
Eq (Node v a)
-> (Node v a -> Node v a -> Ordering)
-> (Node v a -> Node v a -> Bool)
-> (Node v a -> Node v a -> Bool)
-> (Node v a -> Node v a -> Bool)
-> (Node v a -> Node v a -> Bool)
-> (Node v a -> Node v a -> Node v a)
-> (Node v a -> Node v a -> Node v a)
-> Ord (Node v a)
Node v a -> Node v a -> Bool
Node v a -> Node v a -> Ordering
Node v a -> Node v a -> Node v a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v a. (Ord v, Ord a) => Eq (Node v a)
forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Bool
forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Ordering
forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Node v a
min :: Node v a -> Node v a -> Node v a
$cmin :: forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Node v a
max :: Node v a -> Node v a -> Node v a
$cmax :: forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Node v a
>= :: Node v a -> Node v a -> Bool
$c>= :: forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Bool
> :: Node v a -> Node v a -> Bool
$c> :: forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Bool
<= :: Node v a -> Node v a -> Bool
$c<= :: forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Bool
< :: Node v a -> Node v a -> Bool
$c< :: forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Bool
compare :: Node v a -> Node v a -> Ordering
$ccompare :: forall v a. (Ord v, Ord a) => Node v a -> Node v a -> Ordering
$cp1Ord :: forall v a. (Ord v, Ord a) => Eq (Node v a)
Ord, Int -> Node v a -> ShowS
[Node v a] -> ShowS
Node v a -> String
(Int -> Node v a -> ShowS)
-> (Node v a -> String) -> ([Node v a] -> ShowS) -> Show (Node v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v a. (Show v, Show a) => Int -> Node v a -> ShowS
forall v a. (Show v, Show a) => [Node v a] -> ShowS
forall v a. (Show v, Show a) => Node v a -> String
showList :: [Node v a] -> ShowS
$cshowList :: forall v a. (Show v, Show a) => [Node v a] -> ShowS
show :: Node v a -> String
$cshow :: forall v a. (Show v, Show a) => Node v a -> String
showsPrec :: Int -> Node v a -> ShowS
$cshowsPrec :: forall v a. (Show v, Show a) => Int -> Node v a -> ShowS
Show, ReadPrec [Node v a]
ReadPrec (Node v a)
Int -> ReadS (Node v a)
ReadS [Node v a]
(Int -> ReadS (Node v a))
-> ReadS [Node v a]
-> ReadPrec (Node v a)
-> ReadPrec [Node v a]
-> Read (Node v a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall v a. (Read v, Read a) => ReadPrec [Node v a]
forall v a. (Read v, Read a) => ReadPrec (Node v a)
forall v a. (Read v, Read a) => Int -> ReadS (Node v a)
forall v a. (Read v, Read a) => ReadS [Node v a]
readListPrec :: ReadPrec [Node v a]
$creadListPrec :: forall v a. (Read v, Read a) => ReadPrec [Node v a]
readPrec :: ReadPrec (Node v a)
$creadPrec :: forall v a. (Read v, Read a) => ReadPrec (Node v a)
readList :: ReadS [Node v a]
$creadList :: forall v a. (Read v, Read a) => ReadS [Node v a]
readsPrec :: Int -> ReadS (Node v a)
$creadsPrec :: forall v a. (Read v, Read a) => Int -> ReadS (Node v a)
Read
#if __GLASGOW_HASKELL__ >= 706
        , (forall x. Node v a -> Rep (Node v a) x)
-> (forall x. Rep (Node v a) x -> Node v a) -> Generic (Node v a)
forall x. Rep (Node v a) x -> Node v a
forall x. Node v a -> Rep (Node v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a x. Rep (Node v a) x -> Node v a
forall v a x. Node v a -> Rep (Node v a) x
$cto :: forall v a x. Rep (Node v a) x -> Node v a
$cfrom :: forall v a x. Node v a -> Rep (Node v a) x
Generic
#endif
        )

instance Functor (Node v) where
    fmap :: (a -> b) -> Node v a -> Node v b
fmap a -> b
f (Node Interval v
i a
x) = Interval v -> b -> Node v b
forall v a. Interval v -> a -> Node v a
Node Interval v
i (a -> b
f a
x)

instance Foldable (Node v) where
    foldMap :: (a -> m) -> Node v a -> m
foldMap a -> m
f (Node Interval v
_ a
x) = a -> m
f a
x

instance Traversable (Node v) where
    traverse :: (a -> f b) -> Node v a -> f (Node v b)
traverse a -> f b
f (Node Interval v
i a
x) = Interval v -> b -> Node v b
forall v a. Interval v -> a -> Node v a
Node Interval v
i (b -> Node v b) -> f b -> f (Node v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

-- rightmost interval (including largest lower bound) and largest upper bound.
data IntInterval v = NoInterval | IntInterval (Interval v) v
#if __GLASGOW_HASKELL__ >= 706
    deriving ((forall x. IntInterval v -> Rep (IntInterval v) x)
-> (forall x. Rep (IntInterval v) x -> IntInterval v)
-> Generic (IntInterval v)
forall x. Rep (IntInterval v) x -> IntInterval v
forall x. IntInterval v -> Rep (IntInterval v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (IntInterval v) x -> IntInterval v
forall v x. IntInterval v -> Rep (IntInterval v) x
$cto :: forall v x. Rep (IntInterval v) x -> IntInterval v
$cfrom :: forall v x. IntInterval v -> Rep (IntInterval v) x
Generic)
#endif

#if MIN_VERSION_base(4,9,0)
instance Ord v => Semigroup (IntInterval v) where
    <> :: IntInterval v -> IntInterval v -> IntInterval v
(<>) = IntInterval v -> IntInterval v -> IntInterval v
forall v. Ord v => IntInterval v -> IntInterval v -> IntInterval v
intervalUnion
#endif

instance Ord v => Monoid (IntInterval v) where
    mempty :: IntInterval v
mempty = IntInterval v
forall v. IntInterval v
NoInterval
#if !(MIN_VERSION_base(4,11,0))
    mappend = intervalUnion
#endif

intervalUnion :: Ord v => IntInterval v -> IntInterval v -> IntInterval v
IntInterval v
NoInterval intervalUnion :: IntInterval v -> IntInterval v -> IntInterval v
`intervalUnion` IntInterval v
i  = IntInterval v
i
IntInterval v
i `intervalUnion` IntInterval v
NoInterval  = IntInterval v
i
IntInterval Interval v
_ v
hi1 `intervalUnion` IntInterval Interval v
int2 v
hi2 =
    Interval v -> v -> IntInterval v
forall v. Interval v -> v -> IntInterval v
IntInterval Interval v
int2 (v -> v -> v
forall a. Ord a => a -> a -> a
max v
hi1 v
hi2)

instance (Ord v) => Measured (IntInterval v) (Node v a) where
    measure :: Node v a -> IntInterval v
measure (Node Interval v
i a
_) = Interval v -> v -> IntInterval v
forall v. Interval v -> v -> IntInterval v
IntInterval Interval v
i (Interval v -> v
forall v. Interval v -> v
high Interval v
i)

-- | Map of closed intervals, possibly with duplicates.
newtype IntervalMap v a =
    IntervalMap (FingerTree (IntInterval v) (Node v a))
#if __GLASGOW_HASKELL__ >= 706
    deriving ((forall x. IntervalMap v a -> Rep (IntervalMap v a) x)
-> (forall x. Rep (IntervalMap v a) x -> IntervalMap v a)
-> Generic (IntervalMap v a)
forall x. Rep (IntervalMap v a) x -> IntervalMap v a
forall x. IntervalMap v a -> Rep (IntervalMap v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a x. Rep (IntervalMap v a) x -> IntervalMap v a
forall v a x. IntervalMap v a -> Rep (IntervalMap v a) x
$cto :: forall v a x. Rep (IntervalMap v a) x -> IntervalMap v a
$cfrom :: forall v a x. IntervalMap v a -> Rep (IntervalMap v a) x
Generic)
#endif
-- ordered lexicographically by interval

instance Functor (IntervalMap v) where
    fmap :: (a -> b) -> IntervalMap v a -> IntervalMap v b
fmap a -> b
f (IntervalMap FingerTree (IntInterval v) (Node v a)
t) = FingerTree (IntInterval v) (Node v b) -> IntervalMap v b
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap ((Node v a -> Node v b)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v b)
forall a b v. (a -> b) -> FingerTree v a -> FingerTree v b
FT.unsafeFmap ((a -> b) -> Node v a -> Node v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (IntInterval v) (Node v a)
t)

-- | Values in lexicographical order of intervals.
instance Foldable (IntervalMap v) where
    foldMap :: (a -> m) -> IntervalMap v a -> m
foldMap a -> m
f (IntervalMap FingerTree (IntInterval v) (Node v a)
t) = (Node v a -> m) -> FingerTree (IntInterval v) (Node v a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Node v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) FingerTree (IntInterval v) (Node v a)
t
#if MIN_VERSION_base(4,8,0)
    null :: IntervalMap v a -> Bool
null (IntervalMap FingerTree (IntInterval v) (Node v a)
t) = FingerTree (IntInterval v) (Node v a) -> Bool
forall v a. FingerTree v a -> Bool
FT.null FingerTree (IntInterval v) (Node v a)
t
#endif

-- | Traverse the intervals in lexicographical order.
instance Traversable (IntervalMap v) where
    traverse :: (a -> f b) -> IntervalMap v a -> f (IntervalMap v b)
traverse a -> f b
f (IntervalMap FingerTree (IntInterval v) (Node v a)
t) =
        FingerTree (IntInterval v) (Node v b) -> IntervalMap v b
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (FingerTree (IntInterval v) (Node v b) -> IntervalMap v b)
-> f (FingerTree (IntInterval v) (Node v b)) -> f (IntervalMap v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node v a -> f (Node v b))
-> FingerTree (IntInterval v) (Node v a)
-> f (FingerTree (IntInterval v) (Node v b))
forall (f :: * -> *) a b v.
Applicative f =>
(a -> f b) -> FingerTree v a -> f (FingerTree v b)
FT.unsafeTraverse ((a -> f b) -> Node v a -> f (Node v b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) FingerTree (IntInterval v) (Node v a)
t

instance (Eq v, Eq a) => Eq (IntervalMap v a) where
    IntervalMap FingerTree (IntInterval v) (Node v a)
xs == :: IntervalMap v a -> IntervalMap v a -> Bool
== IntervalMap FingerTree (IntInterval v) (Node v a)
ys = FingerTree (IntInterval v) (Node v a) -> [Node v a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FingerTree (IntInterval v) (Node v a)
xs [Node v a] -> [Node v a] -> Bool
forall a. Eq a => a -> a -> Bool
== FingerTree (IntInterval v) (Node v a) -> [Node v a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FingerTree (IntInterval v) (Node v a)
ys

-- | Lexicographical ordering
instance (Ord v, Ord a) => Ord (IntervalMap v a) where
    compare :: IntervalMap v a -> IntervalMap v a -> Ordering
compare (IntervalMap FingerTree (IntInterval v) (Node v a)
xs) (IntervalMap FingerTree (IntInterval v) (Node v a)
ys) = [Node v a] -> [Node v a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FingerTree (IntInterval v) (Node v a) -> [Node v a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FingerTree (IntInterval v) (Node v a)
xs) (FingerTree (IntInterval v) (Node v a) -> [Node v a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FingerTree (IntInterval v) (Node v a)
ys)

instance (Show v, Show a) => Show (IntervalMap v a) where
    showsPrec :: Int -> IntervalMap v a -> ShowS
showsPrec Int
p (IntervalMap FingerTree (IntInterval v) (Node v a)
ns)
      | FingerTree (IntInterval v) (Node v a) -> Bool
forall v a. FingerTree v a -> Bool
FT.null FingerTree (IntInterval v) (Node v a)
ns = String -> ShowS
showString String
"empty"
      | Bool
otherwise =
        Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ([Node v a] -> ShowS
forall v a. (Show v, Show a) => [Node v a] -> ShowS
showIntervals (FingerTree (IntInterval v) (Node v a) -> [Node v a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FingerTree (IntInterval v) (Node v a)
ns))
      where
        showIntervals :: [Node v a] -> ShowS
showIntervals [] = String -> ShowS
showString String
"empty"
        showIntervals (Node Interval v
i a
x:[Node v a]
ixs) =
            String -> ShowS
showString String
"insert " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Interval v -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Interval v
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                String -> ShowS
showString String
" $ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node v a] -> ShowS
showIntervals [Node v a]
ixs

#if MIN_VERSION_base(4,9,0)
-- | 'union'.
instance (Ord v) => Semigroup (IntervalMap v a) where
    <> :: IntervalMap v a -> IntervalMap v a -> IntervalMap v a
(<>) = IntervalMap v a -> IntervalMap v a -> IntervalMap v a
forall v a.
Ord v =>
IntervalMap v a -> IntervalMap v a -> IntervalMap v a
union
#endif

-- | 'empty' and 'union'.
instance (Ord v) => Monoid (IntervalMap v a) where
    mempty :: IntervalMap v a
mempty = IntervalMap v a
forall v a. Ord v => IntervalMap v a
empty
#if !(MIN_VERSION_base(4,11,0))
    mappend = union
#endif

-- | /O(1)/.  The empty interval map.
empty :: (Ord v) => IntervalMap v a
empty :: IntervalMap v a
empty = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => FingerTree v a
FT.empty

-- | /O(1)/.  Interval map with a single entry.
singleton :: (Ord v) => Interval v -> a -> IntervalMap v a
singleton :: Interval v -> a -> IntervalMap v a
singleton Interval v
i a
x = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (Node v a -> FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => a -> FingerTree v a
FT.singleton (Interval v -> a -> Node v a
forall v a. Interval v -> a -> Node v a
Node Interval v
i a
x))

-- | /O(log n)/.  Insert an interval and associated value into a map.
-- The map may contain duplicate intervals; the new entry will be inserted
-- before any existing entries for the same interval.
insert :: (Ord v) => Interval v -> a -> IntervalMap v a -> IntervalMap v a
insert :: Interval v -> a -> IntervalMap v a -> IntervalMap v a
insert (Interval v
lo v
hi) a
_ IntervalMap v a
m | v
lo v -> v -> Bool
forall a. Ord a => a -> a -> Bool
> v
hi = IntervalMap v a
m
insert Interval v
i a
x (IntervalMap FingerTree (IntInterval v) (Node v a)
t) = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (FingerTree (IntInterval v) (Node v a)
l FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< Interval v -> a -> Node v a
forall v a. Interval v -> a -> Node v a
Node Interval v
i a
x Node v a
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (IntInterval v) (Node v a)
r)
  where
    (FingerTree (IntInterval v) (Node v a)
l, FingerTree (IntInterval v) (Node v a)
r) = (IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> (FingerTree (IntInterval v) (Node v a),
    FingerTree (IntInterval v) (Node v a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split IntInterval v -> Bool
larger FingerTree (IntInterval v) (Node v a)
t
    larger :: IntInterval v -> Bool
larger (IntInterval Interval v
k v
_) = Interval v
k Interval v -> Interval v -> Bool
forall a. Ord a => a -> a -> Bool
>= Interval v
i
    larger IntInterval v
NoInterval = String -> Bool
forall a. HasCallStack => String -> a
error String
"larger NoInterval"

-- | /O(m log (n/\//m))/.  Merge two interval maps.
-- The map may contain duplicate intervals; entries with equal intervals
-- are kept in the original order.
union  ::  (Ord v) => IntervalMap v a -> IntervalMap v a -> IntervalMap v a
union :: IntervalMap v a -> IntervalMap v a -> IntervalMap v a
union (IntervalMap FingerTree (IntInterval v) (Node v a)
xs) (IntervalMap FingerTree (IntInterval v) (Node v a)
ys) = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Ord v =>
FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge1 FingerTree (IntInterval v) (Node v a)
xs FingerTree (IntInterval v) (Node v a)
ys)
  where
    merge1 :: FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge1 FingerTree (IntInterval v) (Node v a)
as FingerTree (IntInterval v) (Node v a)
bs = case FingerTree (IntInterval v) (Node v a)
-> ViewL (FingerTree (IntInterval v)) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (IntInterval v) (Node v a)
as of
        ViewL (FingerTree (IntInterval v)) (Node v a)
EmptyL                  -> FingerTree (IntInterval v) (Node v a)
bs
        a :: Node v a
a@(Node Interval v
i a
_) :< FingerTree (IntInterval v) (Node v a)
as'     -> FingerTree (IntInterval v) (Node v a)
l FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< Node v a
a Node v a
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge2 FingerTree (IntInterval v) (Node v a)
as' FingerTree (IntInterval v) (Node v a)
r
          where
            (FingerTree (IntInterval v) (Node v a)
l, FingerTree (IntInterval v) (Node v a)
r) = (IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> (FingerTree (IntInterval v) (Node v a),
    FingerTree (IntInterval v) (Node v a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split IntInterval v -> Bool
larger FingerTree (IntInterval v) (Node v a)
bs
            larger :: IntInterval v -> Bool
larger (IntInterval Interval v
k v
_) = Interval v
k Interval v -> Interval v -> Bool
forall a. Ord a => a -> a -> Bool
>= Interval v
i
            larger IntInterval v
NoInterval = String -> Bool
forall a. HasCallStack => String -> a
error String
"larger NoInterval"
    merge2 :: FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge2 FingerTree (IntInterval v) (Node v a)
as FingerTree (IntInterval v) (Node v a)
bs = case FingerTree (IntInterval v) (Node v a)
-> ViewL (FingerTree (IntInterval v)) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (IntInterval v) (Node v a)
bs of
        ViewL (FingerTree (IntInterval v)) (Node v a)
EmptyL                  -> FingerTree (IntInterval v) (Node v a)
as
        b :: Node v a
b@(Node Interval v
i a
_) :< FingerTree (IntInterval v) (Node v a)
bs'     -> FingerTree (IntInterval v) (Node v a)
l FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< Node v a
b Node v a
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge1 FingerTree (IntInterval v) (Node v a)
r FingerTree (IntInterval v) (Node v a)
bs'
          where
            (FingerTree (IntInterval v) (Node v a)
l, FingerTree (IntInterval v) (Node v a)
r) = (IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> (FingerTree (IntInterval v) (Node v a),
    FingerTree (IntInterval v) (Node v a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split IntInterval v -> Bool
larger FingerTree (IntInterval v) (Node v a)
as
            larger :: IntInterval v -> Bool
larger (IntInterval Interval v
k v
_) = Interval v
k Interval v -> Interval v -> Bool
forall a. Ord a => a -> a -> Bool
> Interval v
i
            larger IntInterval v
NoInterval = String -> Bool
forall a. HasCallStack => String -> a
error String
"larger NoInterval"

-- | /O(k log (n/\//k))/.  All intervals that intersect with the given
-- interval, in lexicographical order.
intersections :: (Ord v) => Interval v -> IntervalMap v a -> [(Interval v, a)]
intersections :: Interval v -> IntervalMap v a -> [(Interval v, a)]
intersections Interval v
i = v -> v -> IntervalMap v a -> [(Interval v, a)]
forall v a. Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
inRange (Interval v -> v
forall v. Interval v -> v
low Interval v
i) (Interval v -> v
forall v. Interval v -> v
high Interval v
i)

-- | /O(k log (n/\//k))/.  All intervals that contain the given interval,
-- in lexicographical order.
dominators :: (Ord v) => Interval v -> IntervalMap v a -> [(Interval v, a)]
dominators :: Interval v -> IntervalMap v a -> [(Interval v, a)]
dominators Interval v
i = v -> v -> IntervalMap v a -> [(Interval v, a)]
forall v a. Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
inRange (Interval v -> v
forall v. Interval v -> v
high Interval v
i) (Interval v -> v
forall v. Interval v -> v
low Interval v
i)

-- | /O(k log (n/\//k))/.  All intervals that contain the given point,
-- in lexicographical order.
search :: (Ord v) => v -> IntervalMap v a -> [(Interval v, a)]
search :: v -> IntervalMap v a -> [(Interval v, a)]
search v
p = v -> v -> IntervalMap v a -> [(Interval v, a)]
forall v a. Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
inRange v
p v
p

-- | /O(k log (n/\//k))/.  All intervals that intersect with the given
-- interval, in lexicographical order.
inRange :: (Ord v) => v -> v -> IntervalMap v a -> [(Interval v, a)]
inRange :: v -> v -> IntervalMap v a -> [(Interval v, a)]
inRange v
lo v
hi (IntervalMap FingerTree (IntInterval v) (Node v a)
t) = FingerTree (IntInterval v) (Node v a) -> [(Interval v, a)]
forall b.
FingerTree (IntInterval v) (Node v b) -> [(Interval v, b)]
matches ((IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> FingerTree v a
FT.takeUntil (v -> IntInterval v -> Bool
forall v. Ord v => v -> IntInterval v -> Bool
greater v
hi) FingerTree (IntInterval v) (Node v a)
t)
  where
    matches :: FingerTree (IntInterval v) (Node v b) -> [(Interval v, b)]
matches FingerTree (IntInterval v) (Node v b)
xs  =  case FingerTree (IntInterval v) (Node v b)
-> ViewL (FingerTree (IntInterval v)) (Node v b)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl ((IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v b)
-> FingerTree (IntInterval v) (Node v b)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> FingerTree v a
FT.dropUntil (v -> IntInterval v -> Bool
forall v. Ord v => v -> IntInterval v -> Bool
atleast v
lo) FingerTree (IntInterval v) (Node v b)
xs) of
        ViewL (FingerTree (IntInterval v)) (Node v b)
EmptyL    ->  []
        Node Interval v
i b
x :< FingerTree (IntInterval v) (Node v b)
xs'  ->  (Interval v
i, b
x) (Interval v, b) -> [(Interval v, b)] -> [(Interval v, b)]
forall a. a -> [a] -> [a]
: FingerTree (IntInterval v) (Node v b) -> [(Interval v, b)]
matches FingerTree (IntInterval v) (Node v b)
xs'

-- | /O(1)/.  @'bounds' m@ returns @'Nothing'@ if @m@ is empty, and
-- otherwise @'Just' i@, where @i@ is the smallest interval containing
-- all the intervals in the map.
--
-- @since 0.1.3.0
bounds :: (Ord v) => IntervalMap v a -> Maybe (Interval v)
bounds :: IntervalMap v a -> Maybe (Interval v)
bounds (IntervalMap FingerTree (IntInterval v) (Node v a)
t) = case FingerTree (IntInterval v) (Node v a) -> IntInterval v
forall v a. Measured v a => a -> v
measure FingerTree (IntInterval v) (Node v a)
t of
    IntInterval v
NoInterval -> Maybe (Interval v)
forall a. Maybe a
Nothing
    IntInterval Interval v
_ v
hi -> case FingerTree (IntInterval v) (Node v a)
-> ViewL (FingerTree (IntInterval v)) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (IntInterval v) (Node v a)
t of
        ViewL (FingerTree (IntInterval v)) (Node v a)
EmptyL -> Maybe (Interval v)
forall a. Maybe a
Nothing
        Node (Interval v
lo v
_) a
_ FT.:< FingerTree (IntInterval v) (Node v a)
_ -> Interval v -> Maybe (Interval v)
forall a. a -> Maybe a
Just (v -> v -> Interval v
forall v. v -> v -> Interval v
Interval v
lo v
hi)

-- | /O(1)/.  @'leastView' m@ returns @'Nothing'@ if @m@ is empty, and
-- otherwise @'Just' ((i, x), m')@, where @i@ is the least interval,
-- @x@ is the associated value, and @m'@ is the rest of the map.
--
-- @since 0.1.3.0
leastView :: Ord v =>
    IntervalMap v a -> Maybe ((Interval v, a), IntervalMap v a)
leastView :: IntervalMap v a -> Maybe ((Interval v, a), IntervalMap v a)
leastView (IntervalMap FingerTree (IntInterval v) (Node v a)
t) = case FingerTree (IntInterval v) (Node v a)
-> ViewL (FingerTree (IntInterval v)) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (IntInterval v) (Node v a)
t of
    ViewL (FingerTree (IntInterval v)) (Node v a)
EmptyL -> Maybe ((Interval v, a), IntervalMap v a)
forall a. Maybe a
Nothing
    Node Interval v
i a
a FT.:< FingerTree (IntInterval v) (Node v a)
t' -> ((Interval v, a), IntervalMap v a)
-> Maybe ((Interval v, a), IntervalMap v a)
forall a. a -> Maybe a
Just ((Interval v
i, a
a), FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap FingerTree (IntInterval v) (Node v a)
t')

-- | /O(log(min(i,n-i)))/.  @'splitAfter' k m@ returns a pair of submaps,
-- one consisting of intervals whose lower bound is less than or equal
-- to @k@, and the other of those whose lower bound is greater.
--
-- @since 0.1.3.0
splitAfter :: Ord v =>
    v -> IntervalMap v a -> (IntervalMap v a, IntervalMap v a)
splitAfter :: v -> IntervalMap v a -> (IntervalMap v a, IntervalMap v a)
splitAfter v
k (IntervalMap FingerTree (IntInterval v) (Node v a)
t) = (FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap FingerTree (IntInterval v) (Node v a)
before, FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap FingerTree (IntInterval v) (Node v a)
after)
  where
    (FingerTree (IntInterval v) (Node v a)
before, FingerTree (IntInterval v) (Node v a)
after) = (IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> (FingerTree (IntInterval v) (Node v a),
    FingerTree (IntInterval v) (Node v a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split (v -> IntInterval v -> Bool
forall v. Ord v => v -> IntInterval v -> Bool
greater v
k) FingerTree (IntInterval v) (Node v a)
t

atleast :: (Ord v) => v -> IntInterval v -> Bool
atleast :: v -> IntInterval v -> Bool
atleast v
k (IntInterval Interval v
_ v
hi) = v
k v -> v -> Bool
forall a. Ord a => a -> a -> Bool
<= v
hi
atleast v
_ IntInterval v
NoInterval = String -> Bool
forall a. HasCallStack => String -> a
error String
"atleast NoInterval"

greater :: (Ord v) => v -> IntInterval v -> Bool
greater :: v -> IntInterval v -> Bool
greater v
k (IntInterval Interval v
i v
_) = Interval v -> v
forall v. Interval v -> v
low Interval v
i v -> v -> Bool
forall a. Ord a => a -> a -> Bool
> v
k
greater v
_ IntInterval v
NoInterval = String -> Bool
forall a. HasCallStack => String -> a
error String
"greater NoInterval"

{-
-- Examples

mkMap :: (Ord v) => [(v, v, a)] -> IntervalMap v a
mkMap = foldr ins empty
  where
    ins (lo, hi, n) = insert (Interval lo hi) n

composers :: IntervalMap Int String
composers = mkMap [
    (1685, 1750, "Bach"),
    (1685, 1759, "Handel"),
    (1732, 1809, "Haydn"),
    (1756, 1791, "Mozart"),
    (1770, 1827, "Beethoven"),
    (1782, 1840, "Paganini"),
    (1797, 1828, "Schubert"),
    (1803, 1869, "Berlioz"),
    (1810, 1849, "Chopin"),
    (1833, 1897, "Brahms"),
    (1838, 1875, "Bizet")]

mathematicians :: IntervalMap Int String
mathematicians = mkMap [
    (1642, 1727, "Newton"),
    (1646, 1716, "Leibniz"),
    (1707, 1783, "Euler"),
    (1736, 1813, "Lagrange"),
    (1777, 1855, "Gauss"),
    (1811, 1831, "Galois")]
-}