# ABC308 振り返り
- [CodeQUEEN 2023 予選 (AtCoder Beginner Contest 308) - AtCoder](https://atcoder.jp/contests/abc308)
- 成績 ABCD 4完 [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc308)
- 前回 [[ABC307 振り返り]]
以下、キーワードリンクはローカルの内部リンクになっていて辿れません
----
## [A - New Scheme](https://atcoder.jp/contests/abc308/tasks/abc308_a)
今日も夕方に有酸素運動をしたおかげか、慣れてきたのか、以前に比較すると緊張レベルが少し下がっていて落ち着いて取り組めました 💪
A 問題、B 問題に取り組むときの心構えがわかってきた気がします。
- 条件を満たさないケースから除外して行って全部通ったら `True`
- Haskell のガードの `|` に否定の意味を加えられたらもっとスッキリ書けるんですけども
```haskell
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
solve :: Integral a => [a] -> Bool
solve ss
| not $ all (uncurry (<=)) (zip ss (tail ss)) = False
| not $ all (\s -> s `mod` 25 == 0) ss = False
| not $ all (>= 100) ss = False
| not $ all (<= 675) ss = False
| otherwise = True
main :: IO ()
main = do
ss <- getInts
putStrLn $ if solve ss then "Yes" else "No"
```
----
## [B - Default Price](https://atcoder.jp/contests/abc308/tasks/abc308_b)
回転寿司🍣の食べたお皿の総額計算。
辞書で商品に対する金額のマスターデータを構築し、その金額通りに、食べたものの総額を計算する。
まあ、この辺は業務システムプログラマーとしては慣れたもの。chokudai さん回転寿司好きそうだなとか妙なことを考えて実装してました。
```haskell
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
main :: IO ()
main = do
[_, _] <- getInts
cs <- words <gt; getLine
ds <- words <gt; getLine
ps <- getInts
let (p0 : ps') = ps
prices = Map.fromList $ zip ds ps'
let xs = map (\ci -> Map.findWithDefault p0 ci prices) cs
print $ sum xs
```
----
## [C - Standings](https://atcoder.jp/contests/abc308/tasks/abc308_c)
本日の山場。
一見簡単に見せかけて、割り算のところにオーバーフローの地雷がある。
最初割り算を見た時に「こりゃ浮動小数点で割り算するとヤバそう」と思ったのですが、深読みしすぎか? と思ってナイーブに実装して送信したらやっぱり WA になりました。「もしかしてソートが安定ソートじゃないのか?」と疑心暗鬼になってしまい、ソート条件をいじって送信してもオーバーフローは直ってないので当然 WA。
ここで WA を重ねるとまずいなと思い、一旦飛ばして D に行きました。
戻ってきて、割り算のオーバーフローどうしたもんか、と考えましたがたまらず Google で検索。Haskell には `Rational` と言うデータ型があり、この型で除算を記述すると浮動小数点にならず分数のまま演算ができる... つまり分数のまま大小比較ができる! Oh, 便利!
- [haskell の Int と Integer の違いや Float や Double や Rational を理解する - Qiita](https://qiita.com/suzuki-hoge/items/17cf0cd3680ef10b2cc1#rational)
「😍 いい! すごく良い! も 最っ高!! これよ これ! 私が求めてたのは!!」
Rational みたいなのがない場合は割り算の不等式を掛け算の不等式に変換して比較すると良いみたいですね。覚えておきます。
「Double ででかい数字割り算したらオーバーフローするよねー」みたいなのはときどき思うことですが、それに対する対策方法を曖昧にしてたつけで 2WA もらっちゃいました。こういうのちょくちょくありますが、こうして本戦で頭を悩ますたび一つ強くなれると言うことにしておきます。
```haskell
{-# LANGUAGE TypeApplications #-}
import Control.Monad (replicateM)
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (sortBy, 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)
main :: IO ()
main = do
n <- readLn @Int
xs <- replicateM n getTuple
let xs' = sortBy (\(x, y) (x', y') -> compare (x', y) (x, y')) $ map (\((a, b), i) -> (f a b, i)) $ zip xs [1 :: Int ..]
putStrLn . unwords $ map (show . snd) xs'
where
f a b = a' / (a' + b') :: Rational
where
(a', b') = (fromIntegral a, fromIntegral b)
```
----
## [D - Snuke Maze](https://atcoder.jp/contests/abc308/tasks/abc308_d)
すぬけがゲシュタルト崩壊。
BFS で、次の行き先が `s -> n -> u -> k -> e -> s ...` になってないときはそのマスには入れません、と定義して探索する。
BFS は我ながらうまく盆栽できていて「現在の頂点から遷移できる次の頂点集合」を関数 $f(v)$ で渡すように抽象化しているので、こういう問題はシュッと解けます。
Twitter を見てたら `snuke` じゃなくて `sunuke` (す が su になってる) だと思ってはまったと言う方がいてウケました。
```haskell
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
import Control.Monad (filterM, foldM, forM_, replicateM)
import Data.Array.IArray (bounds, listArray, (!))
import Data.Array.MArray (newArray, readArray, writeArray)
import Data.Array.ST (runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.Ix (Ix, inRange)
import Data.Sequence (Seq (Empty, (:<|)), (|>))
import qualified Data.Sequence as Seq
around :: (Int, Int) -> [(Int, Int)]
around xy = map (xy `to`) [(1, 0), (0, 1), (-1, 0), (0, -1)]
where
to :: (Int, Int) -> (Int, Int) -> (Int, Int)
to (x, y) (x', y') = (x + x', y + y')
reachable :: Ix i => UArray i Char -> i -> i -> Bool
reachable grid x i
| (not . inRange (bounds grid)) i = False
| otherwise = case (p, q) of
('s', 'n') -> True
('n', 'u') -> True
('u', 'k') -> True
('k', 'e') -> True
('e', 's') -> True
_ -> False
where
p = grid ! x
q = grid ! i
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
main :: IO ()
main = do
[h, w] <- map (read @Int) . words <gt; getLine
ss <- replicateM h getLine
let grid = listArray @UArray ((1, 1), (h, w)) $ concat ss
dist = bfs (\v -> filter (reachable grid v) $ around v) (-1) ((1, 1), (h, w)) [(1, 1)]
let result = dist ! (h, w)
putStrLn $ if result == -1 then "No" else "Yes"
```
----
## [E - MEX](https://atcoder.jp/contests/abc308/tasks/abc308_e) (コンテスト後にAC)
こういう部分列の問題で、繰り返し出てくる部分列の回数を数え上げるとかは DP だと相場が決まっています。似たような問題だと [D - We Love ABC](https://atcoder.jp/contests/abc104/tasks/abc104_d) とか。
問題は MEX と渡り歩いたときに $(0, 0, 1)$ になるのか $(0, 1, 2)$ になるのか $(1,1,2)$ になるのか... が文脈によって変わるというところですね。考慮しなければいけない状態が
- 入力の文字 `EXMMXXXEMEXEXMM` を左から順番に一文字ずつ遷移する、時間的遷移
- `M -> E -> X` の順に文字を辿ったかどうかを管理する状態空間
- `M -> E -> X` を辿ったときに $0, 1, 2$ のどの数字を得たか
と3つあるので 2次元DPでは難しそう。幸いにして3つ目の状態は空間が $0, 1, 2$ と狭いのでビットで管理できますね。というわけで3次元DP + ビットDP です。
残り30分ぐらいでこの解法を整理できたのでついに初の5完なるか!? と思ったのですが、ビットDPは実装ハマりがちなんですよねー... 8割ぐらい実装してバグ取りしてる間に時間オーバー... いとくやし 🥺
5完の壁は高い...!
```haskell
{-# LANGUAGE TypeApplications #-}
import Data.Array.Base (UArray, assocs)
import Data.Array.Unboxed (accum, accumArray, (!))
import Data.Bits (Bits (setBit))
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import qualified Data.IntSet as IS
import Data.Ix (Ix)
import Data.List (find, foldl', unfoldr)
import Data.Maybe (fromJust)
getInts :: IO [Int]
getInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <gt; BS.getLine
data MEX = NULL | M | E | X deriving (Show, Eq, Ord, Ix)
toMEX :: Char -> MEX
toMEX 'M' = M
toMEX 'E' = E
toMEX 'X' = X
toMEX _ = error "unknown"
toA :: Int -> [Int]
toA 0 = []
toA 1 = [0]
toA 2 = [1]
toA 3 = [1, 0]
toA 4 = [2]
toA 5 = [2, 0]
toA 6 = [2, 1]
toA 7 = [2, 1, 0]
toA _ = error "unknown"
solve :: [(MEX, Int)] -> UArray (MEX, Int) Int
solve xs = do
let dp = accumArray (+) 0 ((NULL, 0), (X, 7)) [((NULL, 0), 1)]
foldl' transition dp xs
where
transition dp (si, ai) = do
accum (+) dp $ concatMap (\(i, e) -> f (i, e) (si, ai)) (assocs dp)
f ((x, bits), cnt) (si, ai)
| cnt == 0 = []
| otherwise = case (x, si) of
(NULL, M) -> [((M, setBit bits ai), 1)]
(M, E) -> [((E, setBit bits ai), cnt)]
(E, X) -> [((X, setBit bits ai), cnt)]
_ -> []
main :: IO ()
main = do
_ <- readLn @Int
as <- getInts
s <- getLine
let xs = zip (map toMEX s) as
dp = solve xs
print $ sum $ map (\i -> mex (toA i) * dp ! (X, i)) [0 .. 7]
{-- Library --}
-- >>> mex []
-- 0
-- >>> mex [0]
-- 1
-- >>> mex [0, 1]
-- 2
-- >>> mex [0, 2]
-- 1
-- >>> mex [1, 1, 2]
-- 0
-- >>> mex [0, 1, 2]
-- 3
mex :: [Int] -> Int
mex xs = fromJust $ find (`IS.notMember` set) [0 ..]
where
set = IS.fromList xs
```
----
## 感想・反省など
というわけで、今回も5完ならず。そして本戦で緑問題解く、という実績解除もなりませんでした。
が、回を重ねるたび E 問題に AC できるまであとちょっと、という距離が縮まっている感じはするので、希望はあります。茶色diff は本戦でもほぼ 100% 解けているので、緑問題の練習を続けていればそのうち解けるようになるでしょう。
- 前回は二次元配列の重実装問題で焦ったので今週、重点的に練習してました。Haskell の ixmap を研究したり、二次元座標圧縮なんかも盆栽して万全の体制で臨みましたが今回は二次元配列なし!
- 主客転倒で寄与数で解く、みたいな問題を集中的に解くのもやりましたが、それも今回は出番がなかったです
この ABC308 の反省からすると、やはり DP ですね。少し複雑な DP になってくると実装スピードが落ちてしまって時間切れになりがちなので、今週は DP を中心に練習メニューを組み立ててみようと思います。
あと、前回もそうでしたがコンテスト当日の夕方に有酸素運動をすると、プラセボかわかりませんが緊張も和らぐようですし、当然体調も良くなりますのでこれは毎週のルーチンにしようと思います。フィットボクシング。
なお次回ABC309 は私用でお休みです。次次回 ABC310 でお会いしましょう。