A - Armor
シグネチャを決める。
abc461a :: Int -- A
-> Int -- D
-> Bool -- 答え
abc461a a d = a <= d
B - The Honest Woodcutters
シグネチャを決める。
abc461b :: Int -- N
-> [Int] -- Ai
-> [Int] -- Bi
-> Bool -- 答え
全ての $A_i = j$ に対して $B_j = i$ と対応が一致すればよい。
結果
abc461b _n as bs = and [bs !! pred a == i | (i, a) <- zip [1 ..] as]
C - Variety
シグネチャを決める。横着する。
abc461c :: [Int] -- N,K,M
-> [[Int]] -- Ci,Vi
-> Int -- 答え
色の種類の制約を満たしつつ、価値を最大にすることを考えると、
まず、全ての色についてその色で最大の価値を調べて、そこから上位M個を選んでこれを確定させる。
残りの$K-M$ 個は、選ばなかったものから、色関係なしに価値の上位を選べばよい。
結果
import Data.List
import qualified Data.IntMap as IM
abc461c :: [Int] -> [[Int]] -> Int
abc461c [_n,k,m] cvs = sum as + sum cs
where
(imN, ysN) = foldl' step (IM.empty, []) cvs -- 色ごとに最高の価値と、それ以外の価値のリスト
step (im, ys) (c:v:_) =
case IM.lookup c im of
Nothing -> (IM.insert c v im, ys) -- 初出の色は最高価値として登録
Just w -> (IM.insert c (max v w) im, min v w : ys) -- 既出の色は最高価値を再登録、選外はsndへ
(as,bs) = splitAt m $ sortBy (flip compare) $ IM.elems imN -- 上位M個とそれ以外
cs = take (k - m) $ sortBy (flip compare) $ bs ++ ysN -- bsと選外から残りを選ぶ
D - Count Subgrid Sum = K
シグネチャを決める。
abc461d :: [Int] -- H,W,K
-> [String] -- Si
-> Int -- 答え
いわゆるいもす法、二次元累積和を使って、領域の合計を素早く求める話なのだけど、総当たりする場合が多いので工夫をする。
まず、行の範囲 $r_1, r_2$ に関して総当たりする、そのある一つの計算としてこれらの値を固定して考える。
縦方向、列ごとに1がいくつあるかを、足し合わせることで求めておく。
この数列について、区間の和が K になるような $c_1, c_2$ の組の個数を数える。
ここで尺取法を使うと、横方向の累積和をとることなく、$O(W)$ で達成できる。
ただし注意する点として、値に0がありうるのに、尺取法では $c_1$ に対して最小の $c_2$ しか見つけられない。
これを克服するため、右側を取り込むとき、正の値を必ず取り込むようにして、それに0が続いているときそれらも同時に全て取り込み、その個数を記録しておくことで、数えるべき区間の個数を補正する。
左側についてもどうようにできるはずだが、バグが解消できなかったので、こちらはひとつず進めることにする。
尺取法は K=0 の場合には対応できないので、これはまた別の対応が必要になる。
しかし実はこちらの方が楽で、0が続く区間だけ抽出し、それぞれの0の個数 k に関して $k (k + 1) / 2$ のやり方を計上するだけでよい。
$r_1, r_2$ に関して総当たりするところは、毎回足し合わせるのでなく、
$r_2 = r_1$ から始め、$r_2$ を一つ大きくするたびに次の行を足し合わせることで、縦方向の和を順に求められる。
これの計算量は、ストレートにいもす法を使って、全体の二次元累積和を計算しておいて、後は引き算をする方法と結局変わらない。
結果
import Data.Char
import Data.List
abc461d :: [Int] -> [String] -> Int
abc461d [_h,_w,k] ss = sum
[ solve acs -- 尺取法で合計 K の区間の個数を数える
| oxss1 <- tails oxss -- 上の行を総当たり
, acs <- scanl1 (zipWith (+)) oxss1 -- 下の行まで足し合わせるのを総当たり
]
where
oxss = map (map digitToInt) ss -- 行ごとの値
solve = if k == 0 then solveZ else solveNZ
-- K=0のとき
solveZ = sum . map ((\k -> div (k * succ k) 2) . length) . filter head . group . map (0 ==)
-- K≠0のとき
solveNZ acs
| head acs == 0 = maomao 0 acs (length as) xs
| otherwise = maomao 0 acs 1 acs
where
(as,xs) = span (0 ==) acs
maomao acc ls _ rs | acc < k = -- 足らないとき、右を伸ばそうとする
case chomp rs of
Nothing -> 0 -- 伸ばせないので終了
Just (r, cr1, rs1) -> maomao (acc + r) ls cr1 rs1 -- 伸ばした
maomao acc ls cr rs = -- ちょうどか多いとき、左を縮める
(if acc == k then cr else 0) + -- ちょうどのときはcrのスコアを得る
case ls of
[] -> 0 -- 縮まないので終了
l:ls1 -> maomao (acc - l) ls1 cr rs -- 縮めた
chomp [] = Nothing -- 右側を取り込むときに後続する0を数えて捨てる
chomp (x:xs) = Just (x, succ $ length as, bs)
where
(as,bs) = span (0 ==) xs
公式解説のやり方？
似たような方針でやっているように話は書いてあるけど、似て非なるところが理解しづらい。
自分の maomao は、取り込んでいる区間の和を維持する状態を持っている。
それをしない代わりに、横方向の累積和をとって、左(l)と右(r1,r2)の位置を状態として持ち、
差(a[r1]-a[l])で区間の和を取り出している。
自分の苦労した、0行進があるときへの対処は、
K以上になった位置で止まるr1と、K超えで止まるr2との差で数えるという点がミソらしい。
なのでその差を res+=(r2-r1) で足し込んでいる。
r1=max(r1,l+1) によって、rがlに追いつかれたときに押し出すことで、K=0の場合も対応できるようにしている。
添字を使っているからできる芸当で、自分の Haskell リスト式尺取法ではこれは真似できないな…
E - E-liter
シグネチャを決める。
諸事情により、答えは出た側から print していく形にする。
abc461e :: Int -- N
-> Int -- Q
-> [[Int]] -- query_i
-> IO () -- 答えを求める
諸事情
セグメント木と、もう一つ命令型配列が必要なので、Data.Array.Diff がない以上
一つ一つのクエリを処理する計算はIOまたはSTのモナドアクションにせざるを得ない。
どちらでもよいが、IOとしておく。
すると、プログラムの概形は以下のようにできる。
ただし、全てのクエリは必ず答えを返すため、そうでない場合よりは少し楽になっている。
abc461e n q qs =
do
{- 準備 -}
forM qs (\qi -> do
{- クエリ処理 -}
return {- 答え -}
)
ところでこの問題の場合、命令型配列に加えてもう一つ「現在の黒マスの数」という状態を持ち回す必要がある。
forM のままこれを受け渡すには、IORef で状態を保存しておいて読み書きする、という、
それもう命令型言語で書いたら？なコードになってしまう。
純粋計算ならこれは mapAccumL で済むのだが、モナドにこれがないのが厄介。
foldM が使えそうだが、
abc461e n q qs =
do
{- 準備 -}
foldM_ (\state qi -> do
{- クエリ処理 -}
return state'
) {- 状態の初期値 -} qs
ループ内のアクションが return するものが答えでなく次の周回に伝える状態になってしまい、
答えを集める方法を別に設ける必要がある。
Writer モナドを重ねて tell するのが教科書的な解決策。
そこまでしなくても、計算アクションがIOモナドなら、もうprintして終わりでよくない？
abc461e n q qs =
do
{- 準備 -}
foldM_ (\state qi -> do
{- クエリ処理 -}
print {- 答え -}
return state'
) {- 状態の初期値 -} qs
ということで、微妙に不本意ながら、こういうシグネチャにした。
このスタイルに割りきると、AtCoderでしばしば見る、タイプ1クエリでは計算だけ、タイプ2クエリでは答えを返す、というような場合にも対応が容易で便利。
MS copilot さんに聞いたら、mapAccumM 自作する手があるよ、と言われた。
mapAccumM :: Monad m => (s -> a -> m (s, b)) -> s -> [a] -> m (s, [b])
mapAccumM _ s [] = return (s, [])
mapAccumM f s (x:xs) =
do
(s1, y ) <- f s x
(s2, ys) <- mapAccumM f s1 xs
return (s2, y : ys)
わかるけど、pure な遅延計算なら y : まで計算して次のステップに渡すストリームが起きるのに、
これだと mapAccumM ... xs の計算が完了するまで答えはふん詰まりで出てこないので、
$Q \leq 3 \times 10^5$ みたいな状況でそれはうれしくない。
考える
黒い横線を引くとき、それが初めてのその行への線なら、元は真っ白なので黒マスは N 個増える。
そうでないとき、前回引いたときから現在までに、白い縦線を引いた本数（ただし重ね塗りに注意）だけ白マスで途切れているのを塗り直すので、その本数になる。
白い縦線を引くとき、それが初めてのその列への線なら、ビッグバンから現在までに引いた全ての黒い横線を寸断するので、その本数（ただし重ね塗りに注意）だけ黒マスが減る。
そうでないとき、前回引いたときから現在までの本数で同様に考える。
なので、一度も引いたことがない場合、時刻0に引いたと見なして、初回かどうかの判別は不要。
黒線については、一度も引いたことがない場合はそのように識別する必要がある。
ある行または列への書き込みを前回した時刻は、命令型配列に、最終書き込み時刻を上書きしていくことで追跡できる。
初期値-1としておき、-1なら初回とする。
さて、ある時刻から現在までにひいた線の本数、ただし重ね塗りを正しく数えて、の方法として、
自分は、「時刻を添字、引いてある線の行または列番号のIntSetを値、演算は和集合」というセグメント木を考えた。
このとき、セグメント木を構築する最初の段階で全てのクエリに対して値を設定してしまい、
クエリに対しては、時刻のスパンでの問いあわせをするだけで、セグメント木の修正は不要になった。
意外にもメモリに関しては大丈夫だったのだが、さすがに計算時間が厳しくてTLEしてしまった。
公式解説を見た
セグメント木に対して調べる時刻範囲が、前回から現在、と常に後ろが一定なことに注目する。
そこで、セグメント木の構成を「時刻を添字、過去の任意の時刻から現在までに引かれて現在まで有効になっている線の本数を値、演算は足し算」とする。
線が上書きされたとき、最新の時刻での書き足しについて1とし、前回の書き込みについてセグメント木の要素を0に修正することで、「現在までの範囲で」何本引かれているかを数えるだけの使い方で齟齬が出ないようにするのがポイント。
結果
import Control.Monad
import Data.Array.IO
abc461e :: Int -> Int -> [[Int]] -> IO ()
abc461e n q qs =
do
prev <- newArray (-n,n) (-1) :: IO (IOUArray Int Int) -- 以前のクエリの時刻
st1 <- makeRQArrayN (+) 0 (q + 1) :: IO (RQArray IOUArray Int) -- 横線を数えるセグ木
st2 <- makeRQArrayN (+) 0 (q + 1) :: IO (RQArray IOUArray Int) -- 縦線を数えるセグ木
foldM_ (body prev st1 st2) 0 $ zip [0 ..] qs
where
body prev st1 st2 cnt (i, (1:r:_)) = do
j <- readArray prev r -- 前回の時刻、または-1
writeArray prev r i -- 今回の時刻に更新
updateRQArray st1 i 1
when (j >= 0) $ updateRQArray st1 j 0
cnt1 <- (cnt +) <$> if j < 0 then pure n else queryRQArray st2 j i
print cnt1
return cnt1
body prev st1 st2 cnt (i, (2:c:_)) = do
j <- readArray prev (- c)
writeArray prev (- c) i
updateRQArray st2 i 1
when (j >= 0) $ updateRQArray st2 j 0
cnt1 <- (cnt -) <$> queryRQArray st1 (max 0 j) i
print cnt1
return cnt1
F - Total Product is N
シグネチャを決める。
abc461f :: Int -- N
-> Int -- 答え
考える
結局、Aの要素としては、Nのいずれかの約数しか登場しない。
計算の途中で、使用済みのAでNを割った、以降に選択するAで作るべき積の値も同様である。
なのでまずNの約数をすべて求めておく。
あとは普通にDPで、約数を小さい方から $a$ 個までを使ってよいという上限を順に引き上げつつ、
その中で実際 $b$ 個を選んだ、その積が $c$ になるような場合について、
一つの場合のスコア $s$ を考える。
$a$ を一つ増やして次の約数 $f$ を選ぶとき、選んだ個数は $b+1$ に、積は $cf$ に、スコアは $s+f$ になる。
$a,b,c$ について複数の場合が考えられる、例えば約数2,3,4 を選んだ場合と約数 1,3,8 を選んだ場合のように。
そのため、それらをひとまとめに考えようとすると、
重ねられている場合の数を $k$ として、$f$ を選ぶときスコアは $s + fk$ になり、
他からの場合を合流させるときはスコア、場合の数ともに足し合わせればよい。
スコアを $S[a,b,c]$, 場合の数を $K[a,b,c]$ とすると、基底部は次のようになる。
$S[0,0,1] = 0, S[0,b,c] = 0$
$K[0,0,1] = 1, K[0,b,c] = 0$
$N$ の約数が$M$個、$f_1, f_2, \dots, f_M$ とすると、再帰部は、$f_a$ を使うかどうかで場合分けすることになり、
$c f_a$ が $N$ の約数でないとき、使えないので増加なし：
$S[a,b,c] = S[a-1,b,c]$
$K[a,b,c] = K[a-1,b,c]$
$c f_a$ が $N$ の約数であるとき、使わない場合と使う場合との和を考えるので、$c \cdot f_a \cdot g = N$ として
$S[a,b,c] = S[a-1,b,c] + S[a-1,b-1,g] + f_a \cdot K[a-1,b-1,g]$
$K[a,b,c] = K[a-1,b,c] + K[a-1,b-1,g]$
最終的に $S[M,b,N]$ を全ての $b$ について、順列の分 $b!$ を掛けながら足し合わせれば答えが得られる。
実際には $b,c$ に関する二次元配列を、漸化式によって$M$回更新することで計算できる。
と、ここまではいい。
しかし実装すると、どうも計算時間が足らない。$a$が0から$M$まで増えるに従って、
$b$も$M$まで増え、$c$も$N$の約数としての背番号で考えて1から$M$まで考えればよいので、
計算量は $M^3$ かかるとしか思えない。
bの上限：公式解説をみる
$\prod_{i=1}^{14} i > 10^{10}$ なので、 $b$ は14以下で計算すればよいです。
えっ？
使う約数として最小のものを選んで、その積が上限を超えるのが14個のときなので、
$0 \leq b < 14$ の範囲だけ考えればよい、と。
これは本当に大雑把な上限で、実際には求めた$N$の約数を小さい方から掛けて$N$以下であるような個数がその問題の場合の真の上限になる。
$c$ の値として $N$ 以下の場合しか考えないので、これを超えた領域では0行進しか起きていないのだが、それらを空虚に舐めて更新する計算量の無駄が嵩んだらしい。
配列を使ったDPでTLEしなくなった。が、02_03.txt ひとつREが残った。何だこれ。
約数か判定：Companionsに頼る
特徴的な結果なので、AtCoder Companionsに聞いたら、あっさり解決策が得られた。
「$c f_a$ が $N$ の約数であるかを判定する」には、当然、mod n (c * f) == 0 とやる、これが間違いだと。
mod (div n c) f == 0 とやれと。ナンデ？同じじゃん？
$N \leq 10^{10}$ という制約がミソで、$f_M, f_{M-1}$ がやはり $10^{10}$ に近い値をとるような $N$ を持ってこられると、
$c$ と $f_a$ がこれになり、その積が $10^{20}$ 近くなる。
64ビット整数は $10^{18}$ までなら安全だが、$10^{19}$ はオーバーフローする。
なので前者の c * f はオーバーフローの危険があり、それを回避する必要があるのだと。
二次元immutable配列を使った実装 499ms
座標圧縮的に、Nの約数からその背番号を取り出すIntMapを検索することで、Nの約数でないような $c f_a$ は表にないし、オーバーフローしてもやはり表にないから、上の問題が回避できている。
Haskellyな解
状況を二次元配列でなく、IntMap の無限リストで保持することにする。
DPループの周回で $a$ を表現する。
リストの第 $b$ 要素が、使っている約数の個数に関する情報。
IntMap のキーは、使った約数の積 $c$。
IntMap の値は (Int,Int) で、左がスコア $S$ で右が場合の数 $K$。
初期状態は、先頭に1要素があり、後は空なマップが無限に続く。
ステップ処理では、追加分を持つリストを作り、一つ後ろにずらしてから zipWith でマージする。
最終結果を「全ての $b$ について足し合わせる」がこのままでは無限リストになるが、
空マップでないところまで取り出す takeWhile (not . IM.null) をかけることで、意味のある値がある範囲だけ切り取れる。
import qualified Data.IntMap as IM
import Data.List
abc461f :: Int -> Int
abc461f n = summ [mul s f | (im, f) <- zip imsZ $ scanl mul 1 [1 ..], Just (s, _) <- [IM.lookup n im]]
where
ims0 = IM.singleton 1 (0,1) : repeat IM.empty
imsZ = takeWhile (not . IM.null) $ foldl' step ims0 $ factors n
step ims f = zipWith (IM.unionWith addp) ims $ IM.empty : map (ff f) ims
ff f im = IM.fromDistinctAscList
[(p * f, (add s $ mul f k, k))
| (p, (s, k)) <- IM.assocs im
, mod (div n p) f == 0] -- オーバーフロー対策
addp (a,b) (c,d) = (add a c, b + d)
factors :: Int -> [Int] -- 約数列挙
提出 1901ms で間に合った。
DPしない解
そも、こんなつぶやきがTLに流れてきたときから気になっていた。
ユーザ解説にも、できると書いてある。
約数のリストと階乗のリストを両方持ち回し、約数を一つ使うたびに階乗のリストも一つ進めることで、
答えに到達したときにちょうど、使った約数の個数の階乗がリストの先頭にあるようにする。
ユーザ解説のヒントに、約数1はまともに相手をするな、とある。
つまりそれ以上の約数についてだけ考えて、
約数 $b$ 個で合計 $s$ な場合が見つかったら、1を使う場合も合わせて
$s \cdot b! + (s+1) \cdot (b+1)! = s \cdot (b! + (b+1)!) + (b+1)!$
を答えに足し込めばよい。これで探索空間を半分にできる。
しかしまだTLEする。
ユーザ解説のサンプルコードを読んだ。
自分の素朴な再帰は、
今考えている値について、約数リストの先頭と比較して、
・約数で割り切れないなら、その約数を使わない場合だけを考えるために、約数を一つ捨てて再帰する
・割り切れる場合、使わない場合と、使う場合の両方で再帰し、結果を足し合わせる
という2分岐をしていた。これだと、次に割り切る約数に到達するまで、一つずつ再帰を繰り返すために大変遅い。
約数の個数$M$に対して$2^M$通りの再帰呼び出しをするのではとても遅いに決まっている。
そこで、
今考えている値について、約数リストの全ての値と比較して、
・割り切れないものについてはもう考えない
・割り切れるものについて、それを使って、さらにその値以降の約数について再帰した結果を足し合わせる
というn分岐にすることがポイントのようだ。
さらにこれに加えて、「約数リストを降順にすることで、考えている値を急速に小さくし、分岐先も減らす」
を使うことで、制限時間に間に合った。
import Data.List
abc461f :: Int -> Int
abc461f n = recur n 0 (reverse $ tail $ factors n) facts
where
facts = scanl mul 1 [1 ..]
recur 1 s _ (e1:e2:_) = add e2 $! mul s $! add e1 e2 -- 割りきったら成功
recur x s fs (_:es) = summ
[ recur q (add s f1) fs1 es
| (f1:fs1) <- tails $ dropWhile (x <) fs -- xを割りきるようなfsの要素について、それ以降について続きをする
, let (q,r) = divMod x f1, r == 0 ]
提出 1856ms
G - Graph Problem 2026
…ごめん。