# ABC348 振り返り - [トヨタ自動車プログラミングコンテスト2024#4(AtCoder Beginner Contest 348) - AtCoder](https://atcoder.jp/contests/abc348) - ABC 3完 (974) ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc348) ![[スクリーンショット 2024-04-07 16.13.15.png]] ![[スクリーンショット 2024-04-07 9.50.33.png]] ![[スクリーンショット 2024-04-07 9.52.10.png|300]] ABC348 でした。 D の BFS は方針、実装ともにあっていたのですが、途中に差し込んだデバッグ文によるパフォーマンス劣化が原因で TLE してしまい、AC を逃しました。 ![](https://twitter.com/naoya_ito/status/1776615219982164254) なんとも悔しい 😭 - A (灰) ··· mod 3 == 0 ごとに x を出力、ほかは o - B (灰) ··· 各頂点からのユークリッド距離を $O(N^2)$ で全探索 - C (灰) ··· 色ごとにまとめてそれぞれの最小をとって、その最大を残す - D (緑, upsolve) ··· 薬のあるマスに薬の値を置く。それ以外 $0$ にする。スタートから始めて遷移するたびエネルギー -1 の BFS でした。 D にかかりっきりになっていて E は手つかず。全方位木DP なにそれ? 状態です。 昨年 AtCoder の言語アップデートで Haskell は ghc-9.4.5 になったのですが、手元の環境は長らく ghc-8.4.5 のままでした。 重い腰をあげて ghc-9.4.5 にアップデートした際に、訳あって自作のデバッグ関数の仕様を変えたところ、そのオーバーヘッドが想定していたよりも大きく TLE の原因になってしまいました。むーん、高い授業料でした。 ## [A - Penalty Kick](https://atcoder.jp/contests/abc348/tasks/abc348_a) やるだけ問題。もっとかっこいい実装もありそうと思いつつ、さっさと AC ```haskell main :: IO () main = do n <- getInt putStrLn $ map (\i -> if i `mod` 3 == 0 then 'x' else 'o') [1 .. n] ``` ## [B - Farthest Point](https://atcoder.jp/contests/abc348/tasks/abc348_b) 距離の大小にしか関心がないので浮動小数点は使わず距離の二乗、整数のまま比較します ```haskell -- ユークリッド距離 (平方根にしない) -- >>> distance (0, 0) (1, 2) -- 3 eDistance :: (Num a) => (a, a) -> (a, a) -> a eDistance (x1, y1) (x2, y2) = (x1 - x2) ^ (2 :: Int) + (y1 - y2) ^ (2 :: Int) main :: IO () main = do n <- getInt vs <- replicateM n getTuple let res = [fst $ maximumOn snd [(i, eDistance v u) | (i, u) <- indexed 1 vs, v /= u] | v <- vs] for_ res print ``` ## [C - Colorful Beans](https://atcoder.jp/contests/abc348/tasks/abc348_c) 前回は C が難しかったですが、手の平を返したかのように簡単ですね。 色ごとに値をまとめあげてその最小を取って、最大にする。 こういう値ごとにリストにまとめる、というのはグラフの隣接リストと同じ構造です。 `imGraph` という関数で、IntMap ベースのグラフを構築できるようにしてあるのでそれを使いました。 IntMap は Foldable なので、直接 `maximum` で最大値を求めることができます。 こういう多相性が Haskell の好きなところです ```haskell main :: IO () main = do n <- getInt xs <- replicateM n getTuple let g = imGraph [(c, a) | (a, c) <- xs] print $ maximum $ IM.map minimum g ``` ## [D - Medicines on Grid](https://atcoder.jp/contests/abc348/tasks/abc348_d) 色々な解き方がありそうで、面白い問題です。 私は BFS の改造でやりました。 各辺の重みを $1$ ではなく $-1$ にする、つまり遷移するたび距離が減る BFS にします。 そして普段は距離と思っているものを、問題でいうところのエネルギーとみなします。 - 各マスのエネルギーの初期値は $0$ にする - 薬のあるマスには、$E_i$ の値を置いておく - BFS しながら薬をみつけた場合に、エネルギーを今より増やせるなら薬を使って $E_i$ にする - たとえ訪問済みのマスでも、エネルギーを今よりも増やせるなら訪問してその値に更新する - 遠回りしたところにエネルギー値が高い薬があるケースを考慮 - エネルギーが $0$ になったらそれ以上遷移しない この方針で BFS して、ゴール地点が訪問済みになるかどうかを調べる。 これで通ります。 解説にもあるとおり、この問題で薬を使うと「 $E_i$ になる」のであって $E_i$ が加わるわけではないです。 そして $E_i$ になったあと以降は、その値から再び、遷移のたび $-1$ されていきます。 よって、薬のあるマスはエネルギーの初期値が $E_i$ になっているだけ、とみなせばよい。 そして「より高いエネルギーに更新できる場合はそうする」という戦略は、薬のあるマスにはいったときも通常の遷移のときも同じように考えてよいです。 実装的には、距離を記録する配列とは別に訪問済み頂点も明示的に管理します。 普段の BFS では距離の配列の初期値を $-1$ にでもしておいて、値が $-1$ であるすなわち未訪問とみなしていますが、この問題では初期値を $0$ にしてて、かつ、一つのマスに複数回遷移することがあるので別途訪問済み頂点を管理するほうが楽だと考えました。 計算量がやや心配でしたが、実質的には薬の数 $N$ 回分 BFS しているのと同じでかつ必要のない経路は再計算されないからいけるはず... と踏みました。 高速化のため cojna さんの Data.Buffer を使っているのと、状態管理を高速に済ませるため MArray をつかうので全体として実装は手続き的になっています ```haskell bfs nextStates initial b xs v0s = do dist <- newArray @IOUArray b initial visited <- newArray @IOUArray b False queue <- newBufferAsQueue (300 * rangeSize b) for_ v0s $ \v0 -> do writeArray dist v0 0 writeArray visited v0 True pushBackBuf v0 queue for_ xs $ \(v, e) -> do writeArray dist v e aux queue dist visited return (dist, visited) where aux queue dist visited = do !entry <- popFrontBuf queue case entry of Nothing -> return () Just v -> do d <- readArray dist v if d == 0 then aux queue dist visited else do us <- filterM ( \u -> do vstd <- readArray visited u du <- readArray dist u return $ not vstd || d - 1 > du -- 訪問済みでもよりよいエネルギー値に更新できるなら再度訪問 ) (nextStates v) for_ us $ \u -> do -- よりよいエネルギー値に更新できるならする / できないときは -1 x <- readArray dist u if x > d - 1 then writeArray dist u x else writeArray dist u (d - 1) writeArray visited u True pushBackBuf u queue aux queue dist visited main :: IO () main = do [h, w] <- getInts grid <- getCharGrid ((1, 1), (h, w)) n <- getInt items <- replicateM n $ do [r, c, e] <- getInts return ((r, c), e) let s = fromJust $ findArrayIndex (== 'S') grid t = fromJust $ findArrayIndex (== 'T') grid (_, visited) <- bfs (\v -> [u | u <- around v, reachable grid u]) 0 (bounds grid) items [s] printYn =<< readArray visited t -- (h, w) 形式 lrud@[left, right, up, down] = [(0, -1), (0, 1), (-1, 0), (1, 0)] -- (x, y) 形式 -- lrud@[left, right, up, down] = [(-1, 0), (1, 0), (0, 1), (0, -1)] around :: (Int, Int) -> [(Int, Int)] around v = map (v +) lrud reachable :: (Ix v, IArray a Char) => a v Char -> v -> Bool reachable grid v | (not . inRange (bounds grid)) v = False | grid ! v == '#' = False | otherwise = True ``` ### デバッグ文で TLE 冒頭のとおり、デバッグ文の挿入が悪さをして、TLE してしまいました。 デバッグ関数を従前から変更した経緯はこの辺です。 ![](https://twitter.com/naoya_ito/status/1775843495766524221) もともと ghc-8.4.5 のときはデバッグ出力関数を、 toyboot さんから教えてもらって、以下のように CPP 拡張の ifdef で実装していました。 DEBUG フラグを落とすとコンパイル段階で、何もしない関数に差し換えられるので、パフォーマンスへの影響はありません。 ```haskell #ifdef DEBUG dbg :: Show a => a -> () dbg !x = let !_ = traceShow x () in () #else dbg :: Show a => a -> () dbg _ = () #endif ``` ところが ghc-9.4.5 にアップデートすると、CPP 拡張とエディタの Apply hint fix の挙動がうまく噛み合わず。 そこで CPP 拡張を使うのをやめて、以下の様に環境変数で制御するようにしました。 ```haskell dbg :: (Show a) => a -> () dbg x = unsafePerformIO $ do debugMode <- lookupEnv "DEBUG" return $ case debugMode of Just _ -> traceShow x () Nothing -> () ``` `lookupEnv` に多少のオーバーヘッドがあるようで、BFS の再帰の中にデバッグ文を置いたところ、TLE の原因になってしまいました。 事前に少しテストをしていて大丈夫と思っていたのですが、負荷が十分でなかったようです。 その後 excelspeedup さんが実験してくださり、結果、環境変数の取得をキャッシュするとオーバーヘッドが無視できることがわかりました。 ```haskell dbg :: (Show a) => a -> () dbg = case getDebugEnv of Just _ -> (`traceShow` ()) Nothing -> const () getDebugEnv :: Maybe String getDebugEnv = unsafePerformIO (lookupEnv "DEBUG") {-# NOINLINE getDebugEnv #-} ``` なお、このデバッグ関数は以下のように使います。 ```haskell -- 使用例 d <- readArray dist v -- 変数を出力したいところで即時評価する let !_ = dbg ("d", d) ``` 高い授業料でしたが ghc-8.4.5 に切り戻す必要がなかったのは良かったです。 ## 感想など C まで10分未満で解いてあとは D で延々と悩んで AC できず、今回も不完全燃焼に終わりました。 ただし不幸中の幸いか C までが速かったのでレーティングへの影響は軽微に抑えられました。 ADT Medium へのバーチャル参加を中心にしばらくやってきた結果、自分でも気づかないうちに序盤の問題の速解きができるようになったようです。 あとは D 問題や E 問題の詰めですね。 ここ数回、詰めの甘さで落としていることが多く、次の課題ポイントはそこな気がします。 緊張からくるパフォーマンス劣化は、コントロールできるようになってもう大丈夫だと思います。 今回もそれほど緊張することなく、取り組むことができました。 バチャでタイマーを切って精進し続けてるうちに、慣れてきたというのもあるかも知れません。 ---- # おまけの精進記録 今週精進した中で発見のあったことなど ## [C - Number Place](https://atcoder.jp/contests/abc327/tasks/abc327_c) どうってことない問題だが、9 x 9 マスを 3 x 3 の 9 区画に分けるところの実装をどうするか リストモナドを直積を作る計算だというメンタルモデルにだいぶ慣れてきて `i <- [1, 4, 7], j <- [1, 4, 7]` とすると `(1, 1), (1, 4), (1, 7) ...` と、各区画の左上マスの集合が得られる、というのを瞬時に判断できるようになった。 これを二重ループだと捉えていると、どうも頭のなかでループの動きを追い始めてしまって認知負荷が高まる 二つの集合を用意して直積をとる、と考えると静的な様子を思い浮かべることになりそれがない ```haskell main :: IO () main = do rows <- replicateM 9 getInts let grid = listArray @UArray ((1, 1), (9, 9)) $ concat rows let cond1 = all (\row -> length (nubOrd row) == 9) rows cond2 = all (\col -> length (nubOrd col) == 9) $ transpose rows cond3 = all (\cell -> length (nubOrd cell) == 9) [[grid ! v | v <- range ((i, j), (i + 2, j + 2))] | i <- [1, 4, 7], j <- [1, 4, 7]] printYn $ cond1 && cond2 && cond3 ``` ## [E - Revenge of "The Salary of AtCoder Inc."](https://atcoder.jp/contests/abc326/tasks/abc326_e) 期待値DP どうも期待値DP は計算の開始点をどこにするかをよく間違えてしまう。 この問題の場合 $dp(N)$ から後ろに計算していく... $dp(i)$ を「**$x = i$ のときに以降サイコロを振ることでもらえる金額の期待値**」とすると、 $N$ 地点ではもうサイコロが触れないので $dp(N) = 0$ となる。ここの考え方をいつも間違えてしまう。 ```haskell main :: IO () main = do n <- getInt as <- getInts let s = listArray @Array (1, n + 1) $ scanl' (+) 0 $ map IntMod as p = invIntMod (IntMod n) dp <- newBIT @IOArray (0, n) forM_ [n - 1, n - 2 .. 0] $ \i -> do let x = s ! (n + 1) - s ! (i + 1) y <- rangeSumBIT dp (i + 1) (n + 1) incrementBIT dp i $ (x + y) * p IntMod ans <- rangeSumBIT dp 0 1 print ans ``` ## [C - World Tour Finals](https://atcoder.jp/contests/abc323/tasks/abc323_c) これも大した問題ではないが、本番のとき実装で少し沼って時間がかかってしまった記憶がある。 事前に落ち着いて実装方針を設計するのと、リストモナドを積極的に使うことで沼らずにさっと実装できた。 ところで Data.List の sort は遅い。 そこで `sort'` `sortOn'` `sortBy'` という関数で、 Vector.Algorithms.Into のイントロソートをする関数を実装した。 インとローソートしたいときに `VU.modify VAI.sort ...` と書くの面倒なので。ただし安定ソートじゃないので気をつける必要あり。 ```haskell main :: IO () main = do [n, m] <- getInts as <- getInts ss <- replicateM n getLine let xs = [i + sum [a | (a, flag) <- zip as (map (== 'o') s), flag] | (i, s) <- indexed 1 ss] m = maximum xs xs' = [sortOn' Down [a | (a, flag) <- zip as (map (== 'o') s), not flag] | s <- ss] let res = zipWith f xs xs' where f x vs = takeWhile (< m) $ scanl' (+) x vs for_ (map length res) print ``` ## [C - Slot Strategy 2 (Easy)](https://atcoder.jp/contests/abc320/tasks/abc320_c) リスト内包表記の良さに魅せられている昨今、調子にのって Maybe なども内包表記で掛けるモナド内包表記拡張を使った。 が、ぱっと見リストと誤認してしまうので、厳しいかも。 ```haskell {-# LANGUAGE MonadComprehensions #-} resolve [a, b, c] x = [ t3 | t1 <- findIndexFrom 0 (== x) a, t2 <- findIndexFrom (t1 + 1) (== x) b, t3 <- findIndexFrom (t2 + 1) (== x) c ] resolve _ _ = error "invalid" main :: IO () main = do m <- getInt ss <- replicateM 3 getLine let [s1, s2, s3] = map (\s -> s ++ s ++ s) ss res = [ resolve ss' x | x <- ['0' .. '9'], ss' <- permutations [s1, s2, s3] ] print $ minimumWithDefault (-1) $ catMaybes res ``` ## [E - Sandwiches](https://atcoder.jp/contests/abc318/tasks/abc318_e) 三つ組みを考えるときは真ん中を考えるとよい、という典型があるが当時はいまいち理解できてなかった。 それを理解した。 間に挟まれた「真ん中の要素群の寄与数」を考えるのがポイント。 真ん中の要素から左にある要素、右にある要素それらが真ん中の寄与数にどう作用するか。 この問題の場合 ``` 2 x x 2 y y y 2 z z z z 2 ``` とあったときに x y z それぞれからみると、左に 2 が何個あって右に 2 が何個あるか? が関心事。 そして各 x y z の寄与数は (左にある2の個数) $\times$ (右にある2の個数) と、積の法則で計算できる。 ```haskell -- >>> resolve [1, 5, 6 ,8] -- 12 resolve xs = sum [l * x * r | (l, x) <- indexed 1 xs', let r = n - l] where n = length xs xs' = zipWith (\a b -> b - a - 1) xs (tail xs) -- 真ん中の値の個数 main :: IO () main = do n <- getInt as <- getInts let g = graph (1, n) $ zip as [1 :: Int ..] g' = amap (resolve . reverse) g print $ sum (elems g') ``` ## [D - Distinct Trio](https://atcoder.jp/contests/abc252/tasks/abc252_d) 同じくこの問題も三つ組みの真ん中を考えるとよい。 数列 $A$ から三つ値を選んだときに、全部が違う値になる組み数。 数列 $A$ はソートしても構わないのでソートする。 ``` 1 1 3 4 ``` すると、たとえば 3 からみると自分より小さい値が左に 2個あって、自分より大きい値が右に 1つある。 (自分より小さい値, 自分, 自分より大きい値) の3つ組みは問題の設定を言い換えたものと同じ。 というわけで、真ん中の数の寄与数 = 左にある自分より小さい数の個数 $\times$ 右にある自分より大きい数の個数 と計算できる。 個数を数え上げるのはソートされているので二分探索で OK ```haskell main :: IO () main = do n <- getInt as <- getInts let as' = listArray @UArray (1, n) $ sort' as res = [ left * right | a <- as, let left = boundLT a as' right = n - boundLE a as' ] print $ sum res ``` ところでこの問題のDP 解法も面白い。 素直に DP で、ナップザック問題的に「選ぶ・選ばない」でやって 3 つ選ぶ... とやっていくだけだと、3 つ選ぶ過程でダブりがないかどうかを調べるのに、選んだ数を記憶していく必要がでてくる。これだと状態空間が大きくなりすぎて、計算量的に間に合わない。 しかし、ここでバケットを作って考えてみる。すると系列の中にダブりの値がくることはなくなる。 てナップザック DP の過程で重複した値が二度と出現しないという前提が加わるので、過去に選択した値の次元をカットして、選んだ個数のみに着目して DP にすることができる 場合の数は、通常なら `(+) 0` の DP なので `acc` をそのまま状態遷移させることで足し込んでいくが、バケットをとっているので遷移時に出現回数 $k$ 倍つまり `k * acc` にして配ると良い。 ```haskell main :: IO () main = do _ <- getInt as <- getInts let bucket = toBucket (1, 2 * 10 ^ 5) as let dp = accumDP @UArray f (+) 0 (0, 3) [(0, 1)] (filter (> 0) $ elems bucket) where f (i, acc) k | acc == 0 = [] | otherwise = [(i + 1, k * acc)] print $ dp ! 3