Go to Qiita Advent Calendar Top
LoginSignup
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@gotoki_no_joe(じょお)

ABC408をHaskellで

Posted at

A - Timeout

問題 ABC408A

シグネチャを決める。

abc408a :: Int   -- N
        -> Int   -- S
        -> [Int] -- Ti
        -> Bool  -- 答え

時刻0の分も含めて、肩を叩く時間間隔が全て $S$ 以下ならば寝落ちを回避できる。

結果

abc48a _n s ts = all (s >=) $ between subtract (0 : ts)

between f xs = zipWith f xs $ tail xs

B - Compression

問題 ABC408B

シグネチャを決める。

import qualified Data.IntSet as IS

abc408b :: Int   -- N
        -> [Int] -- Ai
        -> [Int] -- 答え Ci
abc408b _n = IS.elems . IS.fromList as

Mは length で数えて。

配列脳な人のための別解

import Data.Array

abc408b :: Int -> [Int] -> [Int]
abc308b as =
  map fst $ filter snd $ assocs $
  accumArray (flip const) False (1, 100)
  [(a, True) | a <- as]

C - Not All Covered

問題 ABC408C

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

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

それぞれの区画がいくつの砲台にカバーされているかを数え、その最小値が答え。

ひとつひとつ塗ると

import Data.Array

abc408c :: Int -> Int -> [[Int]] -> Int
abc480c n _m lrs =
  minimum $ elems $
  accumArray (+) 0 (1, n)
  [(x, 1) | l:r:_ <- lrs, x <- [l .. r]]

$O(NM)$ で間に合わないので、累積和による積分を使う。

結果

abc408c n _m lrs =
  minimum $ scanl1 (+) $ elems $
  accumArray (+) 0 (1, n) $ concat
  [(l, 1) : [(succ r, -1) | r < n] | l:r:_ <- lrs]

こう書いた方がシンプルか？

abc408c n _m lrs =
  minimum $ scanl1 (+) $ elems $
  accumArray (+) 0 (1, n) $
  [(l, 1) | l:_ <- lrs] ++
  [(succ r, -1) | _:r:_ <- lrs, r < n]

D - Flip to Gather

問題 ABC408D

シグネチャを決める。ひとつのテストケースについて計算する。

import qualified Data.ByteString.Char8 as BS

abc408d :: Int           -- N
        -> BS.ByteString -- S
        -> Int           -- 答え

1 の区間が高々1個なので、0個でもよい。そうするには全ての 1 を 0 に変えるので、1 の個数分のコストがかかる。
特に、元々 1 がひとつも無いような場合はコスト0で、これは確実に最善である。

1 の区間を左から1番、2番、…、M番と呼ぶことにする。
1番からM番の間にある 0 を全て 1 に変えると、ひとつも消すことなく区間をひとつにできる。
この形を基本形、これにコスト $C$ を基本値とする。
これは、1番の左とM番の右が区間の両端になっている。

$j$ 番の左を区間の左端にするとき、基本コストからの変動を考える。
1番から$j-1$番までの 1 を全て 0 に変えるコストが余計に掛かり、
その代わり、それらの右隣にあった 0 を全て 1 に変えていたコストが浮く。
このコスト変動を $L(j)$ とする。これは、一つ一つの変動の累積和として求められる。
$k$ 番の右を区間の右端にするときのコスト変動も同様に求められる。これを $R(k)$ とする。

ここから最適コストは $C + \min_{1 \leq j \leq M} \min_{j \leq k \leq M} \left (L(j) + R(k) \right )$ となるが、これをそのまま計算すると $O(N^2)$ かかる。

ある $i$ 番を「芯」に選び、その位置は 1 とすることを確定させ、左端は1番から $i$ 番のいずれか最適なものを選ぶ、右端も $i$ 番から $M$ 番のいずれか最適なものを選ぶとする。
$L_{\min}(j) = \min_{i \leq j} L(i), R_{\min}(k) = \min_{k \leq i} R(i)$ とすると、$i$ 番を芯にしたときの最小コストは $C + L_{\min}(i) + R_{\min}(i)$ となり、最終的な答えはその最小値 $C + \min_i \big (L_{\min}(i) + R_{\min}(i) \big )$ となる。

結果

import Data.List.Split

abc408d :: Int -> BS.ByteString -> Int
abc408d _n bs
  | null ls = 0 -- '1' がなかった
  | otherwise = base + minimum (zipWith (+) scoreLs scoreRs)
  where
-- 両端の0をトリミングしてから、
-- 1の長さ、0の長さ、…、1の長さを数える
    ls = map BS.length $ BS.group $ BS.dropWhileEnd ('0' ==) $ BS.dropWhile ('0' ==) bs
    len = length ls
-- 全体を1にするコストは、0を全て1にするコスト
    base = sum [z | (z, True) <- zip ls $ cycle [False, True]]
-- 左から1ブロックと0ブロックをまとめて基本形から外すときのコスト変動をminで累積
    diffLs = scanl1 min $ scanl (\acc [l, o] -> acc + l - o) 0 $ init $ chunksOf 2 ls
