{-# 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,
    size,

    -- * Lookups
    contains,
    containsInterval,
    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, stToPrim)
import Control.Monad.ST (ST)
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` with capacity \(n\).
--
-- @since 1.1.0.0
{-# INLINE new #-}
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
{-# INLINE build #-}
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
{-# INLINE buildM #-}
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 a. Unbox a => Vector a -> Int
VU.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 a. (Unbox a, Eq a) => Vector a -> [Vector a]
VU.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 a. Unbox a => Vector a -> Int
VU.length Vector a
xs'
      ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l (Int
l', Vector a -> a
forall a. Unbox a => Vector a -> a
VU.head Vector a
xs')
      Int -> Int -> a -> m ()
onAdd Int
l Int
l' (Vector a -> a
forall a. Unbox a => Vector a -> a
VU.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(1)\) Returns the number of intervals in the map.
--
-- @since 1.2.1.0
{-# INLINE size #-}
size :: (PrimMonad m) => IntervalMap (PrimState m) a -> m Int
size :: forall (m :: * -> *) a.
PrimMonad m =>
IntervalMap (PrimState m) a -> m Int
size = IntMap (PrimState m) (Int, a) -> m Int
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> m Int
IM.size (IntMap (PrimState m) (Int, a) -> m Int)
-> (IntervalMap (PrimState m) a -> IntMap (PrimState m) (Int, a))
-> IntervalMap (PrimState m) a
-> m Int
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

-- | \(O(\log n)\) Returns whether a point \(x\) is contained within any of the intervals.
--
-- @since 1.1.0.0
{-# INLINE contains #-}
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 = ST (PrimState m) Bool -> m Bool
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) Bool -> m Bool)
-> ST (PrimState m) Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ IntervalMap (PrimState m) a -> Int -> Int -> ST (PrimState m) Bool
forall a s. Unbox a => IntervalMap s a -> Int -> Int -> ST s Bool
containsIntervalST 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
{-# INLINE containsInterval #-}
containsInterval :: (PrimMonad m, VU.Unbox a) => IntervalMap (PrimState m) a -> Int -> Int -> m Bool
containsInterval :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> m Bool
containsInterval IntervalMap (PrimState m) a
itm Int
l Int
r = ST (PrimState m) Bool -> m Bool
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) Bool -> m Bool)
-> ST (PrimState m) Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ IntervalMap (PrimState m) a -> Int -> Int -> ST (PrimState m) Bool
forall a s. Unbox a => IntervalMap s a -> Int -> Int -> ST s Bool
containsIntervalST IntervalMap (PrimState m) a
itm Int
l Int
r

-- | \(O(\log n)\) Looks up an interval that fully contains \([l, r)\).
--
-- @since 1.1.0.0
{-# INLINE lookup #-}
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 (PrimState m) a
itm Int
l Int
r = ST (PrimState m) (Maybe (Int, Int, a)) -> m (Maybe (Int, Int, a))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe (Int, Int, a)) -> m (Maybe (Int, Int, a)))
-> ST (PrimState m) (Maybe (Int, Int, a))
-> m (Maybe (Int, Int, a))
forall a b. (a -> b) -> a -> b
$ IntervalMap (PrimState m) a
-> Int -> Int -> ST (PrimState m) (Maybe (Int, Int, a))
forall a s.
Unbox a =>
IntervalMap s a -> Int -> Int -> ST s (Maybe (Int, Int, a))
lookupST IntervalMap (PrimState m) a
itm Int
l Int
r

-- | \(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
{-# INLINE read #-}
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 = ST (PrimState m) a -> m a
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) a -> m a) -> ST (PrimState m) a -> m a
forall a b. (a -> b) -> a -> b
$ IntervalMap (PrimState m) a -> Int -> Int -> ST (PrimState m) a
forall a s.
(HasCallStack, Unbox a) =>
IntervalMap s a -> Int -> Int -> ST s a
readST IntervalMap (PrimState m) a
itm 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
{-# INLINE readMaybe #-}
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 (PrimState m) a
itm Int
l Int
r = ST (PrimState m) (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe a) -> m (Maybe a))
-> ST (PrimState m) (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ IntervalMap (PrimState m) a
-> Int -> Int -> ST (PrimState m) (Maybe a)
forall a s.
Unbox a =>
IntervalMap s a -> Int -> Int -> ST s (Maybe a)
readMaybeST IntervalMap (PrimState m) a
itm Int
l Int
r

-- | 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
{-# INLINE insert #-}
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
{-# INLINEABLE insertM #-}
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
      ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (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 <- ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe (Int, (Int, a)))
 -> m (Maybe (Int, (Int, a))))
-> ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState 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)
IntMap (PrimState (ST (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
forall {t}. (Int, (Int, a)) -> t -> 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)) -> t -> Int -> m Int
run (!Int
l', (!Int
r', !a
x')) t
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'
          ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState m) ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (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'
          Maybe (Int, (Int, a))
res <- ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe (Int, (Int, a)))
 -> m (Maybe (Int, (Int, a))))
-> ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall a b. (a -> b) -> a -> b
$ do
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState m) ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState 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)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
          case Maybe (Int, (Int, a))
res of
            Just (Int, (Int, a))
rng -> (Int, (Int, a)) -> t -> Int -> m Int
run (Int, (Int, a))
rng t
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'
          ST (PrimState m) Int -> m Int
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) Int -> m Int) -> ST (PrimState m) Int -> m Int
forall a b. (a -> b) -> a -> b
$ do
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState m) ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
            Int -> ST (PrimState m) Int
forall a. a -> ST (PrimState 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'
          ST (PrimState m) Int -> m Int
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) Int -> m Int) -> ST (PrimState m) Int -> m Int
forall a b. (a -> b) -> a -> b
$ do
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState m) ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
r (Int
r', a
x')
            Int -> ST (PrimState m) Int
forall a. a -> ST (PrimState 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 <- ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe (Int, (Int, a)))
 -> m (Maybe (Int, (Int, a))))
-> ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState 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)
IntMap (PrimState (ST (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'
              ST (PrimState m) (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Int, Int) -> m (Int, Int))
-> ST (PrimState m) (Int, Int) -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
                IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState m) ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
                (Int, Int) -> ST (PrimState m) (Int, Int)
forall a. a -> ST (PrimState 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'
              ST (PrimState m) (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Int, Int) -> m (Int, Int))
-> ST (PrimState m) (Int, Int) -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
                IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState m) ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
                (Int, Int) -> ST (PrimState m) (Int, Int)
forall a. a -> ST (PrimState 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'
              ST (PrimState m) (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Int, Int) -> m (Int, Int))
-> ST (PrimState m) (Int, Int) -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
                -- IM.delete_ dim l'
                IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l' (Int
l, a
x')
                IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
r (Int
r', a
x')
                (Int, Int) -> ST (PrimState m) (Int, Int)
forall a. a -> ST (PrimState 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'
              ST (PrimState m) (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Int, Int) -> m (Int, Int))
-> ST (PrimState m) (Int, Int) -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
                -- IM.delete_ dim l'
                IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l' (Int
l, a
x')
                (Int, Int) -> ST (PrimState m) (Int, Int)
forall a. a -> ST (PrimState 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
{-# INLINE delete #-}
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
{-# INLINEABLE deleteM #-}
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 <- ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe (Int, (Int, a)))
 -> m (Maybe (Int, (Int, a))))
-> ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState 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)
IntMap (PrimState (ST (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 ()
forall {t}. (Int, (Int, a)) -> t -> 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)) -> t -> Int -> m ()
run (!Int
l', (!Int
r', !a
x')) t
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'
          Maybe (Int, (Int, a))
res <- ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe (Int, (Int, a)))
 -> m (Maybe (Int, (Int, a))))
-> ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall a b. (a -> b) -> a -> b
$ do
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState m) ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState 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)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
          case Maybe (Int, (Int, a))
res of
            Just (Int, (Int, a))
rng -> (Int, (Int, a)) -> t -> Int -> m ()
run (Int, (Int, a))
rng t
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'
          ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState m) ()
forall (m :: * -> *) a.
PrimMonad m =>
IntMap (PrimState m) a -> Int -> m ()
IM.delete_ IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l'
            IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
r (Int
r', a
x')
            () -> ST (PrimState m) ()
forall a. a -> ST (PrimState 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 <- ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe (Int, (Int, a)))
 -> m (Maybe (Int, (Int, a))))
-> ST (PrimState m) (Maybe (Int, (Int, a)))
-> m (Maybe (Int, (Int, a)))
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> ST (PrimState 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)
IntMap (PrimState (ST (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'
              ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                -- IM.delete dim l'
                IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (PrimState m))) (Int, a)
dim Int
l' (Int
l, a
x')
                IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (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'
              ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ IntMap (PrimState (ST (PrimState m))) (Int, a)
-> Int -> (Int, a) -> ST (PrimState m) ()
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> a -> m ()
IM.insert IntMap (PrimState m) (Int, a)
IntMap (PrimState (ST (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
{-# INLINE overwrite #-}
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 = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ IntervalMap (PrimState m) a
-> Int -> Int -> a -> ST (PrimState m) ()
forall a s.
(Eq a, Unbox a) =>
IntervalMap s a -> Int -> Int -> a -> ST s ()
overwriteST IntervalMap (PrimState m) a
itm Int
l Int
r a
x

-- | \(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
{-# INLINE overwriteM #-}
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 <- ST (PrimState m) (Maybe (Int, Int, a)) -> m (Maybe (Int, Int, a))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (Maybe (Int, Int, a)) -> m (Maybe (Int, Int, a)))
-> ST (PrimState m) (Maybe (Int, Int, a))
-> m (Maybe (Int, Int, a))
forall a b. (a -> b) -> a -> b
$ IntervalMap (PrimState m) a
-> Int -> Int -> ST (PrimState m) (Maybe (Int, Int, a))
forall a s.
Unbox a =>
IntervalMap s a -> Int -> Int -> ST s (Maybe (Int, Int, a))
lookupST 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
{-# INLINE freeze #-}
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

-- -------------------------------------------------------------------------------------------------
-- Internal
-- -------------------------------------------------------------------------------------------------

{-# INLINEABLE containsIntervalST #-}
containsIntervalST :: (VU.Unbox a) => IntervalMap s a -> Int -> Int -> ST s Bool
containsIntervalST :: forall a s. Unbox a => IntervalMap s a -> Int -> Int -> ST s Bool
containsIntervalST (IntervalMap IntMap s (Int, a)
dim) Int
l Int
r
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r = Bool -> ST s Bool
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  | Bool
otherwise = do
      Maybe (Int, (Int, a))
res <- IntMap (PrimState (ST s)) (Int, a)
-> Int -> ST s (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupLE IntMap s (Int, a)
IntMap (PrimState (ST s)) (Int, a)
dim Int
l
      Bool -> ST s Bool
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ST s Bool) -> Bool -> ST s 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

{-# INLINEABLE lookupST #-}
lookupST :: (VU.Unbox a) => IntervalMap s a -> Int -> Int -> ST s (Maybe (Int, Int, a))
lookupST :: forall a s.
Unbox a =>
IntervalMap s a -> Int -> Int -> ST s (Maybe (Int, Int, a))
lookupST (IntervalMap IntMap s (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) -> ST s (Maybe (Int, Int, a))
forall a. a -> ST s 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 (ST s)) (Int, a)
-> Int -> ST s (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupLE IntMap s (Int, a)
IntMap (PrimState (ST s)) (Int, a)
im Int
l
      Maybe (Int, Int, a) -> ST s (Maybe (Int, Int, a))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int, Int, a) -> ST s (Maybe (Int, Int, a)))
-> Maybe (Int, Int, a) -> ST s (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

{-# INLINEABLE readST #-}
readST :: (HasCallStack, VU.Unbox a) => IntervalMap s a -> Int -> Int -> ST s a
readST :: forall a s.
(HasCallStack, Unbox a) =>
IntervalMap s a -> Int -> Int -> ST s a
readST IntervalMap s a
itm Int
l Int
r = do
  Maybe a
res <- IntervalMap s a -> Int -> Int -> ST s (Maybe a)
forall a s.
Unbox a =>
IntervalMap s a -> Int -> Int -> ST s (Maybe a)
readMaybeST IntervalMap s a
itm Int
l Int
r
  a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> a -> ST s 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]
"AtCoder.Extra.IntervalMap.readST: 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)

{-# INLINEABLE readMaybeST #-}
readMaybeST :: (VU.Unbox a) => IntervalMap s a -> Int -> Int -> ST s (Maybe a)
readMaybeST :: forall a s.
Unbox a =>
IntervalMap s a -> Int -> Int -> ST s (Maybe a)
readMaybeST (IntervalMap IntMap s (Int, a)
dim) Int
l Int
r
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r = Maybe a -> ST s (Maybe a)
forall a. a -> ST s 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 (ST s)) (Int, a)
-> Int -> ST s (Maybe (Int, (Int, a)))
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m, Unbox a) =>
IntMap (PrimState m) a -> Int -> m (Maybe (Int, a))
IM.lookupLE IntMap s (Int, a)
IntMap (PrimState (ST s)) (Int, a)
dim Int
l
      Maybe a -> ST s (Maybe a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> ST s (Maybe a)) -> Maybe a -> ST s (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

{-# INLINEABLE overwriteST #-}
overwriteST :: (Eq a, VU.Unbox a) => IntervalMap s a -> Int -> Int -> a -> ST s ()
overwriteST :: forall a s.
(Eq a, Unbox a) =>
IntervalMap s a -> Int -> Int -> a -> ST s ()
overwriteST IntervalMap s a
itm Int
l Int
r a
x = do
  Maybe (Int, Int, a)
res <- IntervalMap s a -> Int -> Int -> ST s (Maybe (Int, Int, a))
forall a s.
Unbox a =>
IntervalMap s a -> Int -> Int -> ST s (Maybe (Int, Int, a))
lookupST IntervalMap s a
itm Int
l Int
r
  case Maybe (Int, Int, a)
res of
    Just (!Int
l', !Int
r', !a
_) -> IntervalMap (PrimState (ST s)) a -> Int -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Eq a, Unbox a) =>
IntervalMap (PrimState m) a -> Int -> Int -> a -> m ()
insert IntervalMap s a
IntervalMap (PrimState (ST s)) a
itm Int
l' Int
r' a
x
    Maybe (Int, Int, a)
Nothing -> () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()