# ABC394 振り返り
- [鹿島建設プログラミングコンテスト2025（AtCoder Beginner Contest 394） - AtCoder](https://atcoder.jp/contests/abc394)
- ABCDE 5完 (1392) ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc394)
![[スクリーンショット 2025-02-23 8.53.22.png]]
ABC394 でした。E を解いて 5完、パフォーマンス 1392 でレートは 1210 に到達し入水しました!
嬉しいです!!
- A (灰, 12) ··· フィルタで `2` だけ残す
- B (灰, 30) ··· 文字列の長さでソートして連結して出力
- C (灰, 161) ··· `W...WA` は `AC...C` に写像できる。連長圧縮して `W -> A` のときだけ特別扱いし `A ... C` に伸張する
- D (灰, 253) ··· 3種類ある括弧の対応が取れているか。スタックでやる
- E (水, 1403) ··· 回文の中心から左右にどれだけ伸ばしていけるか。左を $u$ で右を $v$ として $(u, v)$ の二次元で状態を表現し、BFS
- F (水, 1549, WA) ··· 木DP でどうにかするらしい。解けていない
## [A - 22222](https://atcoder.jp/contests/abc394/tasks/abc394_a)
`2` 以外の数を取り除くので `2` だけを残して出力
`2`の数を数えて `replicate` でもよかったですね
```haskell
main :: IO ()
main = do
s <- getLine
putStrLn [c | c <- s, c == '2']
```
## [B - cat](https://atcoder.jp/contests/abc394/tasks/abc394_b)
問題文の通りにやる。長さの昇順でソートして結合する
```haskell
main :: IO ()
main = do
n <- getInt
ss <- replicateM n getLine
let ss' = concatMap snd $ sortOn fst [(length s, s) | s <- ss]
putStrLn ss'
```
## [C - Debug](https://atcoder.jp/contests/abc394/tasks/abc394_c)
スタックを使って `WA` があったら `AC` に... というのを再帰的にやろうと試みましたが沼り始めたので、改めて考察。
よく考えると `WWWA -> WWAC -> WACC -> ACCC` のように再帰的に `AC` になっていくものは、中間の置換を考慮しなくても `WWWA -> ACCC` と `W` の数を数えて写像できることに気がつきます。
本番では `W` が出たらその数を累積していって `A`が出てきたら `A ... C` に置換、`A` 以外が出てきたら `W` を戻すみたいなやり方でやりました。
が、以下のように連長圧縮で一つ前は何だったかをみていくのが楽ですね。
```haskell
main :: IO ()
main = do
s <- getLine
let ((cl, k), s') = mapAccumL f ('*', 0) $ rle s
where
f ('W', i) ('A', j) = (('A', j - 1), 'A' : replicate i 'C')
f (c, i) next = (next, replicate i c)
putStrLn $ concat s' ++ replicate k cl
```
## [D - Colorful Bracket Sequence](https://atcoder.jp/contests/abc394/tasks/abc394_d)
こちらはむしろスタックを使うと簡単です。
3種類の括弧が与えられる、括弧の対応が取れているか? という問題です。
スタックに括弧を積んでいき、閉じ括弧が出たときスタックの先頭をみて対応する括弧種だったらその括弧を取り除く。
これを繰り返して $S$ を末尾までみたときスタックが空になっていれば、括弧の対応が取れています。
```haskell
main :: IO ()
main = do
s <- getLine
let res = foldl' f [] s
where
f ('(' : xs) ')' = xs
f ('<' : xs) '>' = xs
f ('[' : xs) ']' = xs
f xs c = c : xs
printYn $ null res
```
## [E - Palindromic Shortest Path](https://atcoder.jp/contests/abc394/tasks/abc394_e)
今回の山場です。
完全グラフですが、$N \leq 100$ なので $O(N^3)$ 程度かかっても構わない、というのがわかります。
BFS や DFS あるいはワーシャルフロイドのようなアルゴリズムが使える可能性を示唆しています。
グラフアルゴリズムを使うということは、頂点の状態遷移が肝です。そのコンテキストをもって、回文の性質をすこし考えてみます。
`abcdcba`
という回文は、まず中心の `d` があって、そこから左右に遷移が伸びていく、と考えることができそう。
```
c <- d -> c
```
から
```
b <- c <- d -> c -> b
```
というように。
このとき、左側の `<-` の遷移先と右側の `->` の遷移先の文字が同じであれば回文としての遷移が可能ですが、もしその二文字が異なる場合は、状態遷移がそこで途切れます。左、右と二方向に同時に遷移を考える必要がありはするものの、要するに「**中心から左右どこまで距離を伸ばせるか**」という問題です。
二方向を同時に考える状態遷移といえば、二次元の BFS です。
状態空間を二次元の $(u, v)$ で表現し、$u$ が先の左側の頂点 (回文の先頭)、$v$ が右側の頂点 (回文の末尾) と考えます。
この $(u, v)$ から遷移可能な $(x, y)$ はどこか? という状態遷移 $f (u, v)$ を考えることで BFS で問題が解けそう。
この問題のグラフは完全グラフなので、$u → x$ の遷移の候補は $1 \ldots N$ の全部
同様に $v → y$ の候補も $1 \ldots N$ の全部です。
それを総当たり的に確かめて、遷移先の文字が同じ $(x, y)$ のペアに対して、状態は遷移できます。
このとき $u → x$ は実際は末尾から先頭へ向かう逆向きの遷移なのでグラフでは $u ← x$ の辺を辿るとよいです。
これで BFS の状態遷移は構築できます。あとは初期状態ですが、回文の初期状態には中心が空文字の場合と、任意のアルファベット一文字の場合があります。空文字は $(u, v)$ の $u = v$ の状態と考えることができます。アルファベット一文字は $u \ne v$ かつ $(u, v)$ の辺の文字が `-` ではないケースです。
これらを統合して、既存の BFS のフレームワーク実装に落とし込みます。
我ながら自分の BFS の盆栽はよくできていて、初期状態と状態遷移 $f$ だけを考えればよいようになっていて、思考の整理も助けてくれます。
なお、答える必要があるのは回文の文字数で、状態遷移1回ごとに文字としては2文字伸びることになるため BFS で通常は距離が $+1$ されるところを $+2$ するように、カスタムしました。
余談ですが、二つの頂点を同時に考えて BFS する、という問題がときどきありますが、これを考えるときいつもバイナリィランドというゲームを思い出します。
```haskell
main :: IO ()
main = do
n <- getInt
g <- getCharGrid ((1, 1), (n, n))
let dist = bfs f (-1) ((1, 1), (n, n)) $ [((v, v), 0) | v <- [1 .. n]] ++ [((i, j), 1) | ((i, j), c) <- assocs g, c /= '-', i /= j]
where
f (u, v) =
[ (x, y)
| x <- [1 .. n],
g ! (x, u) /= '-',
y <- [1 .. n],
g ! (x, u) == g ! (v, y)
]
printIntGrid dist
bfs :: (Ix v) => (v -> [v]) -> Int -> (v, v) -> [(v, Int)] -> UArray v Int
bfs nextStates initial b v0s = runSTUArray $ do
dist <- newArray b initial
for_ v0s $ \(v0, d0) -> do
writeArray dist v0 d0
aux (Seq.fromList [v0 | (v0, _) <- v0s]) dist
return dist
where
aux Empty _ = return ()
aux (v :<| queue) dist = do
d <- readArray dist v
us <- filterM (fmap (== initial) . readArray dist) (nextStates v)
queue' <- foldForM queue us $ \q u -> do
writeArray dist u (d + 2)
return $ q |> u
aux queue' dist
```
## [F - Alkane](https://atcoder.jp/contests/abc394/tasks/abc394_f) (WA)
木 DP で解けるようですが、まだ upsolve できていません。WA が取れない...
## 感想など
目標にしていた水色コーダーになりました。
初めてコンテストに出た ABC300 から2年弱掛かりました。
初回の ABC300 は A 問題 1問しか解けなかったことを思い出すと、感慨深いです。
敢えて Haskell を使ってここまでやってきました。当初は大リーグ養成ギプスをしながら戦っているような感覚があったものの、ここ最近は Haskell の利点を活かした実装や考察ができるようにり、むしろライブラリを整備して戦うタイプの自分にとって、Haskell がこそベストな選択であると思えるようになりました。
反復練習を繰り返し「こういうことがやりたい」と思ったことを、認知エネルギーを使わず瞬時に記述・考察できるようにする。
そうして余った認知エネルギーを、未知の問題の分析や、慣れない実装に割り当てる。
こういう方針で自分の脳を最適化していくのが正しいはずと思い、その方針にあった練習を続けていましたが、結果それが功を奏したように思いました。
自分は決して天才ではないという自覚があります。一方、正しく地道に努力をすれば、ある一定の領域までは自分でも到達できるんだということがわかって良かったです。
![[スクリーンショット 2025-02-23 12.01.59.png]]
より詳しい入水記事はまた別途、投稿したいと思います。