Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

This article is a Private article. Only a writer and users who know the URL can access it.
Please change open range to public in publish setting if you want to share this article with other users.

ABC179をHaskellで

0
Last updated at Posted at 2026-04-15

A - Plural Form

問題 ABC179A

シグネチャを決める。

abc179a :: String  -- S
        -> String  -- 答え
abc179a s = s ++ if last s == 's' then "es" else "s"

B - Go to Jail

問題 ABC179B

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

abc179b :: Int      -- N
        -> [[Int]]  -- Di,j
        -> Bool     -- 答え

Data.List.Split.divvy で連続する3つずつに切り出すと便利。

結果

import Data.List.Split

abc179b :: Int -> [[Int]] -> Bool
abc179b _n dss = or $ map and $ divvy 3 1 [d1 == d2 | d1:d2:_ <- dss]

お節介な言語支援が or . map andany and に書きかえろと言ってくる。
述語といえない and をそうやるのは自分には奇妙に見える。

C - A x B + C

問題 ABC179C

シグネチャを決める。

abc179c :: Int     -- N
        -> Int     -- 答え

$1 \leq A,B,C$ より、$1 \leq A, A \times B \leq N-1$ となる。
ある $A$ に対して、$A \times B \leq N-1$ となる $B$ の個数は $\lfloor (N-1)/A \rfloor$ となり、
ある $A,B$ に対して、$C = N - A \times B$ は一意に定まる。

結果

abc179c n = sum [div n1 a | let n1 = pred n, a <- [1 .. n1]]

ユーザ解説 by drken のやり方

これはすごい。
ふたつの場合がどちらも $\sqrt N$を超えないところまで A を増やしていくので、同時に求める。

abc179c :: Int -> Int
abc179c n = sum
  [ 1 + 2 * (div n1 a - a)
  | let n1 = pred n
  , a <- takeWhile ((n >) . (^ 2)) [1 ..] ]

D - Leaping Tak

問題 ABC179D

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

abc179d :: Int      -- N
        -> Int      -- K
        -> [[Int]]  -- Li,Ri
        -> Bool     -- 答え

考える

$[Li,Ri]$ により選べる、進む歩数のバリエーションがやたらと多いという点に目をつぶれば、
普通にスゴロクでゴールに到達するやり方の場合の数を聞かれているのと変わらない。

小さなサイコロによるスゴロク問題は簡単な配るDPで解ける。
マス 1~N への行き方の場合の数を足し込む配列 $cnt[1..N]$ を用意し、
$cnt[1] = 1, cnt[1 < i \leq N] = 0$ と初期化しておく。
スタートマス $i = 1$ から順に、そのマスまでの行き方の場合の数 $cnt[i]$ を、
サイコロのそれぞれの目 $k$ について、それだけ進んだマス $cnt[i + k]$ に足し込む。
ゴールまでこの処理が済んだら、$cnt[N]$ が答え。

しかしこの問題の場合、$1 \leq L_i \leq R_i \leq N \leq 2\times 10^5$ と
サイコロの面が多すぎるので、単純に実装するとマスごとに配る計算が $O(N)$ になり間に合わない。

ひとつの解法は、$K \leq 10$ 個の区間からなることを利用して、
遅延セグメント木を、範囲に対して操作を加えることのできる配列として利用する方法である。
これなら、配るDPの基本形をそのまま拡大することで実現できる。
ただ、この頃のD問題にしては使う道具が大袈裟な印象。

もうひとつのやり方は、累積和による積分を使う。
しかし、マスを進める毎に新たな差分が足し込まれる。
これを毎回先頭から足し合わせると、全体の計算量は $O(N^2)$ になってしまう。
位置 $i$ から分配する先は $j > i$ なマスだけで $i$ 以前は変化しないので、
累積和の計算は前回までの結果を持っておき、続きから行うようにすることで、$O(N)$ になる。

結果

Data.IntMap を配列の代用にしたimmutable実装。

import qualified Data.IntMap as IM

abc179d :: Int -> Int -> [[Int]] -> Int
abc179d n _k lrs = ans
  where
    delta0 = IM.fromList [(1,1),(2,-1)]
    (ans, _cntN) = foldl' step (0, delta0) [1 .. n]
    step (acc, delta) i = (acc1, delta1)
      where
        acc1 = add acc $ IM.findWithDefault 0 i delta
        delta1 = IM.unionWith add (IM.delete i delta) $
                 IM.fromListWith add $
                 [ p
                 | l:r:_ <- lrs, let il = i + l, il <= n
                 , p <- (il, acc1) : [(ir1, - acc1) | let ir1 = i + succ r, ir1 <= n]]
    add x y = mod (x + y) 998244353

これでも 538ms で間に合う。
同じアルゴリズムをSTArrayにより命令的に実装すると 16ms なので比較にならないが…

公式解説から

「配るDP、貰うDPのどちらでも解くことができる」
注目しているマス i へと遷移できるマスの集合を $L_i, R_i$ から逆算しておいて、それらの区間の値の和を遅延セグメント木で求めて、その結果でセグメント木を更新する感じかしら。

