2025-10-6 プロパティを思いついたので追記
ネットをふらふらしていたらHaskell初級者がAtCoderの問題でプロパティベーステストを試すという記事を見つけて、例題がABC333Cだったので、FとGを埋めて書きました。
A - Three Threes
シグネチャを決める。1桁の数なので文字で読み込んでしまう。
import Data.Char
abc333a :: Char -- N
-> String -- 答え
abc333a n = replicate (digitToInt n) n
ウルトラC
ユーザ解説にすごいのが書いてあった。
そもそも333回めなので repunit がらみのネタで、$n$ 桁の repunit は $\frac{10^n - 1}{10 - 1}$ で作れるので、それを n 倍すれば全て数値計算でいけるという。
$\frac{10^n - 1}{10 - 1}$ は、分子は「9がn桁並んだ数」になるので、9で割ったらrepunitになる。
これは、2進数で1がn個並んだ数を作るのに $2^n - 1$ とやるのと同じで、繰り下がりを利用している。
abc333a :: Int -- N
-> Int -- 答え
abc333a n = n * div (10 ^ n - 1) 9
B - Pentagon
シグネチャを決める。横着する。
abc333b :: String -- S_1 S_2
-> String -- T_1 T_2
-> Bool -- 答え
文字のアスキーコードの差を絶対値で求めると位置の差 1～4 になる。
3,4はそれぞれ2,1に読み替える。
結果
import Data.Char
abc333b s12 t12 = dist s12 == dist t12
where
dist (c1:c2:_) = [0,1,2,2,1] !! abs (ord c1 - ord c2)
別解
当時の自分のコードはかなり様子が違う。
abc333b (s1:s2:_) (t1:t2:_) = ns == nt
where
ns = succ1 s1 == s2 || s1 == succ1 s2
nt = succ1 t1 == t2 || t1 == succ1 t2
succ1 'E' = 'A'
succ1 c = succ c
長さ0でないこと $S_1 \neq S_2, T_1 \neq T_2$ が保証されているならば、
あとは「ひとつ隣」か「ふたつ隣」かのどちらかしかない。
前者かどうかを succ1 で等しくなるかで判定している。
公式解説と同じアプローチではあるようだ。
ユーザ解説も同じことを、風変わりな方法で判定している。
そのまま再現すると
import Data.List
abc333b :: String -> String -> Bool
abc333b s12 t12 = side s12 == side t12
where
side s = isInfixOf s "ABCDEAEDCBA"
このテクニカルな文字列で空間節約するのもなんだかなぁと思うのでもう少しまとも(?)にやると
abc333b :: String -> String -> Bool
abc333b s12 t12 = side s12 == side t12
where
conn c d = [c,d]
side1 = zipWith conn "ABCDE" "BCDEA"
side2 = map reverse side1 ++ side1
side s = elem s side2
C - Repunit Trio
unit を repeat したものだから rep-unit で、ネイティブの発音が「レピュニット」にしか聞こえなくてもそれは音韻で、カタカナでは「レプユニット」と綴るべきなんじゃないか派です。
シグネチャを決める。
abc333c :: Int -- N
-> Int -- 答え
例1に、同じrepunitを複数回使ってもいいと書いてある。思い違いしやすいポイントだ。
$n$桁のrepunitを$R(n)$とする。
最大の桁数が $m$ であるような「3つのrepunitの和」からなる集合を $S(k) = { R(i) + R(j) + R(k) \mid i,j \leq k}$ とする。
ここで、同じ桁のrepunitを3つ足し合わせても $33\cdots3$ という数になるだけで桁上がりは起きないことから、これらは交わらないことがわかる。つまり
$\max(S(k)) < \min(S(k+1))$ が成り立つ。
よって、最大の桁 $k$ を順に増やしながら、$i,j$ によって作られる要素を昇順に並べればよい。
ここでもまた同様の議論ができて、$j$ の昇順に $i$ を小さい方ものから選べばよい。
$j$は$k$を超えてはならないし、$i$は$j$を超えてはならない。
これらを真面目にコードにするとこうなる：
abc333c n = ss !! pred n
where
rs = 1 : map (succ . (10 *)) rs -- rs !! i は i+1 桁の repunit
r n = rs !! pred n -- R(n)
s k = [r i + r j + r k | k <- [1 ..], j <- [1 .. k], i <- [1 .. j]] -- S(k)
ss = concatMap ss [1 ..]
結果
添え字i,j,kを介さずにrepunitの並んだリストを直接操作するようにできる。
abc333c n = ss !! pred n
where
rs = 1 : map (succ . (10 *)) rs -- rs !! i は i+1 桁の repunit
ss = [rk + rj + ri | rk <- rs, rj <- takeWhile (rk >=) rs, ri <- takeWhile (rj >=) rs]
ユーザ解説
「速い by ngtkana」が明解。
上の $i \leq j \leq k$ な組を $(k,j,i)$ とすると、これの辞書式順序と $R(i) + R(j) + R(k)$ の順序が一致すると。
ここで解説では少しずらして $R(a,b,c) = R(c+1) + R(b) + R(a), a \geq b \geq c \geq 0$ としている。
- $(0,0,0)$ から $(a-1,a-1,a-1)$ までの要素数は、$|S(a)| = a(a+1)/2$ であることから $\sum_{k=0}^{a-1} a(a+1)/2 = a(a+1)(a+2) / 6$ である。
- $(a,0,0)$ から $(a,b-1,b-1)$ までの要素数は $b(b+1)/2$ である。
- $(a,b,0)$ から $(a,b,c)$ までの間の要素数は $c$ である。
よって、$(a,b,c)$ より小さい要素は $a(a+1)(a+2)/6 + b(b+1)/2 + c$ となる。
$M-1$がこれになるような$(a,b,c)$は、a,b,cを順に線形探索すると、$a^3$で接近するので $O(\sqrt[3]{N})$ で求められるとのこと。
abc333c :: Int -> String
abc333c n = replicate (p - q) '1' ++ replicate (q - r) '2' ++ replicate (succ r) '3'
where
n1 = pred n
cnt a b c = div (a * succ a * (a + 2)) 6 + div (b * succ b) 2 + c
p = last $ takeWhile (\a -> cnt a 0 0 <= n1) [0 ..]
q = last $ takeWhile (\b -> cnt p b 0 <= n1) [0 ..]
r = n1 - cnt p q 0
全探索
続く「全探索 by ngtkana」では next_permutation() を持ち出しているが、説明を読んでもコード（これRust?）をみても、どんな列をシャッフルしているのかぜんぜんわからない。それこそ $(a,b,c)$ を辞書順に挙げればいいのだから
abc333c n = ss !! pred n
where
ss = [ f a b c | a <- [0 ..], b <- [0 .. a], c <- [0 .. b]]
f a b c = replicate (a - b) '1' ++ replicate (b - c) '2' ++ replicate (succ c) '3'
とするだけでは。命令型だと、3重ループの内側にカウンタを付けてN個めで脱出するか、
次々に答えを yield する generator を走らせるか、どちらかで実装できるだろう。
「別解 by 原案者 by evima」の下側のコードが脱出スタイルと一致している。
（というか、i のループに上限 L = 12 を付ける必要がない。）
D - Erase Leaves
シグネチャを決める。横着する。
abc333d :: Int -- N
-> [[Int]] -- u_i, v_i
-> Int -- 答え
どこかの端を根と決めて、木の向きを決める。
そして1を根とする部分木全体のノード数が、葉をむしって1を削除するまでにかかる手数になる。
逆に、1よりも親やその子孫、根から1より手前までの部分は毟られずに残る。
これをなるべく多く(k)残せば、問題の手数を小さく(N-k)できる。
そもそもその数はどうやって数えたらよいか？
逆に発想して、1を根として見てみると、子のうちの誰か一人だけが残る親となり、それ以外は1と運命を共にする。
なので、1の子に対してサイズを数えると、それがkである。最大値を選べばよい。
結果
import Data.Array
abc333d :: Int -> [[Int]] -> Int
abc333d n uvs = n - maximum cnts
where
g = accumArray (flip (:)) [] (1,n) [p | u:v:_ <- uvs, p <- [(u,v),(v,u)]]
cnts = [dfs 1 u | u <- g ! 1]
dfs p u = succ $ sum [dfs u v | v <- g ! u, v /= p]
E - Takahashi Quest
シグネチャを決める。横着する。
答えは、できない場合 [[-1]] できる場合 [[Kmin],[1/0...]] を返す。
abc333e :: Int -- N
-> [[Int]] -- t_i, x_i
-> [[Int]] -- 答え
時計を逆に回して、
- モンスターに遭遇したときにタイプ $x_i$ を1本消費することをカウントする。
- 消費が予約されているポーション $x_j$ を発見したときに、1本調達できたとカウントを減らす。これを拾うことにする。
- 消費予約カウントの最大値を把握する。
- 時刻0になっても調達できなかったポーションがあったら、生存は不可能。
この戦略を時計を普通に回して眺めると、必要になるタイプのポーションを極力後のタイミングで拾うことになるので、これでKの最小値が得られる。
結果
mapAccumR の状態は
- ポーションのタイプをキー、必要な個数を値とする
IntMap - 現在必要なポーションの総数（Mapの値の総和だが、いちいち計算するのは勿体ないので）
結果値は
- 状態のsnd 現在必要なポーションの総数
- ポーションを拾うイベントのとき、拾うかどうか。違うとき
Nothing出力の2行目を作る
import qualified Data.IntMap as IM
import Data.Maybe
abc333e :: Int -> [[Int]] -> [[Int]]
abc333e n txs
| any (0 <) $ IM.elems im = [[-1]]
| otherwise = [[maximum ks], catMaybes rs]
where
((im, _), krs) = mapAccumR step (IM.empty, 0) txs
(ks, rs) = unzip krs
step (im, k) (2:x:_) = ((IM.insertWith (+) x 1 im, succ k), (succ k, Nothing))
step imk@(im, k) (1:x:_)
| imx == 0 = (imk, (k, Just 0))
| otherwise = ((IM.insertWith (+) x (-1) im, pred k), (pred k, Just 1))
where
imx = IM.findWithDefault 0 x im
公式解説のやり方
前向きに状況をシミュレーションしていく。
- ポーションを拾うとき、とりあえず拾っておき、タイプごとに分類して、拾った時刻順にスタックに突っ込む。
これで、使うときに、直近に拾ったものを即座に選択できる。 - ポーションを使うとき、スタックトップのものを使う。スタックが空なら敗北する。どこで拾ったものをどこで使ったかを記録する。
- 最後まで生き延びたとき、スタックに残っていたポーションは拾っていなかったことにする。
これで、実際消費したポーションの一覧と、手許に置いておいた時間区間がわかるので、その累積和をとることで $K_\min$ が求められる。
状況を追跡する計算において、失敗は途中で発覚するが、これをうまく外に伝える方法がない。
例外処理で飛ばしてしまえる命令型なら楽なのだけど。
import qualified Data.IntMap as IM
import Data.Array.Unboxed
import Data.Bool
abc333e :: Int -> [[Int]] -> [[Int]]
abc333e n txs =
case mim of
Nothing -> [[-1]]
_ -> [[kmin], res]
where
(mim, pds) = mapAccumL step (Just IM.empty) $ zip [1 ..] txs
-- がめつく拾うシミュレーション実行
step (Just im) (i, 1:x:_) = (Just $ IM.insertWith (++) x [i] im, [])
step (Just im) (i, 2:x:_) =
case IM.lookup x im of
Just (j:js) -> (Just $ IM.insert x js im, [j, -i])
_ -> (Nothing, [])
step Nothing _ = (Nothing, [])
-- 使うポーションを拾う時刻をpdsから取り出してマーク
resA = accumArray (flip const) 0 (1,n) [(j, 1) | j <- concat pds, j > 0] :: UArray Int Int
-- 拾うイベントのところだけかいつまんで0/1を出力する
res = [ol | (ol, 1:_) <- zip (elems resA) txs]
-- ポーション同時持ちの最大数を累積和で見つける
cntA = accumArray (+) 0 (1,n) [(abs j, bool (-1) 1 (j > 0)) | j <- concat pds] :: UArray Int Int
kmin = maximum $ scanl (+) 0 $ elems cntA
全てのイベントでなくポーションを拾うイベントの個数だけ、拾ったかどうかを判定するために復元する手間が増えている。
モナド力（りょく）が低いので、step 関数が、既に失敗していた場合なにもさせないための Maybe を使っている箇所を、Maybeモナドの (>>) で包んできれいに書けない。
F - Bomb Game 2
シグネチャを決める。何ともシンプル。
abc333f :: Int -- N
-> [Int] -- 答え
考える。
人数が $i$ の行列の前から $j$ 番目の人が、最後の一人になる確率を $P[i,j]$ とする。$1 \leq i \leq N, j \leq i$ となる。
ゲーム終了のため $P[1,1] = 1$ である。
もう一度アクションが起きると、先頭の人は1/2の確率で抜け、さもなくば最後尾に並び直す。
$P[i,1] = \frac{1}{2} P[i,i]$
先頭以外の人は必ず一つ前の位置にずれるが、1/2の確率で列が1短くなっている。
$P[i,j] = \frac{1}{2} (P[i,j-1] + P[i-1,j-1])$ $(j > 1)$
$P[i-1,j]$ が既知だとして、それを元に $P[i,j]$ を求める、数列の漸化式が欲しい。
見やすさのために、$Q[j] = P[i-1,j], P[j] = P[i,j]$ と呼ぶと、上の式は
$P[1] = P[i] / 2$
$P[j] = (P[j-1] + Q[j-1]) / 2$ $(j > 1)$
となる。
$2P[1] = P[i] =$
$(P[i-1] + Q[i-1]) / 2 =$
$((P[i-2] + Q[i-2]) / 2 + Q[i-1])/ 2 =$
$\vdots$
$(\cdots((P[1] + Q[1])/ 2 + Q[2])/2 \cdots +Q[i-1])/2 =$
$P[1]/2^{i-1} + Q$
（ただし $Q = (\cdots(Q[1]/2 + Q[2])/2 + \cdots + Q[i-1])/2$ とする）
$(2 - 1/2^{i-1}) P[1] = Q$
$\displaystyle \therefore P[1] = \frac{2^{i-1}}{2^i - 1} Q$
試作版
これで外していたら嫌なので、とりあえず Rational で計算する版を作って確認する。
$Q$ を作る計算と$P[j-1]$から$P[j]$を作る計算がよく見ると同じだった。足して二で割る。
import Data.List
import Data.Ratio
abc333f :: Int -> [Rational]
abc333f n = pN
where
p1 = [1 % 1]
pN = foldl' step p1 [2 .. n]
step :: [Rational] -> Int -> [Rational]
step qs i = ps
where
op a b = 1 % 2 * (a + b)
qq = foldl' op 0 qs
p1 = (2 ^ pred i) % (2 ^ i - 1) * qq
ps = scanl' op p1 qs
ghci> abc333f 2
[1 % 3,2 % 3]
ghci> abc333f 5
[157 % 1085,106 % 651,202 % 1085,706 % 3255,314 % 1085]
例1は正しいことがわかるが、例2が検証できない。
答えの方から引っ張ってみる。
ghci> mul x y = mod (x * y) 998244353
ghci> zipWith mul [1085, 651, 1085, 3255, 1085] [235530465, 792768557, 258531487, 238597268, 471060930]
[157,106,202,706,314]
出力例2の謎の整数列に、実行結果の分母をそれぞれ掛けて、結果が分子になった、ということで合ってる。
提出版
ならば後は、Rational で計算しているところを modint に置き換えた版に書きかえるだけでよい。
abc333f :: Int -> [Int]
abc333f n = foldl' step [1] [2 .. n]
step :: [Int] -> Int -> [Int]
step qs i = ps
where
r2 = modRecip 2
op a b = mul r2 $ add a b
qq = foldl' op 0 qs
pow2i = modPower 2 i
p1 = prodd [qq, pow2i, r2, modRecip $ add pow2i (-1)]
ps = scanl' op p1 qs
-- modintは省略
見た目はほぼ変わっていない。
公式解説など
何か皆さん一般項を導いてそれをで解く！という流れでなんだかとっても難しい話になっているんですが、その一般項を解く途中の漸化式がたぶんこれで、漸化式に従って計算しているだけでDPでも何でもないのではないかと…
G - Nearest Fraction
シグネチャを決める。これまた何ともシンプル。
しかし、$r$ を実際 Double で読み込むと、浮動小数点数の誤差で面倒なことになりそうだし、
そもそも桁数がたかだか18桁で1未満の「実数」0.abcdef は、有理数 abcdef / 1000000 に他ならない。
なのでそのように読んだ後、そういう Rational で渡すことにする。
import Data.Ratio
abc333g :: Rational -- r
-> Integer -- N
-> Raitonal -- 答え
なんもわからん
のでフレンズさんのヒントを見る。
アライグマ「G問題はStern Brocot Treeを思い浮かべると、互助法みたいに近い分数を作っていけるのだ！
あとはちょっと考えると128bit整数の範囲で計算できるのだ！」
Stern-Brocot Tree
ググって、この問題に使えそうな耳より情報だけつまみ食いすると…
表現としては：
- 二分木のノードに、4つの整数 $(a,b,p,q)$ を割り当てる
- $i = a + p, j = b + q$ として、左右の子に $(a,b,i,j)$ と $(i,j,p,q)$ が割り当てられる
- 根は $(0,1,1,0)$ が割り当てられる
解釈は：
- この木は、正の有理数の二分探索木
- ノード $(a,b,c,d)$ は有理数 $i/j$ を表す
- ノードの部分木に現れる値の範囲は下限 $a/b$ 上限 $p/q$ である
- 根は $1/1$ で、その下限は $0$ 上限は $1/0 = \infty$
- あらゆる正の有理数がユニークに出現する、ただし通分されていないこともある
フレンズさんのポンチ絵は、この木を二分探索で降りていくという意味だろう。
$r$ を探して下っていくうちに、通分しても分母が N を超えるところまで降りたとき、
そのノードの下限と上限（これらは分母がNを超えておらず、$r$ を挟み込んでいることは保証される）
のうち $r$ に近い方を答えとすればよい、というのが大方針のようだ。
大抵の変数は64ビットに収まるサイズなのだが、$r$ と $i/j$ との大小比較をするときに Ratio Int ではオーバーフローするので、128ビット整数という話が出てくる感じ。面倒なので Rational = Ration Integer で済ませよう。
（Ratio Int の Ord.compare がそこを配慮した特別製になっていることを期待しない。）
やってみる。
import Data.Ratio
abc333g :: Rational -> Integer -> Rational
abc333g r n
| denominator r <= n = r
| otherwise = loop 0 1 1 1
where
loop :: Integer -> Integer -> Integer -> Integer -> Rational
loop a b p q
| n < denominator ij = if r - l <= u - r then l else u -- ここで終わる
| otherwise = -- まだ続ける
case compare r ij of
LT -> loop a b i j
GT -> loop i j p q
EQ -> error "never happens"
where
l = a % b
u = p % q
i = a + p
j = b + q
ij = i % j
大方針は合っているのだが、出題側の狙い通りにTLEx3した。
そこが「あとはちょっと考えると」で、マシュマロへの返答
（1/10^10 のときにTLEするという指摘に対して）
アライグマ「そうなのだ。だから同じ計算をしてるところを飛ばせるように工夫するのだ！」
といっていることなのか。
あとちょっと考える
Stern-Brocot Tree を降りていくときに、例えば左に降り続けるとき、
$(a,b,p,q) \to (a,b,a+p,b+q) \to (a,b,2a+p,2b+q) \to \cdots \to (a,b,ka+p,kb+q)$
と、一定の速度で増え続ける。
例の $1/10^{10}$ をnaiveに探しに行くと
$(0,1,1,0) \to (0,1,1,2) \to (0,1,1,3) \to (0,1,1,4) \to \cdots \to (0,1,1,10^{10})$
と、いかにも間に合わない。
そこで、同じ側へ、$r$と$i/j$の関係が1ステップ目と変わらない間を一気に詰める処理を追加する。
きっちりとやるには、何らかの上限を決めて二分探索、ということになるが、
1ステップ、2ステップ、4ステップ、と2のべきで飛ばす量を変えるだけ、余りが大幅に出るかもしれないがそれは次の周回で埋める、という大雑把なアプローチが提案されていた。
（動的配列をメモリに確保するとき、最初は1kB、これで足りなくなったらもう1kB、次は2kB、次は4kB、と、確保する量を倍々にしていくアイデアと通じるものがある。）
import Data.Ratio
abc333g :: Rational -> Integer -> Rational
abc333g r n
| denominator r <= n = r
| otherwise = loop (0,1) (1,1)
where
loop :: (Integer,Integer) -> (Integer,Integer) -> Rational
loop ab@(a,b) pq@(p,q)
| n < denominator ij = if r - l <= u - r then l else u -- ここで終わる
| otherwise = -- まだ続ける
case compare r ij of
LT -> zoom ab pq LT loop -- goLeft a b p q -- rとijの位置関係が変わらない最大限まで進めて再帰
GT -> zoom pq ab GT (flip loop) -- goRight a b p q
EQ -> error "never happens"
where
l = uncurry (%) ab
u = uncurry (%) pq
ij = (a + p) % (b + q)
-- (xy (od) r (od) xy+zw) が保証されている。
-- r (od) (2^k)xy+zw が満たされ、かつN以下である最大の2^kまで一気に進み、
-- next に結果を渡して次のターンへ
zoom xy@(x,y) (z,w) od next
| prop kmax = next xy (kmax * x + z, kmax * y + w)
| otherwise = next xy (k1 * x + z, k1 * y + w)
where
kmax = div (n - w) y -- ky + w ≦ N
prop k = od == compare r ((k * x + z) % (k * y + w))
k1 = min kmax $ last $ (1 :) $ takeWhile prop $ iterate (2 *) 2
みんなと同じ1msでACできた。
（最初は LT の場合と GT の場合でそっくりな下請け関数を2つ書いていたが、
flip と使ったりしてうまいこと統合している人のコードをみてパクりました。）
ユーザ解説
「そのものずばりが Python にあるよ」ワロタ。どんなとき使うんだ。
C問題の関数の性質
現実的な問題にプロパティベーステストを使おうとしても、なかなかうまくいかないんですよね。
関数 abc333c を $f(N)$ とします。
naive実装との比較
どうせ333個までとわかっているので、全て列挙しておいて、答えが分かっているテストをすることはできるけど、それは旧来のテスト手法と変わってないね。
性質？
「答えは正の数」はちょっとtrivialすぎるかも。
- $i < j$ ならば $f(i) < f(j)$
prop_order :: Positive Int -> Positive Int -> Bool
prop_order (Positive i) (Positive j) = abc333c i < abc333c (i + j)
原理主義者はこれを
prop_order :: Positive Int -> Positive Int -> Property
prop_order (Positive i) (Positive j) = i < j ==> abc333c i < abc333c j
と書きたくなるが、そうすると +++ OK, passed 100 tests; 87 discarded. とかなる。
- $f(i)$ は3つのrepunitの和である
（その数以下の最大の repunit を引く、という操作を3回繰り返すと0になる、で判定する）
prop_isSumOf3repunits :: Int -> Bool
prop_isSumOf3repunits i = isSumOf3repunits (abc333c i)
isSumOf3repunits :: Int -> Bool
isSumOf3repunits = p1
where
rs = takeWhile (0 <) $ 1 : map (succ . (10 *)) rs
r x = last $ takeWhile (x >=) rs
p1 x = x > 0 && p2 (x - r x)
p2 x = x > 0 && p3 (x - r x)
p3 x = x > 0 && x == r x
とかですかね。
性質追加 (2025-10-6)
まず、isSumOf3repunits をもっと効率よく、正規表現 1*2*3+ とマッチするか確認する版にする。
isSumOf3repunits x = all ('3' ==) cs && not (null cs)
where
cs = dropWhile ('2' ==) $ dropWhile ('1' ==) $ show x
固定の性質として、$f(1) = 3$ は別で確認しておく。
本題、$f(i)$ と $f(i+1)$ の間の数は、どれもそういう数ではない。
prop_between :: Positive Int -> Bool
prop_between (Positive i) =
all (not . isSumOf3repunits) [succ $ abc333c i .. pred $ abc333c $ succ i]
少し計算量は嵩むけども。