# ABC385 振り返り
- [ユニークビジョンプログラミングコンテスト2024 クリスマス（AtCoder Beginner Contest 385） - AtCoder](https://atcoder.jp/contests/abc385)
- ABCD 4完 (1187) ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc385)
![[スクリーンショット 2024-12-22 9.52.50.png]]
ABC385 でした。
A, B, C までは順調に解けたものの、D が実装に四苦八苦。結果 E を考察する時間なしでパフォーマンスは 1187 止まり、レートは横ばいでした。
- A (14) ··· $A, B, C$ すべて同じ、もしくはうち $2$ つの組み合わせがのこった $1$ 個と一致するか
- B (77) ··· `LRUD` 方向への移動をシミュレーションしながら、通過した `@` の座標の履歴を残し最後にユニーク数を数える
- C (446) ··· $H_i$ の値ごとに値の出現位置を転置インデックスにする。インデックスのリストの最長等差部分列を計算
- D (1171) ··· $x$ 軸と $y$ 軸を独立に考えつつ、家の位置を順序付き集合で持って、通過するたびに集合から削除していく。実装大変
- E (1406, upsolve) ··· 貪欲法。$1 \ldots N$ までどこを根にするか、根を決めたら $x$ を全探索。先に次数の降順にソートしておくと計算量が嵩まない
でした。
## [A - Equally](https://atcoder.jp/contests/abc385/tasks/abc385_a)
$3$ つの整数を $2$ つ以上に分ける、なので
```haskell
main :: IO ()
main = do
[a, b, c] <- getInts
printYn $ or [allSame [a, b, c], a + b == c, a + c == b, b + c == a]
```
これでよいのですが、頭を使うのがめんどくさかったのと、盆栽にちょうどいい関数 `allPartitions` ··· リストの分割パターンを全列挙する、があったのでそれを使ってオーバーキルしました。
```haskell
main :: IO ()
main = do
abc <- getInts
let res =
[ allSame (map sum xss)
| abc' <- permutations abc,
xss <- allPartitions abc',
length xss >= 2
]
printYn $ or res
```
```haskell
-- 並び順は維持しつつ分割可能箇所で分割するパターンを全列挙する
--- >>> allPartitions [1, 2, 5]
-- [[[1],[2],[5]],[[1],[2,5]],[[1,2],[5]],[[1,2,5]]]
allPartitions :: [a] -> [[[a]]]
allPartitions as = do
xs <- subsequences [1 .. length as - 1]
let ((_, remain), grouped) = mapAccumL f (0, as) xs
where
f (i, acc) j =
let k = j - i
in ((j, drop k acc), take k acc)
[grouped ++ [remain]]
```
## [B - Santa Claus 1](https://atcoder.jp/contests/abc385/tasks/abc385_b)
グリッド上を `LRUD` の四方向に進む、というよくある問題。この問題は制約が緩いので、シミュレーションで OK です。
`mapAccumL` などで現在位置を状態にしつつ、移動で `@` を通ったときのマスの履歴を残していく。
最後に履歴のユニークを取って、答えとする。
`LRUD` で移動する問題は `left` `right` ... で方向のベクトルを表現し、また `fromLRUD` で `Char` からそのベクトルに写像関数を予め作っておくと実装が楽です。
```haskell
lrud@[left, right, up, down] = [(0, -1), (0, 1), (-1, 0), (1, 0)] :: [(Int, Int)]
fromLRUD :: Char -> (Int, Int)
fromLRUD d = case d of
'L' -> left
'R' -> right
'U' -> up
'D' -> down
_ -> error "Invalid direction"
main :: IO ()
main = do
[h, w, x, y] <- getInts
grid <- getCharGrid ((1, 1), (h, w))
t <- getLine
let ((x', y'), vs) = mapAccumL f (x, y) t
where
f pos d = case grid ! pos' of
'#' -> (pos, Nothing)
'.' -> (pos', Nothing)
'@' -> (pos', Just pos')
_ -> error "Invalid"
where
pos' = pos + fromLRUD d
let ans = (length . nubOrd . catMaybes) vs
printList [x', y', ans]
```
なお以下のように $2$ 値の `Num` のタプルに対する四則演算を定義しておくと、移動を現在地 `pos` に対するベクトルの足し算、`pos + fromLRUD v` というイディオムでかけて更に良いです。
```haskell
{-- Tuple --}
instance (Num a) => Num (a, a) where
(x1, x2) + (y1, y2) = (x1 + y1, x2 + y2)
(x1, x2) - (y1, y2) = (x1 - y1, x2 - y2)
(x1, x2) * (y1, y2) = (x1 * y1, x2 * y2)
negate (x1, x2) = (negate x1, negate x2)
abs (x1, x2) = (abs x1, abs x2)
signum (x1, x2) = (signum x1, signum x2)
fromInteger n = (fromInteger n, fromInteger n)
```
## [C - Illuminate Buildings](https://atcoder.jp/contests/abc385/tasks/abc385_c)
数列 $H$ の中から、値が同じで等間隔で並んでいる最長の部分列を見つける。
やや頭を使う問題です。
値が同じもの同士で分割すると独立に考えられそう、というわけで $H_i$ の値をキーに、数字の登場位置のリストを値にした `7 => [2, 4, 5, 7, 8]` みたいなデータ構造を作ります。いわゆる転置インデックスですね。ここまでは、典型思考です。
さて、この `[2, 4, 5, 7, 8]` という登場位置のリストに対して差が等間隔の最長の部分列を求める部分問題になりました。
最長等差部分列です。
制約をよくみると $N \leq 3000$ で $H_i \leq 3000$ です。$O(n^2)$ の計算量でも通りそう。
リストに登場する値の 2 値組み合わせ全てを走査して、最長等差部分列の計算をする。リストの長さを $M$ としたとき計算量は $O(M^2)$ です。
$i < j$ な $2$ 点間 $(i, j)$ の差を $d$ としたとき DP の要領で
$dp[j][d] = dp[i][d] + 1$
という式を計算していくと、最終的にこの dp 配列の値の最大値が、最長等差部分列の長さになります。
```haskell
main :: IO ()
main = do
_ <- getInt
hs <- getInts
let g = amap sort' $ accumArray @Array (flip (:)) [] (1, 3000) $ zip hs [1 :: Int ..]
res <- for (filter notNull $ elems g) $ \ps -> do
let m = length ps
p = listArray @UArray (1, m) ps
dp <- newArray @IOUArray ((1, 0), (m, 3000)) (1 :: Int)
for_ (comb2 [1 .. m]) $ \(i, j) -> do
let d = p ! j - p ! i
acc <- readArray dp (i, d)
writeArray dp (j, d) $! acc + 1
xs <- getElems dp
return $ maximum xs
print $ maximum res
```
## [D - Santa Claus 2](https://atcoder.jp/contests/abc385/tasks/abc385_d)
実装に骨の折れる問題でした。
B 問題に同じく二次元空間の移動の問題なのですが、こちらの問題は座標が $-10^9 \leq X_i, Y_i \leq 10^9$ と大きいので、ナイーブにシミュレーションは出来ません。
まず、この類の問題は $x$ 軸と $y$ 軸を独立に考えるのが定石。
座標を、ある $x_i$ に対する $y$ の値の集合、ある $y_i$ に対する $x$ の集合という風にまとめます。
Haskell なら IntMap の辞書で $x, y$ いずれかをキーにし、対する値の集合を IntSet で表現する。
これで IntSet の `lookupGE` などの関数を使うことで、例えば現在地 $(x, y)$ から $(x', y)$ に動いたとき $(x, x')$ 間にある $y_i$ を効率的に計算できます。
ここまでは良いとして、この問題の面倒なところは到達した家の数を求めるにあたり、複数回通過しても重複して数えないところ。
重複して数えてよいなら、例えば $x$ 軸をある位置 $l$ から $r$ まで移動したときこの $(l, r)$ の間にいくつ $y_i$ があったかを、二分探索などで数えれば良いです。
が、そういうわけにはいかない。
ここで家の数は高々 $2 \times 10^5$ なのを利用します。$x$ 軸上、もしくは $y$ 軸上をある地点 $l$ から $r$ まで移動したとき、そこに含まれていた家は先の集合からその都度削除することにします。トータルの削除回数の上界は家の数 $M$ に等しいため、削除回数が嵩んで TLE することはありません。
というわけで
- $x$ 軸 $y$ 軸ごとに座標を分解して先の IntMap + IntSet のデータ構造にまとめる
- `LRUD` の指示に従い移動したときの $(l, r)$ を求める
- 集合から $(l, r)$ に含まれる値を削除する。順序つき集合なら削除対象の値を効率的に探索できる
ということを繰り返して、最終的に削除できなかった家の数を、$N$ から引けばよいです。
実装上めどくさいのは、上下に移動したときと左右に移動したときで対象となるデータ構造が変わること。
また、例えばある $y_i$ 軸上の $(l, r)$ に含まれていた $x_j$ を削除したらそのあと、その削除された $x_j$ すべてに対して、 $(x_j, y_i)$ を $x_i$ 軸上の $y$ を管理しているもう一方の IntMap からも削除する必要がある点も面倒です。説明すら面倒くさい。
Haskell で、IntMap や IntSet のようなイミュータブルなデータ構造を使ってこれを実装すると以下のような実装になり、かなり疲れます。
さすがにこうい問題は、命令型データ構造の方が実装しやすいでしょう
とはいえ Haskell でやるからにはこだわっていきたいところ...
```haskell
deleteInRangeViewIS :: (IS.Key, IS.Key) -> IS.IntSet -> ([IS.Key], IS.IntSet)
deleteInRangeViewIS (l, r) = loop []
where
loop acc s = case IS.lookupGE l s of
Just v | inRange (l, r) v -> loop (v : acc) (IS.delete v s)
_ -> (acc, s)
main :: IO ()
main = do
[n, m, sx, sy] <- getInts
xys <- replicateM n getTuple
qs <- replicateM m $ auto @(Char, Int)
let xy0 = accumIntMap (flip IS.insert) IS.empty xys
yx0 = accumIntMap (flip IS.insert) IS.empty $ map swap xys
let ((tx, ty), s1, _) = foldl' f ((sx, sy), xy0, yx0) qs
where
f ((x, y), xy, yx) (di, ci)
| di `elem` ['U', 'D'] =
let (xy', yx') = case IM.lookup x xy of
Nothing -> (xy, yx)
Just ys ->
let (vs, ys') = deleteInRangeViewIS (l, r) ys
in ( IM.insert x ys' xy,
foldl' (\acc v -> IM.adjust (IS.delete x) v acc) yx vs
)
in (pos', xy', yx')
| otherwise =
let (xy', yx') = case IM.lookup y yx of
Nothing -> (xy, yx)
Just xs ->
let (vs, xs') = deleteInRangeViewIS (l, r) xs
in ( foldl' (\acc v -> IM.adjust (IS.delete y) v acc) xy vs,
IM.insert y xs' yx
)
in (pos', xy', yx')
where
(pos', (l, r)) = case di of
'L' -> ((x - ci, y), (x - ci, x))
'R' -> ((x + ci, y), (x, x + ci))
'U' -> ((x, y + ci), (y, y + ci))
'D' -> ((x, y - ci), (y - ci, y))
_ -> error "!?"
let deleted = sum' $ map IS.size $ IM.elems s1
printList [tx, ty, n - deleted]
```
## [E - Snowflake Tree](https://atcoder.jp/contests/abc385/tasks/abc385_e) (upsolve)
D 問題の実装で時間を使ってしまい、残り 15 分弱では考察しきれずゲームーオーバーでした。
改めて朝に取り組んでみましたが 30 分考察してみても解法に辿り着けずだったので、いずれにせよ解けなかったと思います。
木DP か? 全方位木 DP か? と延々と考えていましたが、そのいずれでもなく、貪欲法でした。
ポイントになるのは $2$ 点
- $x$ と $y$ の値が決まれば、削除対象の頂点数は $N - (1 + x + xy)$ で計算できる。つまり、部分木の頂点数を予め求めておかなくても計算可能
- 根の隣接頂点を $x$ 個選んだら、$y$ はその $x$ 個の頂点のもつ次数 $d$ のうち最小の値 $d_{v_x} - 1$ になる。操作は削除しか許されていないので、最小の次数に依存する、というのが理由
後者をもとに考えて、グラフの隣接頂点を次数の降順に並べておくことで根と $x$ を効率的に全探索することができます。
実装を見るほうが早いと思います。
グラフ探索、木DP や全方位木 DP という典型の可能性を棄却して貪欲で考察しきる必要があり、ABC にしては難しい問題。
ABC の E 問題だということで、何かしらの典型アルゴリズムを適用するんだと当てにいくと解けないです。
どちらかというと ARC とかに出そうな問題? のような気もしました。
```haskell
main :: IO ()
main = do
n <- getInt
uvs <- replicateM (n - 1) getTuple
let g = graph2 (1, n) uvs
deg = amap length g
g' = amap (sortOn' (Down . (deg !))) g
res =
[ n - (1 + x + x * y)
| u <- [1 .. n],
(x, v) <- indexed 1 (g' ! u),
let di = deg ! v
y = di - 1
]
print $ minimum res
```
## 感想など
D のようなグリッドを $x$ 軸と $y$ 軸で分けて二分探索なりで効率的に探索しながら〜、という問題は実装がごちゃつく傾向にありますが WA なしで実装して通ったこと自体は良かったです。
一歩間違えると大敗してもおかしくない問題セットにしては健闘したのかもしれない。
問題は実装スピードですね。Haskell だとどうしても実装量も嵩むし、認知負荷も高めな実装が要求されます。
イミュータブルにこだわるなら、やはり典型的なイディオムを反射で出せるように鍛錬を続け、身体化して挑むしかないでしょうか。
入水目前ですがなかなか、次の一歩を踏み出せずついに年末です。
次回もがんばります。