「$O(N \log N)$ で解けることが知られている」
は ユーザ解説 by maspy に書いてある「形式的べき級数の逆元」らしい。
ユーザ解説 by drken にも言及とC++コードがある。

E - Sequence Sum

問題 ABC179E

シグネチャを決める。

abc179e :: Int  -- N
        -> Int  -- X
        -> Int  -- M
        -> Int  -- 答え

$N \leq 10^{10}$ と大変な個数の項を足し合わせろと言われている。
しかし各項は剰余であることから $0 \leq A_i < M$ なので、バリエーションはそんなになく、数列はすぐ同じパターンの繰り返しにおちいる。
$S(a,b) = \sum_{i=a}^b A_i$ とする。

ループにはいる最初の項 $A_j$ とループの長さ $L$ がわかれば、
(つまり $j \leq k$ について $A_k = A_{k+L}$)
$j \leq N$ のとき、ループ回数と最後の周回の余りを $(N - j) \div L = Q \cdots R$ として、
答えは $S(1,j-1) + Q \times S(j, j+L-1) + S(j,j+R-1)$ とわかる。
$N < j$ と小さいとき、あるいは $N < M$ のときは、直接 $S(1,N)$ を求めればよい。

$L$ を求めるには、最悪の場合 $L = M$ であっても $A_{M+1}$ は確実にループの2周目に入っているため、
$A_{M+1}$ と等しい最大の添字の $A_i$ を探せばその差が $L$ である。
$L$ が判れば、$j$ は先頭から探せばよい。

結果

import Data.Array.Unboxed

abc179e :: Int -> Int -> Int -> Int
abc179e n x m
  | n <= m    = sum $ take n $ iterate f x
  | otherwise = s13 + q * s2
  where
    f a = mod (a * a) m
    m1 = succ m
    a = listArray (1, m1) $ iterate f x :: UArray Int Int -- A[1~M+1]
    am1 = a ! m1
    l = head [m1 - i | i <- [m, pred m ..], a ! i == am1] -- L
    j = head [i | i <- [1 ..], a ! i == a ! (i + l)]      -- j
    s13 = sum $ take (pred j + r) $ elems a
    (q,r) = divMod (n - pred j) l                         -- Q,R
    s2 = sum [a ! i | i <- [j .. pred j + l]]

ダブリングによる解法

ユーザ解説 by drken より。
計算量が上の $O(M)$ より遅い $O(M \log N)$ ではあるけど、違うアプローチ。

$A_i$ のとる値 $0 \leq v < M$ 全てについて、

  • $2^t$ ステップ進んだ値 $nex[t][v] = f^(2^t)(v)$
  • その手前の項までの総和 $sam[t][v] = v + f(v) + \dots + f^(2^t-1)(v)$

を、$2^t \leq N$ まで表で求める。$N$の2進表現からこの表の値を上手いこと拾うことで答えが得られる。
べき乗の計算を $x^5 = x^1 \cdot x^4 = x^1 \cdot (x^2)^2$ みたいにやるあれ。

ふたつのテーブルの初期値と漸化式は次のようになる
nex[0][v] = f(v), nex[t][v] = nex[t-1][nex[t-1][v]]
sam[0][v] = v, sam[t][v] = sam[t-1][v] + sam[t-1][nex[t-1][v]]
次の段階のテーブルの構築と、$A_1 = X$ から出発して N ステップを2のべきで辿った先とそこまでの和を現在のテーブルから取り出す計算を同時並行で行う。

import Data.Array.Unboxed
import Data.List

type ARR = UArray Int Int
type State =
  ( Int -- 現在の値 Ai
  , ARR -- 現在のnexテーブル
  , ARR ) -- 現在のsamテーブル

abc179e :: [Int] -> Int
abc179e [n, x, m] = sum $ snd $ mapAccumL step (x, nex0, sam0) bs
  where
    bnds = (0, pred m)
    f a = mod (a * a) m -- 関数 f(x,m)

    bs = map odd $ takeWhile (0 <) $ iterate (flip div 2) n -- Nの2進表現

    nex0 = listArray bnds $ map f [0 ..] :: ARR
    sam0 = listArray bnds [0 ..] :: ARR

    step :: State
         -> Bool         -- Nの2進展開、下位桁から。Trueのときテーブルを辿り、Falseのときは辿らない
         -> (State, Int) -- 移動した A[i+2^t], 更新したテーブル、sam ! Ai
    step (v, nex, sam) b
      | b         = ((nex ! v, nex1, sam1), sam ! v)
      | otherwise = ((v, nex1, sam1), 0)
      where
        nex1 = listArray bnds [nex ! j | j <- elems nex]
        sam1 = listArray bnds [s + sam ! j | (j,s) <- zip (elems nex) (elems sam)]

ダブリング完全に理解した。
理屈でいうとこのアルゴリズムは、自分のこのライブラリ関数

powerish mul i a b = foldl' mul i [p | (True, p) <- zip bs ps]
  where
    bs = map odd $ takeWhile (0 <) $ iterate (flip div 2) b
    ps = iterate (\x -> mul x x) a

