# ABC343 振り返り
- [AtCoder Beginner Contest 343 - AtCoder](https://atcoder.jp/contests/abc343)
- ABCD 4完 (1083) ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc343)
![[スクリーンショット 2024-03-03 4.08.45.png]]
![[スクリーンショット 2024-03-03 4.10.38.png]]
ABC343 でした。
A 〜 D まで比較的平易で E が青難易度だったこともあり4完、大渋滞みたいな回でした。
E か F を解いてそこを突破でできればワンチャン。
自分は調子よく D まで解いたあと F のセグメント木の問題に取り組みましたが、あと一歩というところで AC できず···、残念。
- A (灰) ··· $A+ B$ 以外の数字を適当にみつけて出力する。集合でやりました
- B (灰) ··· グラフの隣接行列が当たられるので、隣接リストにして出力
- C (灰) ··· 上界を見極める。$10^6$ まで全探索
- D (茶) ··· 適切なデータ構造の選択。プレイヤーごとの現在スコアと値の集合を管理。Haskell の Map ならサイズを $O(1)$ で計算できる
- E (青, 解けず) ··· 全探索で良さそうなのはわかりましたが、難しそうなので飛ばして F にいきました
- F (水, upsolve) ··· 変モ (変なモノイド) をセグメント木に載せる。上位2件の値と個数の両方とも載せてしまう。
----
## [A - Wrong Answer](https://atcoder.jp/contests/abc343/tasks/abc343_a)
A 問題でサンプルのテストそのままでなくても良い問題は、珍しいですね。
ユニットテスト感覚のサンプルテストが確認できないので、いつもよりやや慎重に確認してから送信しました。
```haskell
main :: IO ()
main = do
[a, b] <- getInts
let s = IS.fromList [0 .. 9]
s' = IS.delete (a + b) s
print $ IS.findMin s'
```
## [B - Adjacency Matrix](https://atcoder.jp/contests/abc343/tasks/abc343_b)
これはやるだけですね。
グリッドを入力から作る、グラフを構築する、リストを出力するなどの定型処理を簡単にできるライブラリを作っておくと、実装を早く済ませられます。
```haskell
main :: IO ()
main = do
n <- getInt
grid <- getIntGrid ((1, 1), (n, n))
let g = graph2 (1, n) [(v, u) | v <- [1 .. n], u <- [1 .. n], grid ! (v, u) == 1]
for_ [1 .. n] $ \v -> do
let us = g ! v
printList $ (nubOrd . sort) us
```
## [C - 343](https://atcoder.jp/contests/abc343/tasks/abc343_c)
制約から上界を見積もります。三乗に対して $N \leq 10^{18}$ なので、$10^6$ まで全探索すれば OK
C で暗黙の上界を見積もって全探索、というのはよく出る気がします。
```haskell
isPalindrome s = xs == reverse xs
where
xs = map intToDigit (toDigits 10 s)
main :: IO ()
main = do
n <- getInt
let res = maximum [x | i <- [1 .. 10 ^ 6], let x = i * i * i, x <= n, isPalindrome x]
print res
```
## [D - Diversity of Scores](https://atcoder.jp/contests/abc343/tasks/abc343_d)
プレイヤー $1$名の得点が毎時更新される中、その時点の得点数のユニークをとったら幾つになるかを答えていく問題です。
$1$ 秒進むたびに誰かのスコアが更新されるということは、値の種類的には、その更新される前の値が削除されて、更新された値が追加されると考えられます。
集合的になくなる値と新しく入る値を管理して、全体として何種類あるかを $O(1)$ や $O(\log{n})$ 程度で都度計算できるデータ構造があると楽そうですね。
Haskell の Map は `Map.size` で $O(1)$ で要素数を数えられます。
Map のキーに得点を、値にはその得点になってる人数を入れて管理。$0$ になったら要素を削除します。
プレイヤー $A_i$ の更新前の値が幾つだったかも知っておく必要があるのでそれは別途 MArray で管理しておきます。
同じ Map 系のデータ構造に、整数のキー限定でより高速な IntMap がありますがこちらは `size` が $O(n)$ なのでそれを使うと TLE します。
Set と IntSet、Map と IntMap は同様の関係にあります。
Map の内部実装は平衡二分木、IntMap の内部実装はパトリシア木で、その都合で `size` の計算量が異なっています。
```haskell
main :: IO ()
main = do
[n, t] <- getInts
qs <- replicateM t getTuple
let s0 = Map.singleton (0 :: Int) n
as <- newArray @IOUArray (1, n) (0 :: Int)
foldForM_ s0 qs $ \s (ai, bi) -> do
before <- readArray as ai
updateArray (+) as ai bi
after <- readArray as ai
let s' =
Map.insertWith (+) after 1 $
Map.update (\x -> let x' = x - 1 in bool Nothing (Just x') $ x' > 0) before s
print $ Map.size s'
return s'
```
ところで Map をこのように個数管理に使うと、 「$0$ になったら削除」のところで `update` の面倒なイディオムが必要になるのと、常にキーと個数を二つ意識して実装するのでやや認知負荷が高めです。
IntMap はそれを抽象化して IntMultiSet と多重集合操作で扱えるようにしたライブラリを持っています。
今回のように size の計算量の違いもありますし Map 版の MultiSet も作っておこうと思います。
## [E - 7x7x7](https://atcoder.jp/contests/abc343/tasks/abc343_e) (未完🍊)
これはちょっと頭を使うなあと思い、一方の F は典型の雰囲気がしたので F に行きました。
## [F - Second Largest Query](https://atcoder.jp/contests/abc343/tasks/abc343_f) (upsolve)
セグメント木の問題なのは、一点更新区間取得なので、割とすぐ分かりますね。
あとはそのセグメント木に載せる「変なモノイド」をどう設計するかです。
いや、別に変ではないんですがプリミティブではないものを載せるときに「変なモノイド」と呼ぶのが面白くて使ってます。変モ。
結論としては、上位 $2$ 件の最大値と、その個数をセグメント木に載せれば OK でした。
結合の二項演算では上位 $2$ 件を抽出して、同じ値がある場合は個数の和をとる。
これで通ります。実装を見るほうが早いと思います。
```haskell
combine (a, b) (c, d) = do
let bucket = accumIntMap (+) 0 [a, b, c, d]
xs = take 2 (reverse $ IM.assocs bucket)
if length xs == 2
then let [p, q] = xs in (p, q)
else (head xs, (minBound, 0))
main :: IO ()
main = do
[n, q] <- getInts
as <- getInts
tree <- newListST @IOArray combine ((minBound, 0), (minBound, 0)) (1, n) [((a, 1 :: Int), (minBound, 0)) | a <- as]
replicateM_ q $ do
query <- getInts
case query of
[1, p, x] -> do
updateST tree p (const ((x, 1), (minBound, 0)))
[2, l, r] -> do
(_, (_, x)) <- rangeQueryST tree l (r + 1)
print x
_ -> undefined
```
TLE で通しきれなかった自分の元の解法は、上位 $2$ 件の値をセグメント木に載せつつ、各区間に何個その値があるかは別途、更新可能な転置インデックスで値の出現位置を保持しておいて $O(\log{n})$ で数えるという方針でした。
- [提出 #50848876 - AtCoder Beginner Contest 343](https://atcoder.jp/contests/abc343/submissions/50848876)
計算量的にはいけそうですが、転置インデックスの更新や探索に $O(\log {n})$ を何度か必要とすることもあり、定数倍に時間がかかって TLE x 6がどうしても取れませんでした。無念。
「セグ木 ? 個数は別途転置インデックスにすればいけそうだお」
![[スクリーンショット 2023-11-19 11.51.45.png|240]]
「あわわ、TLE···」
![[スクリーンショット 2023-11-19 11.51.28.png|300]]
~~AC した方の実装でも 1.6 sec かかっていて、結構テストケースがきつい問題だったんですね。
3sec 制限など、あともうちょっとそこが緩い問題なら、通ったんじゃないかと思います。
ちゃんと個数までセグ木に載せないとダメよ、という出題意図なのかなと思いました。~~
<ins>その後いろいろ試してみたところ Vector ベースのセグメント木ならもっと速く通せることがわかりました。</ins>
### 「変モ」を載せるとはどういうことか
「変なモノイド」の構成の方ですが、以下の図のように考えます。
セグメント木においては、実データと言えばいいでしょうか、入力で与えられた値は葉が保持します。
一方、葉よりも上位階層のノードは自身の子どもに対する二項演算の結果を保持していますが、こちらは実データではなくてあくまで計算結果。計算結果をキャッシュしたようなものと考えられます。
葉のデータが更新されるたび、更新にともなってキャッシュのようなデータの更新がボトムから根にむかって走っていきます。
よって、上位 $2$ 件の値と、その $2$ 件の出現回数を結合する演算を適切に実装できていれば全体として矛盾なく計算結果を保持し続けられます。
![[IMG_0654.jpg]]
セグメント木は二分木になっていて、ノードが二項演算の結果を保持しているということは理解できていたので上位 2 件の値の方をモノイドに載せられるのは思いつき、実装しました。
一方で「葉が実データでノードはキャッシュ」のような認識をまだあまり明確には持てていなかったこともあり「個数の方は値ごとに持つ必要があるし別途管理しないとなあ」と考えてしまいました。
改めて考えると、なんで値は保持できて個数は保持できないと思うのかそこの理屈が通ってないですね。
コンテスト本番中のメモ書きには「結合で値と<s>個数を残す</s>演算」と書いててわざわざ個数を残す可能性を棄却してしまっています 😂
なんとなくこう、個数に関しては上位 $2$ 件の値以外も含めて全体を残しておかないと再計算できないと考えてしまったんですが、実データは葉がちゃんと保持しているので、そんなことはないわけです。
![[IMG_0653.jpg]]
まとめると
- セグメント木の葉ではないノードが持っている値はすべてキャッシュ的なもの
- 葉に、実データが載っている
- 葉が更新されるたび、ノードのうち必要な箇所のみそのキャッシュ的なものが更新される。
- 葉の実データを元にすれば、値も個数もその都度正しく計算できるから心配いらない
···となっているので、個数の方も持たせてセグメント木を構成するとちゃんと想定通りに動く、というわけでした。
### 追記
combine 関数で、値を結合したあとに長さが2になることを保証していますが、よく考えると、これは必要なさそうです。
```haskell
combine (a, b) (c, d) = do
let bucket = accumIntMap (+) 0 [a, b, c, d]
xs = take 2 (reverse $ IM.assocs bucket)
if length xs == 2
then let [p, q] = xs in (p, q)
else (head xs, (minBound, 0))
```
は、以下でよかったです。
ここを削るだけで数100ms速くなりました。
```haskell
combine (a, b) (c, d) = do
let bucket = accumIntMap (+) 0 [a, b, c, d]
[q, p] = takeEnd 2 (IM.assocs bucket)
(p, q)
```
### 追記 (2)
combine 関数で IntMap を使っているところのオーバーヘッドが結構ありそうです。
愚直に場合分けしてみました。
```haskell
combine ((a, i), (b, j)) ((c, k), (d, l))
| a == c && b == d = ((a, i + k), (b, j + l))
| a == c = ((a, i + k), max (b, j) (d, l))
| a == d = ((c, k), (a, i + l))
| b == c = ((a, i), (b, j + k))
| b == d = if a > c then ((a, i), (c, k)) else ((c, k), (a, i))
| otherwise = do
let [p, q] = take 2 $ sortOn Down [(a, i), (b, j), (c, k), (d, l)]
(p, q)
{-# INLINE combine #-}
```
これで更に 200ms ほど短縮。1200ms まで来ました。可読性は犠牲になりますが...
### 追記 (3)
![[スクリーンショット 2024-03-03 14.10.59.png]]
私のセグメント木の実装は MArray をベースにしています。
今回の問題ではタプルを載せることになるので IOUArray ではなく IOArray を使わざるを得ないのですが、Vector ベースのセグメント木の実装ではタプルも Unbox 扱いにできます。
というわけで過去に実装した Vector で実装されたセグメント木で試してみたところ一気に高速化されました。
なん···だと···
### 追記 (4)
Vector ベースのセグメント木だとだいぶ高速化されるので、試しに昨晩 TLE した方針でも実装してみたところ、通りました。
- [提出 #50867711 - AtCoder Beginner Contest 343](https://atcoder.jp/contests/abc343/submissions/50867711)
MArray vs Vector でここまで顕著に差がつくのは初めてですね 😂
## 感想など
F が解けなかったのは悔しいところですが、おかげでセグメント木への理解が深まりました。理解が深まっ太郎です。
ここ1ヶ月は、常時スコアを 1000 over を取れていて、以前のような爆死が減り安定感が出てきました。
相変わらず AtCoder Daily Training の MEDIUM にバーチャル参加してコツコツ解いてます。
その過程で Haskell の実装のイディオムを煮詰めたり、細かい盆栽を作ったりしているのがバグりにくい実装に繋がっていると思います。
また、通算で $100$ 回以上バーチャルコンテストをやっていることもあって、メンタルコントロールを意識的にできるようになってきているのも大きいと思います。
最近は、呼吸を意識しながら問題を解いています。夢中になると呼吸が止まって、それが心拍数上昇の原因になって緊張に繋がります。呼吸を意識することでそれを避けられることがわかってきました。
レートは 1008 → 1015 と微増ではありますが、安定感がでてきたことで少し自信もついてきており、コンテスト本番も前向きな気持ちで取り組めるようになってきました。良い傾向だと思います。
----
# おまけ 今週のHaskell 精進記録
今週の精進で更新した盆栽や記憶に残ったことなどを整理
## AtCoder Daily Training MEDIUM より
### [G - Prefix K-th Max](https://atcoder.jp/contests/adt_medium_20240227_2/tasks/abc234_d)
構造的に ABC343 の D に少し似ていて、値の個数を管理しながらや削除 / 挿入をやっていくやつ。
IntMultiSet を使っているので綺麗に、かつ平易に書ける。ABC343 D も同様に書きたい。
```haskell
main :: IO ()
main = do
[n, k] <- getInts
as <- getInts
let s0 = fromListMS (take k as)
s' <- foldForM s0 (drop k as) $ \s ai -> do
let x = findMinMS s
print x
if x < ai
then return (insertMS ai $ deleteMinMS s)
else return s
print $ findMinMS s'
```
### [D - Iroha and Haiku (New ABC Edition)](https://atcoder.jp/contests/abc265/tasks/abc265_d)
典型としては累積和 + 二分探索の問題。
もう一年ぐらい前に一度解いてそのあと一度も解いてなかったのですっかり解法も忘れていたが、解けてよかった。
二分探索で、境界を引くのではなく、値そのものを探す場合は `bisect` を使うよりも集合で管理する方がシンプルに書けることは多い。
そしてこの問題の場合、一見、値に単調性がないので二分探索は使えないようにみえるが累積和をとることでそれが可能になる。
累積和を取る、というのはデータ系列に単調性を確保したいがためにやることでもある、という発想を持っておくとよい。
```haskell
main :: IO ()
main = do
[_, p, q, r] <- getInts
as <- getInts
let s = IS.fromList $ scanl' (+) 0 as
xs = IS.toList s
ys = [y | x <- xs, let y = x + p, IS.member y s]
zs = [z | y <- ys, let z = y + q, IS.member z s]
ws = [w | z <- zs, let w = z + r, IS.member w s]
printYn $ (not . null) ws
```
### [G - Rectangles](https://atcoder.jp/contests/adt_medium_20240228_3/tasks/abc218_d)
$x$ 軸と $y$ 軸を独立に考えて辞書で同じ $y$ 軸上にある $x$ の値をまとめあげる。
拙作の `accumIntMap` 関数が火を噴く。
かつ、Map や IntMap は Foldable であることを忘れない。畳み込みできるのはもちろん、concat も直接できてしまうぞ。
「Map は Foldable」
写経して毎朝唱えましょう。はい、みなさんご唱和「Map は Foldable」
```haskell
main :: IO ()
main = do
n <- getInt
xys <- replicateM n getTuple
let g = IM.map (comb2 . sort) $ accumIntMap (flip (:)) [] $ map swap xys
bucket = accumMap (+) 0 $ map (,1) (concat g)
print $ foldl' (\acc x -> acc + nc2 x) 0 bucket
```
### [G - Together Square](https://atcoder.jp/contests/adt_medium_20240229_1/tasks/abc254_d)
先週の ABC342 D 問題で使った平方数の性質を使う問題。
比較したら、平方数因子 (と私が勝手に呼んでる) の算出の実装は全く同じ。
また将来使うかもしれないので盆栽化した。
```haskell
-- 平方数因子 (n に掛けたら平方数になる因数) を返す
-- 第一引数は素因数分解の関数
-- >>> squareFactor (factorize mf) 12
-- 3
squareFactor :: (Int -> [Int]) -> Int -> Int
squareFactor factorizeF n =
let bucket = accumIntMap (+) 0 [(p, 1 :: Int) | p <- factorizeF n]
in (product . IM.keys . IM.filter odd) bucket
main :: IO ()
main = do
n <- getInt
let mf = minFactorSieve (2 * 10 ^ 5)
let res =
[ takeWhile (<= n) [s * x * x | x <- [1 .. ]] -- これは i に掛けたら平方数になる数
| i <- [1 .. n],
let s = squareFactor (factorize mf) i
]
print $ length (concat res)
```
### [C - log2(N)](https://atcoder.jp/contests/adt_medium_20240229_2/tasks/abc215_b)
対数を求める問題はときどきでるが、ceiling なのか floor なのかが場合によって異なる。
```haskell
main :: IO ()
main = do
n <- getInt
print $ pred . length $ takeWhile (<= n) $ iterate' (* 2) 1
```
と毎回それに合わせて書いてるのも認知エネルギーの無駄··· というか上記を横着して浮動小数点で最初やったら1ペナもらった。
なので
```haskell
-- >>> log2GE 5
-- 3
log2GE :: (Integral b, Num a, Ord a) => a -> b
log2GE n = until ((>= n) . (2 ^)) succ 0
-- >>> log2LE 5
-- 2
log2LE :: (Integral b, Num a, Ord a) => a -> b
log2LE n = until (\x -> 2 ^ (x + 1) > n) succ 0
```
という関数を作った。
### [D - Distance Between Tokens](https://atcoder.jp/contests/adt_medium_20240229_3/tasks/abc253_b)
グリッド内から `o` がついてる座標を複数取得するときに `[ i | (i, c) <- assocs grid, c == 'o' ]` みたいな実装を毎回書いてて面倒になってきたので `findArrayIndices` を作った。
こういう簡単な問題でも、盆栽作りの糧になる。
```haskell
main :: IO ()
main = do
[h, w] <- getInts
grid <- getCharGrid ((1, 1), (h, w))
let [s, g] = findArrayIndices (== 'o') grid
print $ distance s g
```
### [E - The Kth Time Query](https://atcoder.jp/contests/adt_medium_20240229_3/tasks/abc235_c)
配列境界を超えてアクセスしてランタイムエラーになったことが私はあります。いや、ない人はいない。
`!?` を使えば境界を超えたら `Nothing` になるので安心して使えます。
といいつつ以外と出番が少なく、存在を忘れてつい境界チェックの if 式を書いてしまう。
```haskell
main :: IO ()
main = do
[_, q] <- getInts
as <- getInts
qs <- replicateM q getTuple
let g = IM.map (\vs -> listArray @UArray (1, length vs) $ reverse vs) $ imGraph (zip as [1 :: Int ..])
for_ qs $ \(x, k) -> do
print $ case IM.lookup x g of
Just vs -> fromMaybe (-1) (vs !? k)
Nothing -> -1
```
### [G - Shift vs. CapsLock](https://atcoder.jp/contests/adt_medium_20240229_3/tasks/abc303_d)
ABC303 で出た、Caps Lock 押したままいくべきかいかないべきか的な DP
accumArrayDP があれば宣言的に書けるのだ
```haskell
main :: IO ()
main = do
[x, y, z] <- getInts
s <- getLine
let dp = accumArrayDP @UArray f min (maxBound :: Int) (False, True) [(False, 0)] s
where
f (st, ms) aA
| ms == maxBound = []
| otherwise = case (st, aA) of
(False, 'A') -> [(False, ms + y), (True, ms + z + x)]
(True, 'A') -> [(False, ms + z + y), (True, ms + x)]
(False, 'a') -> [(False, ms + x), (True, ms + z + y)]
(True, 'a') -> [(False, ms + z + x), (True, ms + y)]
_ -> undefined
print $ minimum (elems dp)
```
### [C - Connect 6](https://atcoder.jp/contests/abc241/tasks/abc241_c)
割と最近に LRUD の方向の値の定義を間違えて、本番中に 30 分ぐらい無駄にしたという苦い経験をし、予め left, right, up, down に名前をつけるようにした。
すると特定の斜め方向は例えば `left` と `down` の合成で表現できる。
タプルの $2$ 値の結合を `+` 演算子で書ければより自然にそれを宣言できる。
X でぶつぶつ言ってたら @ruichi さんが instance 宣言のやり方を教えてくれた。やったー。
```haskell
main :: IO ()
main = do
n <- getInt
grid <- getCharGrid ((1, 1), (n, n))
let res =
catMaybes
[ linearScanN grid 6 d v
| v <- range (bounds grid),
d <- [right, down, right + down, left + down]
]
res' = [xs | xs <- res, countBy ((== '#') . snd) xs >= 4]
printYn $ (not . null) res'
lrud@[left, right, up, down] = [(0, -1), (0, 1), (-1, 0), (1, 0)]
```
ここ最近で一番すっきりしたことかも
### [G - Neighbors](https://atcoder.jp/contests/adt_medium_20240228_2/tasks/abc231_d)
グラフが一直線になってるかどうか判定、ときどきある。
出次数だけみて閉路がないこと、というのをチェックし忘れやすい。備忘録。
```haskell
main :: IO ()
main = do
[n, m] <- getInts
uvs <- replicateM m getTuple
let g = amap length $ graph2 (1, n) uvs
uf <- newUF @IOUArray (1, n) (-1)
hasCycle <- foldForM False uvs $ \acc (u, v) -> do
same <- isSame uf u v
unite uf u v
return (acc || same)
cs <- getComponentsUF uf
let isLinear = and [g ! v <= 2 | vs <- cs, v <- vs]
printYn $ (not hasCycle) && isLinear
```
## ほか
### [E - Last Train](https://atcoder.jp/contests/abc342/tasks/abc342_e)
前回 ABC342 の E で解けなかったダイクストラ法の問題。
ダイクストラ法の実装を改良して、コスト計算の関数と、最小化/最大化どちらに最適化するか、インタフェースを開放した。
おかげでダイクストラ法の実装には変更を加えなくても、こいういう「最大化への最適化 + コスト計算がやや複雑」みたいな応用問題も解ける。
ダイクストラ法の実装を変更しなくていいことが最大のメリットというよりも「ダイクストラ法は最大化方向にも最適化できるし、二項演算をカスタムすることもできる」ということを関数のインタフェースが語っていることが重要。
ダイクストラ法の問題が次に出たときも、インタフェースがそれを教えてくれる。
なお、内部実装も優先度付きキューを、psqueues から自作の MArray ベースの二分ヒープに変えた。
競技プログラミングでのダイクストラ法は (BFS もそうだが) キューに多大な負荷がかかる問題が多いのでそこの実装が律速になりやすい。
この問題も初回の提出時は 1.1sec ぐらいだったが、BinaryHeap に変更して 600ms を切るところまで高速化できた。
```haskell
main :: IO ()
main = do
[n, m] <- getInts
xs <- replicateM m getInts
let uvs = [((v, u), (l, d, k, c)) | [l, d, k, c, u, v] <- xs]
g = wGraph (1, n) uvs
dist = dijkstra (g !) f Maximize minBound (bounds g) [(n, maxBound)]
where
f acc (l, d, k, c) = do
let (ok, _) = bisect2 (0, k + 1) (\x -> l + (x - 1) * d + c <= acc)
if ok == 0
then minBound
else l + (ok - 1) * d
for_ [1 .. n - 1] $ \v -> do
if dist ! v == minBound
then putStrLn "Unreachable"
else print $ dist ! v
```
というわけで先週前半は過去に解いたダイクストラ法の解き直しを中心にやっていた。
今週は「変モセグ木 」すなわち変なモノイドのセグメント木を練習しておこう。
ここ最近セグメント木の出題が続いているので、さすがにもうしばらく出題頻度も減るような気はするが、記憶に定着させるためにはいずれにせよ一度忘れるところまでいく必要があるので、やるにこしたことはない。