3
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?

ABC465 A~FをHaskellで

3
Last updated at Posted at 2026-07-13

ご無沙汰してました。

A - Supermajority

問題 ABC465A

$A > B \times \frac{2}{3}$ は $3A > 2B$

abc465a :: Int -- A
        -> Int -- B
        -> Bool -- 答え
abc465a a b = a * 3 > b * 2

B - Parking 2

問題 ABC465B

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

abc465b :: [Int]  -- X,Y,L,R,A,B
        -> Int    -- 答え

$[L,R]$ と $[A,B]$ の共通部分は $[\max(L,A), \min(R,B)]$ となる。
ただし、下限が上限を超える不正な場合は空になる。

駐車時間 $B-A$ のうち、料金が $X$ な時間は共通部分の長さで、残りは $Y$ となる。

結果

abc465b [x,y,l,r,a,b] = t * x + (b - a - t) * y
  where
    t = max 0 $ min r b - max l a

C - Reverse Permutation

問題 ABC465C

シグネチャを決める。長いので ByteString を使う。

import qualified Data.ByteString.Char8 as BS

abc465c :: Int           -- N
        -> BS.ByteString -- S
        -> [Int]         -- 答え

パンケーキソート…うっ頭が。

$k$ ステップめの操作では、$k-1$ ステップめまでの結果の末尾に $k$ を続け、
さらに $S_k = \texttt{'o'}$ ならばそれを逆転させる。

これを時計を逆回しにして考えると、$k$ ステップめで数 $k$ の位置が確定し、
より小さい数の入る範囲と向きも確定する、再帰的な計算で答えが得られるとわかる。

つまり、今後の数を入れていくべき範囲と向きを $a$ から $b$ $(|a - b| = k)$ として、
$S_k = \texttt{'o'}$ なら $a$ と $b$ を入れ替えておいて、
位置 $b$ に $k$ を置き、$b$ を $a$ の方に1つずらす、
を $k = N, N-1, \cdots, 1$ について順に行えばよい。

結果

import Data.Array
import Data.Tuple

abc465c :: Int -> BS.ByteString -> [Int]
abc465c n bs = elems $ array (1,n) $ go (1, n) n
  where
    go _ 0 = []
    go ab k = (b, k) : go (a, b + signum (a - b)) (pred k)
      where
        (a,b) = if BS.index bs (pred k) == 'o' then swap ab else ab

公式解説のやり方

順方向に考えても別に解けるよと。

kまでの区間の末尾にkを追記してから、o なら反転、を繰り返す。
現状は Data.Sequence を用いて単一の列で表す。
現在は順方向なのか逆方向なのかを別で持っておく。
順方向なら末尾、逆方向なら先頭にkを付け足して、o なら反転する。
最後に、末尾でない方から全ての要素を順に取り出す。

import qualified Data.Sequence as S

abc465c :: Int -> BS.ByteString -> [Int]
abc465c n bs = unfoldr (if revN then rstep else lstep) seqN
  where
    (seqN, revN) = foldl' step (S.Empty, False) [1 .. n]
    step (seq, False) k = (seq S.:|> k, BS.index bs (pred k) == 'o')
    step (seq, True ) k = (k S.:<| seq, BS.index bs (pred k) /= 'o')

    lstep S.Empty = Nothing
    lstep (x S.:<| xS) = Just (x, xS)

    rstep S.Empty = Nothing
    rstep (xS S.:|> x) = Just (x, xS)

D - X to Y

問題 ABC465D

シグネチャを決める。テストケースひとつを処理する。横着する。

abc465d :: [Int] -- X,Y,K
        -> Int   -- 答え

$\displaystyle \left \lfloor \frac{x}{K} \right \rfloor = y$ は、$x$ から直接計算できる。
$\displaystyle \left \lfloor \frac{y}{K} \right \rfloor = x$ とは、$Kx \leq y < K(x+1)$ の任意の $y$ が選べるということ。

$X,Y,K \leq 10^{18}$ という64ビット整数上限近い制約が問題になる。
掛け算を使うとあっさりオーバーフローする。

$x$,$y$ を $K$ 進数で表記した様子を考えると、
$\displaystyle \left \lfloor \frac{x}{K} \right \rfloor = y$ とは、$x$ の最下位桁を消すということ。
$\displaystyle \left \lfloor \frac{y}{K} \right \rfloor = x$ とは、$x$ の最下位桁に $[0,K)$の任意の「数字」を追加するということ。

なので、最下位桁を減らす向きだけで考えて、
$x,y$ の大きい方から最下位桁を消す、という操作を、両者が等しくなるまで繰り返せば、
求める手数が得られる。

結果

abc465d [x0, y0, k] = go x0 y0
  where
    go x y =
      case compare x y of
        EQ -> 0
        LT -> succ $ go x (div y k)
        GT -> succ $ go (div x k) y

E - Digit Circus

問題 ABC465E

シグネチャを決める。いかにも桁DPなので、$N$ は Integer でなく String で受け取る。

abc465e :: String -- N
        -> Int    -- 答え

