シグネチャを決める。
import Data.Bool
abc401a :: Int -- S
-> String -- 答え
abc401a s = bool "Failure" "Success" $ 200 s && s 299
$100 leq S leq 999$ と桁数が一定なので、文字列のまま比較してもよいし、
入力の条件をさらに悪用すると、先頭が 2 であることを確認するだけでよい。
abc401a :: String -- S
-> String -- 答え
abc401a ('2':_) = "Success"
abc401a _ = "Failure"
シグネチャを決める。
abc401b :: Int -- N
-> [String] -- Si
-> Int -- 答え
検出するべきエラーは、private を受け取ったときに、
ログインしていない状態だった瞬間である。
エラーの報告と回数のカウントを責務として分離する作り方が好き。
オートマトンの内部状態が、ログインしているかしていないか、だけにできる。
import Data.List
abc401b :: Int -> [String] -> Int
abc401b _n ss = length $ filter id es
where
(_, es) = mapAccumL step True ss
step _ "login" = (False, False)
step _ "logout" = (True, False)
step mode "public" = (mode, False)
step mode "private" = (mode, mode)
エラー回数のカウントも内部状態に持たせれば、mapAccumL よりも小さい foldl でできる。
import Data.List
abc401b :: Int -> [String] -> Int
abc401b _n ss = ans
where
(_, ans) = foldl step (True, 0) ss
step (_ ,cnt) "login" = (False, cnt)
step (_ ,cnt) "logout" = (True, cnt)
step (True,cnt) "private" = (True, succ cnt)
step mc _ = mc
シグネチャを決める。
abc401c :: Int -- N
-> Int -- K
-> Int -- 答え
$A_K = A_0 + A_1 + dots + A_{K-1} = 1 + 1 + dots + 1 = K$ である。
$K
$A_{i } = A_{i -K} + A_{i -K+1} + dots + A_{i -1}$
$A_{i-1} = A_{i-1-K} + A_{i-1-K+1} + dots + A_{i-1-1}$
差をとると
$A_{i} – A_{i-1} = A_{i-1} – A_{i-1-K}$
つまり、尺取法で直前の値を足し$K$個前の値を引くことで次の値が得られる。
abc401c :: Int -> Int -> Int
abc401c n k = as !! n
where
as = replicate k 1 ++ maomao as k (drop k as)
maomao (x:xs) acc (y:ys) = acc : maomao xs (mod (acc + y - x) (10^9)) ys
しかし動かない。maomao の本体で acc : をしているから第K項も出るだろうに？と悩んでしまった。
等式が選択されるのはパターンマッチに成功してからなので、(drop k as) というリストが (y:ys) というパターンにマッチする、
つまり as はここで空にならないことを先に保証しなければならない。
空にならないことがわかるように、先に値をリストに確定させておくと動くようになるが、maomao が少しダサくなる。
as = replicate k 1 ++ k : maomao as k (drop k as)
maomao (x:xs) acc (y:ys) = acc1 : maomao xs (mod acc1 (10^9)) ys
where
acc1 = mod (acc + y - x) (10^9)
パターンマッチで (y:ys) と分離することを諦めるやり方もある。
as = replicate k 1 ++ maomao as k (drop k as)
maomao (x:xs) acc yys = acc : maomao xs (mod (acc + head yys - x) (10^9)) (tail yys)
しかしここで使う y とは、直前で出力した値、つまり acc と等しいことに気づくと、ys 引数そのものをなくせる。
as = replicate k 1 ++ maomao as k
maomao (x:xs) !acc = acc : maomao xs (mod (acc + acc - x) (10^9))
シグネチャを決める。Sが長いので ByteString を使う。
import qualified Data.ByteString.Char8 as BS
abc401d :: Int -- N
-> Int -- K
-> BS.ByteString -- S
-> String -- 答え
DPを使う問題？…ではなかった。
$S$ に既にある o の個数を $K$ から引き、? に置くべき o の個数 $J$ を考える。
規則から、o が隣にある ? は . に必ずなる。これは前処理で消しておく。
次に、$k$ 個の連続する ? について、最大でいくつの o を入れることができるか考える。
$k$ が奇数のとき、o.o.o のようになり、$lfloor (k+1)/2 rfloor$ 個入れられる。
$k$ が偶数のとき、o.o. または .o.o で、$k / 2 = lfloor (k+1)/2 rfloor$ 個入れられる。
$S$ を調べて、可能な o の最大を数えたとき、これが $J$ とちょうど等しいとき、
奇数個の連続にはどのように入れるか確定し、
偶数個の連続には二通りの入れ方があるので任意となる。
$J$ が可能な数より小さいとき、最大の入れ方からどれを外してもよいし、
奇数個の連続に対する入れ方も自由になるので、全てが任意となる。
$J=0$ の場合だけ特別で、o を入れる機会がないので全て . で確定する。
import Data.Array.Unboxed
import Data.List
abc401d :: Int -> Int -> BS.ByteString -> String
abc401d n k s
| cnt0 == 0 = map g $ BS.unpack s -- そもそも?に置くoがないなら、?にならない。
| cnt0 avail = elems s1 -- 余裕がある場合はs1ママ
| otherwise = out $ elems s1 -- ぱっつんなので、奇数はぴっちり偶数は?で出す
where
-- ?の中に置く必要のある 'o' の個数 J
cnt0 = k - BS.count 'o' s
-- cnt0 == 0 の場合
g '?' = '.'
g c = c
-- 前後に o がある ? は . で確定させる前処理
bnds = (0, pred n)
s1 :: UArray Int Char
s1 = listArray bnds (BS.unpack s) //
[ (j, '.')
| i [0 .. pred n], 'o' == BS.index s i
, j [pred i, succ i], inRange bnds j]
-- 連続する ? の長さを数えて、置ける o の最大個数を数える
avail = sum $ map (flip div 2 . succ . length) $
filter head $ group $ map ('?' ==) $ elems s1
-- ぱっつんの場合の出力を計算
out "" = ""
out cs
| even l1 = cs1 ++ cs2 ++ out cs3
| otherwise = take l1 ('o' : cycle ".o") ++ cs2 ++ out cs3
where
(cs1, cs23) = span ('?' ==) cs
(cs2, cs3) = span ('?' /=) cs23
l1 = length cs1
ユーザ解説 by seekworser にDPでする方法も示されていた。
（実装例のC++コードはぱっと見短く見えるが、3行めに何やらライブラリが詰め込まれている。）
シグネチャを決める。
abc401e :: Int -- N
-> Int -- M
-> [[Int]] -- u_i, v_i
-> [Int] -- 答え
目的の状態にするには、頂点 $k+1$ ～ $N$ のうち、
頂点1から頂点kまでのいずれかと辺を持つものを全て削除する必要がある。
ただしこうしたとき、頂点1からkまでが連結にならなかったら、その$k$については不可能と判定する。
$k=1$ のとき、条件は必ず満たすことができ、頂点1と隣接する頂点が消すべき対象である。この頂点集合を $S_k$ とする。
$S_1 = { v | (1,v) in E }$
$k=j$ について考えるとき、頂点1から$j$までからなる部分グラフが連結である必要がある。
（途中で一端切れてまた繋がるような場合を考えると、
$S_{j-1}$ が頂点 $j$ を含むことは条件を満たすための必要条件であるが十分条件ではない。）
条件は、Union-Findへ順に頂点を追加することで判定することができる。
$S_j$ は頂点 $j$ を除く必要があり、また
頂点 $j+1$ ～ $N$ のうち、頂点 $j$ と辺を持つようなものを全て追加で削除する必要がある。
$S_j = S_{j-1} setminus {j} cup { v | (j,v) in E }$
immutableなUnion-Findで実装する。
$S_k$ を IntSet で表すとき、素朴に IS.size を使うと重いので、丁寧に数える。
import Data.List
import Data.Array
import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
abc401e :: Int -> Int -> [[Int]] -> [Int]
abc401e n _m uvs = ans
where
-- 頂点 j から左向きの辺リスト
ls = accumArray (flip (:)) [] (1,n) [(j,u) | u:j:_ uvs]
-- 頂点 j から右向きの辺リスト
rs = accumArray (flip (:)) [] (1,n) [(j,v) | j:v:_ uvs]
-- j=1,...,Nまで順に、
-- 頂点jを追加した部分グラフが1から連結かどうかの判定と、Sjを計算する
(_,ans) = mapAccumL step (newUF, IS.empty, 0) [1 .. n]
step (uf, is, siz) j = ((uf1, is1, siz1), if cond then siz1 else (-1))
where
uf1 = foldl (uf -> uniteUF uf j) uf (ls ! j)
cond = j == snd (getRoot uf1 1)
is1 = IS.union (IS.delete j is) (IS.fromList $ rs ! j)
siz1 = siz - (if IS.member j is then 1 else 0) + length [() | v rs ! j, IS.notMember v is]
type UnionFind = IM.IntMap Int
newUF = IM.empty
-- 代表元と、分割の大きさの対を返す
getRoot :: UnionFind -> Int -> (Int, Int)
getRoot uf p =
case IM.lookup p uf of
Nothing -> (p, 1)
Just q | q 0 -> (p, negate q)
| otherwise -> getRoot uf q
-- 統合する
uniteUF :: UnionFind -> Int -> Int -> UnionFind
uniteUF uf p q
| a == b = uf
| s >= t = IM.insert a (negate (s + t)) $ IM.insert b a uf
| otherwise = IM.insert b (negate (s + t)) $ IM.insert a b uf
where
(a,s) = getRoot uf p
(b,t) = getRoot uf q
https://atcoder.jp/contests/abc401/editorial/12705
頂点1からkの範囲に収まる辺全てを使ったグラフの、
1を含む分割のサイズがkであることが条件、という、上と同じUnion-Findの使い方に加えて、
頂点1からkから生えている全ての辺を使ったグラフを考える。
これは $S_k cup {1 ,dots, k}$ に他ならないので、芯をくりぬけば求める大きさが得られるというからくり。
abc401e :: Int -> Int -> [[Int]] -> [Int]
abc401e n _m uvs = ans
where
-- 頂点 j から左向きの辺リスト
ls = accumArray (flip (:)) [] (1,n) [(j,u) | u:j:_ uvs]
-- 頂点 j から右向きの辺リスト
rs = accumArray (flip (:)) [] (1,n) [(j,v) | j:v:_ uvs]
-- j=1,...,Nまで順に、大きいUFと小さいUFの両方を更新し、
-- 小さい方で条件判定、大きい方でサイズを計算する
(_,ans) = mapAccumL step (newUF, newUF) [1 .. n]
step (uf_small, uf_large) k = ((uf_small1, uf_large1), if cond then siz else (-1))
where
uf_small1 = foldl (uf -> uniteUF uf k) uf_small (ls ! k)
cond = k == snd (getRoot uf_small1 1)
uf_large1 = foldl (uf -> uniteUF uf k) uf_large (ls ! k ++ rs ! k)
siz = snd (getRoot uf_large1 1) - k
immutableなUnion-Findのままで1966 msとギリギリでACした。
https://atcoder.jp/contests/abc401/editorial/12706
上記の解法は、頂点1からkまでからなる部分グラフを芯として考えたが、
これは、「頂点1からkまでからなる部分グラフにおいて、頂点1から到達可能な頂点集合」を $S_k$ として芯にすえて考える。
また、$S_k$ に隣接する頂点集合 $T_k$ も管理する。
$S_1 = { 1 }, T_1 = {v | (1, v) in E }$ である。
$k+1 notin S_k$ のとき、$k+1$ を経由してどこにも行けないので $S_{k+1} = S_k, T_{k+1} = T_k$ で、このとき条件を満たさない。
$k+1 in S_k$ のとき、$k+1$ を経由してまた $j leq k$ な頂点にも到達可能になる可能性がある。
このとき、$k+1$と隣接する$k$以下の頂点で、$S_k$ に含まれないものと、
そこからさらに$k$以下の頂点で到達できるものすべては、グラフの探索で発見できる。
これを $A_{k+1}$ とすると、$S_{k+1} = S_k cup A_{k+1}$ となる。
$A_{k+1}$ に隣接する $k+1$ より大きい頂点の集合 $B_{k+1}$ も、$A_{k+1}$ の構築時に同時に収集できる。
そして $T_{k+1} = (T_k setminus {k+1}) cup B_{k+1}$ となる。
これらの計算は辺の本数だけ行うので、全体で $O(M)$ かかる。
前半の「$A_{k+1}$をDFSで探索する」と後半の「$B_{k+1}$ を発見する」がどちらも $O(M)$ で実行できるのはいずれも、$O(1)$で更新できる命令型配列によるフラグ配列が前提で、immutableな計算とは相性がよくない。
シグネチャを決める。
abc401f :: Int -- N1
-> [[Int]] -- u_1,i, v_1,i
-> Int -- N2
-> [[Int]] -- u_2,i, v_2,i
-> Int -- 答え
abc401f n1 uvs1 n2 uvs2 = ...
自分の考えた解法は、公式解説のやり方の、後半は二分探索なものだった。
まず、両方の木を、いつものグラフ表現に直す。uvs1, uvs2 からそれを作る関数を立てる。
import Data.Array.Unboxed
-- グラフの隣接リスト表現
type Graph = Array Int [Int]
-- グラフ配列を作る
gArray :: Int -> [[Int]] -> Graph
gArray n uvs = accumArray (flip (:)) [] (1,n) $ concat [[(u,v),(v,u)] | u:v:_ uvs]
この木に対して、直径の両端の頂点を特定し、
全ての頂点に対して、両者からの距離の大きい方を割り当てる。
ついでに、その最大値が直径になるのでその値も得ておく。
これをするには、まず任意の葉 v1 を適当に選び、そこから最も遠い葉 v2 を見つける。これが一端になる。
そこから最も遠い葉 v3 がもう一端になる。
import Data.Function
-- 木の各頂点から最も遠い頂点までの距離をそれぞれ求める 最大値たる直径もついでに返す
radDists :: Graph -> (Int, UArray Int Int)
radDists g = (rad, res)
where
v1 = head [v | (v,[_]) assocs g]
(v2, _) = maximumBy (compare `on` snd) $ dfs v1 v1 (0 :: Int) []
dfs p v d rest = (v, d) : foldr (c -> dfs v c (succ d)) rest [c | c g ! v, c /= p]
distV2 = array (bounds g) $ dfs v2 v2 0 []
(v3, rad) = maximumBy (compare `on` snd) $ assocs distV2
res = accum max distV2 $ dfs v3 v3 0 []
ちなみに、dfs の定義を横着して
dfs p v d = (v, d) : [vd | c g ! v, c /= p, vd dfs v c (succ d)]
のようにすると、concat が起きまくってTLEする。
ここまでを abc401f 本体から使っておく。
abc401f :: Int -> [[Int]] -> Int -> [[Int]] -> Int
abc401f n1 uvs1 n2 uvs2 = ...
where
(r1, ds1) = radDists $ gArray n1 uvs1 -- 木1の直径、各頂点からの最大距離
(r2, ds2) = radDists $ gArray n2 uvs2 -- 木2の (ry
r12 = max r1 r2 -- d1 + 1 + d2 より大きいかもしれない直径
木1の頂点 $i$ 木2の頂点 $j$ を結んだ辺を通る最長の経路の長さは $ds1[i] + 1 + ds2[j]$ で、これが $r12$ 以下ならこちらを選ぶ。
一つの $ds1[i]$ の値に対して、$ds2[cdot]$ の値を一括で処理したい。
$r12 r12 – 1 – ds1[i]$ である
$j$ の個数と、そのような $ds2[j]$ の総和を $ds1[i]$ に対して与える IntMap が必要である。
ある $i$ に対して個数が $cnt$、$ds2[j]$ の総和が $sum$ であるとき、$i$ に関する答えの値は
$cnt (ds1[i] + 1) + sum + (N2 – cnt) cdot r12 = cnt (ds1[i] + 1 – r12) + sum + r12 cdot N2$
と求められる。
キーとする値のリストが与えられたとき、そのキーに対して与えられた関数を適用したものを値とするマップを作り、
さらにそれを大きい方からの累積和に置き換えたマップを作る関数を用意する。
import qualified Data.IntMap as IM
mkMap :: (Int -> Int) -> [Int] -> IM.IntMap Int
mkMap f xs = IM.fromDistinctAscList $ zip (IM.keys im0) $ scanr1 (+) $ IM.elems im0
where
im0 = IM.fromListWith (+) $ (maxBound, 0) : [(x, f x) | x xs]
関数として const 1 を与えると個数、id を与えると値の累積和として使える。
そのように本体から使う。
-- ds2の要素について、より大きい値の個数と、その値の総和を持つIntMap
cntD2 = mkMap (const 1) $ elems ds2
sumD2 = mkMap id $ elems ds2
$ds1[i]$ のそれぞれの値に対して答えを求め、総和をとると答えになる。
abc401f n1 uvs1 n2 uvs2 = sum
[ n2 * r12 + c * (succ d1 - r12) + s
| d1 elems ds1, let t = pred r12 - d1
, let Just (_,c) = IM.lookupGT t cntD2
, let Just (_,s) = IM.lookupGT t sumD2 ]
where
...
前半の、各頂点からの最大距離を求める計算は、全方位木DPという技法が使えるとあるが、
それをマスターしていないのでよくわからない。
後半の、$ds1[i]$ に対する $cnt, sum$ を求める計算は、
$ds1[cdot], ds2[cdot]$ の両方をソートしてからとりかかると、
$ds1[i]$ が大きくなるにつれて $ds2[j]$ の境界は減少する一方であり、
二分探索で探す代わりに、大きい方から線形探索し、
次の $ds1[i+1]$ について探すときは続きからやることで、
全体で $O(N_1 N_2)$ でなく $O(N_2)$ だけで済む、という尺取法が使える。
順に舐めていくので累積和も同時に計算できてしまう。すごい。
後半をFFTを用いて求める別解が 解説 by shobonvip で述べられている。
しかし、AtCoder Library の convolution_ll は、
「素数で割った余りを求めない畳み込み」を求めている風ではあるが、
実のところ、「素数で割った余りを求める畳み込み」を複数の素数で行った結果から
中国剰余定理で真値を推測するという仕組みではなかったか。
シグネチャを決める。
abc401g :: Int -- N
-> [[Int]] -- sx_i, sy_i
-> [[Int]] -- gx_i, gy_i
-> Double -- 答え
わからないのでヒントをください。
フレンズさんいわく
アライグマ「G問題は、答えを二分探索なのだ！
「t秒以内にできるか？」の判定問題を考えると二部マッチングになるのだ！」
「二部マッチング」というキーワードで検索すると、蟻本がバイブルらしい。
手許にあるのは古い方だけど書いてあった。
ネットワークフローを計算する Dinic 法を応用するのだと。
さらに、二部マッチング問題の性質を利用したより簡潔なアルゴリズムが載っている。
これをスタート地点にしよう。
// は原文のコメント、/// は自分が追加した解釈。
int V; // 頂点数
vectorint> G[MAX_V]; // グラフの隣接リスト表現
int match[MAX_V]; // マッチングのペア
bool used[MAX_V]; // DFSですでに調べたかのフラグ
// uとvを結ぶ辺をグラフに追加する
void add_edge(int u, int v) {
G[u].push_back(v);
G[v].push_back(u);
}
// 増加パスをDFSで探す
bool dfs(int v) {
used[v] = true;
for (int i = 0; i G[v].size(); i++) { /// v から生えている全ての辺について調べる
int u = G[v][i], w = match[u]; /// u がもう一端、w がuが既にマッチしている相手
if (w 0 || !used[w] && dfs(w)) { /// uはまだマッチしていない、または、usedでなく、再帰的にdfsした結果がtrueなら
match[v] = u; /// vとuはマッチしたとして記録して
match[u] = v;
return true; /// 成功を返す
}
}
return false; /// どの辺も失敗したなら失敗
}
// 二部グラフの最大マッチングを求める
int bipartite_matching() {
int res = 0;
memset(match, -1, sizeof(match)); /// match[]を-1に初期化
for (int v = 0; v V; v++) { /// vを順に調べる
if (match[v] 0) { /// 以前のvによってマッチが決まっていないならする
memset(used, 0, sizeof(used)); /// used[]を0に初期化
if (dfs(v)) { /// dfsして、上手くいったら成功数を1増やす
res++;
}
}
}
return res;
}
match に対応がとれた相手が保存される。初期値 -1 のときはまだ対応がない。used は dfs() を始めるたびにリセットされる。res がインクリメントされるのはbipartite_matching()の中だけで、vごとに一度しか機会はないので、漏れなくマッチがとれるかを判定する使い方のときは、一度でも失敗したらそこで終了にできる。
drkenさんの記事の最大二部マッチング問題の適用例を解くプログラムで実装を試みる。
男1～10に番号1～10、女1～10に番号11～20を割り当てる。
上の match, used は大域的な状態で、State モナドを使うか持ち回すかする必要がある。
ここでは持ち回している。dfsの引数2はusedで、最初に起動するときに新規作成、フラグを立てるのは呼び出し側の責務。
ループで調べるuの候補をoppoで作るのも呼び出し側の仕事で、
このHaskell版のdfsは上のC++版のdfs()のforループの部分だけに対応する。
ループが途中脱出を含むのでこんな形になってしまった。
import Data.Array
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
-- テストデータ 添字は（男番号, 女番号）
g :: Array (Int, Int) Bool
g = listArray ((1,11),(10,20)) $ map ('1' ==) $
"1001000010" ++
"0001001000" ++
"0100010001" ++
"0001000000" ++
"0010010001" ++
"1000100100" ++
"0001001000" ++
"1010000010" ++
"0100100000" ++
"0001000000"
type Match = IM.IntMap Int
type Used = IS.IntSet
findMatch = foldl step IM.empty [1 .. 20] -- 全参加者について処理、dfsでmatchの更新を試みる
where
step match v
| IM.member v match = match -- マッチが決まっていたらやることなし
| otherwise = finalize $ dfs match (IS.singleton v) v (oppo v) -- dfsした最終結果のmatchを返す
finalize (_,m,_) = m
oppo v -- v に隣接する頂点リストを g から作る
| v 10 = [u | u [11 .. 20], g ! (v,u)]
| otherwise = [u | u [ 1 .. 10], g ! (u,v)]
dfs :: Match -> Used -> Int -> [Int] -> (Bool, Match, Used)
dfs match used _v [] = (False,match,used)
dfs match used v (u:us)
| IM.notMember u match = (True, adduv match, used)
| IS.member w used = dfs match used v us
| succeeded = (True, adduv match1, used1)
| otherwise = dfs match1 used1 v us
where
adduv = IM.insert u v . IM.insert v u
w = match IM.! u
(succeeded, match1, used1) = dfs match (IS.insert w used) w (oppo w)
これをいじくることで、さらにいくつかの性質が見えてきた。
v,w に入る頂点は左側、u に入る頂点は右側のものだけbipartite_matching()のループは左側の頂点だけやればよい。
foldl は [1 .. 10] で十分。oppo も引数は男だけ、結果は女だけ。場合分け不要。ある距離を上限とし、高橋くんからボタンまでの距離が上限以下のものはマッチできるというグラフについて、
二部マッチングが完成するかを判断する二分探索を行う。
高橋くんからボタンまでの距離の最小は1、最大は $sqrt{2} times 10^{18}$ となる。
この範囲の実数で二分探索し、反復の差分が $10^{-6}$ 以下になったところで止めれば題意を満たせる。
しかし、任意の距離で調べる必要はなく、答えになる可能性のある距離は、
高橋くんからボタンまでの距離 $N^2$ とおりのうちのいずれかである。
なので、それら最大 $300^2$ とおりの場合だけ離散的に試す二分探索で足りるし、厳密解が得られる。
距離を計算するために、座標成分ごとの差の二乗を計算する。
$10^{18}$ はぎりぎり Int に収まるが、その二乗はあふれる。
ここで Integer を使う選択肢もあるが、早めに Double に変換してしまうことにする。
ただし、二分探索の間は距離の二乗のままで進めて、最後に答えだけ平方根をとる。
immutableな二部マッチングのままで試したもの：TLEx12
二部マッチングの計算を ST モナドでmutableに実装したものAC, 821ms, 36MB
Be the first to comment
