# ABC344 振り返り
- [トヨタ自動車プログラミングコンテスト2024#3（AtCoder Beginner Contest 344） - AtCoder](https://atcoder.jp/contests/abc344)
- ABCD 4完 (974) ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc344)
![[スクリーンショット 2024-03-10 12.49.21.png]]
![[スクリーンショット 2024-03-10 12.49.54.png]]
ABC344 でした。
D と E が緑難易度で 5完したかったですが、E 問題で微妙な差異による TLE が取れず敗退。
D まで 30分で解ききったので今回はいけると思いましたが前回同様、あと一歩というところで終了しました。
- A (灰) ··· split で `|` で文字列を区切ります
- B (灰) ··· やや珍しい問題。$N$ が与えられない中入力をEOFまでみる。Haskell なら `getContents`
- C (灰) ··· $3$ 変数の全探索。事前に全探索して結果を集合にでも入れて、クエリに答えます
- D (緑) ··· DP
- E (緑, upsolve) ··· 双方向リスト
でした。
E はロジックは合っていましたが、双方向リストのベースに `IntMap` を使い、値の更新を `IM.!` で取得して `IM.insert` で上書きする ... とやっていたら TLE してしまいました。`IM.adjust` でアトミックに更新すると、TLE せず。
定数倍のわずかな差が TLE との境目になっているのに気がつかず、時間切れとなりました 😭
確かに `IM.!` してから `IM.insert` だと、2度キーを探索するので、`IM.adjust` にする方がよいです。
しかし、テストケースによってはこれで 1秒近く差がついていて、まさかここまで差がつくと思っていませんでした。
横着してはいけない! そしてやはり `IntMap` を酷使すると遅いですね。実装には気をつけなければなりません。
とはいえ、コンテスト中に定番データ構造をいちから素で実装するというのは初めての経験でなかなか面白かったです。
以下、あまり時間がないのでさくっと振り返ります。
## [A - Spoiler](https://atcoder.jp/contests/abc344/tasks/abc344_a)
`|` で区切って間の文字列を抜く。
A にしてはやや面倒な問題。Data.List.Extra の `split` を使いました。
```haskell
main :: IO ()
main = do
s <- getLine
let ss = split (== '|') s
putStrLn $ head ss ++ last ss
```
## [B - Delimiter](https://atcoder.jp/contests/abc344/tasks/abc344_b)
$N$ が与えられないなか、入力を EOF まで読む。AtCoder では珍しい入出力ですね。
`getContents` 使い慣れてなくて少し悩みました。
```haskell
main :: IO ()
main = do
contents <- BS.getContents
let as = BS.lines contents
for_ (reverse as) $ \i -> do
BS.putStrLn i
```
## [C - A+B+C](https://atcoder.jp/contests/abc344/tasks/abc344_c)
正直 A, B より簡単だと思ってしまいました。
3 つの集合が与えられるので、直積を作って全探索。先に探索しておいてその結果を `IntSet` にいれておき、クエリに答えます。
```haskell
main :: IO ()
main = do
n <- getInt
as <- getInts
m <- getInt
bs <- getInts
l <- getInt
cs <- getInts
q <- getInt
qs <- getInts
let s = IS.fromList [a + b + c | [a, b, c] <- sequence [as, bs, cs]]
for_ qs $ \x -> do
printYn $ IS.member x s
```
## [D - String Bags](https://atcoder.jp/contests/abc344/tasks/abc344_d)
D で DP が出るのは久し振りです。
各 $i$ の文字列を使う / 使わないなのでナップザック問題。その応用ですね。
$i$ には最大で $10$ 種類の文字列があるので、一回あたり最大で $10$ 方向へ状態遷移します。うち、$T$ の現在位置からの prefix になっていないものは条件を満たさないので、使えない。
拙作の [[関数適用による状態遷移で DP を解く]] フレームワークで落ち着いて解きました。
```haskell
g i t s
| not (s `isPrefixOf` t') = Nothing
| otherwise = Just (length s)
where
t' = drop i t
main :: IO ()
main = do
t <- getLine
n <- getInt
sss <- replicateM n $ do
(_ : ss) <- words <
gt; getLine
return ss
let m = length t
let dp = accumDP @UArray f min (maxBound :: Int) (0, m) [(0, 0)] sss
where
f (i, v) ss
| v == maxBound = []
| otherwise =
[ (i + fromJust j, v + 1)
| s <- ss,
let j = g i t s,
isJust j
]
print $
if dp ! m == maxBound
then -1
else dp ! m
```
## [E - Insert or Erase](https://atcoder.jp/contests/abc344/tasks/abc344_e)
双方向リストを作る問題です。
`IntMap` をベースに実装しました。こういう大量の更新に対して `IntMap` を使うのは、経験上ちょっと速度的な心配がありましたが... 悪い予感が的中し TLE しました。
冒頭でも書いたとおり、値の更新操作をアトミックに行わず読み/書きに分けたところ定数倍が嵩んだようです。
この TLE がなかなか取れず、30分近く格闘しましたが AC できず終わりました。
終了後 `IM.adjust` を使えるところでは使うようにしたところ、1.5sec となり AC でした。
1.5 sec は結構ぎりぎりで、挿入や削除の関数の中で少し凝ったことをするともう駄目、という感じでした。
富豪的プログラミング 🙅 ゼッタイ
```haskell
main :: IO ()
main = do
_ <- getInt
as <- getInts
q <- getInt
qs <- replicateM q getInts
let xs' = foldFor' (fromListLL as) qs $ \xs query -> do
case query of
[1, x, y] -> insertLL x y xs
[2, x] -> deleteLL x xs
_ -> undefined
printList $ toListLL xs'
{-- LinkedList --}
type IntLinkedList = IM.IntMap (Int, Int)
toListLL :: IntLinkedList -> [Int]
toListLL xs = drop1 . takeWhile (/= maxBound) $ iterate (\k -> snd (xs IM.! k)) minBound
deleteLL :: Int -> IntLinkedList -> IntLinkedList
deleteLL x xs = do
let (left, right) = xs IM.! x
IM.adjust (\(_, r) -> (left, r)) right $ IM.adjust (\(l, _) -> (l, right)) left xs
{-# INLINE deleteLL #-}
insertLL :: Int -> Int -> IntLinkedList -> IntLinkedList
insertLL x y xs = do
let (_, right) = xs IM.! x
IM.adjust (\(_, r) -> (y, r)) right $ IM.adjust (\(l, _) -> (l, y)) x $ IM.insert y (x, right) xs
{-# INLINE insertLL #-}
fromListLL :: [Int] -> IntLinkedList
fromListLL as = do
let (x0, prev') = foldl' (\(x, prev) (cur, next) -> (IM.insert cur (prev, next) x, cur)) (IM.empty, minBound :: Int) $ zip as (tail as)
IM.insert minBound (minBound :: Int, head as) $ IM.insert (last as) (prev', maxBound :: Int) x0
```
### 座標圧縮 + MVector で実装
`IntMap` ではどうも 1.5 sec ぐらいが限界に感じたので、ベースを Unboxed MVector にした実装を作ってみました。
予め、最大の要素数分領域を確保する必要があるので使い勝手は少し落ちますが、その分速いです。こちらなら 570ms 程度。
最大サイズを事前に見積もる、インデックスを現実的な大きさに収める必要があるのでクエリ先読み + 座標圧縮をします。
こちらの方が、最大サイズの考慮が必要だったり作用を伴いモナディックになるなど実装としてはやや難易度が上がるので、短い時間で実装するならやはり `IntMap` の方がよいですね。
```haskell
-- ABC343 E
-- https://atcoder.jp/contests/abc344/tasks/abc344_e
main :: IO ()
main = do
_ <- getInt
as <- getInts
q <- getInt
qs <- replicateM q getInts
-- 値の挿入にはインデックスが必要なので先に値を座標圧縮して索引を振っておく
let qs' =
concat
[ case query of
[1, x, y] -> [x, y]
[2, x] -> [x]
_ -> undefined
| query <- qs
]
(rank, ix) = zaatsuRank 0 (minBound : as ++ qs')
n = rangeSize (bounds rank)
xs <- newLL n (-1)
for_ (zip (minBound : as) as) $ \(x, y) -> do
insertAfterLL xs (ix x) (ix y, y)
for_ qs $ \case
[1, x, y] -> insertAfterLL xs (ix x) (ix y, y)
[2, x] -> deleteLL xs (ix x)
_ -> undefined
result <- getElemsLL xs
printList result
{-- VUM LinkedList --}
type LinkedList s e = VUM.MVector (PrimState s) (Int, Int, e)
-- 最大要素数 n の双方向リスト
-- 先頭の番兵のインデックスは 0 / インデックスは値に対して座標圧縮で振る
newLL :: (PrimMonad m, VUM.Unbox e) => Int -> e -> m (LinkedList m e)
newLL n def = do
xs <- VUM.new (n + 2)
VUM.write xs 0 (minBound, VUM.length xs - 1, def)
VUM.write xs (VUM.length xs - 1) (0, maxBound, def)
return xs
insertAfterLL :: (PrimMonad m, VUM.Unbox e) => LinkedList m e -> Int -> (Int, e) -> m ()
insertAfterLL xs i (j, val) = do
(_, right, _) <- VUM.read xs i
VUM.modify xs (second3 (const j)) i
VUM.write xs j (i, right, val)
VUM.modify xs (first3 (const j)) right
{-# INLINE insertAfterLL #-}
deleteLL :: (PrimMonad m, VUM.Unbox e) => LinkedList m e -> Int -> m ()
deleteLL xs i = do
(left, right, _) <- VUM.read xs i
VUM.modify xs (second3 (const right)) left
VUM.modify xs (first3 (const left)) right
{-# INLINE deleteLL #-}
getElemsLL :: (PrimMonad m, VUM.Unbox e) => LinkedList m e -> m [e]
getElemsLL xs = tail . reverse <gt; loop [] h
where
(h, t) = (0, VUM.length xs - 1)
loop acc k
| k == t = return acc
| otherwise = do
(_, next, val) <- VUM.read xs k
loop (val : acc) next
```
## (追記) HashMap に変更すると辞書でも比較的余裕が出る
[[Haskell の IntMap vs HashMap]] に詳しく記載しました。
## 感想など
前回同様、水色パフォーマンスにもう少しで手が届くかとおもったところで、逃しました 😂
が、やはり序盤の問題の実装の安定感が出てきていてそこは成長を感じます。
ここからはそのあと一歩をどう詰められるかの勝負になっていくと思います。
引き続きがんばります。
----
# おまけ Haskell 精進記録
あとで追記するかも