考える

桁DPはいつも細かいところで混乱するので苦手。
今回きれいにできたので整理しておく。

桁DP

桁DPなので、区別するべき状態ごとに場合の数をカウントしていくことを、最上位桁から順に調べていく。
$N$未満の数であることが確定した場合についてカウントし、それらは、次の桁に0~9の任意の数字が続く。
別に、ちょうど上限$N$にぴったり張り付いている状態ががどこなのかも追跡し、
さらに次の桁が $D$ のとき、0~$D-1$の数字を続けることで、この桁で$N$未満になる場合を追加する。
最上位桁のとき、0の場合を数えてしまうと leading zero になるので除外する必要がある。
また、最上位桁以外のとき、その桁から始まる数を、先頭1から9として追加する必要がある。

最下位桁までDPが終わったら、ちょうど$N$を追加する補正をする。

場合の数をカウントする配列の添字範囲を bnds として、
全体的に次のようなコードになる。

import Data.Array.Unboxed
import Data.Char
import Data.List

abc465e :: String -> Int
abc465e n = {- final と nnn から答えを算出 -}
  where
    nd1:nds = map digitToInt n
    bnds = {- 場合の数をカウントする配列の添字範囲 -}
    initial :: UArray {- 添字の型 -} Int
    initial = listArray bnds $ repeat 0  -- カウント配列の初期状態オール0
    st0 = {- まっさらな状態 -}
    first = step True (initial, st0) nd1 -- 最上位桁を処理
    (final, nnn) = foldl' (step False) first $ map digitToInt nds -- 残りの桁を処理

    step msd (cnt, nn) nd = (cnt1, nn1)
      where
-- msd 最上位桁のときTrue
-- cnt カウント配列
-- nn Nに張り付いている状態
-- nd Nの次の桁の数字
-- cnt1 更新された、カウント配列
-- nn1 更新された、Nに張り付いている状態
-- 全ての有効な状態から、全ての数字で配る
-- Nから剥がれた状態を追加 msd = True のとき1からnd-1、Falseのとき0からnd-1
-- msd = False のとき、この桁から始まる数を1~9追加する

状態

  • 条件A:「3の倍数」は、使った数字を足し合わせて3の剰余をとった3状態で追跡できる。
  • 条件B:「十進表記に3が含まれる」は、3が現れたかどうかの真理値2状態で追跡できる。
  • 条件C:「十進表記でちょうど3種類の数字」は、使った数字の集合をビット表現で追跡できる。
    これはleading zero含めて$2^{10} = 1024$状態になる。
    条件Bの情報を含むので、統合する。

3つの条件を判定できる場合分け全てを区別する添字の型を (Int,Int)
添字の範囲を bnds = ((0,0),(2,1023)) と定める。

任意の状態に対して、さらに次に数字を続けたときの推移先が定められる。

next ac@(a,c) d = (mod (a + d) 3, setBit c d)

この推移先へカウント値を配る step が定義できる。

    step msd (cnt, nn) nd = (cnt1, nn1)
      where
        cnt1 = accumArray add 0 bnds $
          [(next st0 i, 1) | not msd, i <- [1 .. 9]] ++ -- この桁から始まる数
          [(next nn i, 1) | i <- [bool 0 1 msd .. nd - 1]] ++ -- Nから剥がれ落ちた数
          [(next st i, k) | (st,k) <- assocs cnt, k > 0, i <- [0 .. 9]] -- カウントしている数にもう一桁追加

集計

それぞれの状態が、条件A,B,Cを満たしているかを判定する。

condA (a,_) = a == 0

condB (_,c) = testBit c 3

condC (_,c) = popCount c == 3

この条件のうち、一つだけを満たしているものについて、カウント結果 final の総和を取る。
$N$ 自身 nnn について補正する。

abc465e n = summ
  [ k
  | (abc,k) <- (nnn,1) : assocs final, k > 0
  , (1 ==) $ length $ filter ($ abc) [condA, condB, condC] ]

F - Sjeltzer?

問題 ABC465F

シグネチャを決める。後の都合で Xi, Yi は文字列のまま受け取ることにする。

abc465f :: Int     -- N
        -> [[Int]] -- Si, Vi
        -> Int     -- Q
        -> [[String]] -- Xi, Yi
        -> [Int]   -- 答え
abc465f _n svs _q xys = ...

考える

添字の範囲0~9の、ただし6次元の配列について、いわゆるいもす法をやれ、と言っている。

包除原理

累積和をとった配列のどの要素を足してどれを引けば目標の範囲の和が得られるか、
2次元までならわかるけど、6次元とかどうしていいかわからない。
座標を圧縮して、0と1にして、オール1の範囲を目標として実験してみる。

import Data.Array

