{-# LANGUAGE DerivingStrategies #-}

-- original implementation:
-- <https://noimi.hatenablog.com/entry/2021/05/02/195143>

-- | Dense map covering \([0, n)\) that manages non-overlapping intervals \([l, r)\) within it. Each
-- interval has an associated value \(v\). Use @onAdd@ and @onDel@ hooks to track interval state
-- changes during `buildM`, `insertM` and `deleteM` operations.
--
-- ==== Invariant
-- Each interval is operated as a whole, similar to a persistant data structure. When part of an
-- inerval is modified, the whole interval is deleted first, and the subintervals are re-inserted.
-- It's important for tracking non-linear interval information with the @onAdd@ and @onDel@ hooks
-- (callbacks).
--
-- ==== __Example__
-- Create an `IntervalMap` that covers a half-open interval \([0, n)\):
--
-- >>> import AtCoder.Extra.IntervalMap qualified as ITM
-- >>> import Data.Vector.Unboxed qualified as VU
-- >>> import Data.Vector.Unboxed.Mutable qualified as VUM
-- >>> itm <- ITM.new @_ @Int 4
--
-- It handles range set queries in amortized \(O(\log n)\) time:
--
-- >>> ITM.insert itm 0 4 0 -- 0 0 0 0
-- >>> ITM.insert itm 1 3 1 -- 0 1 1 0
-- >>> ITM.freeze itm
-- [(0,(1,0)),(1,(3,1)),(3,(4,0))]
--
-- Track interval informations with the @onAdd@ and @onDel@ hooks:
--
-- >>> import Debug.Trace (traceShow)
-- >>> itm <- ITM.new @_ @Int 4
-- >>> let onAdd l r x = print ("onAdd", l, r, x)
-- >>> let onDel l r x = print ("onDel", l, r, x)
--
-- >>> ITM.insertM itm 0 4 0 onAdd onDel -- 0 0 0 0
-- ("onAdd",0,4,0)
--
-- >>> ITM.insertM itm 1 3 1 onAdd onDel -- 0 1 1 0
-- ("onDel",0,4,0)
-- ("onAdd",0,1,0)
-- ("onAdd",3,4,0)
-- ("onAdd",1,3,1)
--
-- >>> ITM.deleteM itm 0 4 onAdd onDel
-- ("onDel",0,1,0)
-- ("onDel",1,3,1)
-- ("onDel",3,4,0)
--
-- @since 1.1.0.0
module AtCoder.Extra.IntervalMap
  ( -- * IntervalMap
    IntervalMap,

    -- * Constructors
    new,
    build,
    buildM,

    -- * Metadata
    capacity,

    -- * Lookups
    contains,
    intersects,
    lookup,
    read,
    readMaybe,

    -- * Modifications

    -- ** Insertions
    insert,
    insertM,

    -- ** Deletions
    delete,
    deleteM,

    -- ** Overwrites
    overwrite,
    overwriteM,

    -- * Conversions
    freeze,
  )
where

import AtCoder.Extra.IntMap qualified as IM
import Control.Monad (foldM_)
import Control.Monad.Primitive (PrimMonad, PrimState)
import Data.Vector.Generic qualified as G
import Data.Vector.Unboxed qualified as VU
import GHC.Stack (HasCallStack)
import Prelude hiding (lookup, read)

-- | Dense map covering \([0, n)\) that manages non-overlapping intervals \((l, r)\) within it. Each
-- interval has an associated value \(x\). Use @onAdd@ and @onDel@ hooks to track interval state
-- changes during `buildM`, `insertM` and `deleteM` operations.
--
-- @since 1.1.0.0
newtype IntervalMap s a = IntervalMap
  { -- | Maps \(l\) to \((r, a)\).
    forall s a. IntervalMap s a -> IntMap s (Int, a)
unITM :: IM.IntMap s (Int, a)
  }

-- | \(O(n)\) Creates an empty `IntervalMap`.
--
-- @since 1.1.0.0
new :: (PrimMonad m, VU.Unbox a) => Int -> m (IntervalMap (PrimState m) a)
new :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (IntervalMap (PrimState m) a)
new = (IntMap (PrimState m) (Int, a) -> IntervalMap (PrimState m) a)
-> m (IntMap (PrimState m) (Int, a))
-> m (IntervalMap (PrimState m) a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IntMap (PrimState m) (Int, a) -> IntervalMap (PrimState m) a
forall s a. IntMap s (Int, a) -> IntervalMap s a
IntervalMap (m (IntMap (PrimState m) (Int, a))
 -> m (IntervalMap (PrimState m) a))
-> (Int -> m (IntMap (PrimState m) (Int, a)))
-> Int
-> m (IntervalMap (PrimState m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m (IntMap (PrimState m) (Int, a))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (IntMap (PrimState m) a)
IM.new

-- | \(O(n + m \log n)\) Creates an `IntervalMap` by combining consecutive equal values into one
-- interval.
--
-- ==== __Example__
-- >>> itm <- build @_ @Int (VU.fromList [10,10,11,11,12,12])
-- >>> freeze itm
-- [(0,(2,10)),(2,(4,11)),(4,(6,12))]
--
-- @since 1.1.0.0
build :: (PrimMonad m, Eq a, VU.Unbox a) => VU.Vector a -> m (IntervalMap (PrimState m) a)
build :: forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
Vector a -> m (IntervalMap (PrimState m) a)
build Vector a
xs = Vector a
-> (Int -> Int -> a -> m ()) -> m (IntervalMap (PrimState m) a)
forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
Vector a
-> (Int -> Int -> a -> m ()) -> m (IntervalMap (PrimState m) a)
buildM Vector a
xs Int -> Int -> a -> m ()
forall {f :: * -> *} {p} {p} {p}.
Applicative f =>
p -> p -> p -> f ()
onAdd
  where
    onAdd :: p -> p -> p -> f ()
onAdd p
_ p
_ p
_ = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(n + m \log n)\) Creates an `IntervalMap` by combining consecutive equal values into one
-- interval, while performing @onAdd@ hook for each interval.
--
-- @since 1.1.0.0
buildM ::
  (PrimMonad m, Eq a, VU.Unbox a) =>
  -- | Input values
  VU.Vector a ->
  -- | @onAdd@ hook that take an interval \([l, r)\) with associated value \(v\)
  (Int -> Int -> a -> m ()) ->
  -- | The map
  m (IntervalMap (PrimState m) a)
buildM :: forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
Vector a
-> (Int -> Int -> a -> m ()) -> m (IntervalMap (PrimState m) a)
buildM Vector a
xs Int -> Int -> a -> m ()
onAdd = do
  IntMap (PrimState m) (Int, a)
dim <- Int -> m (IntMap (PrimState m) (Int, a))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (IntMap (PrimState m) a)
IM.new (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector a
xs)
  (Int -> Vector a -> m Int) -> Int -> [Vector a] -> m ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (IntMap (PrimState m) (Int, a) -> Int -> Vector a -> m Int
step IntMap (PrimState m) (Int, a)
dim) (Int
0 :: Int) ([Vector a] -> m ()) -> [Vector a] -> m ()
forall a b. (a -> b) -> a -> b
$ Vector a -> [Vector a]
forall (v :: * -> *) a. (Vector v a, Eq a) => v a -> [v a]
G.group Vector a
xs
  IntervalMap (PrimState m) a -> m (IntervalMap (PrimState m) a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntervalMap (PrimState m) a -> m (IntervalMap (PrimState m) a))
-> IntervalMap (PrimState m) a -> m (IntervalMap (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState m) (Int, a) -> IntervalMap (PrimState m) a
forall s a. IntMap s (Int, a) -> IntervalMap s a
IntervalMap IntMap (PrimState m) (Int, a)
dim
  where
    step :: IntMap (PrimState m) (Int, a) -> Int -> Vector a -> m Int
step IntMap (PrimState m) (Int, a)
dim !Int
l !Vector a
xs' = do
      let !l' :: Int
l' = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector a
xs'
      IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
l (Int
l', Vector a -> a
forall (v :: * -> *) a. Vector v a => v a -> a
G.head Vector a
xs')
      Int -> Int -> a -> m ()
onAdd Int
l Int
l' (Vector a -> a
forall (v :: * -> *) a. Vector v a => v a -> a
G.head Vector a
xs')
      Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
l'

-- | \(O(1)\) Returns the capacity \(n\), where the interval \([0, n)\) is managed by the map.
--
-- @since 1.1.0.0
{-# INLINE capacity #-}
capacity :: IntervalMap s a -> Int
capacity :: forall s a. IntervalMap s a -> Int
capacity = IntMap s (Int, a) -> Int
forall s a. IntMap s a -> Int
IM.capacity (IntMap s (Int, a) -> Int)
-> (IntervalMap s a -> IntMap s (Int, a)) -> IntervalMap s a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalMap s a -> IntMap s (Int, a)
forall s a. IntervalMap s a -> IntMap s (Int, a)
unITM

-- | \(O(\log n)\) Returns whether a point \(x\) is contained within any of the intervals.
--
-- @since 1.1.0.0
contains :: (PrimMonad m, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> m Bool
contains :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> m Bool
contains IntervalMap (PrimState m) a
itm Int
i = IntervalMap (PrimState m) a -> Int -> Int -> m Bool
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> m Bool
intersects IntervalMap (PrimState m) a
itm Int
i (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | \(O(\log n)\) Returns whether an interval \([l, r)\) is fully contained within any of the
-- intervals.
--
-- @since 1.1.0.0
intersects :: (PrimMonad m, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> Int -> m Bool
intersects :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> m Bool
intersects (IntervalMap IntMap (PrimState m) (Int, a)
dim) Int
l Int
r
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  | Bool
otherwise = do
      Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupLE IntMap (PrimState m) (Int, a)
dim Int
l
      Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Maybe (Int, (Int, a))
res of
        Just (!Int
_, (!Int
r', !a
_)) -> Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r'
        Maybe (Int, (Int, a))
_ -> Bool
False

-- | \(O(\log n)\) Looks up an interval that fully contains \([l, r)\).
--
-- @since 1.1.0.0
lookup :: (PrimMonad m, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> Int -> m (Maybe (Int, Int, a))
lookup :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a
-> Int -> Int -> m (Maybe (Int, Int, a))
lookup (IntervalMap IntMap (PrimState m) (Int, a)
im) Int
l Int
r
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r = Maybe (Int, Int, a) -> m (Maybe (Int, Int, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Int, Int, a)
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupLE IntMap (PrimState m) (Int, a)
im Int
l
      Maybe (Int, Int, a) -> m (Maybe (Int, Int, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int, Int, a) -> m (Maybe (Int, Int, a)))
-> Maybe (Int, Int, a) -> m (Maybe (Int, Int, a))
forall a b. (a -> b) -> a -> b
$ case Maybe (Int, (Int, a))
res of
        Just (!Int
l', (!Int
r', !a
a))
          | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r' -> (Int, Int, a) -> Maybe (Int, Int, a)
forall a. a -> Maybe a
Just (Int
l', Int
r', a
a)
        Maybe (Int, (Int, a))
_ -> Maybe (Int, Int, a)
forall a. Maybe a
Nothing

-- | \(O(\log n)\) Looks up an interval that fully contains \([l, r)\) and reads out the value.
-- Throws an error if no such interval exists.
--
-- @since 1.1.0.0
read :: (HasCallStack, PrimMonad m, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> Int -> m a
read :: forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> m a
read IntervalMap (PrimState m) a
itm Int
l Int
r = do
  Maybe a
res <- IntervalMap (PrimState m) a -> Int -> Int -> m (Maybe a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> m (Maybe a)
readMaybe IntervalMap (PrimState m) a
itm Int
l Int
r
  a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ case Maybe a
res of
    Just !a
a -> a
a
    Maybe a
Nothing -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"[read] not a member: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
l, Int
r)

-- | \(O(\log n)\) Looks up an interval that fully contains \([l, r)\) and reads out the value.
-- Returns `Nothing` if no such interval exists.
--
-- @since 1.1.0.0
readMaybe :: (PrimMonad m, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> Int -> m (Maybe a)
readMaybe :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> m (Maybe a)
readMaybe (IntervalMap IntMap (PrimState m) (Int, a)
dim) Int
l Int
r
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupLE IntMap (PrimState m) (Int, a)
dim Int
l
      Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ case Maybe (Int, (Int, a))
res of
        Just (!Int
_, (!Int
r', !a
a))
          | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r' -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
        Maybe (Int, (Int, a))
_ -> Maybe a
forall a. Maybe a
Nothing

-- | Amortized \(O(\log n)\) Inserts an interval \([l, r)\) with associated value \(v\) into the
-- map. Overwrites any overlapping intervals.
--
-- @since 1.1.0.0
insert :: (PrimMonad m, Eq a, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> Int -> a -> m ()
insert :: forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> a -> m ()
insert IntervalMap (PrimState m) a
itm Int
l Int
r a
x = IntervalMap (PrimState m) a
-> Int
-> Int
-> a
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
IntervalMap (PrimState m) a
-> Int
-> Int
-> a
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
insertM IntervalMap (PrimState m) a
itm Int
l Int
r a
x Int -> Int -> a -> m ()
forall {f :: * -> *} {p} {p} {p}.
Applicative f =>
p -> p -> p -> f ()
onAdd Int -> Int -> a -> m ()
forall {f :: * -> *} {p} {p} {p}.
Applicative f =>
p -> p -> p -> f ()
onDel
  where
    onAdd :: p -> p -> p -> f ()
onAdd p
_ p
_ p
_ = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    onDel :: p -> p -> p -> f ()
onDel p
_ p
_ p
_ = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Amortized \(O(\log n)\) Inserts an interval \([l, r)\) with associated value \(v\) into the
-- map. Overwrites any overlapping intervals. Tracks interval state changes via @onAdd@ and @onDel@
-- hooks.
--
-- @since 1.1.0.0
insertM ::
  (PrimMonad m, Eq a, VU.Unbox a) =>
  -- | The map
  IntervalMap (PrimState m) a ->
  -- | \(l\)
  Int ->
  -- | \(r\)
  Int ->
  -- | \(v\)
  a ->
  -- | @onAdd@ hook that take an interval \([l, r)\) with associated value \(v\)
  (Int -> Int -> a -> m ()) ->
  -- | @onDel@ hook that take an interval \([l, r)\) with associated value \(v\)
  (Int -> Int -> a -> m ()) ->
  m ()
insertM :: forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
IntervalMap (PrimState m) a
-> Int
-> Int
-> a
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
insertM (IntervalMap IntMap (PrimState m) (Int, a)
dim) Int
l0 Int
r0 a
x Int -> Int -> a -> m ()
onAdd Int -> Int -> a -> m ()
onDel
  | Int
l0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r0 = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = do
      !Int
r <- Int -> Int -> m Int
handleRight Int
l0 Int
r0
      (!Int
l', !Int
r') <- Int -> Int -> m (Int, Int)
handleLeft Int
l0 Int
r
      Int -> Int -> a -> m ()
onAdd Int
l' Int
r' a
x
      IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
l' (Int
r', a
x)
  where
    handleRight :: Int -> Int -> m Int
handleRight Int
l Int
r = do
      Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupGE IntMap (PrimState m) (Int, a)
dim Int
l
      case Maybe (Int, (Int, a))
res of
        Just interval0 :: (Int, (Int, a))
interval0@(!Int
_, (!Int
_, !a
_)) -> (Int, (Int, a)) -> Int -> Int -> m Int
run (Int, (Int, a))
interval0 Int
l Int
r
        Maybe (Int, (Int, a))
Nothing -> Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r

    -- Looks into intervals with @l' >= l0@.
    --           [----]
    -- (i)            *--------]   overwrite if it's x
    -- (ii)   [-------]*      delete anyways
    -- (iii)    *(------]     overwrite if it's x, or
    run :: (Int, (Int, a)) -> Int -> Int -> m Int
run (!Int
l', (!Int
r', !a
x')) Int
l Int
r
      | Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
r = do
          -- not adjacent: end.
          Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r
      -- (i)
      | Int
l' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r Bool -> Bool -> Bool
&& a
x' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = do
          -- adjacent interval with the same value: merge into one.
          Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
          IntMap (PrimState m) (Int, a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
dim Int
l'
          Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r'
      | Int
l' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r = do
          -- adjacent interval with different values: nothing to do.
          Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r
      -- (ii)
      | Int
r' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r = do
          -- inside the interval: delete and continue
          Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
          IntMap (PrimState m) (Int, a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
dim Int
l'
          Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupGT IntMap (PrimState m) (Int, a)
dim Int
l'
          case Maybe (Int, (Int, a))
res of
            Just (Int, (Int, a))
rng -> (Int, (Int, a)) -> Int -> Int -> m Int
run (Int, (Int, a))
rng Int
l Int
r
            Maybe (Int, (Int, a))
Nothing -> Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r
      -- (iii)
      | a
x' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = do
          -- intersecting interval with the same value: merge into one.
          Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
          IntMap (PrimState m) (Int, a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
dim Int
l'
          Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r'
      | Bool
otherwise = do
          -- intersecting interval with a different value: delete the intersection.
          Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
          Int -> Int -> a -> m ()
onAdd Int
r Int
r' a
x'
          IntMap (PrimState m) (Int, a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
dim Int
l'
          IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
r (Int
r', a
x')
          Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r

    handleLeft :: Int -> Int -> m (Int, Int)
handleLeft Int
l Int
r = do
      Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupLT IntMap (PrimState m) (Int, a)
dim Int
l
      case Maybe (Int, (Int, a))
res of
        Maybe (Int, (Int, a))
Nothing -> (Int, Int) -> m (Int, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
l, Int
r)
        Just (!Int
l', (!Int
r', !a
x'))
          -- (i): adjacent interval
          | Int
r' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l Bool -> Bool -> Bool
&& a
x' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x -> do
              -- adjacent interval with the same value: merge into one.
              Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
              IntMap (PrimState m) (Int, a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
dim Int
l'
              (Int, Int) -> m (Int, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
l', Int
r)
          | Int
r' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l -> do
              -- adjacent interval with different values: nothing to do.
              (Int, Int) -> m (Int, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
l, Int
r)
          -- (ii): not adjacent or intersecting
          | Int
r' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l -> do
              (Int, Int) -> m (Int, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
l, Int
r)
          -- (iii): intersecting
          | a
x' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x -> do
              -- insersecting interval with the same value: merge into one.
              Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
              IntMap (PrimState m) (Int, a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
dim Int
l'
              (Int, Int) -> m (Int, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l Int
l', Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
r Int
r')
          | Int
r' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
r -> do
              -- [l', r') contains [l, r) with a different value: split into three.
              Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
              Int -> Int -> a -> m ()
onAdd Int
l' Int
l a
x'
              Int -> Int -> a -> m ()
onAdd Int
r Int
r' a
x'
              -- IM.delete_ dim l'
              IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
l' (Int
l, a
x')
              IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
r (Int
r', a
x')
              (Int, Int) -> m (Int, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
l, Int
r)
          | Bool
otherwise -> do
              -- insersecting interval with a different value: delete.
              Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
              Int -> Int -> a -> m ()
onAdd Int
l' Int
l a
x'
              -- IM.delete_ dim l'
              IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
l' (Int
l, a
x')
              (Int, Int) -> m (Int, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
l, Int
r)

-- | Amortized \(O(\log n)\) Deletes an interval \([l, r)\) from the map.
--
-- @since 1.1.0.0
delete :: (PrimMonad m, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> Int -> m ()
delete :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> m ()
delete IntervalMap (PrimState m) a
itm Int
l Int
r = IntervalMap (PrimState m) a
-> Int
-> Int
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a
-> Int
-> Int
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
deleteM IntervalMap (PrimState m) a
itm Int
l Int
r Int -> Int -> a -> m ()
forall {f :: * -> *} {p} {p} {p}.
Applicative f =>
p -> p -> p -> f ()
onAdd Int -> Int -> a -> m ()
forall {f :: * -> *} {p} {p} {p}.
Applicative f =>
p -> p -> p -> f ()
onDel
  where
    onAdd :: p -> p -> p -> f ()
onAdd p
_ p
_ p
_ = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    onDel :: p -> p -> p -> f ()
onDel p
_ p
_ p
_ = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Amortized \(O(\log n)\) Deletes an interval \([l, r)\) from the map. Tracks interval state
-- changes via @onAdd@ and @onDel@ hooks.
--
-- @since 1.1.0.0
deleteM ::
  (PrimMonad m, VU.Unbox a) =>
  -- | The map
  IntervalMap (PrimState m) a ->
  -- | \(l\)
  Int ->
  -- | \(r\)
  Int ->
  -- | @onAdd@ hook that take an interval \([l, r)\) with associated value \(v\)
  (Int -> Int -> a -> m ()) ->
  -- | @onDel@ hook that take an interval \([l, r)\) with associated value \(v\)
  (Int -> Int -> a -> m ()) ->
  m ()
deleteM :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a
-> Int
-> Int
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
deleteM (IntervalMap IntMap (PrimState m) (Int, a)
dim) Int
l0 Int
r0 Int -> Int -> a -> m ()
onAdd Int -> Int -> a -> m ()
onDel
  | Int
l0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r0 = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = do
      Int -> Int -> m ()
handleRight Int
l0 Int
r0
      Int -> Int -> m ()
handleLeft Int
l0 Int
r0
  where
    handleRight :: Int -> Int -> m ()
handleRight Int
l Int
r = do
      Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupGE IntMap (PrimState m) (Int, a)
dim Int
l
      case Maybe (Int, (Int, a))
res of
        Just interval0 :: (Int, (Int, a))
interval0@(!Int
_, (!Int
_, !a
_)) -> (Int, (Int, a)) -> Int -> Int -> m ()
run (Int, (Int, a))
interval0 Int
l Int
r
        Maybe (Int, (Int, a))
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    run :: (Int, (Int, a)) -> Int -> Int -> m ()
run (!Int
l', (!Int
r', !a
x')) Int
l Int
r
      | Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r = do
          -- not intersecting
          () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Int
r' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r = do
          -- contained
          Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
          IntMap (PrimState m) (Int, a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
dim Int
l'
          Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupGT IntMap (PrimState m) (Int, a)
dim Int
l'
          case Maybe (Int, (Int, a))
res of
            Just (Int, (Int, a))
rng -> (Int, (Int, a)) -> Int -> Int -> m ()
run (Int, (Int, a))
rng Int
l Int
r
            Maybe (Int, (Int, a))
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
          -- intersecting
          Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
          Int -> Int -> a -> m ()
onAdd Int
r Int
r' a
x'
          IntMap (PrimState m) (Int, a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
dim Int
l'
          IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
r (Int
r', a
x')
          () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    handleLeft :: Int -> Int -> m ()
handleLeft Int
l Int
r = do
      Maybe (Int, (Int, a))
res <- IntMap (PrimState m) (Int, a) -> Int -> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupLT IntMap (PrimState m) (Int, a)
dim Int
l
      case Maybe (Int, (Int, a))
res of
        Maybe (Int, (Int, a))
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just (!Int
l', (!Int
r', !a
x'))
          | Int
r' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l -> do
              -- not intersecting
              () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Int
r' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
r -> do
              -- [l', r') contains [l, r)
              Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
              Int -> Int -> a -> m ()
onAdd Int
l' Int
l a
x'
              Int -> Int -> a -> m ()
onAdd Int
r Int
r' a
x'
              -- IM.delete dim l'
              IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
l' (Int
l, a
x')
              IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
r (Int
r', a
x')
          | Bool
otherwise -> do
              -- intersecting
              Int -> Int -> a -> m ()
onDel Int
l' Int
r' a
x'
              Int -> Int -> a -> m ()
onAdd Int
l' Int
l a
x'
              -- IM.delete_ dim l'
              IntMap (PrimState m) (Int, a) -> Int -> (Int, a) -> m ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
dim Int
l' (Int
l, a
x')

-- | \(O(\log n)\) Shorthand for overwriting the value of an interval that contains \([l, r)\).
--
-- @since 1.1.0.0
overwrite :: (PrimMonad m, Eq a, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> Int -> a -> m ()
overwrite :: forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> a -> m ()
overwrite IntervalMap (PrimState m) a
itm Int
l Int
r a
x = do
  Maybe (Int, Int, a)
res <- IntervalMap (PrimState m) a
-> Int -> Int -> m (Maybe (Int, Int, a))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a
-> Int -> Int -> m (Maybe (Int, Int, a))
lookup IntervalMap (PrimState m) a
itm Int
l Int
r
  case Maybe (Int, Int, a)
res of
    Just (!Int
l', !Int
r', !a
_) -> IntervalMap (PrimState m) a -> Int -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> a -> m ()
insert IntervalMap (PrimState m) a
itm Int
l' Int
r' a
x
    Maybe (Int, Int, a)
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log n)\). Shorthand for overwriting the value of an interval that contains \([l, r)\).
-- Tracks interval state changes via @onAdd@ and @onDel@ hooks.
--
-- @since 1.1.0.0
overwriteM ::
  (PrimMonad m, Eq a, VU.Unbox a) =>
  -- | The map
  IntervalMap (PrimState m) a ->
  -- | \(l\)
  Int ->
  -- | \(r\)
  Int ->
  -- | \(v\)
  a ->
  -- | @onAdd@ hook that take an interval \([l, r)\) with associated value \(v\)
  (Int -> Int -> a -> m ()) ->
  -- | @onDel@ hook that take an interval \([l, r)\) with associated value \(v\)
  (Int -> Int -> a -> m ()) ->
  m ()
overwriteM :: forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
IntervalMap (PrimState m) a
-> Int
-> Int
-> a
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
overwriteM IntervalMap (PrimState m) a
itm Int
l Int
r a
x Int -> Int -> a -> m ()
onAdd Int -> Int -> a -> m ()
onDel = do
  Maybe (Int, Int, a)
res <- IntervalMap (PrimState m) a
-> Int -> Int -> m (Maybe (Int, Int, a))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a
-> Int -> Int -> m (Maybe (Int, Int, a))
lookup IntervalMap (PrimState m) a
itm Int
l Int
r
  case Maybe (Int, Int, a)
res of
    Just (!Int
l', !Int
r', !a
_) -> IntervalMap (PrimState m) a
-> Int
-> Int
-> a
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
IntervalMap (PrimState m) a
-> Int
-> Int
-> a
-> (Int -> Int -> a -> m ())
-> (Int -> Int -> a -> m ())
-> m ()
insertM IntervalMap (PrimState m) a
itm Int
l' Int
r' a
x Int -> Int -> a -> m ()
onAdd Int -> Int -> a -> m ()
onDel
    Maybe (Int, Int, a)
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(n \log n)\) Enumerates the intervals and the associated values as \((l, (r, x))\) tuples,
-- where \([l, r)\) is the interval and \(x\) is the associated value.
--
-- @since 1.1.0.0
freeze :: (PrimMonad m, VU.Unbox a) => IntervalMap (PrimState m) a -> m (VU.Vector (Int, (Int, a)))
freeze :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> m (Vector (Int, (Int, a)))
freeze = IntMap (PrimState m) (Int, a) -> m (Vector (Int, (Int, a)))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> m (Vector (Int, a))
IM.assocs (IntMap (PrimState m) (Int, a) -> m (Vector (Int, (Int, a))))
-> (IntervalMap (PrimState m) a -> IntMap (PrimState m) (Int, a))
-> IntervalMap (PrimState m) a
-> m (Vector (Int, (Int, a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalMap (PrimState m) a -> IntMap (PrimState m) (Int, a)
forall s a. IntervalMap s a -> IntMap s (Int, a)
unITM