# ABC373 振り返り
- [AtCoder Beginner Contest 373 - AtCoder](https://atcoder.jp/contests/abc373)
- ABCD 4完 (1252) ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc373)
![[スクリーンショット 2024-09-29 9.28.34.png]]
ABC373 でした
- A (灰) ··· ナイーブに $S_i$ の長さを求めて $i$ と同じか比較
- B (灰) ··· 各 `A .. Z` の距離を最初に決めて、`A` → `Z` までの距離計算
- C (灰) ··· 整数列 $A$ と整数列 $B$ のそれぞれ最大値を足す (えっ)
- D (茶) ··· 各連結成分に DFS。スタート地点の頂点の値を $0$ にして、遷移するたび親の値 + $w_i$ で決めていく (もしくは重み付きUnion-Find)
- E (水, 未完) ··· わからん
- F (黄, 未完) ··· DP、70分格闘したものの WA が取れず
今回は A 〜 D まで比較的簡単で、ノーペナで素速く解くことができた、かつ E, F は難易度が高かったためパフォーマンスとしては水色で、勝ちました。
F を解いて大勝、と行きたかったのですが結果的には採用した方針が合っておらず AC ならず。黄 diff は伊達じゃない。
## [A - September](https://atcoder.jp/contests/abc373/tasks/abc373_a)
$i = 1 \ldots 12$ までの $i$ に対する $S_i$ のうち $length(S_i) = i$ になってるものの数を数える
素直に実装すればよいです
```haskell
main :: IO ()
main = do
ss <- replicateM 12 getLine
print $ sum' [1 :: Int | (i, si) <- indexed 1 ss, length si == i]
```
## [B - 1D Keyboard](https://atcoder.jp/contests/abc373/tasks/abc373_b)
問題文読むのが疲れる。
キーの並び順が適当に入力出与えられる。左から順に距離が $1 \ldots 26$ まで振られる
`A` から `Z` まで順番に出力するためにキーをおしていくと総距離は幾つになるか?
B 問題で良く出るタイプの問題で、`A .. Z` までの文字それぞれに先に距離を与えてマスターデータを配列で作っておき、あとはそのマスターに基づいて距離計算する。
```haskell
main :: IO ()
main = do
s <- getLine
let ds = array @UArray ('A', 'Z') $ zip s [1 .. 26 :: Int]
xs = ['A' .. 'Z']
ans = sum' $ zipWith (\i j -> abs $ ds ! i - ds ! j) xs (tail xs)
print ans
```
## [C - Max Ai+Bj](https://atcoder.jp/contests/abc373/tasks/abc373_c)
数列 $A$ と数列 $B$ が与えられるので $A_i + B_j$ の最大値を求めよ。
$A$ と $B$ はそれぞれ独立に考えられるので、それぞれの最大値を求めて足す。
簡単すぎて「なんでこれが C ?」という気持ち
実装したあと、ほんとにこれでいいのかと、送信するのを躊躇しました。
```haskell
main :: IO ()
main = do
n <- getInt
as <- getInts
bs <- getInts
print $ maximum as + maximum bs
```
## [D - Hidden Weights](https://atcoder.jp/contests/abc373/tasks/abc373_d)
グラフがあり、各頂点が整数の値を持っているがそれは隠されている。
頂点の間の差が幾つになるかが、有向グラフの辺として与えられる。
各頂点の整数をいくつにすると、このグラフが成立するか?
有向グラフ、となっていますが関心事は頂点間の差です。有向グラフなのは、引き算の計算の向きを提示する意味しかない。
ので、グラフは無向グラフで考えて $v_i → v_j$ の重みが $w_i$ に対し、逆向きの $v_j → v_i$ の重みを $- w_i$ とします。
問題文に「与えられる入力について、条件を満たす書き込み方が少なくとも $1$ つ存在することが保証されます。」とある。つまり矛盾がないことは保証されています。
よって周辺の頂点を調べて最適解をみつける的ことはしなくても、DFS なり BFS なりで各頂点を訪問しながら、親の値に重み $w_i$ を足したものを子の値として確定していくだけで良いです。
ただし、グラフは連結性が保証されていないので (DFS や BFS で連結成分を抽出するときのように)
- 訪問済み頂点の情報を大域的に管理する
- $1 \ldots N$ すべての頂点をスタート地点 $v_0$ に DFS / BFS を行うつもりで開始する
- DFS/BFS 開始時に $v_0$ が訪問済みかどうかをみて、すでに訪問済みならその $v_0$ を開始点にした探索はスキップ
ということをしてグラフ全体を漏れなく訪問するようにします。
### DFS
```haskell
dfs' g dist v0 = do
d <- readArray dist v0
when (isNothing d) $ do
writeArray dist v0 $ Just 0
aux dist v0
where
aux dist v = do
prev <- readArray dist v
for_ (g ! v) $ \(u, w) -> do
cur <- readArray dist u
when (isNothing cur) $ do
writeArray dist u $ fmap (+ w) prev
aux dist u
main :: IO ()
main = do
[n, m] <- getInts
uvs <- replicateM m getWeightedEdge
let g = wGraph (1, n) $ concat [[((u, v), w), ((v, u), -w)] | ((u, v), w) <- uvs]
dist <- newArray @IOArray (1, n) Nothing
for_ [1 .. n] $ \v -> do
dfs' g dist v
xs <- getElems dist
printList $ catMaybes xs
```
## BFS
```haskell
bfs' g dist v0 = do
d <- readArray dist v0
when (isNothing d) $ do
writeArray dist v0 $ Just 0
aux (Seq.singleton v0)
where
aux Empty = return ()
aux (v :<| queue) = do
d <- readArray dist v
us <- filterM (\(u, _) -> isNothing <
gt; readArray dist u) (g ! v)
queue' <- foldForM queue us $ \q (u, w) -> do
writeArray dist u $ fmap (+ w) d
return $ q |> u
aux queue'
main :: IO ()
main = do
[n, m] <- getInts
uvs <- replicateM m getWeightedEdge
let g = wGraph (1, n) $ concat [[((u, v), w), ((v, u), -w)] | ((u, v), w) <- uvs]
dist <- newArray @IOArray (1, n) Nothing
for_ [1 .. n] $ \v -> do
bfs' g dist v
xs <- getElems dist
printList $ catMaybes xs
```
コンテスト中、BFS の実装を終えたところでグラフが非連結であることを考慮しておらず、まずいなと思いました。
Haskell でこういう大域的なデータ構造を持ち回りながら副作用を起こして何かするみたいなのを、その場で焦って書こうとすると沼りやすい。
どうしようかなーと思いましたが、解法と実装方針は分かっていたので ChatGPT にそれを指示して Python でコードを出力させて AC しました。
### 重み付き Union-Find
ところで、この問題は重み付き Union-Find を貼るだけでも解けます。
これは本番中にはまったく気づかず。
「重み付き Union-Find」は差分制約 / 相対情報を扱うことができるデータ構造で、この問題のように各要素に決められた値が不明な状態で、要素間の差分がわかるときに出番です。
今回の問題では入力に矛盾がないことが保証されていますが、重み付きUnion-Find は矛盾がある場合も扱うことができます。
[ABC328 F - Good Set Query](https://atcoder.jp/contests/abc328/tasks/abc328_f) を upsolve するために実装した重み付き Union-Find の実装を貼ってみたところ、確かに貼るだけで解けました。
グラフ通りに結合して、結果定まった各要素の重みを出力するだけ。
慣れている人にとってはおそらくこれが最速でしょう。
```haskell
main :: IO ()
main = do
[n, m] <- getInts
uvs <- replicateM m getWeightedEdge
uf <- newWUF @IOUArray (1, n) (-1 :: Int)
for_ uvs $ \((u, v), w) -> do
uniteWUF uf u v w
ws <- traverse (getWeightWUF uf) [1 .. n]
printList ws
{-- 重み付き Union-Find --}
data WeightedUnionFind a v
= WeightedUnionFind
(a v v) -- 親頂点 / -1 は代表元
(IOUArray v Int) -- 集合サイズ (代表元で検索する)
(IOUArray v Int) -- weight
(IORef Int) -- 連結成分数
v -- 代表元 (representative element)
newWUF :: (MArray a v IO, Ix v) => (v, v) -> v -> IO (WeightedUnionFind a v)
newWUF (l, u) rep =
WeightedUnionFind
<gt; newArray (l, u) rep
<*> newArray (l, u) 1
<*> newArray (l, u) 0
<*> newIORef (bool 0 (ix u + 1 - ix l) (u >= l))
<*> pure rep
where
ix = index (l, u)
rootWUF :: (MArray a v IO, Ix v) => WeightedUnionFind a v -> v -> IO v
rootWUF uf@(WeightedUnionFind parent _ weight _ rep) x = do
p <- readArray parent x
if p == rep
then return x
else do
r <- rootWUF uf p
writeArray parent x r
-- 累積和
w <- readArray weight p
updateArray (+) weight x w
return r
getWeightWUF :: (MArray a v IO, Ix v) => WeightedUnionFind a v -> v -> IO Int
getWeightWUF uf@(WeightedUnionFind _ _ weight _ _) x = do
_ <- rootWUF uf x -- 経路圧縮
readArray weight x
-- x と y のグループを W_y - W_x = d (W_y = W_x + d) となるように統合する
uniteWUF :: (MArray a v IO, Ix v) => WeightedUnionFind a v -> v -> v -> Int -> IO ()
uniteWUF uf@(WeightedUnionFind parent size weight refN _) x y w = do
x' <- rootWUF uf x
y' <- rootWUF uf y
wx <- getWeightWUF uf x
wy <- getWeightWUF uf y
let w' = w + wx - wy
when (x' /= y') $ do
sizeX <- readArray size x'
sizeY <- readArray size y'
-- 併合する毎に集合が一つ減る
modifyIORef' refN (+ (-1))
if sizeX > sizeY
then do
writeArray size x' (sizeX + sizeY)
writeArray parent y' x'
writeArray weight y' w'
else do
-- swap
writeArray size y' (sizeX + sizeY)
writeArray parent x' y'
writeArray weight x' (negate w')
isSameWUF :: (MArray a v IO, Ix v) => WeightedUnionFind a v -> v -> v -> IO Bool
isSameWUF uf x y = (==) <gt; rootWUF uf x <*> rootWUF uf y
```
## 感想など
A 〜 D まで簡単な問題が多く、早解きできただけという感じなので、パフォーマンスはそこそこ良かったものの不完全燃焼感がちょっとあります。
まあ、こういうこともときおりありますね。
D が重み付き Union-Find だとすぐ気づけたとか、大域的にデータを用意した DFS / BFS の実装のテンプレートをもっていればあと5 〜 10分程度短縮できたかなと思うと
やや悔しいところではあります。
レートは 1084 となって、2連勝。その前の3連敗分を少し戻しましたがまだ Highest までは戻っていません。
次回も勝ちたいところ!