Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
AtCoder.Extra.Tree.TreeMonoid
Description
Integration of segment trees with the heavy-light decomposition technique. Computes monoid products on a path in \(O(\log^2 n)\) time or on a subtree in \(O(\log n)\) time.
- If vertices have weights, create a
TreeMonoid
withfromVerts
. - If edges have weights, create a tree monoid with
fromEdges
.
(Internals) Weights on edges
When vertices are unweighted and only edges have weights, treat edges as new vertices or assign edge weights to the deeper vertex.
Idea 1. Convert edges into new vertices. This is inefficient.
o--o--o --> o-x-o-x-o
Idea 2. Assign edge weight to the deeper vertex. The is the internal implementation of
fromEdges
and LCAs are ignored on prod
:
o | <--- edge 1 o <- write weight 1 here | <--- edge 2 o <- write weight 2 here
Example (1): Weights are on vertices
>>>
import AtCoder.Extra.Graph qualified as Gr
>>>
import AtCoder.Extra.Tree.Hld qualified as Hld
>>>
import AtCoder.Extra.Tree.TreeMonoid qualified as TM
>>>
import Data.Semigroup (Sum (..))
>>>
import Data.Vector.Unboxed qualified as VU
>>>
-- 0--1--2--3
>>>
-- +
>>>
-- +--4--5
>>>
let n = 6
>>>
let tree = Gr.build' n . Gr.swapDupe' $ VU.fromList [(0, 1), (1, 2), (2, 3), (1, 4), (4, 5)]
>>>
let weights = VU.generate n Sum -- vertex `i` is given weight of `i`
>>>
let hld = Hld.new tree
>>>
tm <- TM.fromVerts hld {- `Sum` is commutative -} Commute weights
>>>
TM.prod tm 1 3
Sum {getSum = 6}
>>>
TM.prodSubtree tm 1
Sum {getSum = 15}
>>>
TM.write tm 1 $ Sum 10
>>>
TM.prod tm 1 3
Sum {getSum = 15}
Example (2): Weights are on edges
>>>
import AtCoder.Extra.Graph qualified as Gr
>>>
import AtCoder.Extra.Tree.Hld qualified as Hld
>>>
import AtCoder.Extra.Tree.TreeMonoid qualified as TM
>>>
import Data.Semigroup (Sum (..))
>>>
import Data.Vector.Unboxed qualified as VU
>>>
-- 0--1--2--3
>>>
-- +
>>>
-- +--4--5
>>>
let n = 6
>>>
let edges = VU.fromList [(0, 1, Sum (1 :: Int)), (1, 2, Sum 2), (2, 3, Sum 3), (1, 4, Sum 4), (4, 5, Sum 5)]
>>>
let tree = Gr.build n $ Gr.swapDupe edges
>>>
let hld = Hld.new tree
>>>
tm <- TM.fromEdges hld {- `Sum` is commutative -} Commute edges
>>>
TM.prod tm 1 3
Sum {getSum = 5}
>>>
TM.prodSubtree tm 1
Sum {getSum = 14}
>>>
TM.write tm 2 $ Sum 10
>>>
TM.prod tm 1 3
Sum {getSum = 13}
Since: 1.1.0.0
Synopsis
- data TreeMonoid a s
- type Vertex = Int
- type VertexHld = Vertex
- data Commutativity
- fromVerts :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => Hld -> Commutativity -> Vector a -> m (TreeMonoid a (PrimState m))
- fromEdges :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => Hld -> Commutativity -> Vector (Vertex, Vertex, a) -> m (TreeMonoid a (PrimState m))
- prod :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> Vertex -> m a
- prodSubtree :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> m a
- read :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> m a
- write :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> a -> m ()
- exchange :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> a -> m a
- modify :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> (a -> a) -> Int -> m ()
- modifyM :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> (a -> m a) -> Int -> m ()
TreeMonoid
data TreeMonoid a s Source #
A wrapper for Hld
getting product on paths on a tree using Hld
and segment tree(s).
Since: 1.1.0.0
data Commutativity Source #
Represents whether a monoid is commutative or noncommutative.
Since: 1.1.0.0
Constructors
Commute | Commutative: \(a \cdot b = b \cdot a\). Since: 1.1.0.0 |
NonCommute | Noncommutative: \(a \cdot b \neq b \cdot a\). Since: 1.1.0.0 |
Instances
Show Commutativity Source # | Since: 1.1.0.0 |
Defined in AtCoder.Extra.Tree.TreeMonoid Methods showsPrec :: Int -> Commutativity -> ShowS # show :: Commutativity -> String # showList :: [Commutativity] -> ShowS # | |
Eq Commutativity Source # | Since: 1.1.0.0 |
Defined in AtCoder.Extra.Tree.TreeMonoid Methods (==) :: Commutativity -> Commutativity -> Bool # (/=) :: Commutativity -> Commutativity -> Bool # |
Constructors
Arguments
:: (HasCallStack, PrimMonad m, Monoid a, Unbox a) | |
=> Hld |
|
-> Commutativity | Whether the monoid is commutative or not. |
-> Vector a | The vertex weights. |
-> m (TreeMonoid a (PrimState m)) | A |
\(O(n)\) Creates a TreeMonoid
with weights on vertices.
Since: 1.1.0.0
Arguments
:: (HasCallStack, PrimMonad m, Monoid a, Unbox a) | |
=> Hld |
|
-> Commutativity | Whether the monoid is commutative or not. |
-> Vector (Vertex, Vertex, a) | Input edges. |
-> m (TreeMonoid a (PrimState m)) | A |
\(O(n)\) Creates a TreeMonoid
with weignts on edges. The edges are not required to be
duplicated: only one of \((u, v, w)\) or \((v, u, w)\) is needed.
Since: 1.1.0.0
Segment tree methods
Reading
prod :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> Vertex -> m a Source #
\(O(\log^2 n)\) Returns the product of the path between two vertices \(u\), \(v\) (invlusive).
Since: 1.1.0.0
prodSubtree :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> m a Source #
\(O(\log n)\) Returns the product of the subtree rooted at the given Vertex
.
Since: 1.1.0.0
read :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> m a Source #
\(O(1)\) Reads a TreeMonoid
value on a Vertex
.
Since: 1.1.0.0
Modifications
write :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> a -> m () Source #
\(O(\log n)\) Write a TreeMonoid
value on a Vertex
.
Since: 1.1.0.0
exchange :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> Vertex -> a -> m a Source #
\(O(\log n)\) Exchanges a TreeMonoid
value on a Vertex
.
Since: 1.1.0.0
modify :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> (a -> a) -> Int -> m () Source #
\(O(\log n)\) Modifies a TreeMonoid
value on a Vertex
.
Since: 1.1.0.0
modifyM :: (HasCallStack, PrimMonad m, Monoid a, Unbox a) => TreeMonoid a (PrimState m) -> (a -> m a) -> Int -> m () Source #
\(O(\log n)\) Modifies a TreeMonoid
value on a Vertex
.
Since: 1.1.0.0