-- 右からも同様
    diffRs = scanr1 mmin $ scanr (\[o, l] acc -> acc + l - o) 0 $ chunksOf 2 $ tail ls

E - Minimum OR Path

問題 ABC408E

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

abc408e :: Int   -- N
        -> Int   -- M
        -> [[Int]] -- ui, vi, wi
        -> Int     -- 答え

OR演算は単調増加するので、ダイクストラ法の距離の足し算をORに差し替えたらいいのかと思ってやってみて、例2で思いっきり否定された。親切。
（だけど原因は「多重辺を含む」からではないのがmisleadingかも…）

最上位ビットから順に、そのビットは0の辺しか使用不可として、辺を制限したグラフについて、1からNに到達可能か調べる。
0だけでも行けたビットは、今後0固定にする。行けなかった場合はその桁は1も許可する。（1限定ではなく、0でも1でも可）
最下位ビットまで調べ尽くしたとき、そのビットパターンがまさに答えである。

結果

0固定にするべきビットを1に、1も許すビットを0にしたマスクと、辺の重みをANDした結果が0になるものが現状許される重みなので、求める結果はマスクの反転になる。

import Data.Array
import Data.Bits

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

abc408d :: Int -> Int -> [[Int]] -> Int
abc408d n _m uvws = post $ foldl step 0 [29, 28 .. 0]
  where
    step mask i
      | connected mask1 = mask1
      | otherwise       = mask
      where
        mask1 = setBit mask i

    connected mask = runST $ do
      uf <- newUF (1, n)
      mapM_ (uncurry $ uniteUF uf) [(u,v) | u:v:w:_ <- uvws, w .&. mask == 0]
      a <- getRoot uf 1
      b <- getRoot uf n
      return $ a == b

    post = xor (bit 30 - 1)

Union-Findは省略。

最初の版では全体をSTモナドにして最外のループ foldl を foldM で回していたが、
STの計算をより小さい範囲に閉じ込めた方が速くなった。

F - Athletic

問題 ABC408F

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

abc408f :: [Int] -- N, D, R
        -> [Int] -- Hi
        -> Int   -- 答え

考える

それぞれの位置 $i$ から開始したときの移動回数 $C[i]$ は、前後 $R$ の範囲で高さ $D$ 以上低い位置すべてのその値の最大値＋１なので
$C[i] = 1 + \max_{i - R \leq j \leq i + R, H_j \leq H_i - D} C[j]$
となる。$\max$の対象要素がない場合0とする。
高さは順序関係なので上の関係式は循環しない漸化式となりDPの構造で計算できるが、$R$ の範囲が大きくなる危険があって $O(RN) \fallingdotseq O(N^2), N \leq 5 \times 10^5$ と巨大なので何とかしないといけない。

配列の任意の範囲から最大値の取り出しを容易にするためにはセグメント木が使える。$C[i]$ を最大値演算のセグメント木に格納する。

高さ条件を満たす要素だけを対象にするために、高さの低い位置から順に考え、位置 $i$ のカウント値 $C[i]$ を求める前に、$H_i - D$ 以下の高さである全ての位置のカウント値をセグメント木に設定する。
そして今求められた$C[i]$の値をセグメント木に即座に反映させず、$H_i + D$ 以上の高さの位置について考える直前まで延期させる。

結局、次のようにすればよいはずだ。

  • カウント値を順次登録する配列 $C[\cdot]$ を使う
  • カウント値を登録するセグメント木を使う
  • 位置 $i$ をその高さ $H_i$ の昇順に考える。これは高さ計算用の$i$の列と、高さ登録用の$i$の列（これを$j$とする）の二つを使う。

そして以下を繰り返す

  • $H_i - D \geq H_j$ ならば、$C[j]$ をセグメント木に登録する
  • そうでないとき、セグメント木に $[i-R,i+R]$ の区間の最大値を問いあわせ、結果＋１を $C[i]$ とする

最後に $\max_i C[i]$ が答え。

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

abc408f :: [Int] -> [Int] -> Int
abc408f [n,d,r] hs = runST $
  do
    rqa <- makeRQArrayN max (- 1) n :: ST s (RQArray (STUArray s) Int) -- セグメント木
    cnt <- newArray (0, pred n) (- 1) :: ST s (STUArray s Int Int)     -- C[i]
    loop rqa cnt his0 (his0 ++ [(maxBound,0)])                         -- (Hi,i) と (Hj,j)
    maximum <$> getElems cnt
  where
    his0 = sort $ zip hs [0 ..]  -- Hiの昇順に整列

    loop _ _ [] _ = return ()
    loop rqa cnt his@((hi,_):_) ((hj,j):hjs) | hj<= hi - d = -- Hj ≦ Hi - D なら Cj を rqa に追加
      do
        cj <- readArray cnt j
        updateRQArray rqa j cj
        loop rqa cnt his hjs
    loop rqa cnt ((_,i):his) hjs = -- さもなくば、[i-R,i+R] の範囲の最大値+1をiの結果とする
      do
        ci <- queryRQArray rqa (max 0 $ i - r) (min n $ succ i + r)
        writeArray cnt i (succ ci)
        loop rqa cnt his hjs

