A - Misdelivery
シグネチャを決める。A問題からこんなに入力データあるの珍しいな。
abc421a :: Int -- N
-> [String] -- Si
-> Int -- X
-> String -- Y
-> Bool -- 答え
abc421a _n ss x y = ss !! pred x == y
B - Fibonacci Reversed
シグネチャを決める。
abc421b :: Int -- X
-> Int -- Y
-> Int -- 答え
よくあるHaskell版のフィボナッチ数列
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
そのまま。
結果
abc421b x y = as !! 9
where
as = x : y : zipWith fadd as (tail as)
fadd p q = read $ reverse $ show $ p + q
C - Alternated
シグネチャを決める。Sが長いので ByteString を使う。
import qualified Data.ByteString.Char8 as BS
abc421c :: Int -- N
-> BS.ByteString -- S
-> Int -- 答え
考える
乱雑に並んだ A と B を ABAB… と並べるのが目標。
B は背景と考えて A を正しい位置に移動させることを考えると、結局、
追い越しをすることなく、初期状態で並んでいる順に、最終状態の位置に移動させると、それぞれの距離ぶんだけの手数がかかる。
その総和が答え。
abc421c _n s = sum $ zipWith dif [0, 2 ..] $ BS.elemIndices 'A' s
where
dif a b = abs $ a - b
WAx3 アイエェ！
やりなおし
目標は BABA… でもよいので、両方試して小さい方を答える必要があった。
abc421c _n s = min abab baba
where
dif a b = abs $ a - b
abab = sum $ zipWith dif [0, 2 ..] $ BS.elemIndices 'A' s
baba = sum $ zipWith dif [1, 3 ..] $ BS.elemIndices 'A' s
AtCoder Problems で●になってるのは、みんなこれに引っかかったってことかしら。
D - RLE Moving
シグネチャを決める。横着する。
abc421d :: [Int] -- Rt,Ct,Ra,Ca
-> [Int] -- N,M,L
-> [(Char,Int)] -- Si,Ai
-> [(Char,Int)] -- Ti,Bi
-> Int -- 答え
考える
ランレングス圧縮を適度にほどく
Nが巨大なので、ランレングス圧縮された列を素朴に展開して座標を突き合わせる訳にはいかない。
長さが短い方を基準にして切り出してくることで、同じ長さのランレングス対について処理するループにすることを考える。
aとbの小さい方をkとして、dropsa k で、いずれかの先頭の対は消え、残る方の対は長さを減らして loop の繰り返しをする。
展開後の長さは同じなので、最後は sas tbs が同時に空リストになり終了する。
abc421d [rt,ct,ra,ca] _nml sas0 tbs0 = ... (loop sas0 tbs0)
where
loop [] _ = []
loop sas@((s,a):_) tbs@((t,b):_) = res : loop (dropsa k sas) (dropsa k tbs)
where
k = min a b
dropsa :: Int -> [(Char,Int)] -> [(Char,Int)]
dropsa k ((s,a):sas)
| k < a = (s, a - k) : sas
| k == a = sas
位置の追跡
二人の位置を2つの座標で追跡する代わりに、高橋君から見た青木君の相対位置ひとつだけを追跡することにする。
これを loop の引数として（先頭に）追加する。
s, t の文字で指定される移動方向から、移動ベクトルに直す。
udlr2xy :: Char -> (Int,Int)
udlr2xy 'U' = (-1,0)
udlr2xy 'D' = ( 1,0)
udlr2xy 'L' = (0,-1)
udlr2xy 'R' = (0, 1)
高橋君の移動ベクトルを逆にしたり、k ステップ移動したりするのでベクトルに係数を掛ける演算が必要。
逆にした高橋君の移動ベクトルに青木君の移動ベクトルを足すと、相対位置の変化ベクトルになる。足す演算も必要。
add :: (Int,Int) -> (Int,Int) -> (Int,Int)
add (a,b) (c,d) = (a+c,b+d)
mag :: Int -> (Int,Int) -> (Int,Int)
mag m (a,b) = (m * a, m * b)
相対位置を追跡するロジックを追加した loop は以下のようになる。
abc421d [rt,ct,ra,ca] _nml sas0 tbs0 = ... $ loop xy0 sas0 tbs0
where
xy0 = (ra - rt, ca - ct)
loop _ [] _ = []
loop xy@(x,y) sas@((s,a):_) tbs@((t,b):_) = loop xy1 (dropsa k sas) (dropsa k tbs)
where
k = min a b
dxy = add (mag (-1) $ udlr2xy s) (udlr2xy t) -- 相対位置の変化ベクトル一歩ぶん
xy1@(x1,y1) = add xy $ mag k dxy -- k倍して足すとkステップ後の位置になる
衝突回数を数える
移動後に相対位置が (0,0) になった回数を数えて報告する機構を loop に追加し、
その総和をとれば答えになる。
abc421d [rt,ct,ra,ca] _nml sas0 tbs0 = sum $ loop xy0 sas0 tbs0
where
loop _ [] _ = []
loop xy@(x,y) sas@((s,a):_) tbs@((t,b):_) = res : loop xy1 (dropsa k sas) (dropsa k tbs)
where
res = ...
sumについて
総和を取る計算も loop に閉じ込める方が高速なのは判っているが
abc421d [rt,ct,ra,ca] _nml sas0 tbs0 = loop 0 xy0 sas0 tbs0
where
loop acc _ [] _ = acc
loop !acc xy@(x,y) ... = acc + res : loop xy1 ...
where
res = ...
責務の分離という視点からこのスタイルは好きじゃない。
相対変化ベクトル dxy の向きによって分類して考える。上が優先。
-
(0,0)変化しないとき- 始めから重なっているとき
xy == (0,0)ならk - さもなくば 0
- 始めから重なっているとき
- 相対位置が変化するとき、最初に重なっている
xy == (0,0)なら離れていくだけなので 0 -
(dx,0)水平移動するとき-
xが偶数、yが 0、移動前のxと移動後のx1の符号が違う（0を含めて）とき、原点を通過したので 1 -
xが奇数のときは原点を飛び越す、yが非0なら原点は通らない、符号が同じなら原点からみて同じ位置に留まるので衝突せず 0
-
-
(0,dy)垂直移動するときは、水平移動と同じロジック -
dx,dyどちらも0でないとき、斜め移動している。$(1,1),(1,-1),(-1,1),(-1,-1)$ のいずれか。- $y = x$ または $y = -x$ の「対角線上」に乗っていることが原点を通過する条件。さもなくば外すだけ
- X軸Y軸ともに、移動前と移動後の符号が異なることが、原点を通過する条件。
- 両方の条件を満たすとき 1 さもなくば 0
- 一見ややこしいけど、水平垂直移動のときと考えていることは同じ
以上の場合分けを実装する。
res =
case (dxy, xy) of
((0,0), (0,0)) -> k
((0,0), _) -> 0
(_ , (0,0)) -> 0
((_,0), (_,0)) | even x, cross x x1 -> 1
((_,0), _) -> 0
((0,_), (0,_)) | even y, cross y y1 -> 1
((0,_), _) -> 0
_ | abs x == abs y, cross x x1, cross y y1 -> 1
| otherwise -> 0
cross x0 x1 = signum x0 /= signum x1
完成。
提出
ただし cross は後出し。
ましまろ
他人のマシュマロに口出しするのも野暮だけど
公式解説が皆さん座標の連立方程式でどうのこうのとやっているのよりも、
上記の res は分かりやすいと思うのだけど、どうかしら？
E - Yacht
シグネチャを決める。
abc421e :: [Int] -- Ai
-> Double -- 答え
abc421e as = ...
なんかすごい色々な場合を考える必要がありそうでたじろぐが、順番に考える。
考える
場合を数え間違わないように、計算途中では常に、6つの面を 1～6 の整数で表して区別し、そのリストで出目の組を扱う。
ダイスの目
$i$ から $A_i$ を引く表を用意しておく。この程度なら dice = (as !!) . pred でも良さそうだけど。
import qualified Data.IntMap as IM
abc421e as = ...
where
dice = IM.fromDistinctAscList $ zip [1 ..] as
例２にあるようにダイスの目は被ることがある。
目の番号リストから最終的なスコアを計算するときに、dice を引いて、目の値ごとに考えて最大値を選ぶ。
ここで、目の番号リストが前半と後半で2度に分けて与えられるので、前半の計算を後半で使い回せるようにする。
score3base xs = IM.fromListWith (+) [(dx, dx) | x <- xs, let dx = dice IM.! x]
score3 im xs = maximum $ IM.elems $ foldl' (\im x -> let dx = dice IM.! x in IM.insertWith (+) dx dx im) im xs
２度めの投げ直し
6つの目のそれぞれについて、1投げ目でキープしたダイスのパターンそれぞれについて、全て計算し直すと多すぎる。
２度めの投げ直しでキープすることになった目のリストをキーに、
それ以外のダイスを振り直した全てのパターンについてscore3を計算して平均することで期待値を求めて、
これを表にする。
score2 :: M.Map [Int] Double
score2 = M.fromList
[ (ps, fromIntegral acc / fromIntegral (6 ^ k))
| ds <- diceList -- 確定させたダイスの目を右詰め、未確定の0を前に並べた
, let ps = dropWhile (0 ==) ds -- 確定させた部分
, let arr = score3base ps
, let k = 5 - length ps -- 未確定の個数
, let acc = sum [score3 arr qs | qs <- replicateM k [1 .. 6]]
]
ここで diceList は0から6の値を昇順に並べる全ての場合を持つ。
1～6はダイスの目の番号、0は振り直しするダイスを表す。
diceList :: [[Int]]
diceList = iter 5 0
where
iter 0 _ = [[]]
iter l e = [x:xs | x <- [e .. 6], xs <- iter (pred l) x]
１度めの投げ直し
２度めの投げ直しと同様に、キープするダイスの目番号リストをキーにして、その期待値を表にする。
キープしない部分を投げ直した結果それぞれに関して、
２度めの投げ直しではキープするかどうかの全ての場合を作り、score2 を引いた最大値を求めて、
投げ直しの場合全体で平均をとることで期待値にする。
score1 :: M.Map [Int] Double
score1 = M.fromList
[ (ps, acc / fromIntegral (6 ^ k))
| ds <- diceList
, let ps = dropWhile (0 ==) ds -- 確定させたダイス
, let k = 5 - length ps
, let acc = score1f ps k
]
score1f ps k = sum
[ maximum
[ score2 M.! foldr insert ps rs
| gs <- replicateM k [False,True] -- 出目を見て、どれを残すか判断して
, let rs = [q | (q, True) <- zip qs gs]
]
| qs <- replicateM k [1 .. 6] -- 振り直し1回めの内容ごとに、
]
最初のダイス振り
上２つと同様に、全てのダイスの目番号のパターンについて、
全てのキープのやり方について score1 を引いた結果の最大値をスコアとし、
これの平均が問題の要求である期待値となる。
abc421e as = total / (6^5)
where
...
total = sum
[ maximum
[ score1 M.! qs
| gs <- replicateM 5 [False,True] -- 出目を見て、どれを残すか判断して
, let qs = sort [q | (q, True) <- zip ds gs]
]
| ds <- replicateM 5 [1 .. 6]
]
結果
すごくややこしい計算をしているように見えるが、GHCiでも1.5秒くらいで答えが出るので大丈夫。
F - Erase between X and Y
シグネチャを決める。
abc421f :: Int -- Q
-> [[Int]] -- クエリi
-> [Int] -- 答え
既視感。xやiという数をキーに、次に来る数を値とする配列$A[\cdot]$でリンクリストを構成してこれを維持する。
- 対象となる数は0からQまで出現する。
- リンク先がない、いわゆるNILを-1で表す。ここで $A[-1] = -1$ としておく。
- 先頭要素を指すポインタは不要。（なんだか落ち着かないが。）
クエリ1に対しては、$y = A[x]$ としたとき、$A[x] = i, A[i] = y$ となるように配列を修正すればよい。
クエリ2に対しては、$p = x$ から順に $p' = A[p]$ を辿り、$y$ まで到達したら、遭遇した全ての値を足し合わせたものが今回の答え、また $A[x] = y$ として途中をリンクからはじきだせばよい。
しかし、$x$ が $y$ より前にあるとは限らない。失敗すると $p = -1$ に落ち込む。
これを避けるために
- $x$ から始めて、-1に落ち込んだら $y$ からでやりなおす
- リンクの先頭から始めて、$x, y$ のいずれかが出現したらそこから開始する
という「リンク全体を舐める」真似をすると計算量が $O(Q^2)$ 近くなって破綻する。
$x$ からと $y$ からとの両方を同時に計算し、$y$ または $x$ というゴールに到達した方を採用すればよい。
失敗する側は-1に落ち込むか、それより手前で停まるか、ともかく空振りするが、
このクエリによって消える要素数 $K$ に対して $O(2K) = O(K)$ で走査は必ず完了し、
これらの要素がリストから消えることで、全体の計算量も $O(Q)$ で収まる。
結果
immutable なリストで示す。
import Data.Array.Diff
abc421f :: Int -> [[Int]] -> [Int]
abc421f q qus = loop arr0 $ zip [1 ..] qus
where
arr0 = listArray (-1,q) $ repeat (-1) :: DiffUArray Int Int
loop _ [] = []
loop arr ((i, [1,x]) : iqus) = let !y = arr ! x in loop (arr // [(x, i), (i, y)]) iqus
loop arr ((_, [2,x,y]) : iqus) = run 0 0 (arr ! x) (arr ! y)
where
run accx accy p q
| p == y = accx : loop (arr // [(x,y)]) iqus
| q == x = accy : loop (arr // [(y,x)]) iqus
| otherwise = run (accx + p) (accy + q) (arr ! p) (arr ! q)
仕方ないので提出は Data.Array.IO を使った版でしている。
提出
添え字-2に先頭を保持しているが、不要。
G - Increase to make it Increasing
前の項との差で考える。
$B[i] = A[i] - A[i-1], A[0] = A[1]$ とする（特に意味なし）
広義単調増加とは、$B[1～N] \geq 0$ ということ。
操作パラメータ $(L,R)$ は、$A[L],A[L+1],\dots,A[R]$ に+1するということは、
$B[L]$ を +1 し、$B[R+1]$ を -1 するということ。
ここで $B[N+1]$ はいくらマイナスになってもよいことに注意。
$B[N+1]$ がないとき、$(L,R)$ は $\sum B[1～N]$ の総和を変えない。
$L=1$ なペアは何の役にも立たない。
$R=N$ なペアは積極的に使うべき。
全ての $B[i] < 0$ に対して $(i,R)$ なペアがないと、どうにもならない。
後はフローグラフに落とし込む感じがする。何となく。
解説を見た
これは最小費用流を用いると解ける形になっています
やっぱりね。