ABC355 A～F をHaskellで

A - Who Ate the Cake?

問題 ABC355A

シグネチャを決める。

abc355a :: Int  -- A
        -> Int  -- B
        -> Int  -- 答え

話のとおりに

容疑者のリスト [1,2,3] からAとBを除き、結果が一つに定まるならそれを答えとする、定まらないなら諦める、問題の内容をそのままなぞることができる。

import Data.List

abc355a :: Int -> Int -> Int
abc355a a b =
  case filter (a /=) $ filter (b /=) [1 .. 3] of
    [x] -> x
    _   -> -1

足し算するやつ

特定できる場合ならば $1 + 2 + 3 - A - B$ がその求める犯人の番号になる。

abc355a a b
  | a == b    = -1
  | otherwise = 6 - a - b

公式解説には、犯人の番号は A と B の xor でも得られると書いてあるけれど、どうしてだろう？
xor を $\oplus$ と書いて、xor は同じ値どうしで0にキャンセルするので、
$1 \oplus 2 \oplus 3 \oplus A \oplus B$
が $6 - A - B$ と同様に答えになることはわかる。
そして $1 \oplus 2 \oplus 3 = 0$ だから、ということで、微妙にたまたま。

B - Piano 2

問題 ABC355B

シグネチャを決める。

abc355b :: Int    -- N
        -> Int    -- M
        -> [Int]  -- Ai
        -> [Int]  -- Bi
        -> Bool   -- 答え

値は重複することなく、また範囲も200までと小さいので、バケツソートで 1 : Aにあった 2 : Bにあった 0 : その値はなかった の列にして、0を飛ばして見たとき1が2つ並んでいるかを調べる。

結果

import Data.Array

abc355b :: Int -> Int -> [Int] -> [Int] -> Bool
abc355b _n _m as bs = elem (1,1) $ zip xs $ tail xs
  where
    xs = filter (0 /=) $ elems $
         accumArray (flip const) 0 (1,200) $
         [(a, 1) | a <- as] ++ [(b, 2) | b <- bs]

C - Bingo 2

問題 ABC355C

シグネチャを決める。

abc355c :: Int    -- N
        -> Int    -- T
        -> [Int]  -- Ai
        -> Int    -- 答え
abc355c n t as = ...

まず、$A_k$ からその座標 $(i,j)$ を取り出したい。
座標の範囲 $[1,N]$ 値の範囲 $[1, N^2]$ でなく、
座標の範囲 $[0, N-1]$ 値の範囲 $[0, N^2 - 1]$ だと扱いやすいのでそうする。

a2ij a = divMod (pred a) n

ビンゴの呼ばれた数をマークして、マークする毎にそのマスから縦横斜めの列がビンゴしたかを調べると、$O(TN) = 8 \times 10^8$ で間に合うかもだけどダサい。

列の揃ったマス数を追跡

縦横斜めの列について、穴の個数を追跡する。$N$になったときビンゴする。
mutable arrayで実装する。

import Control.Monad
import Data.List
import Data.Array.ST
import Control.Monad.ST

abc355c :: Int -> Int -> [Int] -> Int
abc355c n _t as = runST $
  do
    v <- newArray (0, pred n) 0
    h <- newArray (0, pred n) 0
    loop v h 0 0 1 as
  where
    a2ij a = divMod (pred a) n
    loop :: STArray s Int Int  -- 縦の列
         -> STArray s Int Int  -- 横の列
         -> Int -> Int         -- 斜め＼と／
         -> Int                -- ターンカウント
         -> [Int]              -- Ai
         -> ST s Int           -- 答え
    loop _ _ _ _ _ [] = return $ - 1
    loop v h d c i (a:as) = do
      let (x,y) = a2ij a
      vx1 <- succ <$> readArray v x
      writeArray v x vx1
      hy1 <- succ <$> readArray h y
      writeArray h y hy1
      let d1 = if x == y then succ d else d
      let c1 = if x + y == succ n then succ c else c
      if elem n [vx1, hy1, d1, c1] then return i else loop v h d1 c1 (succ i) as

ものすごく命令的なコードになってしまった。
これは公式解説の1つめの解説と同じ。そこにあるPythonコードの方が見やすい。

マスを開けた時刻を表にして、ビンゴした時刻を求める

列の最大値がビンゴした時刻、その最小値が答え。とてもシンプル。

公式解説の2つめにある、ずっとHaskellに合うアプローチ。
このやり方を思いつかなかったのは不覚。

import Data.Array

