# ABC309 振り返り
- [デンソークリエイトプログラミングコンテスト2023（AtCoder Beginner Contest 309） - AtCoder](https://atcoder.jp/contests/abc309)
- 成績 なし (私用のため参加せず)
- 前回 [[ABC308 振り返り]]
ABC309 は私用で不在だったので参加しませんでした。翌日に ABCDE まで解いたのでその記録です。今回は本戦の感想もないのであっさりです。
以下、キーワードリンクはローカルの内部リンクになっていて辿れません
----
## [A - Nine](https://atcoder.jp/contests/abc309/tasks/abc309_a)
$3 \times 3$ マスの隣のマスと連接しているか調べる。
最初、隣接条件が上下左右と誤解していて「A 問題の割に二次元配列書かせるとは、いつもより面倒だな?」と思って実装して WA を出しましたw よくみたら左右だった。隣接条件を左右に修正して、AC。
```haskell
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (unfoldr, find)
import Debug.Trace (traceShow)
import Data.Array.Unboxed
import Data.Maybe (fromJust)
around :: (Int, Int) -> [(Int, Int)]
around xy = map (xy `to`) [(0, 1), (0, -1)]
where
to :: (Int, Int) -> (Int, Int) -> (Int, Int)
to (x, y) (x', y') = (x + x', y + y')
solve grid a b = any (\x -> grid ! x == b) $ filter (inRange(bounds grid)) $ around (i, j)
where
(i, j) = fst . fromJust $ find (\(_, e) -> e == a) $ assocs grid
main :: IO ()
main = do
[a, b] <- getInts
let grid = listArray @UArray ((1, 1), (3, 3) :: (Int, Int)) [1 .. 9 :: Int]
putStrLn $ if solve grid a b then "Yes" else "No"
{-- Library --}
-- (snip.)
```
----
## [B - Rotate](https://atcoder.jp/contests/abc309/tasks/abc309_b)
おー、また二次元配列の実装問題ですね。最近多いですね。
しかし俺たち Haskeller には ixmap がある!!
最近、二次元配列問題が多かったので ixmap を使う練習をしてました。というわけで ixmap で時計回りになるよう元の配列へ写像して AC。美しい。
```haskell
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (unfoldr)
import Debug.Trace (traceShow)
import Control.Monad (replicateM, forM_)
import Data.Array.Unboxed (UArray, listArray, ixmap, IArray (bounds), elems)
import Data.List.Extra (chunksOf)
f _ (1, 1) = (2, 1)
f _ (1, j) = (1, j - 1)
f n (i, j)
| j == n = (i - 1, j)
| i == n = (i, j + 1)
| j == 1 = (i + 1, j)
| otherwise = (i, j)
main :: IO ()
main = do
n <- readLn @Int
as <- replicateM n getLine
let grid = listArray @UArray ((1,1), (n, n)) $ concat as
grid' = ixmap (bounds grid) (f n) grid
forM_ (chunksOf n $ elems grid') $ \row -> do
putStrLn row
{-- Library --}
-- (snip.)
```
----
## [C - Medicine](https://atcoder.jp/contests/abc309/tasks/abc309_c)
$N$ 種類の薬を毎日飲むが、薬ごとにいつまで飲まなければいけないか、期間が決まっている。
飲む薬の数が $K$ 以下に初めてなる日はいつか?
最初、また「いもす法」の出番かなと思ったのですがおくみると座標が $10^9$ ある。座標圧縮してやれば多分いもす法でもいけそうですが、C 問題で座標圧縮 + いもす法は出ないだろう、と思い、もっと簡単な方法があるのではないかと疑う。
区間問題は終端でソートする、という定石に従ってソートしてみると、貪欲法で解ける ... つまり薬を飲み終える期間が早く来るものから順に考えて、残りの飲む薬の数を計算していけば良い。区間スケジューリング問題の亜種ですね。
```haskell
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad (replicateM)
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (mapAccumL, sortOn, unfoldr)
import Debug.Trace (traceShow)
main :: IO ()
main = do
[n, k] <- getInts
xs <- replicateM n getTuple
let s = sum $ map snd xs
zs = mapAccumL (\acc (ai, bi) -> (acc - bi, (acc, ai))) s (sortOn fst xs)
print $ case takeWhile (\(si, _) -> si > k) $ snd zs of
[] -> 1
zs' -> succ . snd . last $ zs'
{-- Library --}
-- (snip.)
```
----
## [D - Add One Edge](https://atcoder.jp/contests/abc309/tasks/abc309_d)
二つの連結成分があり、また連結成分の頂点として $u$ と $v$ がある。辺を一つ足して二つの連結成分を一つにしたとき、$u$ から $v$ への距離が最も遠くなるような繋ぎ方を探す。
やや問題文がややこしかったですが、入力例 $1$ の図を見れば答えは一目瞭然で、$1$ から最も遠い頂点と、$N_1 + N_2$ から最も遠い頂点を辺で結べば良いだけ。よって $1$ と $N_1 + N_2$ からそれぞれ BFS して一番遠い点を探して距離を計算するのみ。
D にしては随分簡単なような?
```haskell
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
import Control.Monad (filterM, foldM, forM_, replicateM)
import Data.Array.IArray (Array, accumArray, (!))
import Data.Array.ST (MArray (newArray), readArray, runSTUArray, writeArray)
import Data.Array.Unboxed (UArray, elems)
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.Ix (Ix)
import Data.List (unfoldr)
import Data.Sequence (Seq (Empty, (:<|)), (|>))
import qualified Data.Sequence as Seq
import Debug.Trace (traceShow)
main :: IO ()
main = do
[n1, n2, m] <- getInts
uvs <- replicateM m getInts
let n = n1 + n2
let g = graph (1, n) uvs
dist1 = bfs (g !) (-1) (1, n) [1]
dist2 = bfs (g !) (-1) (1, n) [n]
d1 = maximum $ elems dist1
d2 = maximum $ elems dist2
print (d1 + d2 + 1)
{-- Library --}
graph :: (Int, Int) -> [[Int]] -> Array Int [Int]
graph (i, n) uvs = accumArray (flip (:)) [] (i, n) xs
where
xs = concatMap (\[u, v] -> [(u, v), (v, u)]) uvs
bfs :: Ix v => (v -> [v]) -> Int -> (v, v) -> [v] -> UArray v Int
bfs nextStates identity (s, e) v0s = runSTUArray $ do
dist <- newArray (s, e) identity
forM_ v0s $ \v0 -> do
writeArray dist v0 0
aux (Seq.fromList v0s) dist
return dist
where
aux Empty _ = return ()
aux (v :<| queue) dist = do
d <- readArray dist v
us <- filterM (fmap (== identity) . readArray dist) (nextStates v)
queue' <-
foldM
( \q u -> do
writeArray dist u (d + 1)
return $ q |> u
)
queue
us
aux queue' dist
-- (snip.)
```
----
## [E - Family and Insurance](https://atcoder.jp/contests/abc309/tasks/abc309_e)
本戦に出ていたら、今回は最初のちょっとした山場が B 問題で、次がこの E だったかな?
木構造のグラフがあって、それぞれの親頂点から、何代の子に渡って影響を与えられる (保険の補償に入ることができる) かがあらかじめわかっている。いずれかの親から影響を受ける頂点は何個? (どの親からも影響を受けられない頂点が何個あるか?)
editorial は DP だったが、これも BFS で解きました。
- まず、$x_i \space y_i$ を、各頂点の初期スコアであるとみなして頂点ごとに整理する。各頂点、$y_i$ が最大のものにしか興味がない
- スコアが割り当てられていない頂点のスコアは $-1$ にする
- その整理された初期スコアを各頂点に設定して、BFSする
- BFS で状態遷移にあたり、「親頂点のスコア $-1$ 」その子らが持つスコアを比較して最大スコアになる方を残す
こうすると、親から影響を与えることができなかった子のスコアは $-1$ になる。ので、スコアが $0$ 以上になっている頂点の数が問題の答えになる。
グラフのメンタルモデルで解いていますが、実質的には DP ですかね。最大スコアを残すところは、DP の緩和に相当すると思います。(木 DP ? 木 DP は一応は部分問題重複性と部分構造最適性が成立しているということで DP なんでしょうけど、あんまり DP を解いているという認識がなくグラフの探索問題と捉えている私でした)
```haskell
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
import Control.Monad (filterM, foldM, forM_, replicateM)
import Control.Monad.ST (ST, runST)
import Data.Array.IArray (Array, accumArray, (!))
import Data.Array.ST (MArray (newArray), STUArray, freeze, readArray, writeArray)
import Data.Array.Unboxed (UArray, elems)
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.Ix (Ix)
import Data.List (unfoldr)
import Data.Sequence (Seq (Empty, (:<|)), (|>))
import qualified Data.Sequence as Seq
import Debug.Trace (traceShow)
bfs :: (Int -> [Int]) -> Int -> (Int, Int) -> [Int] -> UArray Int Int -> (UArray Int Int, UArray Int Int)
bfs nextStates identity (s, e) v0s score0 = runST $ do
dist <- newArray (s, e) identity :: ST s (STUArray s Int Int)
score <- newArray (s, e) identity :: ST s (STUArray s Int Int)
forM_ v0s $ \v0 -> do
writeArray dist v0 0
forM_ [s .. e] $ \v -> do
writeArray score v (score0 ! v)
aux (Seq.fromList v0s) (dist, score)
dist' <- freeze dist
score' <- freeze score
return (dist', score')
where
aux Empty _ = return ()
aux (v :<| queue) (dist, score) = do
d <- readArray dist v
k <- readArray score v
us <- filterM (fmap (== identity) . readArray dist) (nextStates v)
queue' <-
foldM
( \q u -> do
writeArray dist u (d + 1)
updateWith max score u (k - 1)
return $ q |> u
)
queue
us
aux queue' (dist, score)
main :: IO ()
main = do
[n, m] <- getInts
ps <- getInts
xs <- replicateM m getTuple
let uvs = zip ps [2 ..]
g = graph (1, n) uvs
score0 = accumArray @UArray max (-1) (1, n) xs
(_, score) = bfs (g !) (-1) (1, n) [1] score0
print $ length . filter (>= 0) $ elems score
{-- Library --}
graph :: (Int, Int) -> [(Int, Int)] -> Array Int [Int]
graph (i, n) = accumArray (flip (:)) [] (i, n)
dbg :: Show a => a -> ()
dbg !x = let !_ = traceShow x () in ()
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)
{-# INLINE updateWith #-}
updateWith :: (MArray a e m, Ix i) => (e -> e -> e) -> a i e -> i -> e -> m ()
updateWith f arr ix x = do
v <- readArray arr ix
writeArray arr ix (f v x)
```
----
## 感想・反省など
旅行から帰る際の飛行機に乗る前、機内の時間を使って解きました。ABCDE 5問をスムーズに解けたのはよかったです。時間は正確には計測できていませんが、体感では 100分で5つ解けたかもしれないなーという感じでした。
本番でもこれぐらいの力が出せれば... と思いますが、本戦のあの緊張感があるとなしでは、やっぱり全く状況が違います。こうして ABCDE 5問解けるからと言って、本戦で時間内に 5つ解ける! とはならないのが AtCoder 。
それでは次回 ABC310 で会いましょう。
(なお ARC も出てみたいのですが、日曜夜にコンテストに出てしまうと仕事への影響が避けられなそうなので未だ様子を見ています。)