ABC 384

ABC 384 に参加しました。前回と前々回の日記は大敗したのでサボっています。

Table 1: Diff 予想
問題 A 問題 B 問題 C 問題 D 問題 E 問題 F 問題
提出 AC AC AC AC AC TLE
予想 diff 10 10 300 400 800 1600
実際 diff 10 30 187 600 1002 1908

A 問題

文字列 \(S\) の各文字を置換せよ。指示通り実施します。

main=interact$f.words;f[_,[c],[d],s]=map(\x->if x==c then c else d)s

cojna さんの提出 (21:02) は ABC 本番で提出された上に、これよりも短いです。ヤバい。

B 問題

n 回の ARC (div 1, div 2) に参加した後のレーティングを求めよ。シミュレートします。

main=interact$f.tail.map read.words;f(x:d:c:r)|d==1&&x>=1600&&x<2800||d==2&&x>=1200&&x<2400=f(x+c:r)|0<1=f(x:r);f(x:_)=show x

C 問題

5 つの問題の解き方を点数順でソートして出力せよ。 Bit 全探索ですね。

solve :: StateT BS.ByteString IO ()
solve = do
  !xs <- intsU'
  let !cs = U.fromListN 5 "ABCDE"
  let sets = U.generate (bit 5) $ \set ->
        (U.sum (U.backpermute xs (U.filter (testBit set) (U.generate 5 id))), set)
  let res =
        V.modify (VAI.sortBy (comparing (first Down)))
          . G.map (second (U.toList . U.backpermute cs . (\set -> U.filter (testBit set) (U.generate 5 id))))
          $ U.convert sets
  printBSB . unlinesBSB $ G.map snd res

D 問題

数列 \(\{A_i\}_i\) が無限に繰り替えされるとき、和が \(S\) と等しい連続部分列が存在するか調べよ。 \(S \bmod \sum_i A_i\) に対して解くと、数列 \(\{A_i\}_i\) を 2 つ連結した数列の連続部分列のみを考えれば良く尺取り法が使えます。

累積和を用意すれば、 \([l, r]\) 区間の和が \(O(1)\) で求まり、区間の状態を持たずに済みます。こうしたステートレスな尺取り法には、専用の関数を用意してありました:

twoPointersU :: Int -> (Int -> Int -> Bool) -> U.Vector (Int, Int)

以下のように解けました。

solve :: StateT BS.ByteString IO ()
solve = do
  (!n, !s_) <- ints2'
  !xs <- intsU'
  let !s = s_ `mod` U.sum xs
  let csum = csum1D $ xs U.++ xs
  let res = twoPointersU (2 * n) $ \l r -> csum +! (l, r) <= s
  printYn $ s == 0 || U.any ((== s) . (csum +!)) res

E 問題

ヒープの問題です。手続き的に解きました。

solve :: StateT BS.ByteString IO ()
solve = do
  (!h, !w, !xxx) <- ints3'
  (!y0, !x0) <- ints11'
  !gr <- getMat' h w

  let p acc y
        | y < (acc + (xxx - 1)) `div` xxx = True
        | otherwise = False

  let !bounds = zero2 h w
  let addAdj bs heap (!y, !x) = do
        U.forM_ (U.map (add2 (y, x)) ortho4) $ \(!y', !x') -> do
          when (inRange bounds (y', x')) $ do
            unlessM (readIV bs (y', x')) $ do
              writeIV bs (y', x') True
              insertBH heap (gr @! (y', x'), (y', x'))

  bs <- IxVector bounds <$> UM.replicate (h * w) False
  writeIV bs (y0, x0) True

  heap <- newMinBH (4 * h * w)
  addAdj bs heap (y0, x0)

  res <- (`execStateT` (gr @! (y0, x0))) $ fix $ \loop -> do -- 1
    whenJustM (deleteMaybeBH heap) $ \(!dx, (!y, !x)) -> do
      whenM (gets (`p` dx)) $ do
        lift $ addAdj bs heap (y, x)
        modify' (+ dx)
        loop

  printBSB res

F 問題

畳み込みの問題です。畳み込みの問題なんです。

畳み込み (convolution) は多項式の積 \((\sum\limits_i a_i x^i) (\sum\limits_i b_i x^i) := \sum\limits_i c_i x^i\) の係数部分 \(c_i\) を計算してくれます。応用して \(N^2\) 個の和を高速で計算できます。たとえば \(\sum\limits_i \sum\limits_j A_i A_j\) は \(\sum\limits_i \sum\limits_j x^{A_i} x^{B_i} = \sum\limits_i \sum\limits_j x^{A_i + B_i} = \sum\limits_i c_i x^i\) のように指数として計算すれば、 \(O(v \log v)\) (\(v\): 値域) で解けます。

solve :: StateT BS.ByteString IO ()
solve = do
  !n <- int'
  !xs <- intsU'

  let !m = (2 * 10 ^ 7) + 1 :: Int
  let !ps = U.accumulate (+) (U.replicate m (0 :: Int)) $ U.map (,1) xs -- 1
  let !qs = U.accumulate (+) (U.replicate m (0 :: Int)) $ U.map (,1) xs
  let !res = convolute64 ps qs -- 2

  let div2 x = x .>>. countTrailingZeros x
  let !res' = U.sum $ U.imap f res
        where
          f i nx
            | nx == 0 = 0
            | otherwise = div2 i * nx
  printBSB $ (res' + U.sum (U.map (div2 . (* 2)) xs)) `div` 2

TLE しましたが、速い NTT なら AC できるようです。今回も、盆栽力が足りませんでした。

現代のコンピュータは長さ10^7 でも畳み込める

— うし (@ei1333) December 14, 2024

畳み込みの長さ制限に悩んでいる人は、yosupo judgeのconvolution(large)を通そう

— tayu (@tayu_kyopro) December 15, 2024

Convolution (Large) に ACL で投げてみました が、メモリ使用量の問題で RE になりました。どうやるんだ、爆速 convolution.. 。 maspy さんの提出を見ると、入力が巨大な場合は特別処理に分岐しています。じっくり読むしかなさそうです。