abc355c :: Int -> Int -> [Int] -> Int
abc355c n _t as = if ans == maxBound then -1 else ans
  where
    a2ij a = divMod (pred a) n
    n1 = pred n
    arr = accumArray (flip const) maxBound ((0,0),(n1,n1))
          [(a2ij a, t) | (a,t) <- zip as [1..]]
    hs = [maximum [arr ! (i,j) | j <- [1..n]] | i <- [1..n]]
    vs = [maximum [arr ! (i,j) | i <- [1..n]] | j <- [1..n]]
    di = maximum [arr ! (i    ,i) | i <- [1..n]]
    cd = maximum [arr ! (n-i+1,i) | i <- [1..n]]
    ans = minimum $ di : cd : hs ++ vs

D - Intersecting Intervals

問題 ABC355D

シグネチャを決める。$L_i, R_i$は横着する。

abc355d :: Int      -- N
        -> [[Int]]  -- Li, Ri
        -> Int      -- 答え

定規を用意して、$L_i$ から $R_i$ にテープを貼る、を全て重ねて貼る。
現在のテープの重なっている枚数を追跡しながら0の位置からなぞっていって、

• テープの終端 $R_i$ に遭遇したとき、現在の枚数が1減る
• テープの始端 $L_i$ に遭遇したとき、今ここから始まるテープは、その直前までに重なっていたテープと共通部分を持つので、それだけを答えに加える。また、現在の枚数が1増える

$R_i = L_j$ となるようなときは重なりがあると見做すので、$L$ の方を優先して検討する。
同時に複数のテープが始まる $L_i = L_j$ 場合でもこのままで正しく答えが得られる。

結果

import Data.List

abc355d _n lrs = loop 0 ls rs
  where
    ls = sort [l | l:_  <- lrs]
    rs = sort [r | _:r:_ <-lrs]

    loop cnt lls@(l:ls) rrs@(r:rs)
      | r <  l =       loop (pred cnt) lls rs -- rが離脱するなら、ひとつ通過済になる
      | True   = cnt + loop (succ cnt) ls rrs -- lで一つ区間に突入する
    loop _ [] _ = 0

解説ではやたらと余事象を数えろとあるが、その必要もなかった。
ただ、このコードは、公式解説とユーザ解説の合いの子のようなもので、考え方は近い。

E - Guess the Sum

問題 ABC355E

インタラクティブ問題ではあるが、最初に与えられる $N,L,R$ だけから、その後どのような $i,j$ について問い合わせて、その返答をどう足し合わせれば答えが得られるかは確定する。途中の問い合わせ結果によって、それ以降の行動が影響されることはない。

問題文の最後の文がすごく変な言い回しをしていて、言葉が足りていない。今回の出題の $N,L,R$ に関して、質問の最小限の回数を $m$ としてそれ以下、なので、最小限の質問で答えを見つけよというのが主題。

セグメント木を降りていくのと似たような動作をするが、足す代わりに引くことで近道できるならそうする、というその最適な経路を見つけろということ。

$N,L,R$ に対して、
問い合わせをする $(i,j)$ と、返された結果を累積値に足し込むか逆に引くかの符号 $s$ の3つ組のリストを返す計算がpureで本質なので、これだけを取り出して考える。

abc355e :: Int -- N
        -> Int -- L
        -> Int -- R
        -> [(Int,Int,Int)] -- 答え (i, j, 符号) のリスト

結局わからなくて以下は解説を見た。

幅優先探索

現在位置の値 $x$ が $2^i$ で割り切れるような値のとき $(x = 2^i \cdot j)$ 、商が1増減するような値まで移動できる。これで $L$ から $R+1$ まで移動する最短経路を、幅優先探索で発見する。

import qualified Data.IntSet as IS
import Data.Bits
import qualified Data.Sequence as Q

abc355e :: Int -> Int -> Int -> [(Int,Int,Int)]
abc355e n l r = bfs (IS.singleton l) (Q.singleton (l,[]))
  where
    bfs _s Q.Empty = error "fail"
    bfs is ((x, ts) Q.:<| q)
      | x == succ r = ts
      | otherwise   = bfs is1 (q Q.>< Q.fromList i1ss)
      where
        is1 = IS.union is $ IS.fromList $ map fst i1ss
        i1ss =
          [ (x1, (i, j1, s):ts)
          | i <- 0 : takeWhile (not . testBit x . pred) [1 .. n]
          , let j = shiftR x i
          , let p = bit i
          , (x1, j1, s) <- [(x - p, pred j, -1), (x + p, j, 1)]
          , 0 <= x1
          , IS.notMember x1 is
          ]