の延長上にあるはずだけど、今回のこのコードを取り込めるように抽象化できる気がしない。

F - Simplified Reversi

問題 ABC179F

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

abc179f :: Int      -- N
        -> Int      -- Q
        -> [[Int]]  -- Query_i
        -> Int      -- 答え

ナナメはないオセロ。
状況を考えると、それぞれの行と列に関して、もっとも手前にある白石までの黒石はいくつか、
という状況を追跡できればよい。

クエリ $(1,x)$ について、列 $x$ で今回得られる白石の個数 $k$ が取得できる。
また、行 $1$ から行 $k$ について、黒石の個数は、現在の値と $x-1$ との小さい方に更新される。

区間での更新を行うので、遅延セグメント木を、区間で更新できる配列として利用することで達成できる。
横に足し合わせる演算は不要で、一点について読み出せればそれでよいが、(+) 0 を普通に指定しておけばよいだろう。
区間で更新する値の演算は min で、それどうしの重ね合わせも min デフォルト値は N 超の任意の値でよい。

結果

遅延セグメント木はシグネチャだけ示す。
提出, 633ms

import Control.Monad.ST

abc179f :: Int -> Int -> [[Int]] -> Int
abc179f n _k qs = runST $
  do
    stV <- makeSegTree min n min (const min) n $ replicate (n-2) (n-2)
    stH <- makeSegTree min n min (const min) n $ replicate (n-2) (n-2)
    ((n-2)^2 -) . sum <$> forM qs (action stV stH)
  where
    action stV stH (1:x:_) = body stV stH x
    action stV stH (2:x:_) = body stH stV x
    body st1 st2 x = do
      y <- querySegTree st1 (x-2) (x-1)
      updateSegTree st2 0 (succ y) (x-2)
      return y

--- 遅延セグメント木
data SegmentTree s a b = SegmentTree
  (a->a->a) a                  -- 集める演算と0値
  (b->b->b) (Int->a->b->a) b   -- 重ねる演算の乗数併合演算、重ねる演算、1値
  Int                          -- 見かけの配列としての要素数
  (STree s a)                  -- 区間の積和集計結果をもつ配列
  (STree s b)                  -- 区間更新の(*)の値をもつ配列

type STree s a = MUV.STVector s a

-- 初期値を指定して遅延セグメント木を作る
makeSegTree :: (MUV.Unbox a, MUV.Unbox b)
             => (a -> a -> a) -> a       -- (+)演算
             -> (b -> b -> b) -> (Int -> a -> b -> a) -> b -- (*)演算
             -> [a]                      -- 初期値
             -> ST s (SegmentTree s a b) -- 遅延セグ木
makeSegTree f z g h l xs = ...

-- 問いあわせ
-- querySegTree st a b : [a, b)の区間の値を求める
querySegTree :: (MUV.Unbox a, MUV.Unbox b)
             => SegmentTree s a b
             -> Int -> Int -> ST s a
querySegTree (SegmentTree f z g h l w vec wec) a b = ...

-- 区間更新
-- updateSegTree st a b y : [a,b) の区間の要素の係数にyをgで注ぎ足す
-- 戻るときに、ノードの全区間での結果を上に戻すことで全区間結果を更新する、問いあわせと似た動きもする
updateSegTree :: (MUV.Unbox a, MUV.Unbox b)
              => SegmentTree s a b
              -> Int -> Int -> b -> ST s ()
updateSegTree (SegmentTree f z g h l w vec wec) a b y = ...

公式解説のやり方

これも ユーザ解説 by drken でないと何を言っているのかわからなかった。

素朴に、全ての行、全ての列に関して、黒石の取れる個数を配列に持っておくと、更新が大変すぎる。
よく考えると、左上の、最も細かく区切られた領域だけが、さらに切り刻まれる可能性があり、
それより右下の領域へのクエリは、切り刻みに影響しない。
なので、左上領域の大きさ(左上領域の右下の位置?)を追跡する。
そして、この領域が縮むたびに、新たに縮んだ区間は、現在の高さで値が固定される。これは以降変更されない。
そのような固定された値だけを配列に書き込むと、書き込み回数は全体でたかだか $O(N)$ 取り出しは $O(1)$ になる。

これなら IntMap で近似して実装しても間に合いそう。
またそのとき、配列的に使うよりも、lookupLE を使う前提で端っこだけ書き込めば節約できる。

import qualified Data.IntMap as IM

abc179f :: Int -> Int -> [[Int]] -> Int
abc179f n _k qs = ((n-2)^2 -) $ sum $ snd $ mapAccumL step ((n,im0),(n,im0)) qs
  where
    im0 = IM.singleton n n
    step (h,v) (1:x:_) = body h v x
    step (h,v) (2:x:_) = let ((v1,h1),res) = body v h x in ((h1,v1),res)
    body hxhm@(hx, hm) vxvm@(vx,vm) x
      | vx < x = ((hxhm, vxvm), res-2)
      | otherwise = (((hx, IM.insert res x hm), (x, vm)), res-2)
      where
        Just (_,res) = IM.lookupGE x vm
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

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?