{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- 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 HaskellWorks.Data.IntervalMap.FingerTree
  ( -- * Intervals
    Interval(..)
  , point
    -- * Interval maps
  , IntervalMap(..)
  , empty
  , singleton
  , insert
  , union
    -- * Searching
  , search
  , intersections
  , dominators
  ) where

import Control.DeepSeq
import GHC.Generics
import HaskellWorks.Data.FingerTree (FingerTree, Measured (..), ViewL (..), (<|), (><))

import qualified Data.Semigroup               as S
import qualified HaskellWorks.Data.FingerTree as FT

#if !MIN_VERSION_base(4,13,0)
import Control.Applicative          ((<$>))
#endif

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

-- | A closed interval.  The lower bound should be less than or equal
-- to the higher bound.
data Interval v = Interval { Interval v -> v
low :: v, Interval v -> v
high :: v }
  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, (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, Interval v -> ()
(Interval v -> ()) -> NFData (Interval v)
forall v. NFData v => Interval v -> ()
forall a. (a -> ()) -> NFData a
rnf :: Interval v -> ()
$crnf :: forall v. NFData v => Interval v -> ()
NFData)

-- | 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 ((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, Node v a -> ()
(Node v a -> ()) -> NFData (Node v a)
forall a. (a -> ()) -> NFData a
forall v a. (NFData v, NFData a) => Node v a -> ()
rnf :: Node v a -> ()
$crnf :: forall v a. (NFData v, NFData a) => Node v a -> ()
NFData)

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 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, IntInterval v -> ()
(IntInterval v -> ()) -> NFData (IntInterval v)
forall v. NFData v => IntInterval v -> ()
forall a. (a -> ()) -> NFData a
rnf :: IntInterval v -> ()
$crnf :: forall v. NFData v => IntInterval v -> ()
NFData)

appendInterval :: Ord v => IntInterval v -> IntInterval v -> IntInterval v
appendInterval :: IntInterval v -> IntInterval v -> IntInterval v
appendInterval  IntInterval v
NoInterval          IntInterval v
i                     = IntInterval v
i
appendInterval  IntInterval v
i                   IntInterval v
NoInterval            = IntInterval v
i
appendInterval (IntInterval Interval v
_ v
hi1) (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)
{-# INLINE appendInterval #-}

instance Ord v => S.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
appendInterval
  {-# INLINE (<>) #-}

instance Ord v => Monoid (IntInterval v) where
  mempty :: IntInterval v
mempty = IntInterval v
forall v. IntInterval v
NoInterval
  {-# INLINE mempty #-}

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.
-- The 'Foldable' and 'Traversable' instances process the intervals in
-- lexicographical order.
newtype IntervalMap v a =
  IntervalMap (FingerTree (IntInterval v) (Node v a))
  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, IntervalMap v a -> ()
(IntervalMap v a -> ()) -> NFData (IntervalMap v a)
forall a. (a -> ()) -> NFData a
forall v a. (NFData a, NFData v) => IntervalMap v a -> ()
rnf :: IntervalMap v a -> ()
$crnf :: forall v a. (NFData a, NFData v) => IntervalMap v a -> ()
NFData)
-- 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)

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

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 (Ord v) => S.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
  {-# INLINE (<>) #-}

-- | '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
  {-# INLINE mempty #-}

-- | /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 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. (Semigroup v, Container v) => v -> v -> v
>< Interval v -> a -> Node v a
forall v a. Interval v -> a -> Node v a
Node Interval v
i a
x Elem (FingerTree (IntInterval v) (Node v a))
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v. Cons v => Elem v -> v -> v
<| 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. (Semigroup v, Container v) => v -> v -> v
>< Elem (FingerTree (IntInterval v) (Node v a))
Node v a
a Elem (FingerTree (IntInterval v) (Node v a))
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v. Cons v => Elem v -> v -> v
<| 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. (Semigroup v, Container v) => v -> v -> v
>< Elem (FingerTree (IntInterval v) (Node v a))
Node v a
b Elem (FingerTree (IntInterval v) (Node v a))
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v. Cons v => Elem v -> v -> 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)
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'

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")]
-}