(Data.Sequenceを使う版に差し替えました。)

公式解説など

上のコードは、値 x に対して、前と後ろに接続する辺を、BFS中に x に到達したときにオンデマンドで生成している。
公式解説のコードは、グラフを先に構築してから、BFSを実行している。
また、上のコードでは、探索しながらその経路でのクエリ列を同時に構築しているが、
公式解説のコードは、BFS では値の変遷だけを求めて、後でそれを辿るときにクエリに変換している。

これらのコードは0から $2^N$ までの全ての頂点全ての辺を考慮するが、実際には、セグメント木のように、それぞれの桁についてL側から一度だけ登り、R側へ一度だけ降りるようにすれば十分である。
ユーザ解説のO(N)解法では、LやRから始めて、辿る可能性のある辺だけからなるグラフで考えればよいと言っている。

F - MST Query

問題 ABC355F

シグネチャを決める。適宜横着する。

abc355f :: Int      -- N
        -> Int      -- Q
        -> [[Int]]  -- ai, bi, ci
        -> [[Int]]  -- ui, vi, wi
        -> [Int]    -- 答え

解説を見ないとわからなかった。

唐突に、重さ $k$ 以下の辺だけを使ったグラフの連結成分の個数を $C_k$ とする。

与えられるグラフの重みの範囲は 1～10 で、
10で全て連結になることはわかっているので $C_{10} = 1$ である。
0はないので $C_0$ は常に $N$ になるが、それも考える。

$C_{k-1}$ のグラフにさらに重さ $k$ の辺も加えて $C_k$ になったとき、
重さ $k$ の辺がいくつかの連結成分をつなぎ合わせることで連結成分の個数が減る。
減った個数 $C_{k-1} - C_k$ とは、まさに重さ $k$ の辺が最小スパニング木に使われる本数である。
（わぉー。）

では、これを使って最小スパニング木全体の辺の重さの総和 $W$ を求めると

$W = 1(C_0 - C_1) + 2(C_1 - C_2) + 3(C_2 - C_3) + \dots + 10(C_9 - C_{10})$
$ = C_0 + C_1 + \dots + C_9 - 10 C_{10}$
$ = N + C_1 + \dots + C_9 - 10$

よって、$C_1$ ～ $C_9$ を Union-Find を用いて追跡することで、
全てのタイミングでの $W$ の値が得られる。
（おおー。）

さらに、各 Union-Find に真面目に連結成分の個数を問い合わせる代わりに、
辺を追加したときに、それが有効な辺であったときに連結成分が一つ減るわけなので、
初期値からカウントダウンすれば済む。
（ひゃー。）

さらに、$(a_i, b_i, c_i)$ の辺からなる初期グラフについて、
各 Union-Find の連結成分の個数を調べるのも面倒なので、
それらが各頂点を接続しだす前から、重み10の辺$N-1$本で、全てが連結されているということにする。
すると、この段階では $C_{10} = 1, C_w = N, W = 10(N - 1)$ となる。
そして $(a_i, b_i, c_i), (u_i, v_i, w_i)$ を順に見ていき、
辺の重さw 以下にそれぞれ対応する9個の Union-Find のうち、
重さ $c_i$ ～ 9 に対応するものに辺 $(a_i, b_i)$ を追加し、
これが有効な辺であったときに $W$ を1減らす。
こうすることで、$C_w$ の値自体を把握することも不要になる。
（ほぇぇ…）

結果

いつもなら score は foldM の状態として引き回すが、各ステップごとの値を scanl のように取り出す方法がわからなかったので STRef を用いた。

import Control.Monad.ST
import Data.STRef

abc355f :: Int -> Int -> [[Int]] -> [[Int]] -> [Int]
abc355f n q abcs uvws = runST $
  do
    ufa <- listArray (1,9) <$> replicateM 9 (newUF (succ n))
    score <- newSTRef (10 * pred n)
    mapM_ (step ufa score) abcs
    mapM  (\uvw -> step ufa score uvw >> readSTRef score) uvws
  where
    step ufa score (u:v:w:_) =
      forM_ [w .. 9] (\c -> do
        r <- uniteUF (ufa ! c) u v
        when r $ modifySTRef score pred
        )

G - Baseball

フレンズさんいわく

アライグマ「G問題は辺のコストがMongeでAlien DPが高速になるやつらしいのだ！　知らないのだ……」

ばなな (画像略)