# ABC304 振り返り
- [東京海上日動プログラミングコンテスト2023（AtCoder Beginner Contest 304） - AtCoder](https://atcoder.jp/contests/abc304)
- ABC3完 (Rated で参加したが Unrated 回に。成績表は現時点でまだ発行されておらず)
- 前回 [[ABC303 振り返り]]
以下、キーワードリンクはローカルの内部リンクになっていて辿れません
----
## [A - First Player](https://atcoder.jp/contests/abc304/tasks/abc304_a)
A にしてはやや面倒だったかな?
- リストを倍化して円環にする。こういうループものは円環にする、というのをよくやります
- 目的の要素を探して、そこが先頭になるように `drop` して、$N$ 件 `take` する
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (replicateM)
import Data.List (elemIndex)
import Data.List.Extra (minimumOn)
import Data.Maybe (fromJust)
main :: IO ()
main = do
n <- readLn @Int
xs <- replicateM n $ do
[s, a] <- words <
gt; getLine
return (s, read @Int a)
let e = minimumOn snd xs
i = fromJust $ elemIndex e xs
let vs = map fst $ take n $ drop i $ xs ++ xs
mapM_ putStrLn vs
```
----
## [B - Subscribers](https://atcoder.jp/contests/abc304/tasks/abc304_b)
ひたすら条件分岐。時々こういう問題が出ますね
あまりにも愚直に書けばいいだけだと、なんか落とし穴があるんじゃないかと心配になってしまいます。
というわけで haddock も書いて、慎重に... 結果、落とし穴などなかった
```haskell
{-# LANGUAGE TypeApplications #-}
-- >>> f 0
-- 0
-- >>> f 304
-- 304
-- >>> f 500600
-- 500000
-- >>> f 20230603
-- 20200000
f :: Int -> Int
f n
| n < 10 ^ 3 = n
| n < 10 ^ 4 = n `div` 10 * 10
| n < 10 ^ 5 = n `div` 100 * 100
| n < 10 ^ 6 = n `div` 1000 * 1000
| n < 10 ^ 7 = n `div` 10000 * 10000
| n < 10 ^ 8 = n `div` 100000 * 100000
| n < 10 ^ 9 = n `div` 1000000 * 1000000
main :: IO ()
main = do
n <- readLn @Int
print $ f n
```
----
## [C - Virus](https://atcoder.jp/contests/abc304/tasks/abc304_c)
### コンテストで提出した回答
ウィルスに感染した人が、その人から距離 $D$ にいる人にウィルスを伝染させてしまう。つまり再帰的に距離 $D$ の人にウィルスが感染るという問題。「Diablo 3 の Locust Swarm か」とどうでもいいことを考えてしまいました。
結果的には見てのとおり再帰で書きました。実質的に DFS になっているはず。
感染した人を Set に入れつつ、新たに見つかった感染者のリストそれぞれに再帰的に関数を呼び出して、Set に感染者を集めていった。
···と書くとカッコ良さげですが、複数のコンテキストありの再帰で、ハイパー混乱して焦りまくりました。**本番中に再帰を書くのは最後の手段にすべき**。10分ぐらいで解くつもりが30分以上かかってしまった... なんとか WA なしで AC できたものの、submit した時は神にも祈るような気持ちでした。そして送信したところジャッジサーバーが不調になり始めた頃合いで、ジャッジが進まない! 自意識過剰な私は「あれ、俺の再帰でシステム壊しちゃったかな?」とか思ってしまいました。そんなわけないだろう
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (forM_, replicateM)
import Data.List (foldl', partition)
import qualified Data.Set as Set
getTuple :: IO (Int, Int)
getTuple = do
[a, b] <- map (read @Int) . words <gt; getLine
return (a, b)
distance :: (Int, Int) -> (Int, Int) -> Double
distance (x1, y1) (x2, y2) = sqrt . fromIntegral $ (x1 - x2) ^ (2 :: Int) + (y1 - y2) ^ (2 :: Int)
f _ (set, [], _) = set
f d (set, (x : xs), ys) = do
let (set', as, bs) = g set x ys
f d (set', xs ++ as, bs)
where
g s x xs = do
let (as, bs) = partition (\y -> distance x y <= fromIntegral d) xs
let s' = foldl' (flip Set.insert) s as
(s', as, bs)
main :: IO ()
main = do
[n, d] <- map (read @Int) . words <gt; getLine
xys <- replicateM n getTuple
-- let (xs, ys) = partition (\y -> distance (head xys) y <= fromIntegral d) (tail xys)
let h = head xys
set = Set.singleton h
let diseased = f d (set, [h], tail xys)
forM_ xys $ \xy -> do
putStrLn $ if Set.member xy diseased then "Yes" else "No"
```
### コンテスト後の回答
Twitter を見ていたところグラフの問題と捉えて Union-Find や BFS を使ったと言ってる人が多かったので、私も BFS で実装し直してみました。**結果、めちゃくちゃシンプルになった。あの認知負荷は何だったんだ。**
再帰でやったのは完全に方針を誤った感があります。
確かに言われてみれば、ウィルスが周囲の人にどんどん広がっていく様子は幅優先探索そのものですね。
静的なグリッドや隣接リストに対する BFS の実装はよくありますが、遷移のたびに全頂点 (目の前だけでなく、状態空間全域) を対象にして次の遷移先を探す、という BFS はあまり経験がなくそういう発想に至らず。
以降、BFS は隣接リストやグリッドに対して行うもの、という思い込みをなくしていきたい。
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (filterM, forM_, replicateM)
import Data.Array.ST (MArray (newArray), readArray, runSTUArray, writeArray)
import Data.Array.Unboxed (UArray, (!))
import Data.Ix (Ix)
import Data.List (foldl')
import Data.Sequence (Seq (Empty, (:<|)), (|>))
import qualified Data.Sequence as Seq
getTuple :: IO (Int, Int)
getTuple = do
[a, b] <- map (read @Int) . words <gt; getLine
return (a, b)
bfs :: Ix a => (a, a) -> (a -> [a]) -> [a] -> UArray a Int
bfs (s, e) edges v0s = runSTUArray $ do
dist <- newArray (s, e) (-1) -- -1 は未訪問
forM_ v0s $ \v0 -> do
writeArray dist v0 0
bfs_aux (Seq.fromList v0s) dist
return dist
where
bfs_aux Empty _ = return ()
bfs_aux (v :<| q) dist = do
us <- filterM (fmap (== -1) . readArray dist) (edges v)
d <- succ <gt; readArray dist v
forM_ us $ \u -> do
writeArray dist u d
bfs_aux (foldl' (|>) q us) dist
distance :: (Int, Int) -> (Int, Int) -> Double
distance (x1, y1) (x2, y2) = sqrt . fromIntegral $ (x1 - x2) ^ (2 :: Int) + (y1 - y2) ^ (2 :: Int)
f :: Int -> [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
f d us v = filter (\u -> distance v u <= fromIntegral d) us
main :: IO ()
main = do
[n, d] <- map (read @Int) . words <gt; getLine
xys <- replicateM n getTuple
let dist = bfs ((-1000, -1000), (1000, 1000)) (f d xys) [head xys]
forM_ xys $ \v -> do
putStrLn $ if dist ! v /= (-1) then "Yes" else "No"
```
### (追記) Union-Find
Union-Find でも解けるということなので、実装した。
全頂点の組み合わせを作ってお互いの距離が、距離 $D$ にあるものを Union-Find で統合していくと互いに距離 $D$ にある頂点を一つの素集合に統合できる。
確かに言われてみれば...。Union-Find は普段は、明示的に辺が与えられて「この頂点とこの頂点は同じグループですよ」というところから出発する問題が多いが、この問題のように距離関数を定義して、距離関数の結果により頂点同士を同じグループとするという使い方ができる。勉強になる。
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (foldM_, forM_, replicateM, when)
import Data.Array.IArray (Array, elems, listArray)
import Data.Array.IO (IOUArray, freeze, getAssocs)
import Data.Array.MArray (readArray, writeArray)
import Data.Array.ST (MArray (newArray))
import Data.Array.Unboxed (UArray)
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.Ix (index)
import Data.List (tails, unfoldr)
import qualified Data.Map.Strict as Map
data UnionFind
= UnionFind
(IOUArray Int Int) -- 親頂点 / -1 は代表元
(IOUArray Int Int) -- 集合サイズ
newUF :: (Int, Int) -> IO UnionFind
newUF (s, e) =
UnionFind
<gt; newArray (s, e) (-1)
<*> newArray (s, e) 1
root :: UnionFind -> Int -> IO Int
root uf@(UnionFind parent _) x = do
p <- readArray parent x
if p == (-1)
then return x
else do
p' <- root uf p
writeArray parent x p'
return p'
unite :: UnionFind -> Int -> Int -> IO ()
unite uf@(UnionFind parent size) x y = do
x' <- root uf x
y' <- root uf y
when (x' /= y') $ do
sizeX <- readArray size x'
sizeY <- readArray size y'
if sizeX > sizeY
then do
writeArray parent y' x'
writeArray size x' (sizeX + sizeY)
else do
writeArray parent x' y'
writeArray size y' (sizeX + sizeY)
isSame :: UnionFind -> Int -> Int -> IO Bool
isSame uf x y = (==) <gt; root uf x <*> root uf y
getInts :: IO [Int]
getInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <gt; BS.getLine
getTuple :: IO (Int, Int)
getTuple = do
[a, b] <- getInts
return (a, b)
distance :: (Int, Int) -> (Int, Int) -> Double
distance (x1, y1) (x2, y2) = sqrt . fromIntegral $ (x1 - x2) ^ (2 :: Int) + (y1 - y2) ^ (2 :: Int)
main :: IO ()
main = do
[n, d] <- map (read @Int) . words <gt; getLine
us <- replicateM n getTuple
-- 各頂点をナンバリング
let ix = Map.fromList $ zip us [1 ..]
uf <- newUF (1, n)
forM_ [(u, v) | u : vs <- tails us, v <- vs] $ \(u, v) -> do
when (distance u v <= fromIntegral d) $
unite uf (ix Map.! u) (ix Map.! v)
forM_ us $ \u -> do
same <- isSame uf (ix Map.! head us) (ix Map.! u)
putStrLn $ if same then "Yes" else "No"
```
----
## [D - A Piece of Cake](https://atcoder.jp/contests/abc304/tasks/abc304_d) (コンテスト後にAC)
C 問題の再帰で精魂使い果たしたのか、時間内に AC できず。コンテスト後に解きました。
コンテスト中は「無茶苦茶難しいな！」と思いましたが、冷静になってみれば案外簡単でした...
$x$ 軸のパーティションである数列 $A$ と、$y$ 軸パーティションである数列 $B$ とがありますが、任意の座標 $(x, y)$ の $x$ と $y$ を、それぞれ $A$ と $B$ に対して二分探索して、二分探索の境界がパーティションのどことどこの間に位置するかを求める。このとき、同じ区画に入る座標は、二分探索の境界位置は同じ場所に来るのだから、二分探索の結果は同じになる。
ので、$(x, y)$ の $A$ に対する二分探索の結果 $B$ に対する二分探索の結果をペアにし、それをキーに `Map` をバケットにすれば、`Map` のキーが特定の区画を指すことになり、そこに目的の苺の数が累積されていく。
二分探索すれば境界が同じになるというところまではわかったけど、`((Int, In), (Int, Int))` をキーにするという発想に至らず。ここでもやっぱり思い込みがあって `Map` のキーに `((Int, Int), (Int, Int))` みたいな値を入れるという感覚がなくて、せいぜいスカラーかペアぐらいだろうという思い込みっぽいものがあったような気がする。
なお本番中は二分探索でなかなか光明が見えなかったので、座標圧縮 + 二次元累積和か! ということを考えてしまいあらぬ方向に思考がいってしまいゲームオーバーでした。
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (replicateM)
import Data.Array.Unboxed (IArray (bounds), UArray, listArray, (!))
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (unfoldr)
import qualified Data.Map.Strict as Map
getInts :: IO [Int]
getInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <gt; BS.getLine
getTuple :: IO (Int, Int)
getTuple = do
[a, b] <- getInts
return (a, b)
bisect :: (Int, Int) -> (Int -> Bool) -> (Int, Int)
bisect (ng, ok) f
| abs (ok - ng) == 1 = (ng, ok)
| f m = bisect (ng, m) f
| otherwise = bisect (m, ok) f
where
m = (ok + ng) `div` 2
section :: UArray Int Int -> UArray Int Int -> (Int, Int) -> ((Int, Int), (Int, Int))
section as bs (x, y) = (x', y')
where
(_, a) = bounds as
(_, b) = bounds bs
x' = bisect (0, a + 1) (\i -> as ! i > x)
y' = bisect (0, b + 1) (\i -> bs ! i > y)
main :: IO ()
main = do
[w, h] <- getInts
n <- readLn @Int
ps <- replicateM n getTuple
a <- readLn @Int
as <- listArray @UArray (1, a) <gt; getInts
b <- readLn @Int
bs <- listArray @UArray (1, b) <gt; getInts
let s = Map.fromListWith (+) $ map (\p -> (section as bs p, 1 :: Int)) ps
ks = Map.elems s
let k1 = if (a + 1) * (b + 1) > Map.size s then 0 else minimum ks
k2 = maximum ks
putStrLn . unwords . map show $ [k1, k2]
```
----
## [E - Good Graph](https://atcoder.jp/contests/abc304/tasks/abc304_e) (コンテスト後にAC)
Union-Find 案件。問題文は何を言っているかというと、
- 最初に与えられたグラフは、いくつかの島 (連結成分) に分かれている
- クエリ $p_i q_i$ によって辺が加わると、分かれている島が結びつく場合がある。どことどこが結びつくか、あるいは結びつかないかは $p_i$ と $q_i$ の値による
- $x_i y_i$ は、$x_i$ が所属する島と、$y_i$ が所属する島は繋がってはいけない、ということを言っている
となる。この言い換えからも分かる通り、物事を頂点単位ではなく連結成分単位 (互いに素な集合単位) で考えると良い。Union-Find 的には代表元を使えばいい。グラフを Union-Find で作って、あとは頂点てを代表元に変換して突合していく。
- $x_i y_i$ を代表元に変換することで「繋がってはいけない連結成分のペア」が分かる。ので、これを `Set` に入れる
- $p_i q_i$ を代表元に変換することで、各クエリがどことどこの連結成分を繋げてしまうか、が分かる。これをさきの `Set` でチェックすれば、Yes or No 判定ができる
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (forM_, replicateM, when)
import Data.Array.IO (IOUArray)
import Data.Array.MArray (readArray, writeArray)
import Data.Array.ST (MArray (newArray))
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (unfoldr)
import qualified Data.Set as Set
data UnionFind
= UnionFind
(IOUArray Int Int) -- 親頂点 / -1 は代表元
(IOUArray Int Int) -- 集合サイズ
newUF :: (Int, Int) -> IO UnionFind
newUF (s, e) =
UnionFind
<gt; newArray (s, e) (-1)
<*> newArray (s, e) 1
root :: UnionFind -> Int -> IO Int
root uf@(UnionFind parent _) x = do
p <- readArray parent x
if p == (-1)
then return x
else do
p' <- root uf p
writeArray parent x p'
return p'
unite :: UnionFind -> Int -> Int -> IO ()
unite uf@(UnionFind parent size) x y = do
x' <- root uf x
y' <- root uf y
when (x' /= y') $ do
sizeX <- readArray size x'
sizeY <- readArray size y'
if sizeX > sizeY
then do
writeArray parent y' x'
writeArray size x' (sizeX + sizeY)
else do
writeArray parent x' y'
writeArray size y' (sizeX + sizeY)
getInts :: IO [Int]
getInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <gt; BS.getLine
getTuple :: IO (Int, Int)
getTuple = do
[a, b] <- getInts
return (a, b)
main :: IO ()
main = do
[n, m] <- getInts
uvs <- replicateM m getTuple
k <- readLn @Int
xys <- replicateM k getTuple
q <- readLn @Int
qs <- replicateM q getTuple
uf <- newUF (1, n)
forM_ uvs $ \(u, v) -> do
unite uf u v
roots <-
mapM
( \(x, y) -> do
rootX <- root uf x
rootY <- root uf y
return (rootX, rootY)
)
xys
let xx = Set.fromList $ map (\(rx, ry) -> if rx < ry then (rx, ry) else (ry, rx)) roots
forM_ qs $ \(p, q) -> do
rootP <- root uf p
rootQ <- root uf q
let rootPQ = if rootP < rootQ then (rootP, rootQ) else (rootQ, rootP)
putStrLn $ if Set.notMember rootPQ xx then "Yes" else "No"
```
F 以降は難しそうなので、一旦保留。
----
## 感想・反省など
4完、4完ときたので今回も4問は解きたかったが残念ながら3完でした。
3完ということで TL にいる強者の皆さんに比較するとだいぶ物足りない結果ですが、おそらくこの辺が現時点の私の実力なんでしょう。これが今の地力! と結果を素直に受け入れ、爽やかに次の成長に繋げていきたいところです。
というわけで「何が自分に足りないのか分析」です。
時間内に解けなかった D 問題や E 問題はいずれも知らないアルゴリズムが使われているわけではなく、またはまった C 問題も、BFS や Union-Find を使えばもっとシンプルに解ける問題でした。総じて、知識不足ではなく経験不足というか、こうきたらこう返す、という引き出しが十分でない。特に C と D でそれが顕著に出ました。
- C は再帰的な構造がわかったのはよしとして、そこから一足飛びに再帰関数を書くという選択をしてしまったのがよくなかった。AC はできたものの、本番中にコンテキスト付きの再帰を書くと頭がごちゃつくのはあらかじめわかっているので、一度立ち止まってもっとシンプルな回答がないか考えるべき。再帰を書き始めて混乱し始めるとますます正常な判断力が失われていくので、再帰の実装をやめて BFS にする、という発想はそこで完全に潰えてしまった感がありました。
- 途中も書いた通り、BFS はグリッドや隣接リストに使うもの、という思い込みがあった。これは今回の経験で一つ学びを得ました。
- D は二分探索の結果をキーにして辞書を作る、というのが戦略だったわけですが、二分探索の結果の `(ng, ok)` を辞書のキーにするという発想が、やはりどこかにメンタルブロック的なもの (二分探索の結果をそのまま辞書のキーにする、という行為に慣れていないが故) があって、そこに至らなかったなあと思います。こういう思い込みを捨てるには、今回のような経験を積んでいくことが大事かと思います。
最近は茶diff の過去問を中心に解いていて、そろそろ緑問題を中心にしていこうかなと思っていましたが、どうも新しいアルゴリズムの知識を増やすよりも基本的なアルゴリズムを慣れない角度から実装する、みたいな問題で経験値を上げていく方が今の自分には重要かもしれないと思い直しました。実践経験を増やした方が良さそうなので、バーチャルコンテストに参加するなど、少し工夫を始めてみようと思います。
ところで、Haskell 書いてるのに再帰でドツボにはまるとは、そのうち Haskell 神からしばかれそうな気がします。