# ABC305 振り返り
- [京セラプログラミングコンテスト2023(AtCoder Beginner Contest 305) - AtCoder](https://atcoder.jp/contests/abc305)
- ABCD4完 ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc305)
- 前回 [[ABC304 振り返り]]
以下、キーワードリンクはローカルの内部リンクになっていて辿れません
----
## [A - Water Station](https://atcoder.jp/contests/abc305/tasks/abc305_a)
- 順序つき集合で二分探索して答えを求めました。オーバーキルです。
- `divMod 5` すれば良かったんだろうけど、A 問題開始時点ではいつも頭が真っ白で簡単な解法に頭がいかず...。
```haskell
{-# LANGUAGE TypeApplications #-}
import qualified Data.IntSet as IS
import Data.Maybe (fromJust)
main :: IO ()
main = do
n <- readLn @Int
let set = IS.fromList [0, 5 .. 100]
l = fromJust $ IS.lookupLE n set
r = fromJust $ IS.lookupGE n set
print $ if n - l < r - n then l else r
```
----
## [B - ABCDEFG](https://atcoder.jp/contests/abc305/tasks/abc305_b)
この時点でもまだ緊張が解けない。ぱっと見で累積和だなと思ったので、さっさとそれで解いてしまう。
累積和を作り、配列の索引を `[A .. G]` にして $L, R$ 区間で求めました。
```haskell
{-# LANGUAGE TypeApplications #-}
import Data.Array.Unboxed (UArray, listArray, (!))
main :: IO ()
main = do
[p, q] <- map head . words <
gt; getLine
let s = listArray @UArray ('A', 'G') $ scanl (+) (0 :: Int) [3, 1, 4, 1, 5, 9]
(l, r) = if p < q then (p, q) else (q, p)
print $ s ! r - s ! l
```
----
## [C - Snuke the Cookie Picker](https://atcoder.jp/contests/abc305/tasks/abc305_c)
少し緊張がほぐれてきた頃間ですが、相変わらず心拍数が高く呼吸がうまくできておらず窒息しそうだったので深呼吸しました。
色々な解き方がありそうですが、自分は目的の矩形の周辺の余白を全部取り除いた矩形、これが目的の矩形になるだろうと考えました。
例えば以下だと
```
5 6
......
..#.#.
..###.
..###.
......
```
を
```
#.#
###
###
```
こうして考えたい。座標圧縮が頭をよぎりましたが、空間が小さいので、そんな難しいことは必要ありません。前回といい、我ながら座標圧縮したがりなのは何なんでしょうか。
- まずは行単位で上から検索して `#` を一つでも含む行に最初に当たるのは左から 2 行目
- 行を下から検索して `#` を一つでも含む行にあたるのは上から 4 行目
- 列を左から検索して `#` を一つでも含む列にあたるのは左から 3列目
- 列を右から検索して `#` を一つでも含む列にあたるのは左から 5列目
これで $(2, 3)$ と $(4, 5)$ という矩形の左上、右下の座標が求められるのでそれを抜き出して全探索し `.` のマスを求める。
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (replicateM)
import Data.Array.Unboxed (UArray, listArray, (!))
import Data.Ix (Ix (range))
import Data.List (findIndex, transpose)
import Data.Maybe (fromJust)
main :: IO ()
main = do
[h, w] <- map (read @Int) . words <gt; getLine
ss <- replicateM h getLine
let ss' = transpose ss
let h1 = (+ 1) $ fromJust $ findIndex (elem '#') ss
h2 = fromJust $ findIndex (elem '#') (reverse ss)
w1 = (+ 1) $ fromJust $ findIndex (elem '#') ss'
w2 = fromJust $ findIndex (elem '#') (reverse ss')
let grid = listArray @UArray ((1, 1), (h, w)) $ concat ss
[((a, b), _)] = filter (\(_, c) -> c == '.') $ map (\x -> (x, grid ! x)) $ range ((h1, w1), (h - h2, w - w2))
putStrLn . unwords . map show $ [a, b]
```
## 追記
実装がごちゃついてたのでリファクタリングしました。
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (replicateM)
import Data.Array.Unboxed (UArray, listArray, (!))
import Data.Ix (Ix (range))
import Data.List (find, findIndex, transpose)
import Data.Maybe (fromJust)
main :: IO ()
main = do
[h, w] <- map (read @Int) . words <gt; getLine
ss <- replicateM h getLine
let (start, end) = fromJust $ do
let ss' = transpose ss
ix = findIndex (elem '#')
h1 <- (+ 1) <gt; ix ss
h2 <- ix (reverse ss)
w1 <- (+ 1) <gt; ix ss'
w2 <- ix (reverse ss')
return ((h1, w1), (h - h2, w - w2))
let grid = listArray @UArray ((1, 1), (h, w)) $ concat ss
(a, b) = fromJust . find (\x -> grid ! x == '.') $ range (start, end)
putStrLn . unwords . map show $ [a, b]
```
----
## [D - Sleep Log](https://atcoder.jp/contests/abc305/tasks/abc305_d)
今回の山場。累積和と二分探索。
いつもなら C 問題を解いたあたりで緊張は解けるところですが、前回 D 問題でずっこけたこともあって、D でもまだ緊張が解けません。
終始ドギマギしながら実装してました。特に D が「そろそろ解けそう」となってくると目の前がギュイーン (コードギアスのルルーシュの目みたいな感じ) となってきて、わけがわからなくなります。脳内からヤバイ物質が分泌されてる気がします。
もとい、与えられた数列の $A$ は単調増加列だし、クエリは $L, R$ 区間。クエリ一つに対して $O(N)$ で計算すると間に合わない計算量なので、クエリ一つあたり計算量を $O(\log N)$ か $O(1)$ にする必要がある... このあたりで累積和と二分探索であることはおおよそ想像がつきました。
この問題がややこしいのはアルゴリズムの選択ではなく、境界領域をバグらせずに実装できるか、という点。二分探索はとにかく境界線をバグらせやすいので、その沼に落ちないように丁寧に実装していく必要があります。この問題の場合、$L, R$ 区間によって累積和区間を左からと右から押さえていってできた内側区間の区間長を求めれば良いのですが、高橋くんが寝たり起きたりしているので、その区間のうち区間が奇数で始まる区間は区間長に含めない、という細かいことを考える必要がある。
少し考えてみたもののそれをエレガントにシュッと解けるようなアルゴリズムは思いつかないので、ノートに絵を描いて、境界領域を司っている各数字がそれぞれどの変数に当たるのかを明確にして、式を立てて実装しました。こういうのを、ばばばーっとノートとか使わずに正確に実装できるようになるには、1日1万回感謝の二分探索実装を毎日欠かさず3年くらい続ける必要があると言われています。
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (forM_, replicateM)
import Data.Array.Unboxed (UArray, listArray, (!))
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (unfoldr)
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 :: Integral a => (a, a) -> (a -> Bool) -> (a, a)
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
solve n a s ql qr = do
let t = s ! (r + 1) - s ! l
let lx =
if even l
then ql - a ! l
else 0
rx =
if even r
then a ! (r + 1) - qr
else 0
((l, r), t - lx - rx)
where
(l, _) = bisect (0, n + 1) (\x -> a ! x > ql)
(r, _) = bisect (0, n + 1) (\x -> a ! x >= qr)
main :: IO ()
main = do
n <- readLn @Int
as <- getInts
q <- readLn @Int
qs <- replicateM q getTuple
let as' = zip [1 ..] as
let ds = zipWith (\(i, l) (_, r) -> if odd i then 0 else r - l) as' (tail as')
a = listArray @UArray (1, n) as
s = listArray @UArray (1, n) $ scanl (+) 0 ds
forM_ qs $ \(l, r) -> do
print $ snd $ solve n a s l r
```
----
## [E - Art Gallery on Graph](https://atcoder.jp/contests/abc305/tasks/abc305_e) (コンテスト後に upsolve)
D 問題を解いたところで 22:15 だったので残り 20分以上あるし、行けるかなーと思ったけどだめでした。
多始点開始BFSで、開始時の HP を減らしながら BFS していき... とやったら解けるかなと思いましたがそれを思いついた時点で残り10分を切っていて、時間オーバー。そもそもそれで解けたかどうかも怪しい。
優先度付きキューを使った探索アルゴリズムで、隣接頂点に対して、HP を減らしながら移動していく...というアルゴリズムのようです。
全頂点の中から貪欲に、その時点で最も大きなプライオリティ (残りHP) をもつ頂点を選択して隣接頂点を緩和していく...というところがダイクストラ法によく似ています。
Twitter で「ダイクストラ法」という単語は耳にしていましたが、いわゆる単一始点重みつきグラフの最短経路を求めるダイクストラ法そのものではなく、抽象的に考えると「全頂点の中から優先度の高いものから順に探索していく」という探索 ... DFS でもBFS でもなく勝手に命名 PFS (Priority First Search) 。水色に近くなってくると PFS を使う問題がときどき出そうな気がするので、もう少し汎用的なライブラリにしておきたいところです。
```haskell
{-# LANGUAGE BangPatterns #-}
import Control.Monad (replicateM, when)
import Data.Array.IArray (Array, accumArray, (!))
import Data.Array.ST (newArray, readArray, runSTUArray, writeArray)
import Data.Array.Unboxed (UArray, assocs)
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.Foldable (foldlM)
import qualified Data.Heap as Heap
import Data.Ix (Ix)
import Data.List (unfoldr)
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)
graph2 :: Ix i => (i, i) -> [(i, i)] -> Array i [i]
graph2 (s, e) uvs = accumArray (flip (:)) [] (s, e) uvs'
where
!uvs' = concatMap (\(u, v) -> [(u, v), (v, u)]) uvs
-- Priority First Search
pfs :: Ix a => (a, a) -> (a -> [a]) -> Heap.Heap (Int, a) -> UArray a Int
pfs (s, e) edges queue0 = runSTUArray $ do
!dist <- newArray (s, e) (-1)
relax (Heap.uncons queue0) dist
return dist
where
relax Nothing _ = return ()
relax (Just ((d, v), queue)) dist = do
let dv = negate d
writeArray dist v dv
!queue' <-
foldlM
( \q u -> do
-- 隣接頂点に距離を配る
du <- readArray dist u
when (du < dv - 1) $
writeArray dist u (dv - 1)
return $
if du < dv - 1
then Heap.insert (negate (dv - 1), u) q
else q
)
queue
(edges v)
relax (Heap.uncons queue') dist
main :: IO ()
main = do
[n, m, k] <- getInts
uvs <- replicateM m getTuple
phs <- replicateM k getTuple
let !g = graph2 (1, n) uvs
!queue = Heap.fromList $ map (\(v, d) -> (negate d, v)) phs
!dist = pfs (1, n) (g !) queue
!results = map fst $ filter (\(_, d) -> d /= -1) $ assocs dist
print $ length results
putStrLn . unwords . map show $ results
```
F のインタラクティブ問題も手をつけたものの、なんだか WA が取りきれないので今回はここまで。
----
## 感想・反省など
前回は3完で倒れてしまいましたが、今回は 4完できて一安心です。
しかし、A や B に時間をかけすぎているのでここをもう少しさっさと解くことができればレートがもう少し上がりそうです。でも速解きを意識するとより一層緊張してかえって正確性を欠きそうなので、一旦欲張らずにこのペースでやっていこうと思います。
前回の反省として、C 問題以降で「猪突猛進的に思いついた解法を、それ以外の解法と比較することなく適用してしまう」という行動に出ると危ういということを学んだので今回は C, D あたりでは、一度立ち止まって Yet Another な選択肢を考えることができたのは良かったです。
また、繰り返しになりますが焦りは禁物。本番中でも焦らずノートに丁寧に絵を書いて思考を整理したことで、D 問題を WA せずに解けたのは良かったと思います。
ここ二週間ぐらいは、ひたすら ABC の茶問題を解くというのをやっていました。また数日前にタイマーを購入して、自分に時間的なプレッシャーを与えながら問題を解くようにしました。自分が苦手としていることは何なのか、というのを明確にしてその練習になるような問題を解く... ということを意識してのことです。この辺りが功を奏して、二分探索問題で左から押さえて右から押さえて、というときの境界を丁寧に考える、というような思考の筋力が少し発達していたのも良く作用したような気がします。
なお、 ABC の茶問題は全て解き終えました。まだ ARC や AGC の問題が少し残っていますが、茶問題なら Difficulty 800 近くても高い精度で解けるようになりました。一方、ここ2, 3回の自分のコンテストでの実績を見ると、緑色の問題が解けてません。というわけで、そろそろ茶色を切り上げ緑問題を解く訓練が必要なフェーズに入った感がありますので、そのステップに移ろうかと思います。
ちなみに色が茶色になりました。嬉しくないわけではないのですが「ワタシ Haskell チョットカケマス」と言えるのは、緑ぐらいからかなと勝手に思ってるので、色変記事は緑に到達するまでおあずけです。