TLEx5 で全然間に合わない。

問題の条件をよく読む

上の解法は $H_i$ の値の範囲は任意として設計したが、問題文の制約の項を見ると

$H$ は $(1,2,\dots,N)$ の順列

の一文がある。えっ？

順列であることが問題の本質ならば、

高さが1からNまでの足場が一つずつあり、一列に並んでいます。

のように、高さが順列であるという事実を問題文の中に混ぜ込んでおいて欲しかった。

それで、順列だったら最初のDPがもっと容易に計算できるのか？としばらく悩んで、
もしかしたらそうではなくて単に $5 \times 10^5$ 要素という莫大なデータを
Data.List.sort で扱ったのが敗因なのでは、実際順列ならソートをする必要はないし、
ということで、$H_i$ が順列であることを前提に、上のアルゴリズムを修正する。

  • $H^{-1}$ を、$H_i$ を添字 $i$ を値とする配列とする

高さの昇順、$H^{-1}$ の要素 $h_i$ を順に以下を行う

  • 高さ $h_i - D$ の位置 $j = H^{-1}[h_i - D]$ の高さ $C[j]$ をセグメント木に登録する
  • セグメント木に $[i-R,i+R]$ の区間を問いあわせて、＋１を$C[i]$ とする
abc408f :: [Int] -> [Int] -> Int
abc408f [n,d,r] hs = runST $
  do
    rqa <- makeRQArrayN max (- 1) n :: ST s (RQArray (STUArray s) Int)
    cnt <- newArray_ (0, pred n) :: ST s (STUArray s Int Int)
    mapM_ (step rqa cnt) [1 .. n]
    maximum <$> getElems cnt
  where
    h2i = array (1, n) $ zip hs [0 ..]                -- H^(-1)

    step rqa cnt h =
      do
        when (d < h) $ do -- h - d の j の値を登録
          let j = h2i ! (h - d)
          cj <- readArray cnt j
          updateRQArray rqa j cj
        -- h の i について±Rの範囲で最大値を得て cnt に +1 を格納
        let i = h2i ! h
        c <- queryRQArray rqa (max 0 $ i - r) (min n $ succ i + r)
        writeArray cnt i (succ c)

あっさりACした。
問題の本質ではないが、ソートはしなくてよいという親切心からの順列だったようだ。

G - A/B < p/q < C/D

問題 ABC408G

シグネチャを決める。ひとつのテストケースについて計算する。横着する。

abc408g :: [Int] -- A,B,C,D
        -> Int   -- 答え

なんもわからんくて公式解説を読んだ。

答えの $q$ に対して $p$ は一意に定まるので、$p$ も同時に求める $f(\frac{A}{B}, \frac{C}{D}) = (p, q)$ を作る。

  • $1 \leq \frac{A}{B}$ のとき、$n = \lfloor \frac{A}{B} \rfloor$ として$(p, q) = f(\frac{A-nB}{B}, \frac{C-nD}{D})$ を再帰的に求めたら答えは $(p + nq, q)$ となる。

  • 上の条件が満たされない、つまり $\frac{A}{B} < 1$ であって、かつ$1 < \frac{C}{D}$ のとき、$\frac{A}{B} < 1 < \frac{C}{D}$ なので $(1,1)$ が答え。

  • 上の条件が満たされない、つまり $\frac{C}{D} \leq 1$ のとき、全てを逆数にしてひっくり返して
    $(p, q) = f(\frac{D}{C}, \frac{B}{A})$ を再帰的に求めたら答えは $(q, p)$ となる。

でいいらしい。

結果

import Data.Tuple

abc408g :: [Int] -> Int
abc408g [a,b,c,d] = snd $ f a b c d
  where
    f a b c d
      | b <= a    = (p + n * q, q)
      | d < c     = (1, 1)
      | otherwise = swap $ f d c b a
      where
        (n, r) = divMod a b
        (p, q) = f r b (c - d * n) d

追記

最小の $q$ に対して $p$ は一意に定まる、については書いてある証明で理解できた。

$\frac{A}{B} < \frac{C}{D} \leq 1$ のとき $1 \leq \frac{D}{C} < \frac{B}{A}$ で、これに対して $f(\frac{D}{C},\frac{B}{A}) = (p, q)$ を何か求めることはできるかもしれない。
（これが無限ループにならないことは「連分数展開」と対比して考えるとわかるのかな？）
この答えは $\frac{D}{C} < \frac{p}{q} < \frac{B}{A}$ を満たす最小の分母 $q$ と唯一に定まる分子 $p$ であるというのもまぁそうなのだとしよう。
でもその逆数 $\frac{q}{p}$ がやはり最小の分母、唯一の分子を与えるのはどうしてなのかわからない。それも連分数展開がらみなのだろうか。

2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?