arr = accumArray (+) 0 ((0,0,0,0,0,0),(1,1,1,1,1,1)) $
  [(p, 1) | p <- range ((0,0,0,0,0,0),(1,1,1,1,1,1))] -- 累積和の (1,1,1,1,1,1) で取り出せる値の範囲=全体
  ++ [(p, -1) | p <- range ((0,0,0,0,0,0),(0,1,1,1,1,1))] -- 累積和の (0,1,1,1,1,1) に含まれる範囲を引く
  ++ [(p, -1) | p <- range ((0,0,0,0,0,0),(1,0,1,1,1,1))] -- ...
  ++ ...
  ++ [(p, -1) | p <- range ((0,0,0,0,0,0),(1,1,1,1,1,0))]

こんな感じで、次に1の数が多い枠を0にするように足したり引いたりしていくと、
「一番外側と、1の数の偶奇が同じときプラス、違うときマイナス」
にすればいいようだ、と見えてくる。
確認する。

arr = accumArray (+) 0 ((0,0,0,0,0,0),(1,1,1,1,1,1))
  [ (q, s)
  | p <- range ((0,0,0,0,0,0),(1,1,1,1,1,1)) -- 全ての位置について足すか引くかする
  , q <- range ((0,0,0,0,0,0), p)            -- 累積和の p 位置に含まれる範囲を
  , let (a,b,c,d,e,f) = p
  , let s = if even $ a+b+c+d+e+f then 1 else -1 -- 足すか引くか
  ]

elems arr すると、末尾の要素だけが1、他は全て0になって大成功。
これで包除原理は完全に理解できた。

累積和

6次元の各座標軸方向に累積和を取りまくる。7重ループを書く必要がある。
Double型が8バイト、$10^6$ 要素で8MB、結構なサイズなので、immutable arrayでやるのは諦める。
また、色々試した結果、Data.Ix による、6次元配列の配列添字からオフセットを求める積和演算が、
他の言語のように高速化できずに足を引っ張っているようだ。

そこで、配列は Data.Vector のように0始まりの一次元配列とし、
本来の6軸の座標範囲は0から9とすることで、Siの値をそのまま配列の添字とする。
累積和をとるときに、初期値0を入れる枠がなくなるので、読み取りのときに工夫が必要。

Si, Vi を配列に設定するのは容易にできる。

import Data.Array.Unboxed

    arr = accumArray (+) 0 (0,999999) [(s, v) | s:v:_ <- svs] :: UArray Int Int

6方向に累積和をとるとき、添字の計算で乗算を使わないように、また、結果を再利用するように工夫する。
少々泥臭いが、手書きで7重ループ。

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

    bases@[da,db,dc,dd,de,df] = [100000,10000,1000,100,10,1]
-- 6次元配列とみなして累積和を6回とる
    acarr = runSTUArray $ do
      ar <- thaw arr
      forM_ bases (\base ->
        forM_ (bool id tail (base == da) $ take 10 [0,  0  + da ..]) (\ja ->
        forM_ (bool id tail (base == db) $ take 10 [ja, ja + db ..]) (\jb ->
        forM_ (bool id tail (base == dc) $ take 10 [jb, jb + dc ..]) (\jc ->
        forM_ (bool id tail (base == dd) $ take 10 [jc, jc + dd ..]) (\jd ->
        forM_ (bool id tail (base == de) $ take 10 [jd, jd + de ..]) (\je ->
        forM_ (bool id tail (base == df) $ take 10 [je, je + df ..]) (\jf -> do
          a <- readArray ar (jf - base)
          b <- readArray ar jf
          writeArray ar jf (a + b) )))))))
      return ar

6桁について順に、累積和を取る桁として指定する (base)
6桁それぞれについて、0から9を回す、ただし base で指定された桁のときは1からにする
というロジック。

(添字の変数名を i 始まりにしたら idif で二つも被ってしまった。)

これで準備完了。

いもす法

上の「包除原理」の項での知見を適用する。
XiとYiの6つの数字それぞれについて、Xiの側-1と、Yiの側とのどちらかを選んで6桁の数を作る $2^6$ 通りの場合を網羅し、
Yi 側を選んだ個数の偶奇により、足すまたは引いて総和をとる。

ここでも、添字の計算において中間結果を再利用することを徹底する。

abc465f _n svs _q xys = map solve xys
  where
    solve (sx:sy:_)
      | bad       = 0
      | otherwise = recur False 0 (zipWith (*) bases $ map pred xs0) (zipWith (*) bases ys0)
      where
        xs0 = map digitToInt sx
        ys0 = map digitToInt sy

        bad = or $ zipWith (>) sx sy -- 区間に逆転があるものは空

        recur b i [] _ = bool id negate b $! acarr ! i
        recur b !i (x:xs) (y:ys)
          | x < 0     =                         recur (not b) (i + y) xs ys
          | otherwise = recur b (i + x) xs ys + recur (not b) (i + y) xs ys

まとめ

素直なHaskellで書くと全く間に合わず、速度を稼ぐために添字に関する本質的でない工夫が必要になった。
さらに Data.Vector.Unboxed.Mutable で書いたら Haskell 版最速タイムを達成した(提出)。

G - Sum of Mex of Mod of Linear

問題 ABC465G

公式解説もユーザ解説も、危険な空気をびんびんに漂わせているので火傷しないうちに撤収。

3
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
3
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?